home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
SIMTEL
/
CPMUG
/
CPMUG015.ARK
/
KERNL.ASM
< prev
next >
Wrap
Assembly Source File
|
1984-04-29
|
58KB
|
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