PGM KLIB
ORG 0
**********************************************************
* *
* (C) Copyright 1980 Network Development Group *
* Rutherford Laboratory *
* *
**********************************************************
**********************************************************
* Author: Graham C. Adams *
* This is the kernel of TRIPOS for the INTEL 8086, *
* the structure is modelled on that for the PDP11, *
* 11th August 1980 *
* *
* The data segment is assumed to start at 0. *
* *
* Code segment handling improved, June 1981. *
* (i.e. does not have to start at #8000) *
* *
* Changes to support large code system, August 1981. *
* *
**********************************************************
*
* Standard symbols
*
LIBWORD EQU 23456 Marks library routines
SECWORD EQU 12345 Marks a BCPL section
NOTINUSE EQU -1 Link wd of dequeued pkts
*
* Processor states
*
STBIT EQU #100 TF bit of Flags
*
* Clock status registers etc.
*
CLKCSW EQU #D6 status and control
CLKVAL EQU #D0 count
MTICKS EQU 50*60 no. of ticks per minute
*
* PIC addresses
*
* master PIC
MPICA00 EQU #C0 A0 = 0
MPICA01 EQU #C2 A0 = 1
*
* Device driver symbols
*
D.INIT EQU 0 Initialisation rtn
D.UNIN EQU 2 Uninitialisation rtn
*
* Device control block symbols
*
* 0 Device driver ptr (BCPL)
* 2 Code part (empty)
* 4
D.ID EQU 6 Device id
D.WKQ EQU 8 Work queue
D.START EQU 10 Start routine - for QPKT (off+seg)
D.STOP EQU 14 Stop routine - for DQPKT ( " )
D.CALL EQU 18 Subroutine jump to
D.INT EQU 20 Interrupt routine (offset address)
*
* Task control block symbols
*
* 0 Link
T.ID EQU 2 Task id
T.PRI EQU 4 Priority
T.WKQ EQU 6 Work Q
T.STATE EQU 8 State
T.FLAGS EQU 10 Flags for break etc.
T.STSIZ EQU 12 Stack size
T.SEGL EQU 14 Segment list
T.GBASE EQU 16 Global vector base
T.SBASE EQU 18 Root stack base
* Save area
T.G EQU 20 Register DI
T.P EQU 22 Register BP
T.SP EQU 24 Register SP
T.BX EQU 26
T.AX EQU 28
T.CX EQU 30
T.SSAV1 EQU 32 Two words of sys stack
T.SSAV2 EQU 34
T.IP EQU 36 Instruction Pointer
T.CS EQU 38 Code Segment
T.FS EQU 40 Processor status (Flag register)
T.DX EQU 42
T.SI EQU 44
T.UPB EQU 22 Upperbound
*
* Task states
*
S.PKT EQU 1 Pkt on work Q
S.HOLD EQU 2 Held
S.WAIT EQU 4 Wait
S.INT EQU 8 Interrupted
S.DEAD EQU #C Dead
*
* Packet symbols
*
*
* EQU 0 Link
P.ID EQU 2 Task or device id
P.TYPE EQU 4 Type or action
P.RES1 EQU 6 First result
P.RES2 EQU 8 Second result
P.A1 EQU 10 Argument 1
*
* Coroutine stack symbols
*
* 0 Link to next coroutine
C.CLLR EQU 2 Caller coroutine
C.SEND EQU 4 Stack end - 50
C.RESP EQU 6 Resumption ptr (frame)
C.FUNC EQU 8 Function
C.RTRN EQU 10 Return link for STOP
*
* Global Vector symbols
*
* 0*2 Global vector size
G.START EQU 1*2 START
G.RES2 EQU 10*2 Used for error codes
G.RC EQU 11*2 RETURNCODE for STOP
G.SBASE EQU 12*2 Current stack base
G.TCB EQU 13*2 Taskblock pointer
G.TID EQU 14*2 Task id
*
* Kernel Primitives
*
G.ABORT EQU 38*2 ABORT
G.CPRI EQU 35*2 CHANGEPRI
G.CDEV EQU 31*2 CREATEDEV
G.CTASK EQU 33*2 CREATETASK
G.DDEV EQU 32*2 DELETEDEV
G.DTASK EQU 34*2 DELETETASK
G.DQPKT EQU 43*2 DQPKT
G.FVEC EQU 30*2 FREEVEC
G.GLOBIN EQU 28*2 GLOBIN
G.GVEC EQU 29*2 GETVEC
G.HOLD EQU 39*2 HOLD
G.QPKT EQU 42*2 QPKT
G.RELEASE EQU 40*2 RELEASE
G.SFLAGS EQU 36*2 SETFLAGS
G.TWAIT EQU 41*2 TASKWAIT
G.TFLAGS EQU 37*2 TESTFLAGS
**********************************************************
* *
* Interrupt vectors *
* *
* (segment fields are filled in by linker) *
* *
**********************************************************
*
*
MONBRK EQU #58B reenter monitor
*
* Divide by 0
DW D0TRP
DW 0
* 1 Single step
* (set to break back to monitor)
DW MONBRK
DW #FF80
* 2 Non-maskable interrupt
DW ERRINT
DW 0
* 3 1 byte breakpoint
* Set to break back to monitor
DW MONBRK
DW #FF80
* 4 Overflow
DW ERRINT
DW 0
* 5 to 31 reserved by Intel
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
* 32 Return to monitor (instead of HALT, usually)
DW MONBRK
DW #FF80
* 33 Stack checking
DW STKTRP
DW 0
* 34 Software interrupt (abort) on error
DW TRPINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
* 40 Base set for hardware interrupts (in master PIC)
* (slave PICs not yet supported)
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
* 44 Clock interrupt (interrupt 4)
DW CLKINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
DW ERRINT
DW 0
*
*
* The 8086 monitor (in EPROM) uses the next 128 bytes
* for its stack.
* Tripos uses the 128 bytes after that for its system (m/c) stack.
* (Extravagant?)
*
*
RES #100,0
*
* Should now be at address #500!
*
******************************************************
* *
* Root Node *
* *
******************************************************
*
* Two words may be pushed onto the stack with interrupts enabled.
SSBASE EQU #4FC System stack base - two words are left free
* in case of underflow.
* The root node follows
RTNODE EQU $
TSKTAB DW 0 Ptr to task table
DEVTAB DW 0 Ptr to device table
TCBLIST DW 0 Beginning of TCB priority list
CRNTSK DW 0 Ptr to current TCB
BLKLIST DW 0 Beginning of store block list
DEBTSK DW 0 Ptr to DEBUG TCB
DAYS DW 0 Since start of 1978
MINS DW 0 Since midnight
TICKS DW 0 Clock ticks in current minute
CLKWQ DW 0 Ptr to first clock packet
MEMSIZE DW 0 Memsize is size of code area
INFO DW 0 Implementation dependent info
KSTART DW KSTARTA Kernel entry point (MC address)
DEVMVP DW MOVPKT MOVPKT for device drivers (MC addr)
DW 0
DEVINT DW INTENT INTENT for device drivers (MC addr)
DW 0
DEVRET DW INTRET INTRET for device drivers (MC addr)
DW 0
CODESEG DW 0 Code base
CBLKLIST DW 0 BLKLIST for code area (but MC addr)
DW 0
***************************************************
* *
* Entry point. *
* This is in the data segment. *
* The initialisation code is overlaid by *
* DEBUG's stack. *
* *
***************************************************
KSTARTA CLI interrupts off
XOR AX,AX set segment registers to 0
MOV DS,AX
MOV ES,AX
MOV SS,AX
MOV SP,!SSBASE set up system stack
* Initialize PICs (programmable interrupt controllers)
MOV AL,!#13 edge triggered, single; ICW1
OUT MPICA00
MOV AL,!40 base of h/w ints ICW2
OUT MPICA01
MOV AL,!#T00001101 master and 8086 controlled ICW4
OUT MPICA01
MOV AL,!#EF mask all interrupt channels (except clock)
OUT MPICA01
* Start the clock,
* set up clock for 50 tickspersec (uses timer 0)
MOV AL,!#T00110100 rate generator, binary count
OUT CLKCSW
MOV AX,!24576 for 20ms interval
OUT CLKVAL
MOV AL,AH
OUT CLKVAL
* Initialize other devices (set up by SYSLINK)
MOV DI,!1
KST1 INC DI next device
MOV SI,DEVTAB get device table
SHL SI
CMP DI,(SI) compare with UPB
JG KST2 end of table
ADD SI,DI
ADD SI,DI
MOV BX,(SI)
SHL BX MC DCB pointer
JE KST1 this slot empty
MOV SI,(BX)
SHL SI MC driver ptr
LES SI,2(SI) ptr to code
NEG DI id in DI
MOV D.ID(BX),DI set id in DCB
MOV D.WKQ(BX),!0 clear work q
MOV SI,D.INIT(SI)[ES] get ptr to descriptor
CIS (SI) call device init. routine
NEG DI make id positive again
JMP KST1
*
KST2 MOV DI,!TCBLIST get the TCB chain
KST3 MOV BX,(DI) look for the end
SHL BX
JE KST4
MOV DI,BX chain on
JMP KST3
*
KST4 MOV (DI),!IDLTCB link in the idle TCB
SHR (DI) at the end
MOV DEBTSK,!0 clear DEBUG TCB ptr
MOV BX,CRNTSK find initial task
SHL BX
MOV T.WKQ(BX),!IPKT give it a packet
SHR T.WKQ(BX) BCPL pkt address
JIS ENTI activate the task!
*
ENTI DW ACTIV
DW 0
*
GTO BLAB omit BLKCHAIN routine
* This routine amalgamates free blocks in a store chain
*
BLKCHAIN SHL SI
XOR AX,AX get 0 in AX
*
KST5 MOV BX,(SI) get size of block
OR BX,BX
JE KST7 end of chain
MOV DI,SI MC start of block
ADD SI,BX
ADD SI,BX MC end of block
TEST BX,!1 is it free?
JE KST5 no, chain on
DEC SI yes, correct end ptr
DEC SI
INC DI
INC DI
*
KST6 MOV (DI),AX clear block
INC DI
INC DI
CMP DI,SI end of block?
JNE KST6
B KST5 find next block
*
KST7 RET
BLAB AOP
*
* DEBUG's standalone mode stack overlays the initialization code.
* Its length is 150 words.
DEBSAS EQU KSTARTA
RES 150*2+KSTARTA-$,0
*********************************************************
* *
* Tripos KLIB segment starts here. *
* *
*********************************************************
EVEN
REL
EVEN
KLIB DW KLBEND-KLIB/2
DW SECWORD
DB 17,"Klib 11-Aug-81"
**********************************************************
* *
* Standalone DEBUG restart. DEBUG's TCB is found, and *
* DEBUG entered in standalone mode. *
* *
**********************************************************
SADEB CLI interrupts off
MOV SP,!SSBASE set up system stack
CALL FNDEB use TRSAVE to find DEBUG
SAD1 MOV (BX),!0 MODE=0 for sa restart
SHR BX BCPL ptr to DEBPKT
MOV DX,!2
MOV SI,G.START(DI) Start(Pkt)
CIS (SI)
B SADEB
**********************************************************
* *
* The Idle task *
* *
**********************************************************
IDLE HLT Might as well help the bus
B IDLE
INT A byte of space
*************************************************
* *
* The following code implements the task *
* selection algorithm - it is entered with a *
* pointer to the highest priority task that *
* could be free to run. *
* The task list is searched in order of *
* decreasing priority until a task is found *
* that is free to run. *
* *
*************************************************
SRCHWK MOV BX,(BX) chain down 1 task
SRCHW1 MOV CRNTSK,BX BCPL ptr to current task
SRCHW2 SHL BX get MC ptr
MOV SI,T.STATE(BX) get state
SHL SI -> offset
JI SRCHTAB(SI)[CS] jump through table
*
* The action to be taken is determined from the task state -
* each permissible state corresponds to a unique entry in the
* table - for reasons of efficiency the value of the state is
* not checked; therefore, except for debugging purposes
* you should not attempt to modify the state directly.
*
EVEN
SRCHTAB DW RENTER Run
DW RENTER Run with Pkt
DW SRCHWK Run/held
DW SRCHWK Run with Pkt/held
DW SRCHWK Wait
DW UNWAIT Wait with Pkt
DW SRCHWK Wait/held
DW SRCHWK Wait with Pkt/held
DW UNINT Interrupted
DW UNINT Interrupted with Pkt
DW SRCHWK Interrupted/held
DW SRCHWK Interrupted with Pkt/held
DW SRCHWK Dead
DW ACTIV Dead with Pkt (restart)
DW SRCHWK Dead/held
DW SRCHWK Active/held
*
* A task in wait state that receives a packet is reentered.
* The packet address is returned in AX and the link set to NOTINUSE.
*
UNWAIT CALL NXTPKT get next packet
MOV T.BX(BX),AX so pkt addr is returned
*
* A task that is to be directly reentered (was held up due to
* QPKT, RELEASE, etc.) needs only DI, BP, SP and BX restored.
RENTER LEA SP,T.G(BX)
POP DI
POP BP
MOV SP,!SSBASE
MOV BX,T.BX(BX)
ULRET STI enable interrupts
BRET MOV SI,4(BP) standard BCPL exit
SUB BP,SI
JIS (BP,SI)
*
* An interrupted task is reentered here.
* All the registers and the system stack words are restored
* from the TCB before the task is resumed.
*
UNINT AND T.STATE(BX),!~S.INT clear int state
LEA SP,T.G(BX)
POP DI
POP BP
POP SP this is correct value for SP (see case abo
ADD SP,!4 because we will push stack words
MOV SI,T.SI(BX)
MOV AX,T.AX(BX)
MOV CX,T.CX(BX)
PUSH T.SSAV1(BX)
PUSH T.SSAV2(BX)
PUSH T.FS(BX) flags
PUSH T.CS(BX) CS
PUSH T.IP(BX) IP
MOV DX,T.DX(BX)
MOV BX,T.BX(BX)
* stack is now in correct state for an .....
IRET
*
* A dead task with a packet will be activated. The size
* of the global vector is calculated, then it and the stack
* are allocated and the globals are initialized before calling
* START with the packet as argument.
* Entered with BX holding MC TCB pointer.
ACTIV MOV SP,!SSBASE std. system stack
CALL NXTPKT get the packet
STI enable interrupts
MOV SI,BX MC TCB ptr
MOV T.SBASE(SI),AX save pkt
MOV BX,T.SEGL(SI) segment list
MOV AX,BX
SHL BX MC segment list
ADD AX,(BX)
SHL AX MC list end
XOR DX,DX highest ref global (hrg)
B ACT4
*
ACT1 MOV DI,(BX) new Tripos segment
B ACT3A
*
ACT2 CLI protect ES
LES BP,2(DI) new code section
MOV CX,(BP)[ES] c.s. length
SHL CX
ADD BP,CX last word in code section
CMP DX,-2(BP)[ES] HRG?
JAE ACT3
MOV DX,-2(BP)[ES] update HRG
ACT3 STI no longer need ES
MOV DI,(DI) next section
ACT3A SHL DI
JNE ACT2 and try again
*
* onto next segment
ACT4 INC BX
INC BX
CMP BX,AX at the end?
JBE ACT1
*
MOV T.GBASE(SI),DX save HRG
XOR DI,DI indicate no global vector for GETVEC
*
ACT5 MOV BX,T.GBASE(SI)
PUSH CS
CALL GVEC get Global Vector
*
OR BX,BX test if got
JNE ACT5A
JMP ACTE1
ACT5A MOV SI,CRNTSK
SHL SI
MOV DI,BX
SHL DI Global Vector now set up
MOV AX,T.GBASE(SI) G.V. Size
MOV T.GBASE(SI),BX G.V.
ADD BX,AX
SHL BX MC top of G.V.
INC BX
INC BX
* fill globals with address of unassigned global routine descriptor
ACT6 DEC BX
DEC BX
MOV (BX),!UNASGLI
CMP BX,DI
JA ACT6
*
MOV (DI),AX Globsize
MOV DX,CRNTSK
MOV G.TCB(DI),DX
MOV DX,T.ID(SI)
MOV G.TID(DI),DX
*
ACT7 MOV BX,T.STSIZ(SI)
PUSH CS
CALL GVEC get stack
OR BX,BX test if got
JNE ACT7A
JMP ACTE2
ACT7A MOV SI,CRNTSK
SHL SI
MOV G.SBASE(DI),BX Stackbase
MOV AX,T.SEGL(SI) get segment list
MOV CX,T.STSIZ(SI) and stack size
MOV DX,T.SBASE(SI) and Pkt
MOV T.SBASE(SI),BX set Sbase
*
MOV BP,BX
SHL BP set up BCPL stack
ADD CX,BX
MOV BX,CX BCPL stack end
SHL BX MC stack end
INC BX
INC BX
* zero the stack
ACT8 DEC BX
DEC BX
MOV (BX),!0
CMP BX,BP
JA ACT8
*
MOV C.CLLR(BP),!-1 -1 -> root coroutine
SUB CX,!50 safety
MOV C.SEND(BP),CX
MOV SI,AX
MOV 14(BP),AX SEGLIST
SHL SI
ADD AX,(SI) BCPL Ptr to last segment
MOV 16(BP),AX
MOV 18(BP),DX That Pkt again
B ACT10
*
ACT9 SHL BX
MOV BX,(BX)
MOV DX,!20
PUSH CS
CALL GBIN initialize globals
*
ACT10 INC 14(BP) next segment
MOV BX,14(BP)
CMP BX,16(BP)
JBE ACT9
*
MOV BX,18(BP) Pkt is arg1
MOV DX,!10 offset
MOV SI,G.START(DI)
CIS (SI) off we go
*
CLI when task ends disable interrupts
MOV SI,CRNTSK
SHL SI
OR T.STATE(SI),!S.DEAD set dead state
*
DEACT MOV BX,T.SBASE(SI)
PUSH CS
CALL FVEC free the stack
MOV BX,T.GBASE(SI)
PUSH CS
CALL FVEC free the global vector
MOV BX,CRNTSK enter the scheduler
JMP SRCHW2
*
ACTE1 MOV CX,!196
INT 34
JMP ACT5
*
ACTE2 MOV CX,!196
INT 34
JMP ACT7
******************************************************
* *
* CALL NXTPKT *
* *
* This subroutine removes the first packet from a *
* task's work queue. It is entered with the MC TCB *
* ptr in BX and returns with the BCPL addr of the *
* pkt in AX. It must be called with interrupts *
* disabled. *
* *
******************************************************
NXTPKT AND T.STATE(BX),!~S.DEAD Run state
MOV SI,T.WKQ(BX) top of work q
MOV AX,SI
SHL SI
MOV SI,(SI)
MOV T.WKQ(BX),SI
OR SI,SI unless more pkts clear pkt state
JNE NXP1
AND T.STATE(BX),!~S.PKT
NXP1 MOV SI,AX
SHL SI
MOV (SI),!NOTINUSE
RET
*************************************************************
* *
* This is a common exit point for all interrupts which may *
* cause a higher priority task to start. Need to save in *
* the TCB all the registers, the system stack words and the *
* Flags. *
* AX holds the MC new TCB - a task swap will occur unless *
* this is the current TCB *
* On the system stack are - *
* SI,DX,CX,AX,BX,dcb ip,dcb cs,IP,CS,FS *
* *
* When an interrupt is received the driver is reached via *
* an intersegment call in the DCB resulting in the words *
* dcb ip & dcb cs being stacked. *
* *
*************************************************************
INTENT MOV SI,CRNTSK get current task
SHL SI
CMP SI,AX
JE INTRET no task swap - so return
OR T.STATE(SI),!S.INT set interrupted state
MOV T.G(SI),DI
MOV T.P(SI),BP
POP T.SI(SI)
POP T.DX(SI)
POP T.CX(SI)
POP T.AX(SI)
POP T.BX(SI)
ADD SP,!4 ignore IP and CS from DCB CALLS
POP T.IP(SI)
POP T.CS(SI)
POP T.FS(SI)
MOV T.SP(SI),SP
POP T.SSAV2(SI)
POP T.SSAV1(SI)
MOV BX,AX
SHR BX BCPL ptr for SRCHWK
MOV AL,!#20
OUT MPICA00 EOI to PIC
JMP SRCHW1
*
* no task swap, stack is as for INTENT
*
INTRET POP SI
POP DX
POP CX
INTRT2 MOV AL,!#20 EOI to PIC
OUT MPICA00
POP AX
POP BX
ADD SP,!4 ignore extra IP and CS from DCB CALLS
*
* if divide-by-zero interrupt occurs simply return
D0TRP IRET
*
* The following piece of code is used by the stack checking
* option of the code generator.
STKTRP EQU $
POP SI SI := IP
POP ES
PUSH ES
INC SI
INC SI adjust IP for return
PUSH SI
PUSH BX SAVE
MOV BX,G.SBASE(DI)
SHL BX m/c stack base
MOV BX,C.SEND(BX)
SHL BX m/c stack end
SUB BX,BP amount left
MOV SI,-2(SI)[ES] get request (in code)
SHL SI change to bytes
ADD SI,!50 for safety
CMP SI,BX compare with what's available
JAE STKBAD
POP BX get back BX
IRET
*
STKBAD MOV CX,!97 stack overflow
INT 34
B STKBAD
***********************************************************
* *
* Real Time Clock interrupt service routine *
* The absolute time is incremented and any expired pkts *
* held on the timer queue are moved to the calling task. *
* If any of the tasks has a higher priority than the *
* current task then the task selector is entered. *
* *
***********************************************************
CLKINT SUB SP,!4 make it look like other interrupts
PUSH BX (i.e. no DCB CALLS)
PUSH AX ready for INTRT2
MOV AX,TICKS
INC AX
MOV TICKS,AX
CMP AX,!MTICKS end of minute?
JB CLK1 no
MOV TICKS,!0 yes
MOV AX,MINS
INC AX
MOV MINS,AX
CMP AX,!60*24 end of day?
JB CLK1 no
MOV MINS,!0 yes
INC DAYS
*
CLK1 MOV BX,CLKWQ get work queue
SHL BX
JE INTRT2 is empty
DEC P.RES1(BX) decrement top pkt
JG INTRT2 not expired yet
PUSH CX
PUSH DX
PUSH SI
MOV SI,BX
MOV BX,CRNTSK get current task
SHL BX
*
CLK2 MOV CX,(SI) unchain top pkt
MOV CLKWQ,CX
MOV CX,!-1 devtaskid for MOVPKT
PUSH CS
CALL MOVPKT send packet back
MOV SI,CLKWQ try next pkt
SHL SI
JNE CLK2A
JMP INTENT no more packets
CLK2A MOV BX,AX AX, highest priority task
CMP P.RES1(SI),!0 is also expired?
JLE CLK2 yes - send it back
JMP INTENT no - exit
************************************************************
* *
* 'Trap' interrupt handlers. Miscellaneous interrupts are *
* received by ERRINT, software interrupts, which are used *
* for aborts, by TRPINT, and BPT interrupts *
* are received by BPTINT. TF (single step) interrupts) are *
* received by SSTINT. The registers are *
* saved and DEBUG located by TRSAVE, and DEBUG is entered *
* in standalone mode. *
* *
************************************************************
* miscellaneous interrupts come here
* check that SP is in range and even
ERRINT TEST SP,!1
JNE ERR1 SP is odd
CMP SP,!SSBASE
JA ERR1
CMP SP,!SSBASE-30
JB ERR1
CALL TRSAVE
MOV DEBCDE,CX
MOV DEBARG,DX
* read PIC data
MOV AL,!#T00001010 set to read IRR
OUT MPICA00
IN MPICA00 get IRR
MOV DL,AL
MOV AL,!#T00001011 ISR
OUT MPICA00
IN MPICA00 get ISR
MOV DH,AL
MOV AL,!#T00001100
OUT MPICA00
IN MPICA00 get level
MOV CL,AL
IN MPICA01 get mask
MOV AH,CL
MOV CX,!99 abort code=99
MOV (BX),!1
B TRPBRK
ERR1 MOV SP,!SSBASE reset SP
CALL TRSAVE
MOV CX,!95
B TRP2
* software interrupts (INT 34) come here, CX holds code
TRPINT CALL TRSAVE
TRP2 MOV (BX),!1 MODE=1 for aborts
TRP3 MOV DEBCDE,CX abort code
MOV DEBARG,DX address near 'trapped' inst.
*
TRPBRK SHR BX BCPL ptr to DEBPKT
MOV DX,!8
MOV SI,G.START(DI) DEBUG: Start(Pkt)
CIS (SI)
CMP DEBPKT,!2 MODE=2 for breakpoint
JNE TRPHLD
JMP BPT2
* a taskid is returned in BX or 0 if none to be held
TRPHLD CALL TCBST1 find task to be held
JE TRPH1 doesn't exist or zero
OR T.STATE(BX),!S.HOLD mark held
TRPH1 MOV BX,DEBTAS task from DEBPKT, the task
CALL TCBST1 the task that was running
JE TRPCNT 0 task
OR T.STATE(BX),!S.INT mark interrupted
* move saved registers to TCB
MOV SP,!DEBBX
POP T.BX(BX)
POP T.AX(BX)
POP T.CX(BX)
POP T.DX(BX)
POP T.SI(BX)
POP T.P(BX)
POP T.G(BX)
POP T.SP(BX)
POP T.IP(BX)
POP T.CS(BX)
POP T.FS(BX)
POP T.SSAV2(BX)
POP T.SSAV1(BX)
MOV SP,!SSBASE reset SS
MOV BX,TCBLIST start of TCB chain
JMP SRCHW1
*
TRPCNT MOV SP,!DEBAX continue after s/w interrupt
POP AX
POP CX
POP DX
POP SI
POP BP
POP DI
MOV SP,DEBSP system stack now reset
PUSH DEBFS
PUSH DEBCS
MOV BX,DEBBX
PUSH DEBIP stack is now OK for ...
IRET
* Single step interrupt received (TF bit set in FLAG file)
SSTINT PUSH BX clear TF bit and resume execution
MOV BX,SP
AND 6(BX),!~STBIT
MOV ES,4(BX) get segment
MOV BX,DEBARG get old IP
MOV (BX),!#CC[B][ES] put back INT instruction
POP BX
IRET
* breakpoint received (INT instruction)
BPTINT CALL TRSAVE
MOV (BX),!2 MODE=2 for breakpoint
DEC DX backup IP to INT instruction
MOV DEBIP,DX
JMP TRP3
*
BPT2 OR BX,BX
JE BPT2A
JMP TRPHLD don't continue after breakpoint,hold
BPT2A CMP DEBARG,!0 continue after breakpoint
JE TRPCNT breakpoint no longer exists
MOV BX,DEBARG old IP, put back instruction part
MOV DL,DEBCDE
MOV ES,DEBCS
MOV (BX),DL[ES]
OR DEBFS,!STBIT set TF bit
JMP TRPCNT
* unassigned global routine,
* code for global call is 8B 75 n(l) FF 1C (0<=n<=127),
* 8B B5 n(l) n(m) FF 1C (0<=n<=32767).
UNASGL POP BX return address
POP ES return seg
CMP -5(BX),!#758B[ES] global call with small n?
JE UNAS0
CMP -6(BX),!#B58B[ES] global call with large n?
JE UNAS00
MOV AX,!-1 global number := -1
B UNAS1
UNAS0 XOR AH,AH
MOV AL,-3(BX)[ES] get global number
B UNAS1
UNAS00 MOV AX,-4(BX)[ES] get global number
UNAS1 MOV CX,!98
INT 34 unassigned global abort
****************************************************************
* *
* CALL TRSAVE *
* *
* Saves registers and locates DEBUG after a s/w interrupt. It *
* returns with the MC address of DEBPKT in BX, the MC addr *
* of the trapped instruction in DX, DI and BP set up ready for *
* DEBUG, and DEBTAS set to the current task id, or zero if *
* interrupts were off. *
* *
****************************************************************
TRSAVE MOV DEBSP,SP save the registers
MOV SP,!DEBSP
PUSH DI
PUSH BP
PUSH SI
PUSH DX
PUSH CX
PUSH AX
PUSH BX
MOV SP,DEBSP get back SP
POP DX ignore routine return address
POP DX IP
MOV DEBIP,DX
POP BX
MOV DEBCS,BX
MOV DEBTAS,!0 find current task id
POP BX get FS
TEST BX,!#200 interrupts off?
JE TRSV1
MOV SI,CRNTSK no - use current task
SHL SI
MOV SI,T.ID(SI) get its id
MOV DEBTAS,SI
TRSV1 MOV DEBSP,SP save SP
POP DEBSV2
POP DEBSV1 system stack words
SUB SP,!12 restore SP for us
MOV DEBFS,BX
FNDEB MOV BX,!DEBPKT MC ptr to DEBPKT
MOV BP,!DEBSAS BCPL stack for DEBUG
MOV SI,DEBTSK DEBUG's TCB
SHL SI
JE FND2 not there
MOV DI,T.GBASE(SI) global vector
SHL DI
RET
*
FND2 MOV DI,!DEBGLB no DEBUG task
RET
DEBHLT INT 32
XOR BX,BX
RETS try returning to system
*************************************************************
* *
* Kernel Primitives *
* *
*************************************************************
*************************************************************
* *
* GLOBIN(SEG) *
* *
* This function initializes the globals defined in the *
* given segment. It returns -1, or 0 if an error is *
* detected - if an attempt is made to initialize a global *
* beyond the upperbound given by GLOBSIZE. It is included *
* amongst the kernel primitives as it is called by the *
* task activation code - as PUSH CS, CALL GBIN. *
* The global initialization table is held in the code *
* segment. *
* *
*************************************************************
DW LIBWORD
DB 7,"globin "
*
GLOBIN EQU $
GBIN ADD BP,DX std. entry
MOV 4(BP),DX
POP (BP)
POP 2(BP)
*
MOV 8(BP),!-1 holds result
GLBIN1 SHL BX MC section list ptr
JE GLOBRET
CLI protect ES
LES SI,2(BX) code section descriptor
MOV AX,ES
MOV 10(BP),BX save
MOV 12(BP),SI "
MOV CX,(SI)[ES] code section length
STI
SHL CX
MOV DX,CX save byte length of code
ADD SI,CX end
*
GLBIN2 CLI
MOV ES,AX
MOV CX,-4(SI)[ES] glob add
MOV BX,-6(SI)[ES] glob no.
STI
OR CX,CX end of globals?
JE GLBIN4
OR BX,BX
JLE GLBIN3 error in glob no.
SHL BX
ADD BX,DI address in glob vec to plug
SUB CX,DX remember crazy convention!
ADD CX,10(BP) construct address in data part
ADD CX,!6 correct base
MOV (BX),CX
*
GLBIN22 SUB SI,!4
JMP GLBIN2
GLBIN3 MOV 8(BP),!0
MOV G.RES2(DI),!111
JMP GLBIN22
*
GLBIN4 MOV BX,10(BP)
MOV BX,(BX)
JMP GLBIN1
*
GLOBRET MOV BX,8(BP)
JMP BRET
************************************************************
* *
* GETVEC(UPPERBOUND) *
* *
* This function is BCPL callable. *
* It returns the word address of a vector with at least *
* the given upper bound. (In fact, the upperbound is *
* rounded up to the next even number.) The word at offset *
* -1 of the vector contains the length of the store block *
* and should not be touched by the user. *
* Runs with interrupts disabled, but reenables and disables*
* them each time round the search loop, so that they will *
* not be locked out for the whole of a lengthy search *
* This routine may be called as PUSH CS, CALL GVEC, *
* in which case no frame size is required. *
* If no global vector has been set up then DI must be zero.*
* *
************************************************************
DW LIBWORD
DB 7,"getvec "
*
GETVEC EQU $
GVEC INC BX true vector size
JLE GVC7 error if -ve
OR BX,!1 round up to odd number
INC BX
SHL BX
CLI disable interrupts
*
GVCRTY MOV SI,CRNTSK
MOV GVTSK,SI
MOV AX,BLKLIST
SHL AX
GVC1 XCHG AX,SI
GVC1A STI enable interrupts
*
* At this point interrupts are enabled. This is because
* the search for a suitable free block may be long.
* If any other task is run and calls GETVEC then GVTSK
* will be reset and the search must start again at
* the beginning of the block list in case it has been
* updated meanwhile.
CLI disable interrupts again
MOV AX,GVTSK
CMP AX,CRNTSK other callers?
JNE GVCRTY restart the search
MOV CX,(SI)
OR CX,CX
JLE GVC6
TEST CX,!1
JNE GVC2 free
SHL CX
ADD SI,CX
JMP GVC1A
*
GVC2 MOV AX,SI save MC address of free block
GVC3 DEC CX calc. size
SHL CX
ADD SI,CX
MOV CX,(SI)
OR CX,CX
JE GVC4
JS ERRSTOR loop in free store
TEST CX,!1
JNE GVC3 jump if block free
*
* at this point BX = size required in bytes
* AX = byte address of start of free area
* SI = byte address of end of free area
GVC4 MOV DX,SI
SUB DX,AX size of area in bytes
XCHG AX,SI
MOV (SI),DX amalgamate blocks
SHR (SI) -> BCPL
INC (SI) mark as free
SUB DX,BX split block
JB GVC1 can't be done
JE GVC5 exact fit
SUB AX,DX find upper part and calc. size
SHR DX -> BCPL
INC DX mark as free
XCHG AX,BX
MOV (BX),DX plant its size
XCHG BX,AX
GVC5 SHR BX BCPL size of alloc. block
MOV (SI),BX plant size
SHR SI
INC SI BCPL vector address
MOV BX,SI
STI interrupts on
RETS
*
GVC6 JS ERRSTOR
GVC7 OR DI,DI if no glob. vec. then
JE GVC8 can't set RESULT2
MOV G.RES2(DI),!103 insufficient store
GVC8 XOR BX,BX return result of zero
STI
RETS
*
ERRSTOR MOV CX,!197 free store corrupt
INT 34
JMP GVCRTY abort and try again
****************************************************************
* *
* FREEVEC(V) *
* *
* This BCPL callable routine frees the vector V, which should *
* have been obtained by GETVEC. It aborts the task if an error *
* is detected. It may be called as PUSH CS, CALL FVEC, *
* in which case registers AX,CX,DX,BP and DI are preserved. It *
* may be called whether interrupts are on or off. *
* *
****************************************************************
DW LIBWORD
DB 7,"freevec"
FREEVEC EQU $
FVEC SHL BX MC addr of block
JE FVCRET zero => do nothing
TEST -2(BX),!#Q100001 -ve or free?
JNE FVC1 error
INC -2(BX) mark as free
FVCRET RETS
FVC1 MOV CX,!199
INT 34
RETS
****************************************************************
* *
* CREATEDEV(DCB) *
* *
* This function creates a device using the first free slot in *
* the device table. The DCB should have already been linked to *
* a device driver. It returns the devid, or zero on error. *
* *
****************************************************************
DW LIBWORD
DB 7,"created"
CRDEV CLI interrupts off
MOV SI,DEVTAB get devtab
SHL SI
MOV CX,(SI) get upperbound
MOV DX,!1
ADD SI,!2 skip dev 1 (clock)
CRD1 INC DX next slot
CMP DX,CX upperbound yet?
JG CRD2 devtab full
INC SI
INC SI
OR (SI),!0 slot empty?
JNE CRD1 no
MOV (SI),BX fill slot
SHL BX MC DCB in BX
MOV SI,(BX)
SHL SI MC driver in SI
LES SI,2(SI)
MOV SI,D.INIT(SI)[ES]
NEG DX id in DX
MOV D.ID(BX),DX set id in DCB
MOV D.WKQ(BX),!0 clear work queue
CIS (SI) initialize the device
MOV BX,DX
STI enable interrupts
RETS
*
CRD2 MOV G.RES2(DI),!104 device table full
XOR BX,BX
STI
RETS
**********************************************************
* *
* DELETEDEV(DEVID) *
* *
* This function deletes a device, which must have an *
* empty work queue. It returns the DCB, or zero on error *
* *
**********************************************************
DW LIBWORD
DB 7,"deleted"
DELDEV CLI interrupts off
MOV SI,DEVTAB get device table
SHL SI
NEG BX make id +ve
JLE DELD1 invalid id
SHL BX
ADD SI,BX
MOV BX,(SI)
SHL BX
JE DELD1 no such device
OR D.WKQ(BX),!0 work queue empty?
JNE DELD2 no - error
MOV (SI),!0 clear devtab entry
MOV SI,(BX)
SHL SI MC driver
LES SI,2(SI)
MOV SI,D.UNIN(SI)[ES]
CIS (SI) uninitialize device
SHR BX
STI
RETS
*
DELD1 MOV G.RES2(DI),!101 invalid id
B DELD3
DELD2 MOV G.RES2(DI),!107 device not deleteable
DELD3 XOR BX,BX
STI
RETS
*
*
**********************************************************
* *
* CREATETASK(SEGLIST,STSIZE,PRI) *
* *
* This function creates a task using the first free slot *
* in the task table. It gets space for a copy of the *
* segment list and a TCB, initializes them, and inserts *
* the TCB in the task table and priority chain. It *
* returns the taskid, or zero on error. *
* *
**********************************************************
DB 7,"createt"
CRTASK ADD BP,DX std BCPL entry
MOV 4(BP),DX
POP (BP)
POP 2(BP)
MOV 6(BP),SI
MOV 8(BP),BX save args
MOV 10(BP),AX
MOV 12(BP),CX
OR CX,CX
JG CRTSKA
JMP PRERR1 invalid pri
CRTSKA SHL BX MC segment list
JE CRT2 is null
MOV BX,(BX) upperbound
PUSH CS mimic interseg call
CALL GVEC get space for seglist
OR BX,BX
JNE CRTSKA1
JMP CRT8 no space got
CRTSKA1 MOV SI,8(BP) arg seglist
MOV 8(BP),BX new seglist
SHL SI
SHL BX
MOV CX,(SI) counts size
INC CX
CRT1 MOV DX,(SI) copy the list
MOV (BX),DX
INC SI
INC SI
INC BX
INC BX
LOOP CRT1
*
CRT2 MOV BX,!T.UPB
PUSH CS
CALL GVEC get TCB space
OR BX,BX check space was got
JNE CRT2A
JMP CRT7
* look for vacant task table slot
CRT2A CLI interrupts off
MOV SI,TSKTAB
SHL SI MC task table
MOV CX,(SI)
XOR DX,DX taskid counter
CRT3 INC DX next entry
INC SI
INC SI
OR (SI),!0 is it unused?
JE CRT4 yes - found a slot
LOOP CRT3 loop until end of table
MOV G.RES2(DI),!105 task table full
B CRT6
* fill the slot and initialize the TCB
CRT4 MOV (SI),BX set the entry
MOV SI,BX
SHL SI MC TCB ptr
MOV T.ID(SI),DX
MOV DX,12(BP) pri
MOV T.PRI(SI),DX
XOR CX,CX
MOV T.WKQ(SI),CX
MOV T.STATE(SI),!S.DEAD
MOV T.FLAGS(SI),CX
MOV AX,10(BP) stsize
MOV T.STSIZ(SI),AX
MOV AX,8(BP) seglist
MOV T.SEGL(SI),AX
MOV T.GBASE(SI),CX
MOV T.SBASE(SI),CX
* now link the TCB into the priority chain
PUSH BX save TCB
MOV BX,!TCBLIST top of chain
CRT5 MOV CX,BX save last ptr
MOV BX,(BX) chain down
SHL BX
CMP T.PRI(BX),DX compare priorities
JG CRT5 chain higher
JE CRTX equal pri
SHR BX
MOV (SI),BX insert
MOV BX,CX
POP (BX)
MOV BX,T.ID(SI) result is id
JMP ULRET
*
CRTX MOV BX,TSKTAB find task table entry
ADD BX,T.ID(SI)
SHL BX
MOV (BX),!0 clear the slot
MOV G.RES2(DI),!102
POP BX
CRT6 PUSH CS
CALL FVEC free the TCB
CRT7 MOV BX,8(BP)
PUSH CS
CALL FVEC seglist
CRT8 JMP ULERRZ error return
PRERR1 JMP PRERR invalid priority
**********************************************************
* *
* DELETETASK(TASKID) *
* *
* This function deletes a task, which must have an empty *
* work queue and either be the current task, or be dead. *
* Its segment list is freed and the TCB removed from the *
* priority chain and the task table, and then freed. If *
* it was the current task the task deactivation code is *
* entered to free the stack and global vector. It *
* returns a non-zero result unless an error occurs - or *
* the current task is deleted. *
* *
**********************************************************
DB 7,"deletet"
DELTSK ADD BP,DX std BCPL entry
MOV 4(BP),DX
POP (BP)
POP 2(BP)
CALL TCBSET TCB ptr->BX, tasktab slot->DX
JE IDERR5 invalid id
TEST T.STATE(BX),!S.PKT
JNE DELT3 can't delete
MOV AX,BX
SHR AX BCPL TCB ptr
CMP AX,CRNTSK current task?
JE DELT1 yes - ok
CMP T.STATE(BX),!S.DEAD dead & not held?
JNE DELT3 no - can't delete
* unlink the TCB and free it
DELT1 MOV SI,DX tasktab entry
MOV (SI),!0 clear tasktab slot
MOV SI,!TCBLIST top of TCB chain
DELT2 MOV CX,SI save last ptr
MOV SI,(SI) chain on one
SHL SI
CMP SI,BX found it?
JNE DELT2 not yet - loop
MOV DX,(SI) delete it
MOV BX,CX
MOV (BX),DX
MOV BX,T.SEGL(SI) free segment list
PUSH CS
CALL FVEC
MOV BX,AX free TCB
PUSH CS
CALL FVEC
CMP AX,CRNTSK deleting current task?
JE DELT2A
JMP ULRET2 no - unlock and return
DELT2A MOV CRNTSK,DX yes, schedule next task
JMP DEACT after deactivating (MC TCB in SI)
DELT3 MOV BX,!108 task not deleteable
JMP ULERR2
**********************************************************
* *
* CHANGEPRI(TASKID,PRI) *
* *
* This routine alters the priority of a task. Its TCB is *
* moved to the new position in the priority chain, and *
* the task scheduler entered if necessary. It returns *
* non zero, or zero on error. *
* *
**********************************************************
DB 7,"changep"
CHNGPRI ADD BP,DX std. BCPL entry
MOV 4(BP),DX
POP (BP)
POP 2(BP)
MOV 6(BP),SI
CALL TCBSET locate TCB
IDERR5 JNE CHNGPA1
JMP IDERR invalid id
CHNGPA1 OR AX,AX check pri
JLE PRERR invalid priority
* delete TCB from old posn. in chain
MOV SI,!TCBLIST top of TCB chain
CHNGP1 MOV DX,SI save last ptr
MOV SI,(SI) chain on
SHL SI
CMP SI,BX found it
JNE CHNGP1 no - loop
MOV SI,DX yes - unlink it
MOV DX,(BX)
MOV (SI),DX
MOV 12(BP),SI ** save old position
* insert in correct position at new priority
MOV SI,!TCBLIST top of chain
CHNGP2 MOV DX,SI save last ptr
MOV SI,(SI) chain on
SHL SI
CMP T.PRI(SI),AX compare priorities
JG CHNGP2 chain still higher
JE CHNGPX !!equal priority
MOV CX,T.PRI(BX) save old priority
MOV T.PRI(BX),AX set new priority
MOV SI,DX link into chain
MOV DX,(SI)
MOV (BX),DX
MOV AX,BX
SHR AX BCPL TCB ptr
MOV (SI),AX complete insertion
MOV SI,CRNTSK
SHL SI MC current task
CMP BX,SI changing own priority?
JE CHNGP3
CMP T.PRI(BX),CX no - compare priorities
JL ULRET2 new<old, no swap
MOV CX,T.PRI(SI)
CMP T.PRI(BX),CX compare with current
JL ULRET2 new<curr, no swap
MOV AX,BX
JMP TSAV new >=curr, task swap
*
CHNGP3 CMP T.PRI(BX),CX yes - compare priorities
JGE ULRET2
JMP RELSAV new<old, task swap
ULRET2 JMP ULRET new>=old, no swap
*
CHNGPX SHR BX ** relink
MOV SI,12(BP) ** at old
MOV (SI),BX ** position
PRERR MOV BX,!102 invalid priority
ULERR2 JMP ULERR1 error
**********************************************************
* *
* SETFLAGS(TASKID,FLAGS) *
* *
* Sets flags in the TCB of the specifies task. *
* Returns: non-zero, or zero on error. *
* *
**********************************************************
DW LIBWORD
DB 7,"setflag"
SETFLG ADD BP,DX BCPL entry but no
MOV 4(BP),DX IP dump since no
POP (BP) interrupts
POP 2(BP)
CALL TCBSET locate TCB
IDERR4 JE IDERR3 invalid id
OR T.FLAGS(BX),AX OR in the flags
JMP ULRET2 unlock and return
**********************************************************
* *
* TESTFLAGS(FLAGS) *
* *
* Tests and clears flags of the current task. *
* Returns TRUE if any of the specified flags were set, *
* FALSE otherwise. The cleared flags are set in RESULT2 *
* *
**********************************************************
DW LIBWORD
DB 7,"testfla"
TSTFLG CLI
MOV SI,CRNTSK
SHL SI ptr to TCB
MOV AX,T.FLAGS(SI)
NOT BX
AND T.FLAGS(SI),BX clear flags
NOT BX
AND BX,AX
MOV G.RES2(DI),BX
JE TSTRET
MOV BX,!-1
TSTRET STI
RETS
**********************************************************
* *
* ABORT(CODE,ARG) *
* *
* This BCPL callable routine aborts the current task and*
* enters DEBUG in standalone mode with arguments CODE, *
* ARG. DEBUG will usually hold the task on exit *
* *
**********************************************************
DB 7,"abort "
ABORT ADD BP,DX std BCPL entry
MOV 4(BP),DX
POP (BP)
POP 2(BP)
MOV 6(BP),SI
XOR CX,CX
INT 34 args in BX and AX
JMP BRET
**********************************************************
* *
* HOLD(TASKID) *
* *
* This function prevents the specified task from being *
* reentered - even though it may have highest priority *
* It returns non zero, or zero on error *
* *
**********************************************************
DB 7,"hold "
HOLD ADD BP,DX std BCPL entry
MOV 4(BP),DX
POP (BP)
POP 2(BP)
MOV 6(BP),SI
CALL TCBSET locate TCB
IDERR3 JE IDERR2 invalid id
TEST T.STATE(BX),!S.HOLD already held?
JNE HLD1 yes - error
OR T.STATE(BX),!S.HOLD set held state
B RELSAV
HLD1 MOV BX,!110 task already held
ULERR1 JMP ULERR
**********************************************************
* *
* RELEASE(TASKID) *
* *
* This function releases a held task. The task selector *
* is then entered. It returns non zero, or zero on error *
* *
**********************************************************
DB 7,"release"
RELEASE ADD BP,DX std BCPL entry
MOV 4(BP),DX
POP (BP)
POP 2(BP)
MOV 6(BP),SI
CALL TCBSET locate TCB
IDERR2 JNE RELSAVA1
JMP IDERR
RELSAVA1 AND T.STATE(BX),!~S.HOLD clear held state
RELSAV MOV AX,TCBLIST
SHL AX
JMP QPTSAV enter scheduler
**********************************************************
* *
* TASKWAIT() *
* *
* This is a BCPL callable function with no arguments *
* *
* The current task is suspended as long as it has an *
* empty work queue. *
* *
**********************************************************
DB 7,"taskwai"
TASKWAI ADD BP,DX
MOV 4(BP),DX
POP (BP)
POP 2(BP)
MOV 6(BP),SI
CLI
MOV SI,CRNTSK
SHL SI
OR T.STATE(SI),!S.WAIT set wait state
MOV AX,SI new TCB = old
* A task which interrupts itself (with TASKWAIT,
* QPKT etc.) needs to save DI, BP, SP and the
* return code (BX). The other registers will be
* assumed lost over a function call.
* AX points to the next TCB.
* SI points to the current TCB ( both m/c addresses)
TSAV MOV T.G(SI),DI
MOV T.P(SI),BP
MOV T.SP(SI),SP
MOV T.BX(SI),BX
MOV BX,AX
SHR BX word address of TCB for SRCHWK
JMP SRCHW1 enter sched.
**********************************************************
* *
* QPKT(PKT) *
* *
* This BCPL callable function queues the packet onto the *
* work queue of its destination task or device. *
* PKT offset P.ID > 0 => destination is a task *
* = -1 => destination is clock *
* < -1 => destination is a device *
* If the packet is successfully queued, then the task *
* number of the sender is inserted in this field. *
* A zero return indicates error - code in RESULT2 *
* *
**********************************************************
DB 7,"qpkt "
QPKT ADD BP,DX std. entry
MOV 4(BP),DX
POP (BP)
POP 2(BP)
* MOV 6(BP),SI
CLI interrupts off
SHL BX pkt
CMP (BX),!NOTINUSE
JE QPKTA
JMP ERRQPKT
QPKTA MOV SI,CRNTSK current task
SHL SI
MOV CX,T.ID(SI) get taskid of sender
MOV DX,P.ID(BX) get destination in DX
CMP DX,!-1 examine destination
JG QPTSK > -1 => task
JL QPDEV < -1 => device
* Destination is the clock.
* The timer packet must be inserted in the correct
* place in the work queue. A requested delay of zero is
* a special case: the packet is returned immediately.
* The delays of any previous packets on the queue must
* be subtracted.
* Arrive here with byte address of packet in BX,
* current task number in CX.
QPCLK MOV P.ID(BX),CX record sender
MOV CX,P.A1(BX)
MOV P.RES1(BX),CX put delay in RES1
OR CX,CX
JLE QPCLK4 delay<=0
MOV SI,!CLKWQ head of work q
QPCLK1 MOV AX,SI save old ptr
MOV SI,(SI) chainon one
SHL SI
JE QPCLK3 end of q
CMP P.RES1(SI),CX insert yet?
JGE QPCLK2 yes - insert here
SUB CX,P.RES1(SI) subtract the delay
B QPCLK1 and continue down q
*
QPCLK2 SUB P.RES1(SI),CX insert the pkt
QPCLK3 MOV SI,AX link it in
MOV AX,(SI)
MOV (BX),AX
SHR BX
MOV (SI),BX
B ULRET1 en ints and return
QPCLK4 MOV CX,!-1 return immediately as if from clock
MOV SI,CRNTSK
SHL SI
* Destination is a task.
* Note that the invalid destination zero will be
* trapped in MOVPKT.
QPTSK XCHG BX,SI pkt addr for MOVPKT
PUSH CS
CALL MOVPKT q the pkt
IDERR1 JE IDERR invalid id
OR CX,CX =0 if other task to go
JNE ULRET1 return if no change
QPTSAV MOV SI,CRNTSK get current TCB
SHL SI
JMP TSAV
* Destination is a device.
* Arrive here with MC address of packet in BX,
* device id in DX, current task id in CX.
QPDEV MOV SI,DEVTAB ptr to device table
SHL SI
NEG DX as devids are -ve
CMP (SI),DX compare with table upb
JL IDERR invalid id
SHL DX
ADD SI,DX add offset to table
MOV SI,(SI) get DCB ptr
SHL SI
JE IDERR invalid id
MOV P.ID(BX),CX record sender
MOV (BX),!0 clear link field
SHR BX BCPL pkt ptr
MOV AX,D.WKQ(SI)
OR AX,AX
JNE QPDEV2 Jump if not empty
* device start - the packet was sent to a device
* with an empty work q
MOV D.WKQ(SI),BX q pkt
XCHG BX,SI
CIS D.START(BX) start device
B ULRET1
* append the packet to the device work q
QPDEV1 MOV AX,(SI) next pkt from work q
QPDEV2 MOV SI,AX
SHL SI
CMP (SI),!0
JNE QPDEV1 Jump if not the end
MOV (SI),BX
ULRET1 JMP ULRET en ints and return
ERRQPKT MOV CX,!198 packet already in use
INT 34
IDERR MOV BX,!101 invalid id
ULERR MOV G.RES2(DI),BX set RESULT2
ULERRZ XOR BX,BX error - return 0
B ULRET1
**********************************************************
* *
* DQPKT(ID, PKT) *
* *
* Attempts to dequeue PKT from the work queue of the *
* specified device or task. If not found there then it *
* attempts to remove the packet from the work queue of *
* the calling task. It returns the id of the task or *
* device on which the packet was found, or zero, and *
* resets DEVTASKID of the packet if it was found on a *
* queue other than the calling task's work queue. *
* *
**********************************************************
DB 7,"dqpkt "
DQPKT ADD BP,DX std. BCPL entry
MOV 4(BP),DX
POP (BP)
POP 2(BP)
CLI interrupts off
MOV DX,BX copy devtaskid
CMP BX,!-1 device, clock or task?
JG DQPTSK task
JE DQPCLK clock
* pkt expected on device work q
MOV SI,DEVTAB ptr to device table
SHL SI
NEG DX make devid +ve
CMP (SI),DX compare with table upb
JL IDERR invalid id
ADD SI,DX
ADD SI,DX
MOV SI,(SI) DCB ptr
SHL SI
JE IDERR
MOV BX,SI
ADD SI,!D.WKQ addr of wkq
NEG DX make -ve again
B PKTDQ look on device q
* pkt expected on clock work q
DQPCLK MOV SI,!CLKWQ addr of wkq
XOR BX,BX no TCB or DCB
B PKTDQ
* pkt expected to be on a task work q
DQPTSK CALL TCBST1 locate the TCB
JE IDERR invalid id
MOV SI,BX copy TCB ptr
DQPT1 MOV BX,SI
MOV DX,T.ID(BX) taskid
ADD SI,!T.WKQ wkq address
* now try to find the packet on the queue.
* queue's task or device id in DX
* BCPL pkt ptr in AX
* queue's TCB or DCB in BX
* MC work queue addr in SI
PKTDQ OR SI,SI end of chain?
PKTDQ1 JE DQPCNT yes - not on q
CMP (SI),AX found it yet?
JE PKTFND yes
MOV SI,(SI) no - chain on one
SHL SI and try again
B PKTDQ1
* Found the packet. Unless it was on the current task work
* queue its id field must be reset.
PKTFND SHL AX MC addr pf pkt
XCHG AX,SI SI=MC addr pkt, AX=MC addr of above pkt
MOV CX,CRNTSK
SHL CX
CMP BX,CX current task?
JE PKTF1 yes - leave id
MOV P.ID(SI),DX no - reset id
PKTF1 CMP DX,!-1 task, clock or device?
JG PKTF6 task
JE PKTF3 clock
* Found on a device work queue. If it was the head packet
* the device stop routine is called, the packet unlinked,
* and if there are any more packets the device start routine is called.
MOV CX,SI
SHR CX
CMP CX,D.WKQ(BX) was it head pkt?
JNE PKTF4 no
CIS D.STOP(BX) yes - call stop routine
MOV AX,(SI) get next pkt
MOV D.WKQ(BX),AX unlink the pkt
OR AX,AX
JE PKTF2 no more pkts
PUSH SI save the pkt
MOV SI,CX BCPL pkt ptr
CIS D.START(BX) restart the device
POP SI
PKTF2 MOV BX,P.ID(SI) returns q id
B PKTF5
* Found on clock work q, next pkt must be corrected.
PKTF3 MOV BX,(SI) find next pkt
JE PKTF4 no more pkts
SHL BX
MOV CX,P.RES1(SI)
ADD P.RES1(BX),CX correct next pkt
PKTF4 MOV CX,(SI) unlink pkt
MOV BX,AX
MOV (BX),CX
PKTF5A MOV BX,DX return id
PKTF5 MOV (SI),!NOTINUSE mark it not queued
JMP ULRET1
* Found on a task work queue. If it was the only
* packet then the packet bit must be cleared in the
* task state word.
PKTF6 MOV CX,(SI) unlink the pkt
XCHG AX,SI
MOV (SI),CX
XCHG SI,AX
CMP T.WKQ(BX),!0 wkq now empty?
JNE PKTF5A
AND T.STATE(BX),!~S.PKT yes - clear PKT bit
JMP PKTF5A
* Packet not found. Try the current task, unless we were
* already looking at the current task's work q.
DQPCNT MOV SI,CRNTSK current TCB ptr
SHL SI
CMP BX,SI looking at curr. tyask?
JE DQPCNTA
JMP DQPT1 no- try current task
DQPCNTA MOV BX,!109 yes - DQPKT failed
JMP ULERR
**********************************************************
* *
* CALL TCBSET *
* *
* This subroutine will convert a taskid in BX to a TCB *
* pointer. It returns zero on error, with the ZF bit set.*
* It turns off interrupts on entry, but may be entered *
* at TCBST1 if they are off already. Slot address is also*
* returned in DX. *
* *
**********************************************************
TCBSET CLI interrupts off
TCBST1 MOV DX,SI
MOV SI,TSKTAB address of tasktab
SHL SI
OR BX,BX task number valid?
JLE TCBERR if <= 0
SHL BX
ADD SI,BX address of table entry
MOV BX,(SI) BCPL TCB ptr (or zero)
XCHG DX,SI
SHL BX
RET
TCBERR XCHG DX,SI
XOR BX,BX return with BX=0, ZF=1
RET
**********************************************************
* *
* CALL MOVPKT *
* *
* This subroutine moves a pkt pointed to by SI to the *
* end of the destination task work queue. *
* It sets the packet received bit in the task status and *
* compares the priority to that of the task pointed to *
* by BX. *
* The id field of the packet is loaded from CX, which *
* should contain the identity of the sender. *
* The routine is entered with interrupts disabled. *
* On exit: *
* BX contains the byte addr of the destination TCB *
* AX contains the byte addr of the next current TCB *
* SI is a word pointer to the packet *
* CX is zero if a task change is needed *
* ZF is set if and only if there was an error *
* *
**********************************************************
MOVPKT MOV AX,BX
MOV BX,P.ID(SI) taskid
PUSH CX save sender's id
CALL TCBST1 locate TCB
JE MOVPK6
POP P.ID(SI) record sender
MOV (SI),!0 clear link
SHR SI
MOV DX,SI
OR T.STATE(BX),!S.PKT set PKT flag
MOV SI,BX
ADD SI,!T.WKQ ptr to start of work q
*
MOVPK1 MOV CX,SI save last ptr
MOV SI,(SI) chain on
SHL SI
JNE MOVPK1 end of chain?
MOV SI,CX addr to fill in
MOV (SI),DX add pkt to end
MOV SI,AX current TCB
MOVPK3 MOV CX,T.PRI(BX)
CMP CX,T.PRI(SI) compare priorities
JL MOVPK4 < curr. no change
JE MOVPK5 = curr.
XOR CX,CX > curr. task swap
MOV AX,BX set new TCB
MOVPK4 MOV SI,DX BCPL pkt addr
CMP AX,!0 clear ZF
RETS
*
MOVPK5 CMP BX,SI dest=curr?
JE MOVPK4 yes - no change
MOV SI,(SI) equal pri - look at next task
SHL SI after current
JMP MOVPK3
MOVPK6 POP DX pop stack
RETS ZF is already set
*
*
*
EVEN
*
* Globals to be initialized
*
DW 0 end of init list
DW G.GLOBIN/2
DW GLOBINI-KLIB
DW G.GVEC/2
DW GETVECI-KLIB
DW G.FVEC/2
DW FREEVECI-KLIB
DW G.CDEV/2
DW CRDEVI-KLIB
DW G.DDEV/2
DW DELDEVI-KLIB
DW G.CTASK/2
DW CRTASKI-KLIB
DW G.DTASK/2
DW DELTSKI-KLIB
DW G.CPRI/2
DW CHNGPRII-KLIB
DW G.SFLAGS/2
DW SETFLGI-KLIB
DW G.TFLAGS/2
DW TSTFLGI-KLIB
DW G.ABORT/2
DW ABORTI-KLIB
DW G.HOLD/2
DW HOLDI-KLIB
DW G.RELEASE/2
DW RELEASEI-KLIB
DW G.TWAIT/2
DW TASKWAII-KLIB
DW G.QPKT/2
DW QPKTI-KLIB
DW G.DQPKT/2
DW DQPKTI-KLIB
DW 99 highest referenced global
KLBEND EQU $
*
*
DSEG
EVEN
DKLIB DW DKLBEND-DKLIB/2 length of data section
*
EVEN
* Descriptors for globals
GLOBINI DW GLOBIN
DW 0
GETVECI DW GETVEC
DW 0
FREEVECI DW FREEVEC
DW 0
CRDEVI DW CRDEV
DW 0
DELDEVI DW DELDEV
DW 0
CRTASKI DW CRTASK
DW 0
DELTSKI DW DELTSK
DW 0
CHNGPRII DW CHNGPRI
DW 0
SETFLGI DW SETFLG
DW 0
TSTFLGI DW TSTFLG
DW 0
ABORTI DW ABORT
DW 0
HOLDI DW HOLD
DW 0
RELEASEI DW RELEASE
DW 0
TASKWAII DW TASKWAI
DW 0
QPKTI DW QPKT
DW 0
DQPKTI DW DQPKT
DW 0
* Other descriptors
UNASGLI DW UNASGL
DW 0
IPKT DW 0 initial packet
DW 0 from task 0
* TCB for the idle task
IDLTCB DW 0 link - end of chain
DW 0 taskid
DW 0 priority
DW 0 no work q
IDLST DW S.INT interrupted state
DW 0 flags
DW 0 stack size
DW 0 no segment list
DW 0 or global vector
DW 0 or stack
DW 0 DI
DW 0 BP
DW SSBASE SP
DW 0 BX
DW 0 AX
DW 0 CX
DW 0 SSAV1
DW 0 SSAV2
DW IDLE IP
DW 0 CS set up at link time
DW #200 FS (interrupts must be enabled!)
DW 0 DX
DW 0 SI
EVEN
DEBGLB EQU $-G.START dummy global vector
DW DEBGLBB used if no DEBUG task
DEBGLBB DW DEBHLT
DW 0
* DEBUG's dummy packet and register save area
DEBPKT DW 0 dummy pkt for sa DEBUG
DEBTAS DW 0 TASK
DEBCDE DW 0 CODE
DEBARG DW 0 ARG
DEBBX DW 0
DEBAX DW 0
DW 0
DW 0
DW 0
DW 0 BP
DW 0 DI
DEBSP DW 0 SP
DEBIP DW 0
DEBCS DW 0
DEBFS DW 0
DEBSV2 DW 0
DEBSV1 DW 0
*
GVTSK DW 0 caller task for GETVEC
*
DKLBEND END