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=curr, task swap * CHNGP3 CMP T.PRI(BX),CX yes - compare priorities JGE ULRET2 JMP RELSAV 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