ASMB,R,Q,C
*     NAME:   SCHED 
*     SOURCE: 92070-18141 
*     RELOC:  92070-16141 
*     PGMR:   HLC 
* 
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS      * 
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       * 
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * 
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.        * 
*  **************************************************************** 
* 
* 
      NAM SCHED,0  92070-16141  REV.1941  790906  
      ENT $EX09,$EX10 
      ENT $EX23,$EX24,$WTSC 
      ENT $WRTS,$$SCH,$.SCH 
* 
      EXT $RQP8,$XQT,$LIST
      EXT $STAT,$PRAM,$SCXX 
      EXT $RQP1,$RQP2,$RQP3 
      EXT $RQP9,$EXEX,$WRKS 
      EXT $WORK,$XEQ
      EXT $IDNO,$A,$CON 
      EXT $ALCS,$SBLN,$IDSZ,$IDA
      EXT $N5.F,$SCHD 
      EXT $NAME,$TMP1 
* 
A     EQU 0 
B     EQU 1 
* 
* 
$EX09 EQU * 
$EX10 EQU * 
$EX23 EQU * 
$EX24 EQU * 
      JSB $NAME     FIND PROGRAM NAME 
      DEF $RQP2,I 
      SZB,RSS 
      JMP SC05      NOT FOUND 
      STA $A,I      SAVE STATUS 
      SZA 
      JMP QUCHK     NOT DORMANT, CANNOT SCHEDULE IT NOW 
      LDA $RQP9,I 
      SZA,RSS 
      JMP NOSTR     NO STRING PASSED
      SSA 
      CMA,INA,RSS   CONVERT LENGTH TO POSITIVE CHARS
      ALS 
      STA $RQP9     ADDRESS ALREADY IN $RQP8
      JSB $ALCS 
      JMP SC10      NOT ENOUGH MEMORY EVER
      JMP SUSP      NOT ENOUGH MEMORY NOW 
NOSTR LDB $XQT
      JSB $PRAM     CLEAR CALLER'S PARAMETERS 
      NOP 
      LDB $WORK 
      JSB $PRAM     PASS PARAMETERS TO SON
      DEF $RQP3,I 
* 
      LDB $WORK 
      JSB $LIST     SCHEDULE SON
      OCT 60
* 
      LDB $WORK 
      ADB =D28
      STB IDAD      USE DAD'S CONSOLE LU
      LDA B,I 
      LDB $CON,I
      RRR 8 
      ALF,ALF 
      STA IDAD,I      FOR LOGLU 
* 
      LDA $RQP1 
      SLA,RSS 
      JMP $EXEX     EXEC 10 OR EXEC 24, NO WAIT 
      LDB $XQT
      JSB $LIST     SUSPEND CALLER
B3    OCT 3 
      LDB $WORK 
      STB $XQT,I    SET POINTER TO SON IN CALLER'S ID 
* 
      LDB $XQT
      JSB $IDNO     CONVERT TO ID SEGMENT NUMBER
      CCB 
      ADB $WRKS 
      IOR B,I       ADD 5TH CHAR OF NAME
      STA B,I 
      JMP $EXEX 
* 
* 
SUSP  LDA $SBLN     LENGTH OF SAM REQUIRED FOR STRING 
      STA $TMP1,I 
      LDB $XQT
      JSB $LIST     MEMORY SUSPEND CALLER 
      OCT 61
      JMP $XEQ
* 
* 
QUCHK LDA $RQP1 
      RRR 4 
      SLA,RSS 
      JMP $EXEX     EXEC 9 OR EXEC 10, NO QUEUE 
      LDA $WORK 
      LDB $XQT
      JSB $LIST     QU SUSPEND CALLER 
      OCT 53
      JMP $XEQ
* 
* 
      HED  STRING PASSING TO FATHER 
* 
$WRTS EQU *         WRITE STRING TO FATHER
      JSB IDAD      FIND ID SEGMENT ADDRESS OF FATHER 
      JMP $EXEX     NO FATHER 
      STB $A,I      INDICATE SUCCESS (B=0)
      STA B 
      LDA $RQP3 
      STA $RQP8     BUFFER ADDRESS FOR $ALCS
      JSB $ALCS     ALLOCATE STRING FOR FATHER
      JMP SC10      NOT ENOUGH MEMORY EVER
      JMP SUSP      NOT ENOUGH MEMORY NOW 
      JMP $EXEX 
* 
* 
SC05  LDB =D5 
      RSS 
SC10  LDB =D10
      JMP $SCXX 
* 
* 
IDAD  NOP           CONVERT FATHER POINTER TO ID ADDRESS
      LDA $N5.F,I 
      AND =B377 
      SZA,RSS 
      JMP IDAD,I    NO FATHER 
      ISZ IDAD
      ADA =D-1
      MPY $IDSZ     (CLEARS B-REG)
      ADA $IDA
      JMP IDAD,I
* 
* 
$WTSC NOP           SET PROGRAM DORMANT AND SCHEDULE WAITERS
      LDA $STAT,I 
      AND =B77
      CPA B3
      JMP FIXSN     WAITING FOR ANOTHER PROGRAM 
DORM  LDB $XQT
      JSB $LIST     MAKE IT DORMANT 
      OCT 0 
      LDA $XQT
      JSB $SCHD     SCHEDULE QUEUED PROGRAMS
      OCT 53
      JSB IDAD      GET ID ADDRESS OF FATHER
      JMP $WTSC,I   NO FATHER 
* 
      STA IDAD
      STA B 
      JSB $LIST     SCHEDULE FATHER 
      OCT 60
      LDA $N5.F,I 
      AND =B177400  CLEAR FATHER POINTER
      STA $N5.F,I 
* 
      LDB =B100000
      ISZ IDAD
      LDA $STAT,I 
      ALF,ALF 
      SLA           CHECK 'OF' BIT
      STB IDAD,I    ABORTED, TELL THE FATHER
      JMP $WTSC,I 
* 
* 
FIXSN LDB $XQT,I    MAKE SON AN ORPHAN
      ADB =D14
      LDA B,I 
      AND =B177400    BY CLEARING THE FATHER POINTER
      STA B,I 
      JMP DORM
* 
$$SCH EQU *         STANDARD MODULE 
$.SCH DEC 0         STANDARD MODULE 
* 
      END 
                                                                                      