CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug015.ark / KERNL.ASM < prev next >

Wrap

Assembly Source File | 1984-04-29 | 56.4 KB | 1,737 lines

TITLE 'THE KERNEL SUBROUTINES' ;NOTE: Small letters will denote the contents of locations referred to ; by capital letters. For example, cpp = (CPP), a = (A), etc. ;NMPCB = Total number of PCBs allocated to the operating system ;NMMB = Total number of message buffers allocated to the system ;MBPP = Number of message buffers allotted to each process ;NMPR = Number of priorities allowed ; 0 < NMPCB , NMMB 0 < NMPR NMPCB < 32 ; 0 < cpp =< NMPCB NMPCB EQU 5 MBPP EQU 5 NMMB EQU NMPCB*MBPP NMPR EQU 5 MASKQ EQU 1 MASKM EQU 2 MASKA EQU 4 ISIS EQU 64 ; ISIS entry point LOAD EQU 6 ERROR EQU 12 ; MACROS ; ------ ;Register indexed address: RXAD MACRO REGPR,BSADD ; (H&L) _ regpr + BSADD LXI H,BSADD DAD REGPR ENDM ;Register indexed load: RXLD MACRO REG,REGPR,BSADD ; reg _ (regpr + BSADD) RXAD REGPR,BSADD MOV REG,M ENDM ;Register indexed store RXST MACRO REG,REGPR,BSADD ; (regpr + BSADD) <- reg RXAD REGPR,BSADD MOV M,REG ENDM ;Register direct load RDLD MACRO REG,ADDR ; reg <- (ADDR) LXI H,ADDR MOV REG,M ENDM JNZR MACRO REG,LABEL ; If reg is not 0, then jump to LABEL XRA A CMP REG JNZ LABEL ENDM JZR MACRO REG,LABEL ; If reg=0 , then jump to LABEL XRA A CMP REG JZ LABEL ENDM M6A MACRO ; d <- 0 , e <- 6*a RLC MOV E,A ; e <- 2*a RLC ADD E ; a <- 6*a MOV E,A MVI D,0 ENDM STDM MACRO ; (D&E) is stored at address in (H&L) MOV M,E INX H MOV M,D ENDM STORE MACRO PUSH PSW PUSH H PUSH D PUSH B LDA CPP ; Now to load STKP with sp RLC MOV E,A MVI D,0 ; d _ 0 RXAD D,STKP XCHG LXI H,0 DAD SP XCHG ; (D&E) <- sp ; (H&L) <- address of STKP MOV M,E INX H MOV M,D ENDM RSTOR MACRO RLC ; First to load sp with value from STKP MOV C,A RXAD B,STKP MOV E,M INX H MOV D,M XCHG SPHL POP B POP D POP H POP PSW ENDM TRNAM MACRO ;Transfer 6 bytes starting in location indicated by H&L to location ;indicated by D&E. Note that b = 0 at end. MVI B,6 XX: MOV A,M STAX D DCR B JZ YY+3 INX D INX H YY: JMP XX ENDM UNLNK MACRO LAST,NEXT ;Unlink a PCB with index t (which is held in B&C) from the doubly- ;linked list which uses pointers LAST and NEXT. We assume that ; e = NEXT[t] and a = t . RXLD C,B,LAST ; c <- (LAST[t]) = x RXST E,B,NEXT ; (NEXT[x]) <- e RXST C,D,LAST ; (LAST[y]) <- x MOV C,A ; Restore t to C ENDM ORG 8000H ; Origin is set to 32K ; THE DATA STRUCTURE ; ------------------ CPP: DB 1 AP: DB 0 FP: DB 1 FMBP: DB 1 AS: DB 1 DB 0 PRP: ORG $ + NMPR NMR: ORG $ + NMPR ; The storage allocated to the message buffers MBSP EQU $ - 1 ORG $ + NMMB NMBP EQU $ - 1 ORG $ + NMMB ASTAT EQU $ - 1 ORG $ + NMMB MESS EQU $ - 2 ORG $ + 2*NMMB ; The storage allocated to the PCBs BLOCKED bit NAM EQU $ - 6 ; PROGRAM bit | ORG $ + 6*NMPCB ; : : EXC EQU $ - 1 ; (EXC[t]) = XX0000XX ORG $ + NMPCB ; ^ ^ PR EQU $ - 1 ; | STOPPED bit ORG $ + NMPCB ; RESIDENT bit MBC EQU $ - 1 ORG $ + NMPCB WDMK EQU $ - 1 ORG $ + NMPCB RDMK EQU $ - 1 ORG $ + NMPCB FMP EQU $ - 1 ORG $ + NMPCB FQP EQU $ - 1 ORG $ + NMPCB FAP EQU $ - 1 ORG $ + NMPCB ABP EQU $ - 1 ORG $ + NMPCB NSWP EQU $ - 1 ORG $ + NMPCB SEMP EQU $ - 1 ORG $ + NMPCB LAP EQU $ - 1 ORG $ + NMPCB NAP EQU $ - 1 ORG $ + NMPCB LP EQU $ - 1 ORG $ + NMPCB NP EQU $ - 1 ORG $ + NMPCB DSM EQU $ - 2 ORG $ + 2*NMPCB STAD EQU $ - 2 ORG $ + 2*NMPCB STKP EQU $ - 2 ORG $ + 2*NMPCB STACK EQU $ - 10 ; Used to store the register pairs B, ORG $ + 10*NMPCB ; D, H, and also the PSW and PLC ; THE KERNEL SUBROUTINES ; ---------------------- ; SCHED (INDEX) ;It is assumed that interrupts were disabled before the scheduler ;was called. The integer INDEX is passed to the routine in the B ;register and has the following interpretation: ; INDEX action to be taken and initial data ; --------------------------------------------------------------- ; 0 If there is another ready process of the same pri- ; ority as the current one, then the next such after ; the current one is scheduled. (The current process ; will be rescheduled if it is the only ready process ; in its queue.) Otherwise, we try to schedule the ; first ready process of lower priority. If there is ; none, then we HALT. We assume that ; c = q = (PR[cpp]). ; > 0 The process corresponding to the PCB with index ; INDEX is scheduled. We assume that ; c = r = (PR[INDEX]). ;At the end we have b = 0. SCHED: STORE MOV A,B MVI B,0 ORA A JZ ROBIN ; Jump is INDEX = 0 SCH00: ; Entry point for initialization ; routine STA CPP ; cpp _ INDEX MOV E,A ; e <- INDEX MOV D,B ; d <- 0 RXLD E,D,NAP ; e <- x = (NAP[INDEX]) RXST E,B,PRP ; (PRP[r]) <- x ; PRP[r] now points to the PCB following the one with ; index INDEX SCH0: RSTOR EI RET ; Return ROBIN: RXLD A,B,NMR ; a _ (NMR[q]) ORA A JZ SCH2 ; Jump if there is no ready process ; of priority q ; The case where (NMR[q]) > 0 RXLD E,B,PRP ; e _ t = (PRP[q]) MOV D,B ; d <- 0 SCH1: RXLD A,D,EXC ; a _ (EXC[t]) ANI 00000010B JNZ NEXT ; Jump if this process is BLOCKED RXLD A,D,NAP ; a <- (NAP[e]) RXST A,B,PRP ; The priority pointer is set ; to the process after the one ; that is now being scheduled LXI H,CPP MOV M,E ; cpp <- t MOV A,E JMP SCH0 NEXT: RXLD E,D,NAP ; e _ (NAP[t]) JMP SCH1 SCH2: INR C ; Case where (NMR[q]) = 0 MVI A,NMPR ; a _ NMPR SUB C JP ROBIN ; Jump if q =< NMPR EI HALT: HLT ; Case of no ready processes ; P [ID,SEM] ;SEM is the address of the semaphore and is passed to the routine in ;the D and E registers. ID is a 1 byte integer specifying which global ;semaphore SEM is referring to, if any. It is passed to the routine ;in the C register. ; ID semaphore ; ----------------------------------------------------- ; 2 AS ; 0 DSM or any other semaphore local ; to a process ;Neither b nor c may be zero at the end if the semaphore had a ;non-zero value. P: DI XCHG JZR M,PZZ ; Jump if value of semaphore is 0 DCR M ; Decrease value of semaphore by 1 EI RET ; Return PZZ: MOV A,C ; a _ ID XCHG RDLD C,CPP ; c <- cpp MVI B,0 ; b _ 0 RXST A,B,SEMP ; (SEMP[cpp]) <- ID XCHG INX H ; (H&L) _ address of FWP[SEM] MOV E,M ; e _ t = index of first process R ; waiting on this semaphore MOV D,B ; d _ 0 XRA A PXX: CMP E JNZ PNXT ; Jump if other processes waiting ; on semaphore MOV M,C ; fwp or (NSWP[t]) _ cpp RXST B,B,NSWP ; (NSWP[cpp]) <- 0 RXLD A,B,EXC ; a <- (EXC[cpp]) ORI 00000010B MOV M,A ; BLOCKED bit of current process ; has been set to 1 RXLD C,B,PR ; c <- q = (PR[cpp]) RXAD B,NMR ; (H&L) <- address of NMR[q] DCR M ; (NMR[q]) _ (NMR[q])-1 JMP SCHED ; Note that b = 0 and c = q PNXT: RXLD E,D,NSWP ; e _ (NSWP[t]) JMP PXX ; V [SEM] ;SEM is the address of the semaphore and is passed to the routine ;in the B and C registers. ;NOTE. The D register is not used. V: DI MOV H,B MOV L,C SHLD VTMP1 ; Store the address of the semaphore INX H ; (H&L) _ address of FWP[SEM] VXX: JNZR M,VYY ; Jump if at least one (other) process ; is waiting on this semaphore LHLD VTMP1 ; (H&L) _ address of VAL[SEM] INR M ; Increase value of the semaphore by 1 VOUT: EI RET VYY: SHLD VTMP2 ; Store address of the FWP or NSWP[t] MOV C,M ; c _ t = index of the next PCB whose ; corresponding process R is waiting ; on this semaphore MVI B,0 ; b _ 0 (b may be non-zero from START) RXLD A,B,EXC ; a _ (EXC[t]) RRC JNC VZZ ; Jump if Rs STOPPED bit is 0 RXAD B,NSWP ; (H&L) _ address of NSWP[t] JMP VXX VZZ: RLC ANI 01000000B MOV M,A ; EXC[t] now has BLOCKED (and ; STOPPED) bit set to 0 RXST B,B,SEMP ; (SEMP[t]) <- 0 RXLD A,B,NSWP ; a _ (NSWP[t]) LHLD VTMP2 ; Load address of FWP or previous NSWP MOV M,A ; R has now been removed from the queue ; of processes waiting on semaphore RXLD A,B,PR ; a _ r = (PR[t]) MOV E,C ; e _ t , i.e., store t MOV C,A ; c <- r RXAD B,NMR ; (H&L) <- address of NMR[r] INR M ; NMR[r] <- NMR[r] + 1 RDLD C,CPP ; c <- cpp RXAD B,PR ; (H&L) _ address of PR[cpp] CMP M JP VOUT ; Jump if r q = (PR[cpp]) ; Case where r < q MOV C,A ; c _ r MOV B,E ; b _ t JMP SCHED VTMP1: DW 0 VTMP2: DW 0 ; RESULT := SCAN (NAME) ;NAME is passed to this routine in the H and L registers and is the ;address of the new name. The routine returns an integer RESULT in ;the A register with the following interpretation: ; RESULT Meaning ; ------------------------------------------ ; 1 name belongs to a process ; 2 name belongs to a program ; 3 name not found ;At the end, the C register will contain the index t of the last PCB ;scanned. If RESULT is 1 or 2, then b = 0 . SCAN: SHLD LBLK ; Store NAME in LBLK (from parameter ; block for ISIS load routine) LDA AP ; A now holds the index t of the first ; PCB to look at. We assume that t 0. SC1: MOV C,A ; c _ t M6A ; d _ 0 , e _ 6*t RXAD D,NAM XCHG ; (D&E) _ address of NAM[6*t] LHLD LBLK ; (H&L) _ NAME MVI B,6 NXTCH: LDAX D ; Next character of name in PCB is ; loaded into A CMP M JZ MTCH ; Jump if characters match MVI B,0 ; Reset B to 0 RXLD A,B,NP ; a _ (NP[t]) ORA A JNZ SC1 ; Jump if there are more processes ; to scan MVI A,3 ; RESULT _ 3 RET ; Case where name was not found MTCH: DCR B ; b _ b-1 JZ SC2 ; Jump if all 6 characters match INX D INX H JMP NXTCH ; Case where a PCB with the right name was found. Register C ; contains the index of that PCB. Also, b = 0. SC2: RXLD A,B,EXC ; a _ (EXC[t]) RLC JC SC3 ; Jump if this PCB corresponds to a ; program MVI A,1 ; RESULT _ 1 RET SC3: MVI A,2 ; RESULT _ 2 RET ; RESULT := CREA ;This subroutine performs the basic function of setting up a PCB for a ;program which either is already in memory or which has been loaded ;into memory from the disk. It is assumed that LBLK holds the address ;of the name of the process which is to be created. The routine re- ;turns an integer RESULT in the D register which specifies any errors ;that may have occurred: ; RESULT Status ; ------------------------------------------------------ ; 0 no error ; 1 error while attempting to load file from ; disk - probably no file with that name ; 3 no free PCBs available CREA: DCR A JZ CR0 ; Jump if name corresponds to a program CR00: MVI C,LOAD ; Entry point for initialization ; routine LXI D,LBLK CALL ISIS ; Load program from disk using ISIS LDA STAT ; Test error status ORA A JZ CR1 ; Jump if no error in loading ; Case of error while attempting to load file from disk. Note ; that ISIS specifies the error. MVI C,ERROR LXI D,EBLK CALL ISIS ; Type out error message on console MVI D,1 ; RESULT _ 1 RET ; Case where name corresponded to a program. We assume that ; b = 0 and c = t , where t is the index of the PCB for this ; program. CR0: RXLD A,B,EXC ; a _ (EXC[t]) ANI 01000000B ORI 00000001B MOV M,A ; (EXC[t]) _ 0X000001 ; NOTE: Setting EXC here means that in START we have to reset ; the STOPPED bit to 0; however, we save fetching EXC in CREAT. MOV A,C ; a _ t M6A ; d _ 0 , e _ 6*t JMP INIT ; Program is now loaded CR1: LXI D,FP ; (D&E) _ address of FP LDAX D ; a _ fp ORA A JNZ CR2 ; Jump if a free PCB is available ; No more free PCBs are available MVI D,3 ; RESULT _ 3 RET CR2: MOV C,A ; C now holds the index t of a free PCB MVI B,0 ; b _ 0 RXLD A,B,NP ; a _ (NP[t]) STAX D ; The FP is updated ; Now to store the name of the process in the PCB name field. MOV A,C ; a _ t M6A ; d _ 0 , e _ 6*t RXAD D,NAM XCHG ; (D&E) _ address of NAM[6*t] LHLD LBLK ; (H&L) _ NAME TRNAM ; Transfer name CR4: RXAD B,EXC ; (H&L) _ address of EXC[t] MVI M,00000001B ; (EXC[t]) _ 00000001, i.e., STOPPED ; bit is set LHLD ENTRY XCHG RXAD B,STAD DAD B ; (H&L) <- address of STAD[2*t] STDM ; Note that b = 0 , that the execution-state field has been set ; to 0X000001 , and that STAD[2t,2t+1] contains the initial ; starting address of this process. ; Next we initialize the remaining fields of the PCB. INIT: RXAD B,PR MVI M,4 ; (PR[t]) _ 4 , i.e., the priority is ; set to a default value of 4 LXI D,NMPCB ; Note that we still have d = 0 DAD D MVI M,MBPP ; (MBC[t]) _ MBPP ; The WDMK, RDMK, FMP, FQP, FAP, ABP, NSWP, SEMP, LAP, NAP, ; and LP for this process are now set to 0 . MVI A,11 CR5: DAD D MVI M,0 DCR A JNZ CR5 ; Now to link the PCB at the head of the all-PCB-queue and to ; update the AP. DAD D ; (H&L) _ address of NP[t] LDA AP MOV M,A ; (NP[t]) _ ap ORA A JZ CR6 ; Jump if ap = 0. This case occurs ; only during initialization MOV E,A ; e _ ap RXST C,D,LP ; (LP[ap]) <- t CR6: MOV A,C ; a _ t STA AP ; ap _ t ; Next to set the DSM and STKP RLC ; a _ 2*t MOV E,A ; e _ 2*t RLC ; a _ 4*t ADD C ; a _ 5*t MOV L,A ; l _ 5*t MOV H,B ; h _ 0 DAD H XCHG ; (D&E) _ 10*t MOV C,L ; c _ 2*t RXST B,B,DSM ; The DSM field is set to 0 INX H ; " " " MOV M,B ; " " " RXAD D,STACK ; (H&L) _ address of STACK[10*t] XCHG RXAD B,STKP ; (H&L) _ address of STKP[2*t] STDM ; (STKP[2*t]) _ address of STACK[10*t] XCHG ; (H&L) _ address of STACK[10*t] ; Now to set the top 8 bytes of the stack to 0 so that ; when a process is scheduled for the first time its ; registers will all be initialized to 0 MVI A,8 CR7: MVI M,0 INX H DCR A JNZ CR7 XCHG ; (D&E) _ address of STACK[10*t+8] RXLD A,B,STAD STAX D INX D INX H MOV A,M STAX D ; The starting address for the new pro- ; gram is now stored at the bottom of ; the stack. This address is loaded ; into the PLC when the process is ; started. MOV D,B ; RESULT _ 0 RET ; Note that c = 2*t and b = 0 . ; RESULT := CREAT (NAME) ;NAME is passed to this routine in the B and C registers and is the ;address of the name of the process to be created. The routine re- ;turns an integer RESULT in the A register with the following in- ;terpretation: ; RESULT event ; ------------------------------------------------------------ ; 0 routine completed its task successfully ; 1 error while attempting to load file from ; disk - probably no file with that name ; 2 name already used by another process ; or program ; 3 no more PCBs available CREAT: PUSH B ; Store NAME on the process stack ; Note that an interrupt could occur ; here, so that one cannot simply ; store NAME in memory LXI D,AS MVI C,2 CALL P ; P[AS] POP H ; (H&L) _ NAME CALL SCAN SUI 3 JM CR10 ; Jump if name not found among current ; process or program names MVI D,2 ; RESULT _ 2 ; NOTE: EXIT is a global address which is used by almost all ; the routines. EXIT: LXI B,AS CALL V ; V[AS] MOV A,D ; Set RESULT RET CR10: CALL CREA JMP EXIT ; The parameter block for the ISIS load routine. It is used by ; the routines SCAN, CREA, CREAT, START LBLK: DW 0 ; Pointer to filename BIAS: DW 0 ; Bias address RETSW: DW 0 ; Return switch DW ENTRY ; Starting address for the program ; which was loaded DW STAT ; Status (returned) ENTRY: DS 2 EBLK: ; The parameter block for the ISIS ; error routine (used by CREA). STAT: DS 2 DW STAT ; RESULT := START (NAME,PRIORITY) ;NAME is passed to this routine in the B and C registers and is the ;address of the name of a process which is to be started. The E ;register holds the integer PRIORITY which specifies the priority ;that the new process is to have. A value of 0FFH for PRIORITY is ;interpreted to mean that the new process is to be started with ;whatever priority it already had. RESULT is an integer which is ;returned by the routine in the A register. It has the following ;interpretation: ; RESULT event ; ------------------------------------------------------------ ; 0 routine completed its task successfully ; 1 error while attempting to load file from ; disk - probably no file with that name ; 2 specified process was not stopped START: PUSH D ; Store PRIORITY on the stack PUSH B ; Store NAME on the stack LXI D,AS MVI C,2 CALL P ; P[AS] POP H ; (H&L) _ NAME CALL SCAN DCR A JNZ NTFND ; Jump if name not found among current ; process names ; Note that C now contains the index t of the PCB with the name ; we were looking for and that b = 0 . ; Now to check the STOPPED bit RXLD A,B,EXC ; a <- (EXC[t]) RRC JC ST1 ; Jump if process was stopped MVI D,2 ; RESULT <- 2 ST0: POP H ; So as not to leave PRIORITY on ; stack JMP EXIT ; Next to store the status of the BLOCKED bit ST1: RLC ; a <- (EXC[t]) ANI 01000010B MOV M,A ; STOPPED bit in EXC[t] has now ; been set to 0 ANI 00000010B ST2: STA ST4+1 ; Store the BLOCKED bit for check- ; ing later ; Now to store PRIORITY POP D ; e <- PRIORITY MOV D,B ; d <- 0 MVI A,0FFH ; a <- 0FFH CMP E RXAD B,PR ; (H&L) <- address of PR[t] JNZ ST7 ; Jump if priority is to be changed MOV E,M ; e <- old priority ; Next to compare the priority q of the new process ; with r = (PR[cpp]) ST3: MOV A,E ; a <- q RDLD E,CPP ; e <- cpp RXAD D,PR ; (H&L) <- address of PR[cpp] CMP M PUSH PSW ; Save comparison of q and r ; Next to check the BLOCKED bit MOV E,A ; e <- q ST4: MVI A,0 ; NOTE: The BLOCKED bit has been ; stored here by an earlier ; instruction ORA A ; Test the BLOCKED bit JNZ ST5 ; Jump if the new process is blocked RXAD D,NMR INR M ; (NMR[q]) <- (NMR[q])+1 ; Now to link the new PCB into the appropriate active queue ; at the correct place. ST5: RXAD D,PRP ; (H&L) <- address of PRP[q] JZR M,ST9 ; Jump if there are no processes ; of priority q POP PSW ; Restore comparison of q and r. ; Note that a <- q . PUSH PSW ; Resave comparison for later JNZ ST8 ; Jump if r does not equal q . ; Note that e = q . ;Case where q = r RDLD E,CPP ; e <- cpp CALL LINK ; Link the new PCB in front of the ; PCB for the current process ; Now to check if cpp = (PRP[q]) MOV E,A ; e <- q LDA CPP RXAD D,PRP ; (H&L) <- address of PRP[q] CMP M JNZ ST6 ; Jump if cpp and (PRP[q]) are ; unequal MOV M,C ; (PRP[q]) <- t ST6: POP PSW ; Restore the sign bit JP EXIT ; Jump if q >= r ; Case where the new process has higher priority than the ; current one, so that it should be scheduled to run MOV B,C ; b <- t MOV C,E ; c <- q PUSH B ; Store q and t LXI B,AS CALL V ; V[AS] POP B DI JMP SCHED ST7: MOV M,E ; (PR[t]) _ PRIORITY JMP ST3 ; Case where r does not equal q ST8: MOV E,M ; e <- (PRP[q]) CALL LINK ; Link the new PCB in front of the ; PCB pointed to by the PRP[q] ; pointer JMP ST6 ST9: MOV M,C ; (PRP[q]) <- t RXST C,B,NAP ; (NAP[t]) <- t RXST C,B,LAP ; (LAP[t]) <- t JMP ST6 NTFND: CALL CREA JNZR D,ST0 ; Jump if error in program loading MOV A,C ; a _ 2*t , where t is the index of ; the newly created PCB RRC MOV C,A ; c _ t RXLD A,B,EXC ; a <- (EXC[t]) ANI 01000000B MOV M,A ; (EXC[t]) <- 0X000000 XRA A ; a <- 0 JMP ST2 ; LINK ;This subroutine is used by START to link the PCB with index c in ;front of the PCB with index e into the doubly-linked ready list. LINK: RXST E,B,NAP RXLD E,D,LAP MOV M,C RXST C,D,NAP RXST E,B,LAP RET ; STOP0 ;The main task of this routine is to unlink a process PCB from the ;ready queue and to adjust the relevant priority pointer. It is ;called by both the STOP and REMOV routines. We assume that b=0 , ;c=t , and a=( (EXC[t]) shifted right 1 ) , where t is the index ;of the PCB whose corresponding process is to be stopped. Also, ;registers H and L are assumed to hold the address of EXC[t]. ;We still have b = 0 and c = t at the end. STOP0: RLC ORI 00000001B MOV M,A ; Set STOPPED bit to 1 ANI 00000010B RXLD E,B,PR ; e _ q = Qs priority MOV D,B ; d _ 0 JNZ STP01 ; Jump if Q is blocked RXAD D,NMR ; (H&L) _ address of NMR[q] DCR M ; (NMR[q] _ (NMR[q])-1 ; Now to remove the process from its circular list of active ; processes STP01: RXLD A,B,NAP ; a _ (NAP[t]) = y RXAD D,PRP ; (H&L) _ address of PRP[q] CMP C JZ STP03 ; Jump if Q was the only active ; process of priority q , i.e., y = t MOV E,A ; e <- y MOV A,C ; a <- t CMP M JNZ STP02 ; Jump if t is unequal to (PRP[q]) MOV M,E ; (PRP[q]) _ y STP02: UNLNK LAP,NAP ; Unlink Qs PCB from active list RET STP03: MOV M,B ; (PRP[q]) _ 0 ; List of active priority-q processes ; is now empty. RET ; RESULT := STOP (NAME) ;NAME is passed to this routine in the B and C registers and is the ;address of the name of a process which is to be stopped. If b = 0 , ;then the current process is trying to stop itself. RESULT is an ;integer which is returned by the routine in the A register. It ;has the following interpretation: ; RESULT event ; ------------------------------------------------------------- ; 0 routine completed its task successfully ; 1 name not found among current process names STOP: PUSH B ; Store NAME on the stack LXI D,AS MVI C,2 CALL P ; P[AS] POP H ; (H&L) _ NAME JZR H,STP2 ; Jump if current running process is ; trying to stop itself CALL SCAN DCR A JZ STP1 ; Jump if name found among current ; processes MVI D,1 ; RESULT _ 1 JMP EXIT ; See CREAT ; We now have c = 0 and b = t , where t is the index of the ; PCB with the name of the process Q that we were looking for. STP1: RXLD A,B,EXC ; a _ (EXC[t]) RRC JC EXIT ; Jump if process was STOPPED CALL STOP0 JMP EXIT ; Note that d = 0 ; Case where process is trying to stop itself. STP2: RDLD C,CPP ; c <- cpp MVI B,0 RXLD A,B,EXC ; a _ (EXC[cpp]) CALL STOP0+1 NEWP: ; REMOV uses this entry point RXLD D,B,PR ; d _ q = (PR[cpp]) LXI B,AS CALL V ; V[AS] MOV C,D ; c _ q MVI B,0 ; b <- 0 DI JMP SCHED ; RMV ;This subroutine is called by REMOV to free the resources of the ;process that is about to be removed. RMV: ANI 01000000B JNZ RV11 ; Jump if Q corresponds to a permanent- ; ly resident program RXLD E,B,NP ; e _ (NP[t])=y LDA FP MOV M,A ; (NP[t]) _ fp MOV A,C STA FP ; fp _ t ; Qs PCB is now back on stack of free PCBs LDA AP CMP C JZ RV12 ; Jump if ap = t , i.e., Q is the ; first process in the queue MOV A,C ; a <- t UNLNK LP,NP ; Unlink Qs PCB from the list of ; all PCBs ; Now to return all message buffers RV1: RXAD B,FMP ; (H&L) _ address of FMP[t] JZR M,RV3 ; Jump if message queue is empty PUSH B ; Store t on stack RV2: MOV E,M ; e _ (FMP[t])=z=index of message ; buffer RXLD C,D,MBSP ; c _ (MBSP[z])=u RXAD B,MBC ; (H&L) _ address of MBC[u] INR M ; (MBC[u]) _ (MBC[u])+1 RXAD D,NMBP ; (H&L) _ address of NMBP[z] CMP M ; Note that a = 0 JNZ RV2 ; Jump if more messages in queue ; Now to link all the buffers in the message queue back ; on the free stack LDA FMBP ; a _ fmbp MOV M,A ; (NMBP[z]) _ fmbp POP B RXLD A,B,FMP ; a _ (FMP[t]) STA FMBP ; fmbp _ z ; Now to return all returned-answer buffers RV3: RXAD B,FAP ; (H&L) _ address of FAP[t] JZR M,RV5 ; Jump if answer queue is empty PUSH B MOV E,M ; e _ (FAP[t]) = z , i.e., save ; index of first buffer RV4: MOV C,M ; c _ z RXAD B,NMBP ; (H&L) _ address of NMBP[z] CMP M ; Note that a = 0 JNZ RV4 ; Jump if more buffers LDA FMBP MOV M,A ; (NMBP[z]) <- fmbp MOV A,E ; a _ z STA FMBP POP B ; Now to return all question buffers RV5: LXI H,FQP CALL RMVQA ; Now to return all answer buffers LXI H,ABP CALL RMVQA ; All buffers from message system have now been returned ; Next, to clear those sender fields in the message buffers ; which refer to the process which is being removed MOV A,C ; a <- t LXI D,NMMB INR D LXI H,MBSP RV6: INX H CMP M JNZ RV7 MVI M,0 RV7: DCR E JNZ RV6 DCR D JNZ RV6 ; Finally, to remove Qs PCB from any semaphore queue RXAD B,SEMP ; (H&L) <- address of SEM[t] JNZR M,RV8 RET ; Case where process is waiting on AS semaphore RV8: RXLD C,B,NSWP ; c <- (NSWP[t]) LXI H,AS INX H ; (H&L) <- address of FWP[AS] MOV E,M ; e <- x = index of first process ; waiting on AS RV9: CMP E JZ RV10 RXLD E,D,NSWP ; e <- (NSWP[x]) JMP RV9 RV10: MOV M,C RET ; Note that d = 0 RV11: ORI 10000000B MOV M,A ; Reset EXC field MOV D,B ; d <- 0 JMP RV1 RV12: MOV A,E ; a <- y ORA A ; Test y JZ HALT ; Jump if we were asked to ; remove the only process in ; existence STA AP ; ap <- y JMP RV1 ; RMVQA RMVQA: DAD B JZR M,RV15 PUSH B MOV C,M RV13: RXLD E,B,NMBP MOV M,B ; Set memory to 0 PUSH D RXAD B,ASTAT ; (H&L) _ address of ASTAT[z] MVI M,1 ; (ASTAT[z]) _ 1 RXLD E,B,MBSP MOV B,C MVI C,MASKA ; c _ 00000100 LXI H,FAP CALL SSUB POP B JNZR C,RV13 RV14: POP B RV15: RET ; RESULT := REMOV (NAME) ;NAME is passed to this routine in the B and C registers and is the ;address of the name of a process which is to be removed. If b = 0, ;then the process is trying to remove itself. RESULT is an integer ;which is returned by the routine in the A register with the fol- ;lowing interpretation: ; RESULT event ; ----------------------------------------------------------- ; 0 routine completed its task successfully ; 1 name not found among current processes ; and programs REMOV: PUSH B ; Store NAME on the stack LXI D,AS MVI C,2 CALL P ; P[AS] POP H ; (H&L) _ NAME JZR H,REM3 ; Jump if this process is trying to ; remove itself CALL SCAN SUI 3 JM REM1 ; Jump if name found among current ; processes or programs MVI D,1 ; RESULT _ 1 JMP EXIT ; See CREAT ; We now have b = 0 and c = t , where t is the index of the ; PCB with the name of the process Q that we were looking for. REM1: RXLD A,B,EXC ; a _ (EXC[t]) PUSH H ; Save address of EXC[t] RRC CNC STOP0 ; Stop Q if it is not already stopped ; We still have b = 0 and c = t REM2: POP H ; (H&L) <- address of EXC[t] MOV A,M ; a <- (EXC[t]) CALL RMV JMP EXIT ; Note that d = 0 ; Case where process is trying to remove itself REM3: RDLD C,CPP ; c <- cpp MVI B,0 RXLD A,B,EXC ; a <- (EXC[cpp]) PUSH H ; Save address of EXC[cpp] CALL STOP0+1 POP H ; (H&L) <- address of EXC[cpp] MOV A,M ; a <- (EXC[cpp]) PUSH B CALL RMV POP B JMP NEWP ; See STOP ; THE MESSAGE SYSTEM ------------------ ;The next four subroutines (SENDM, SENDQ, SENDA, and WAIT) form the ;basis for the message system between processes. SENDM allows one ;process to send a message to another. SENDQ also is used to send ;a message, except that this time an answer is expected back. This ;answer is returned by the other process via SENDA. WAIT allows a ;process to wait for either a message, question, answer, or ;interrupt. ;NOTE: MB will be an abbreviation for "message buffer". ; RESULT := SENDM (MESSAGE,NAME) ;For definiteness assume that process Q wants to send a message ;to process R. The 2-byte word MESSAGE is passed in the B&C ;register pair. NAME is passed in the D&E register pair and is ;the address of a 6-byte block in memory containing Rs name. The ;routine returns a 1-byte integer RESULT in the A register with ;the following interpretation: ; RESULT event ; ------------------------------------------------------------ ; 0 The routine completed its task successfully ; 1 no more message buffers available ; 2 receivers name not found among current processes SENDM: CALL SMQ MOV E,C ; e <- t = index of Rs PCB LXI H,FMP MVI C,MASKM CALL SSUB JMP EXIT ; RESULT := SENDQ (ADDRESS,NAME) ;The only difference between this routine and SENDM is that an ;answer is expected back. The parameters are also basically the ;same. The only change is caused by the fact that one can only ;pass two parameters in PL/M. ADDRESS is the address of a 3-byte ;block in memory with the following two fields: ; BID: 1 byte ; QUESTION: 2 bytes which are the question (similar to MESSAGE ; in SENDM) ;The integer BID is returned by the routine and is the index of ;the MB that was used to send the question. It has importance to ;this particular process only in connection with the WAIT routine ;when it awaits the answer. ;RESULT is an integer returned in the A register with the same ;interpretation as in SENDM. SENDQ: PUSH B INX B MOV H,B MOV L,C ; (H&L) <- ADDRESS+1 MOV C,M INX H MOV B,M ; (B&C) <- QUESTION CALL SMQ POP H ; (H&L) <- ADDRESS MOV M,B ; Store BID in appropriate location MOV E,C ; e <- t = index of Rs PCB LXI H,FQP MVI C,MASKQ CALL SSUB JMP EXIT ; RESULT := SENDA (ANSWER,BID) ;ANSWER is a 2-byte word passed in the B&C register pair and BID ;is a 1-byte integer passed in the E register. BID is the index ;of the MB that is to be used to return the answer to the process ;that asked the original question. The routine returns a 1-byte ;integer RESULT in the A register with the following interpreta- ;tion: ; RESULT event ; ------------------------------------------------------------ ; 0 routine completed its task successfully ; 1 the correct buffer for returning the answer ; could not be found ; 2 process to whom answer was to be sent was ; removed SENDA: CALL SA MOV E,B ; e <- t = index of PCB which belongs ; to process to which answer ; is being sent MOV B,C ; b <- BID LXI H,FAP MVI C,MASKA CALL SSUB JMP EXIT ; SMQ ;This subroutine is used by SENDM and SENDQ. SENDA also uses ;part of it. SMQ: PUSH B PUSH D MVI C,2 LXI D,AS CALL P ; P(AS) POP H ; (H&L) <- NAME CALL SCAN CPI 1 JNZ SXX ; Jump if Rs name not found among ; processes ; b = 0 and c = t , where t is the index of Rs PCB RDLD E,CPP ; e <- cpp MVI D,0 RXAD D,MBC ; (H&L) <- address of MBC[cpp] XRA A ; a <- 0 CMP M JZ SYY ; Jump if (MBC[cpp]) = 0 DCR M ; (MBC[cpp]) <- (MBC[cpp]) - 1 RDLD E,FMBP ; e <- BID = fmbp RXLD A,D,NMBP STA FMBP ; fmbp <- (NMBP[fmbp]) MOV B,E ; Store new MB index BID in B RXAD D,MBSP ; (H&L) <- address of MBSP[BID] JMP SMQ1 ; Entry point from SA subroutine SAE: MOV E,C ; e <- BID MVI D,0 MOV B,A ; b <- t SMQ1: LDA CPP MOV M,A ; (MBSP[BID]) <- cpp RXST D,D,NMBP ; (NMBP[BID]) <- 0 RXST D,D,ASTAT ; (ASTAT[BID]) <- 0 RXAD D,MESS DAD D ; (H&L) <- address of MESS[2*BID] POP D ; (D&E) <- MESSAGE or ANSWER STDM ; Store MESSAGE or ANSWER in MESS ; field of MB ; In case of SENDM or SENDQ we now have c = t and ; b = BID RET ; SA ;This subroutine is used by SENDA. SA: PUSH B PUSH D LXI D,AS MVI C,2 CALL P ; P(AS) POP B ; c <- BID MVI B,0 ; Begin searching answer-buffer queue for MB with index BID RDLD E,CPP ; e <- cpp MOV D,B ; d <- 0 RXAD D,ABP ; (H&L) <- address of ABP[cpp] JMP SA2 SA1: LXI H,NMBP MOV E,A DAD D SA2: MOV A,M CMP D JZ SYY ; Jump if no buffer found with index ; equal to BID CMP C JNZ SA1 ; Jump if index of this buffer does not ; equal BID XCHG RXLD A,B,NMBP STAX D ; End of search. Also, buffer has been unlinked from queue. ; Check whether sender of question has been removed in the ; meantime RXLD A,B,MBSP ; (H&L) <- address of MBSP[BID] ; a <- t = (MBSP[BID]) ORA A ; Test if a = 0 JNZ SAE ; Jump if sender not removed ; Case where sender was removed LDA FMBP RXST A,B,NMBP ; (NMBP[BID]) <- fmbp MOV A,C STA FMBP ; fmbp <- BID JMP SXX ; Exit points SXX: MVI D,1 SYY: POP H ; Pop NAME or BID POP H ; Pop return address from SENDX INR D ; Set RESULT JMP EXIT ; SSUB ;This subroutine is used by SENDM, SENDQ, SENDA, and RMV. ;For this subroutine we expect MASKX in C, BID in B, index t of ;Rs PCB in E, and address of FXP in H&L. SSUB: MVI D,0 DAD D ; (H&L) <- address of (FMP or FQP ; or FAP)[t] JZR M,SSUB2 PUSH D ; Save t SSUB1: MOV E,M ; e <- s RXAD D,NMBP ; (H&L) <- address of NMBP[s] CMP M ; Note that a = 0 JNZ SSUB1 ; Jump if we still have not reached ; the last MB in the queue POP D ; e <- t SSUB2: MOV M,B ; Entry point from send-interrupt routine SENDI: RXAD D,RDMK ; (H&L) <- address of RDMK[t] MOV A,C ; a <- MASKX DI ORA M MOV M,A ; (RDMK[t]) <- (RDMK[t]) v SMASK RXAD D,WDMK ; (H&L) <- address of WDMK[t] MOV A,C ANA M JZ SSUB3 ; Jump if (WDMK[receiver] AND SMASK)=0 MVI M,0 ; (WDMK[receiver]) <- 0 EI RXAD D,DSM DAD D ; (H&L) <- address of DSM[2*t] MOV C,L MOV B,H CALL V ; V(DSM[receiver]) RET ; Note that d = 0 SSUB3: EI RET ; Note that d = 0 ; RESULT := WAIT (WTBLK,MASK) ;This routine allows a process to wait for a message or interrupt. ; WTBLK (passed in the B&C register pair) is the address of a 10 ; byte block in memory with the following fields: ; EVENT: 1 byte. This binary word specifies what type of ; data was received and has the same interpretation ; as MASK. ; DATA: 2 bytes that are either a message, question, or ; answer. ; BUFID: 1 byte. Since it is possible to send more than one ; question to another process, in order to determine ; to which question an answer (obtained via the WAIT ; routine) corresponds, one merely has to check that ; the integer BUFID matches the integer BID that was ; returned by the SENDQ routine. ; SENDER: 6 bytes which contain the name of the sender. ; MASK is a 1-byte word passed in the E register. Its bits specify ; what data is being waited for: ; MASK ; bit Request ; ------------------------------------ ; 0 Question ; 1 Message ; 2 Answer ; 3-7 Interrupts ; Requests for interrupts are handled first. After that, the word ; is scanned from right to left. ; The routine returns a 1-byte integer RESULT in the A register ; with the following interpretation: ; RESULT event ; ---------------------------------------------------------- ; 0 routine completed its task successfully ; 1 case of dummy answer ; 2 case where sender was removed WAIT: PUSH B ; Store WTBLK on stack WT1: RDLD C,CPP ; c <- cpp MVI B,0 RXAD B,RDMK ; (H&L) <- address of RDMK[cpp] MOV A,E ; a <- MASK DI ANA M ; a <- (MASK AND (RDMK[cpp])) CMP B JNZ WCASE ; Jump if a is not 0 RXST E,B,WDMK ; (WDMK[cpp]) <- MASK RXAD B,DSM DAD B ; (H&L) <- address of DSM[2*cpp] PUSH D ; Save MASK XCHG MOV C,B ; c <- 0 CALL P+1 ; P(DSM[cpp]) POP D JMP WT1 ; Case where desired data had been received WCASE: CPI 8 JP CASEI ; Jump if event is interrupt PUSH H ; Store address of RDMK[cpp] on stack PUSH PSW LXI D,AS MVI C,2 CALL P ; P(AS) POP PSW POP D ; (D&E) <- address of RDMK[cpp] RRC JNC WAM ; Jump if question is not desired ; Case of a question CASEQ: LXI H,ABP-RDMK DAD D ; (H&L) <- address of ABP[cpp] PUSH H LXI H,FQP-RDMK MVI A,MASKQ CALL WMAIN JMP EXIT WAM: RRC LXI H,FMBP PUSH H JNC CASEA ; Jump if message is not desired ; Case of a message CASEM: LXI H,FMP-RDMK MVI A,MASKM CALL WMAIN JC EXIT ; Jump if sdr = 0 , i.e., actual ; sender has been removed in the ; meantime RXAD B,MBC ; (H&L) <- address of MBC[sdr] INR M ; (MBC[sdr]) <- (MBC[sdr])+1 JMP EXIT ; Case of an answer (and no message or question) CASEA: LXI H,FAP-RDMK MVI A,MASKA CALL WMAIN RDLD C,CPP ; c <- cpp RXAD B,MBC ; (H&L) <- address of MBC[cpp] INR M ; (MBC[cpp]) <- (MBC[cpp])+1 JMP EXIT ; Case of interrupt CASEI: MOV C,A ; c <- (MASK AND RDMK[cpp]) MVI B,1 ; b <- MASKI WINT1: MOV A,B RRC ; Rotate MASKI right MOV B,A ANA C ; a <- (MASKI AND MASK AND (RDMK[cpp])) ORA A ; Test if a = 0 JZ WINT1 ; Jump if a = 0 CMA ANA M ; (RDMK[cpp]) <- (RDMK[cpp]) AND -MASKI MOV M,A EI POP H MOV M,B XRA A ; RESULT = 0 RET ; WMAIN ;This subroutine does all the necessary work for WAIT. WMAIN: DAD D ; (H&L) <- address of FXP[cpp] , ; where X = M, Q, or A PUSH D ; Save address of RDMK[cpp] MVI B,0 MOV C,M ; c <- BUFID XCHG ; (D&E) <- address of FXP[cpp] RXAD B,NMBP ; (H&L) <- address of NMBP[BUFID] MOV B,A ; Save MASKX in B MOV A,M ; a <- (NMBP[BUFID]) XCHG ; (D&E) <- address of NMBP[BUFID] ; (H&L) <- address of FXP[cpp] MOV M,A ; Set FXP to new value POP H ; (H&L) <- address of RDMK[cpp] ORA A ; Test if (NMBP[BUFID]) = 0 JNZ WM1 ; Jump if queue is not empty MOV A,B CMA ANA M MOV M,A ; Appropriate bit in (RDMK[cpp]) has ; been set to 0 WM1: POP H ; (H&L) <- return address from call to ; WMAIN XTHL ; Exchange H&L with top of stack ; which holds address of FMBP (in case ; of message or answer) or ABP[cpp] MOV A,M STAX D ; Store a in NMBP[BUFID] MOV M,C ; fmbp or (ABP[cpp]) <- BUFID ; Assemble wait block POP H ; (H&L) <- return address from call ; to WMAIN XTHL ; Exchange H&L with top of stack which ; holds WTBLK MOV M,B ; Store record of event, namely MASKX, ; in WTBLK INX H PUSH H MVI B,0 RXLD A,B,ASTAT ; a <- (ASTAT[BUFID]) ORA A ; Test if a = 0 JNZ WM2 ; Jump if MB contains a dummy answer. ; This can happen only if WMAIN was ; called from CASEA. It may have hap- ; pened that a process was removed and ; it never had a chance to answer the ; question it was asked. In that case ; (ASTAT[BUFID]) was set to 1. RXAD B,MESS DAD B ; (H&L) <- address of MESS[2*BUFID] MOV E,M INX H MOV D,M ; (D&E) <- MESSAGE or ANSWER POP H STDM ; Store MESSAGE or ANSWER in WTBLK INX H MOV M,C ; Store BUFID in WTBLK INX H XCHG RXLD A,B,MBSP ; a <- sdr = (MBSP[BUFID]) ORA A ; Test if a = 0 JZ WM3 ; Jump if sdr = 0 , i.e., actual ; sender has been removed in the ; meantime ; NOTE: We assume that the carry bit which now is 0 stays ; that way until we return from this subroutine. MOV C,A ; Save sdr in C PUSH D M6A ; e <- 6*sdr , d <- 0 RXAD D,NAM ; (H&L) <- address of NAM[6*sdr] POP D ; (D&E) <- address of SENDER field ; in WTBLK TRNAM ; Transfer name MOV D,B ; d <- 0 RET ; Note that the carry bit is assumed ; to be 0 WM2: MVI D,1 ; Set RESULT RET WM3: MVI D,2 ; Set RESULT (sdr=0) STC ; Set the carry bit to 1 RET END HALT