JSB ZSAV STA CODE /SAVE PARAMETER LDA CNTL1 STA PARM CLA STA ZIP BLF /POSITION FUNCTION CODE RBL,RBL CNTL3 EQU * ADB LU,I LDA CB11,I * IF THIS TASK IS LOCKING IOR CB12,I * IT'S DEVICE, LEAVE IT AND =B100000 * LOCKED FOR CONTROL REQS IOR B * STA CONWD * JSB MTO,I DEF *+6 DEF P03$ DEF CONWD DEF CODE PARM NOP DEF IPAR JSB ZRET CNTL1 DEF ZIP ZIP NOP * CNTLX EQU * NOP JSB ZSAV STA CODE JMP CNTL3 /PREP FOR 2 PARAMETERS SKP **************************************************** ******************************************************************************** **************************************************** * LU EQU * CB1 NOP TYPE EQU * CB2 NOP CB3 NOP CB4 NOP CB5 NOP CB6 NOP CB7 NOP CB8 NOP CB9 NOP CB10 NOP CB11 NOP CB12 NOP CB13 NOP CB14 NOP CB15 NOP CB16 NOP STP$ EQU * CB17 NOP SUPV EQU * CB18 NOP STPX EQU STP$-CB1+1 STPY EQU STPX+1 CONWD NOP CODE NOP SKP ******************************************************************************** * * PUSH SUBROUTINE - SAVE RETURN AND CB POINTERS,SET NEW * CB POINTERS * JSB PUSH * DEF *+3 * DEF X ADDRESS OF LAST SUBROUTINE ARGUMENT * DEF CB ADDRESS OF NEW CB ARRAY * ******************************************************************************** PUSH NOP LDB PUSH LDA B,I CMA,CLE,INA ADA PUSH / STA TEMP /SAVE NO. OF PARAMETERS LDA B,I STA PUSH /SAVE RETURN ADDRESS(PUSH) INB LDA B,I /GET SUBROUTINE RETURN * RAL,CLE,ERA /REMOVE INDIRECT BIT INA LDA A,I STA IRET /SAVE FOR PUSH DOWN INB LDA B,I /GET NEXT CB SETTING STA CBNXT JSB PUSHR /PUSH DOWN STACK LDA CBNXT LDB TEMP CPB N03$ /CHANGE CB IF 2 PARAMETERS JSB SETCB /SET NEW CB DEFINITIONS JMP PUSH,I TEMP NOP * * PUSHR NOP JSB SETAD /SET ADDRESS OF CB POINTERS LDB STP$,I /GET STACK POINTER INB CPB SMAX /CHECK FOR OVERFLOW JMP ABRT2 ADB CB1 /FORM ADDRESS LDA IRET STA B,I /SAVE RETURN INB LDA CBLOC STA B,I /SAVE CB ARRAY ISZ STP$,I ISZ STP$,I /INCR STACK POINTER JMP PUSHR,I SKP ******************************************************************************** * * POP SUBROUTINE * JSB POP * DEF *+1 * ******************************************************************************** POP NOP RTRN EQU POP JSB SETAD /SET ADDRESS OF CB POINTERS LDB STP$,I CPB SMIN /STACK EMPTY? JMP ABRT3 ADB CB1 LDA B,I STA CBNXT /GET CB ARRAY ADB N01$ LDA B,I /GET RETURN ADDRESS STA POPX SZA,RSS JMP ABRT4 LDA STP$,I ADA N02$ STA STP$,I /DECR STACK POINTER LDA CBNXT JSB SETCB /SET CB ARRAYS JMP POPX,I POPX NOP * SKP ******************************************************************************** * ALLOCATE DATA BLOCKS * JSB ALLOC * DEF *+3 * DEF BLOK# BLOCK # TO BE ALLOCATED * DEF POOL# BUFFER POOL #,0= RELEASE * ******************************************************************************** BLOK# NOP POOL# NOP ALLOC NOP JSB .ENTR DEF BLOK# JSB SAVAD LDA BLOK#,I /SAVE BLOCK NO. AND P01$ /INSURE 1 OR 2 SZA,RSS LDA P02$ STA CB13,I LDA POOL#,I /SAVE POOL NO. STA CB14,I SZA,RSS /RELEASE? JMP ALLC1 /YES ALLC2 JSB GBUF /NO-REQUEST BUFFER DEF *+3 DEF CB15,I DEF CB14,I LDB CB15,I CPB N01$ /AVAILABLE? JMP ALLC3 /NO-GO PAUSE JSB BLKAD /YES CALCULATE BLOCK PARAM. ADDR. STA B,I /SAVE ADDRESS INB LDA CB15,I ALF,ALF IOR CB14,I /FORM ID + POOL TYPE STA B,I /SAVE POOL TYPE ALLCX EQU * /RETURN JSB POP * ALLC1 EQU * JSB BLKAD /CALCULATE BLOCK PARAM. ADDR. CLA STA B,I /CLR ADDRESS INB LDA B,I AND RBYT$ STA ALLC5 /SAVE POOL TYPE LDA B,I ALF,ALF AND RBYT$ STA ALLC4 /SAVE ID CLA STA B,I /CLR POOL TYPE JSB PBUF DEF *+3 DEF ALLC4 DEF ALLC5 JMP ALLCX ALLC4 NOP ALLC5 NOP * ALLC3 EQU * JSB PAUZ /PAUSE TILL BUFFER AVAIL. DEF *+1 JMP ALLC2 /(NOTE) PAUZ SETS UP CB POINTERS * BLKAD NOP LDB CB13,I BLS ADB CB4 ADDRESS OF BLOCK PARAM. JMP BLKAD,I * * SKP ******************************************************************************** * * PAUSE SUBROUTINE * ******************************************************************************** PAUZ NOP JSB .ENTR DEF PAUZ JSB SAVAD JSB MTO,I DEF *+6 DEF P01$ DEF P63$ DEF P01$ DEF P01$ DEF IPAR JSB POP P63$ DEC 63 * SKP ******************************************************************************** * * SPLIT SUBROUTINE * JSB SPLIT * DEF *+4 * DEF LU LOGICAL UNIT OF NEW THREAD * DEF BLOK# BLOCK # TO BE ATTACHED TO NEW THREAD * DEF NWRDS NO. OF WORK BLOCK WORDS TO PASS * JMP CONT PARENT THREAD RETURNS HERE * --- NEW THREAD STARTS HERE * ******************************************************************************** S1 NOP LU OF NEW THREAD S2 NOP BLOCK TO ATTACH S3 NOP # OF WORK BLOCK WORDS TO PASS * SPLIT NOP JSB .ENTR DEF S1 JSB SAVAD LDA S1,I /SAVE LU STA CB14,I LDA S2,I /SAVE BLOCK # AND P03$ /ALLOW 0-3 ONLY STA CB13,I LDA SPLIT /SAVE RETURN ADDRESS INA STA CB15,I LDA S3,I /SAVE # OF WB WORDS STA CB16,I * SPLT1 EQU * CLA STA CB3,I /CLEAR FLAG LDA ICBX1 /CALCULATE START OF CB'S MPY CBL ADA ICBP STA B LDA ICBX1 INA SPLT4 STA PIPAR /SET PENDING IPAR LDA B,I CPA CB14,I /LU MATCH? JMP SPLT2 /YES SPLT3 EQU * LDA PIPAR CPA ICBX2 /END OF CB'S JMP SPLT5 /YES INA ADB CBL /NO-CHECK NEXT CB JMP SPLT4 SPLT5 LDA CB3,I SZA,RSS /ANY LU'S MATCH? JSB RTRN /NO-RETURN JSB PAUZ /YES-WAIT FOR IT DEF *+1 JMP SPLT1 * SPLT2 EQU * ISZ CB3,I /INDICATE MATCHING LU STB BASE /SAVE POTENTIAL NEW CB ADB P02$ LDA B,I SZA,RSS /CB BUSY? JMP SPLT6 /ON ADB N02$ /YES-RESUME SEARCH JMP SPLT3 SPLT6 EQU * LDA IPAR STA B,I /SET CB BUSY STA CB3,I INB LDA B,I /SAVE WB ADDRESS STA CB14,I LDA CB13,I /CALCULATE ADDRESS OF BLOCK PARAMETERS SZA,RSS /ANY DATA BLOCKS TO TRANSFER? JMP SPLT9 /NO ADB P02$ /YES-OFFSET TO CB6 CPA P02$ /MOVING DB2 ONLY? ADB P02$ /YES-OFFSET TO CB8 STB PTR /SAVE DESTINATION POINTER LDB N02$ /PRIME FOR 1 DATA BLOCK CPA P03$ /BOTH? LDB N04$ /YES-INDICATE 4 WORDS TO MOVE STB CB13,I /SET MOVE COUNT LDB CB6 /DETERMINE SOURCE ADDRESS CPA P02$ /MOVING DB2 ONLY? ADB P02$ /YES-OFFSET TO CB8 JSB SPLTM /MOVE ADDRESS ISZ CB13,I /DONE? JMP *-2 /NO SPLT9 EQU * LDA CB16,I SZA,RSS /WORK BLOCK TRANSFER? JMP SPLTA /NO CMA,INA /YES-SET LOOP COUNT STA CB16,I LDB CB4,I /GET ADDRESS OF WB(PARENT) LDA CB14,I /GET WORK BLOCK(NEW) STA PTR SPLTB EQU * LDA B,I /MOVE STA PTR,I INB ISZ PTR ISZ CB16,I /DONE? JMP SPLTB /NO-MOVE NEXT WORD SPLTA EQU * LDA BASE /MODIFY POINTERS FOR NEW CB STA CB1 ADA N01$ ADA SMIN STA STP$ LDA CB15,I STA IRET LDA SPLT7 STA PUSHR JMP PUSHR+2 /PUT NEW CB RETURN ON STACK SPLT7 DEF *+1 LDA PIPAR /SET POINTER TO PENDING VALUE STA IPAR JSB MTO,I DEF *+7 DEF P01$ DEF PWAIT DEF P01$ DEF P01$ DEF IPAR DEF SPLT8 LDA CB3,I /RESTORE POINTER STA IPAR LDA PIPAR /SET NEW THREAD IN PARENT STA CB3,I JSB POP /RETURN SPLT8 EQU * DEF *-1 * PWAIT OCT 20077 * SPLTM NOP LDA B,I /GET PARENT VALUE STA PTR,I /SAVE ON NEW CB ISZ PTR CLA /CLR PARENT STA B,I INB JMP SPLTM,I * SKP * * RELEASE CONTROL BLOCK * RLSCB NOP JSB ALLOC /RELEASE DATA BLOCK 1 DEF *+3 DEF P01$ DEF P00$ JSB ALLOC /RELEASE DATA BLOCK 2 DEF *+3 DEF P02$ DEF P00$ CLA STA CB3,I /INDICAT NOT BUSY LDA CB2,I /INSURE LOGGING OFF. AND RBYT$ STA CB2,I SUSP JSB MTO,I /SUSPEND DEF *+2 DEF P53$ P53$ DEC 53 SKP ******************************************************************************** ******************************************************************************** * SAVAD NOP LDB SAVAD ADB N04$ LDA B,I STA IRET JSB PUSHR JMP SAVAD,I * * * SET CONTROL BLOCKS * SETCB NOP STA CBLOC /SET CB ARRAY LOCATION JSB SETAD /SET ADDRESS OF CB POINTERS LDB CBLOC ADB N01$ /ADJUST TO ARRAY POINTER LDA CB1 STA B,I /SET CB ARRAY ADB P02$ LDA CB4,I STA B,I /SET WB ARRAY ADB P02$ LDA CB6,I STA B,I /SET DB#1 ARRAY ADB P02$ LDA CB8,I STA B,I /SET DB#2 ARRAY JMP SETCB,I * * SETAD EQU * NOP JSB STAT /GET STATUS CCA ADA IPAR /CALCULATE ADDRESS OF CB MPY CBL ADA ICBP LDB CBX /INITIALIZE LOOP STB PTR LDB CBTL SETA1 STA PTR,I /SET ADDRESSES ISZ PTR INA INB,SZB JMP SETA1 JMP SETAD,I CBX DEF CB1 * * INTERNAL SAVE/RESTORE RETURN ADDRESSES * ZSAV NOP STB ZSAVB LDB ZSAV ADB N02$ LDB B,I STB SUPV,I LDB ZSAVB JMP ZSAV,I * ZRET NOP JSB SETAD LDB SUPV,I STB ZRET JMP ZRET,I ZSAVB NOP * * * STAT NOP LDA IPAR STA PSTAT /SAVE CURRENT THREAD JSB MTO,I DEF *+6 DEF P79$ DEF ISTAT DEF IPAR DEF ILU DEF ILOG LDA IPAR LDB PSTAT SZA,RSS /THREAD =0? STB IPAR /YES-RESTORE PREVIOUS THREAD LDA IPAR SZA,RSS JMP ABRT5 JMP STAT,I PSTAT NOP P79$ DEC 79 .STAT EQU STAT SKP ******************************************************************************** * * THREAD ABORT ROUTINES * ******************************************************************************** ABRT5 JSB ABORT /ILLEGAL THREAD ID (0) ABRT4 JSB ABORT /RETURN ADDRESS=0 ABRT3 JSB ABORT /STACK UNDERFLOW ABRT2 JSB ABORT /STACK OVERFLOW ******************************************************************************** ABRTX DEF *+2 ABORT NOP LDA ABORT CMA,INA ADA ABRTX ADA =B30060 /OUTPUT NAME:XX AB LDB =B40502 /XX=ERROR TYPE JSB ERR0 JMP SUSP CBTL ABS -STPY SMIN ABS STPX SMAX EQU CBL PTR NOP PIPAR NOP CBLOC NOP IRET NOP CBNXT NOP BASE NOP * * BASE PAGE CONSTANTS * # EQU 53B N01$ EQU #-1 N02$ EQU #-2 N03$ EQU #-3 N04$ EQU #-4 N05$ EQU #-5 N06$ EQU #-6 N07$ EQU #-7 N08$ EQU #-8 N09$ EQU #-9 N10$ EQU #-10 N64$ EQU #-11 P00$ EQU # P01$ EQU #+1 P02$ EQU #+2 P03$ EQU #+3 P04$ EQU #+4 P05$ EQU #+5 P06$ EQU #+6 P07$ EQU #+7 P08$ EQU #+8 P09$ EQU #+9 P10$ EQU #+10 P17$ EQU #+11 P64$ EQU #+12 M17$ EQU #+13 M37$ EQU #+14 M77$ EQU #+15 M177$ EQU #+16 RBYT$ EQU #+17 OCT 377 LBYT$ EQU #+18 OCT 177400 M3777 EQU #+19 OCT 3777 M1777 EQU #+20 OCT 177700 CLEAR EQU P00$ OPENL EQU P02$ LCLOS EQU P03$ RWND EQU P04$ RWNDX EQU P05$ DSTAT EQU P06$ LDR EQU P08$ TOF EQU P09$ END :: :CO MOUNT TAPE #8, TYPE :GO :PA