ASMB,R,Q,C
      HED * BASIC SCHED AND TRAP ROUTINES *   92076-1X014 REV. 2001 
      NAM SCHD,7 92076-1X014 REV.2001 800213 92076-12001
* 
* 
**************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS    *
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
* PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
**************************************************************
***************************************************************** 
* 
* 
* 
*   NAME:     TIME SCHEDULING ROUTINES
*   SOURCE:   92076-18014 
*   RELOC:    PART OF 92076-12001 
*   PGRM:     B.J.L.
* 
* 
* 
* 
*      RTE BASIC SCHEDULER ROUTINES 
* 
* 
* 
****************************************************
* 
* THIS MODULE CONTAINS THOSE ROUTINES USED BY THE 
*  BASIC INTERPRETER TO PERFORM PRIORITY
*  SCHEDULING AND EXECUTION OF TASKS
* 
****************************************************
* 
* ENTRY POINTS: 
* 
      ENT TTYS,SSETP,ENABL,DSABL,TRNON,SSTRT
* 
* EXTERNAL REFERENCES:
* 
      EXT ERROR,TIME,EXEC 
      EXT $LIBR,$LIBX 
      EXT .ENTR,TRAP#,TSNXT,TSEND,TSTBL,TSTIM,TSCNT,TSPTR 
      EXT FINDS,TRMAK,TRDEL 
      EXT TRTBL,TRPTR,TRNXT,TRFLG 
      EXT TRMSK,TRPNO,SEKNO,PRINO 
* 
      EXT .FAD,.FMP,.FSB,.FDV,FLOAT,IFIX
SEQNO EQU SEKNO 
* 
* 
      SUP PRESS MULTIPLE LISTING
****************************************************
      SKP 
***** 
* 
** CNVRT ** CONVERT TIME FROM FLOATING POINT HHMMSS FORM
*           TO FLOATING POINT SECONDS 
* 
*     DLD TIME IN FLOATING POINT HHMMSS FORM
*     JSB CNVRT 
*     RETURN  .A.&.B.= FLOATING POINT SECONDS 
* 
* EXTERNALS REQUIRED: 
* 
      EXT ..FCM 
* 
***** 
* 
CNVRT NOP 
      DST WHOLE    SAVE INCOMING VALUE (HHMMSS) 
      JSB .FDV
      DEF F.100 
      JSB IFIX
      JSB FLOAT 
      DST HHMM     HHMM= INT(HHMMSS/100)
      JSB .FDV
      DEF F.100 
      JSB IFIX
      JSB FLOAT 
      DST HH       HH= INT(HHMM/100)
      JSB .FMP
      DEF F.100 
      JSB ..FCM 
      JSB .FAD
      DEF HHMM
      DST MM       MM=HHMM-HH00 
      DLD HHMM
      JSB .FMP
      DEF F.100 
      JSB ..FCM 
      JSB .FAD
      DEF WHOLE 
      DST SS       SS=HHMMSS-HHMM00 
      DLD HH
      JSB .FMP
      DEF F.60
      JSB .FAD
      DEF MM
      JSB .FMP
      DEF F.60
      JSB .FAD     .A.&.B.= (HH*60+MM)*60+SS SECONDS
      DEF SS
      JMP CNVRT,I 
* 
      SKP 
***** 
* 
** BSERR ** BASIC SCHEDULER ERROR ROUTINE 
* 
*     LDA ADDRESS OF ERROR NUMBER 
*     JSB BSERR 
*     RETURN
* 
* 
***** 
* 
BSERR NOP 
      STA BSER1 
      JSB $LIBX 
      DEF *+1,I       *791228*
      DEF *+1 
      JSB ERROR 
      DEF *+3 
BSER1 NOP          (ADDRESS OF ERROR NUMBER)
      DEF SCHED    (ADDRESS OF STRING "SCHED")
      JSB $LIBR 
      OCT 177777      *791228*
      JMP BSERR,I  RETURN 
* 
* 
      SKP 
* 
* 
* 
* CHECK FOR OUT OF RANGE ON THE STATEMENT #'S (BETWEEN 1 AND 9999)
* FOR ROUTINES START, SETP, TRNON.
* 
*      CALLING SEQUENCE:
* 
*        LDA <STATEMENT #>
*        JSB CKST#
*        ERROR RETURN        ISSUE ERROR #8 
*        CONTINUE EXECUTION 
* 
* 
* 
* THIS ROUTINE WAS ADDED 791228 BY B.J.L. 
* 
* 
* 
CKST# NOP 
      STA HOLD      SAVE #
      SZA,RSS       0?
      JMP CKSTE     YES 
      SSA           NEGATIVE? 
      JMP CKSTE     YES 
      ADA M10K      >9999?
      SSA,RSS 
      JMP CKSTE     YES 
      LDA HOLD      RESTORE VALUE OK! 
      ISZ CKST#     RETURN P+2
      JMP CKST#,I 
CKSTE LDA AD8 
      JMP CKST#,I 
* 
HOLD  NOP 
AD8   DEF .8
.8    DEC 8 
M10K  DEC -10000    *800212** 
* 
* 
* 
      SKP 
***** 
* 
** SSETP ** MAKE TRAP TABLE ENTRY WITH GIVEN SEQ NBR AND PRIORITY 
* 
*     JSB SSETP 
*     DEF *+3 
*     DEF SEQUENCE NUMBER 
*     DEF PRIORITY
*     RETURN
* 
***** 
* 
SETPA NOP 
SETPB NOP 
SSETP NOP 
      JSB .ENTR     RETRIEVE
      DEF SETPA      PARAMETERS 
      JSB $LIBR 
      OCT 177777      *791228*
      LDA SETPA,I 
      JSB CKST#      CHECK FOR IN RANGE *791228*
      JMP SETPE      FOR STATEMENT #: NO,ERROR *791228* 
      STA SEQNO      YES,SEQUENCE NUMBER
      LDB SETPB,I 
******************************ADDED 791228*********************** 
      SZB,RSS        ERROR IF 0 
      JMP SETP4 
      SSB            ERROR IF NEG.
      JMP SETP4 
      ADB M100       ERROR IF >99 
      SSB,RSS 
      JMP SETP4 
      LDB SETPB,I    RESTORE B
***************************791228******************************** 
      STB PRINO     PRIORITY
      CLA           ZERO IS DEFAULT VALUE FOR 
      STA TRPNO     TRAP NUMBER OF ENTRY
      LDA SEQNO     GET SEQ NBR 
      JSB FINDS     LOOK FOR ENTRY WITH THAT SEQ NBR
      JMP SETP2      NONE FOUND, MAKE NEW ENTRY 
      LDB TRPTR     FOUND,
      LDA 1,I       SAVE ENTIRE FIRST WORD
      STA SEQNO      SINCE TRAP BIT MAN BE SET
      INB 
      LDA 1,I       GET SECOND WORD OF ENTRY, 
      AND TRMSK      EXTRACT TRAP NBR 
      STA TRPNO       AND SAVE FOR MAKING NEW ENTRY 
      JSB TRDEL        THEN REMOVE THIS ENTRY 
SETP2 JSB TRMAK     MAKE NEW ENTRY
***********************CHANGED 791228****************************** 
       JMP SETP3     NO ROOM
      JMP SETP5     RETURN
SETP3 LDA AD2     TRAP TABLE FULL 
      JMP SETPE 
SETP4 LDA AD7     PRIORITY OUT OF RANGE 
SETPE JSB BSERR 
SETP5 JSB $LIBX 
      DEF SSETP,I     *791228*
* 
M100  DEC -100
* 
* 
      SKP 
******
* 
**  TTYS ALLOWS THE USER TO SCHEDULE A TASK (GOSUB) WITH A
**   TRAP BY TYPING ANY KEY ON AN AUXILLIARY TELETYPE.
* 
* 
*      JSB TTYS 
*      DEF *+3
*      DEF <LOGICAL UNIT # OF THE AUXILLIARY TTY> 
*      DEF <TRAP # TO BE ACTIVATED> 
*      RETURN 
* 
* 
*      NOTE: IF LOGICAL UNIT # IS LESS THAN 7 THEN AN ERROR 
*            MESSAGE 'ERROR TTYS-1' IS PRINTED. 
* 
UNIT  NOP 
TRAPN NOP 
TTYS  NOP 
      JSB .ENTR 
      DEF UNIT
      LDA UNIT,I    GET UNIT#  AND GIVE ERROR IF LESS 
      ADA M7          THAN 7
      SSA 
      JMP ERR       ERROR 
      LDA UNIT,I    GET LU# 
      IOR B2000     MASK IN CONTROL CODE
      STA SNPAR 
      JSB EXEC      ENABLE
      DEF *+3         AUXILLIARY
      DEF .3            TERMINAL
      DEF SNPAR 
      LDA TRAPN,I   GET TRAP #
      JSB $LIBR     BREAK FENCE 
      OCT 177777      *791228*
      STA TRAP#     STORE TRAP NUMBER 
      JSB $LIBX     SEW UP THE FENCE
      DEF TTYS,I      *791228*
* 
ERR  JSB ERROR      ERROR RETURN
      DEF *+3 
      DEF .1
      DEF ERRM
      JMP TTYS,I
      SKP 
* 
***** 
* 
** ENABLE ** ENABLE TRAP TABLE ENTRY ASSOC. WITH GIVEN SEQ NBR
* 
*     JSB ENABL 
*     DEF *+2 
*     DEF SEQUENCE NBR
*     RETURN
* 
* NOTE: ATTEMPT TO ENABLE NON-EXISTENT TRAP TABLE ENTRY 
*       RESULTS IN TRANSFER TO ERROR ROUTINE. 
*       IF SEQ NBR IS ZERO, ALL ENTRIES ARE ENABLED 
***** 
* 
ENABA NOP 
ENABL NOP 
      JSB .ENTR 
      DEF ENABA 
      JSB $LIBR 
      OCT 177777      *791228*
      LDA ENABA,I   RETRIEVE SEQUENCE NUMBER
      SZA,RSS       ZERO MEANS ENABLE ALL ENTRIES 
      JMP ENAB1 
      SSA           IF VALUE IS NEG. ERROR *791228* 
      JMP ENABE      *791228* 
      JSB FINDS     LOOK FOR IT IN TRAP TABLE 
      JMP ENABE     NOT FOUND 
      LDB TRPTR     FOUND 
      INB 
      LDA 1,I       GET SECOND WORD OF ENTRY
      IOR BIT15    SET ENABLE BIT 
      STA 1,I 
      JMP ENAB4     RETURN
ENABE LDA AD4 
      JSB BSERR 
      JMP ENAB3     RETURN
ENAB1 LDB TRTBL 
ENAB2 CPB TRNXT     END OF TABLE
      JMP ENAB4     YES, RETURN 
      INB 
      LDA 1,I       GET SECOND WORD OF ENTRY
      IOR BIT15    SET ENABLE BIT 
      STA 1,I 
      INB           GO TO NEXT ENTRY
      JMP ENAB2     LOOP
ENAB4 STB TRFLG     ENABLE TRAP TABLE SEARCH
ENAB3 JSB $LIBX 
      DEF ENABL,I     *791228*
      SKP 
***** 
* 
** DSABL  ** DISABLE TRAP TABLE ENTRY ASSOC WITH GIVEN SEQ NBR
* 
*     JSB DSABL 
*     DEF *+2 
*     DEF SEQUENCE NUMBER 
*     RETURN
* 
* NOTE: SEQ NBR=0 MEANS DISABLE ALL ENTRIES 
*       SEQ NBR POSITIVE MEANS DISABLE ASSOC ENTRY
*       SEQ NBR NEGATIVE MEANS DELETE ASSOC. ENTRY FROM TABLE 
* 
* NOTE: ENTRY NOT FOUND CAUSES TRANSFER TO ERROR ROUTINE
* 
***** 
DSABA NOP 
DSABL NOP 
      JSB .ENTR 
      DEF DSABA 
      JSB $LIBR 
      OCT 177777      *791228*
      LDA DSABA,I 
      SZA,RSS       ZERO MEANS ENABLE ALL ENTRIES 
      JMP DSAB1 
      SSA           NEG MEANS DELETE ENTRY
      JMP DSAB2 
      JSB FINDS     LOOK FOR ENTRY IN TRAP TABLE
       JMP DSABE    NOT FOUND 
      LDB TRPTR     FOUND 
      INB 
      LDA 1,I       GET SECOND WORD OF ENTRY
      ELA,CLE,ERA    CLEAR ENABLE BIT 
      STA 1,I 
      JMP DSAB4     RETURN
DSABE LDA AD4 
      JSB BSERR 
DSAB4 JSB $LIBX 
      DEF DSABL,I     *791228*
* 
** HERE TO DISABLE WHOLE TABLE
* 
DSAB1 CLA            DONT NEED TO SEARCH TRAP TABLE 
      STA TRFLG      UNTIL SOMETHING HAPPENS
      LDB TRTBL 
DSAB3 CPB TRNXT     END OF TABLE? 
      JMP DSAB4     YES 
      INB 
      LDA 1,I       GET SECOND WORD OF ENTRY
      ELA,CLE,ERA   CLEAR ENABLE BIT
      STA 1,I 
      INB           ADVANCE TO NEXT ENTRY 
      JMP DSAB3     LOOP
* 
** HERE TO DELETE ENTRY 
* 
DSAB2 CMA,INA       MAKE SEQ NBR POSITIVE 
      JSB FINDS     LOOK FOR ASSOC ENTRY
       JMP DSABE    NOT FOUND 
      JSB TRDEL     DELETE ENTRY
      JMP DSAB4     RETURN
* 
*  CONSTANTS
* 
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.6    DEC 6 
M1    DEC -1
M3    DEC -3
M5    DEC -5
M7    DEC -7
M256  DEC -256
MNEG  OCT 100000    MAXIMUM NEG FLOATING
      OCT 376        POINT NUMBER 
BIT15 EQU MNEG
      SKP 
***** 
* 
** TRNON ** ROUTINE TO START TASK AT GIVEN TIME 
* 
*     JSB TRNON 
*     DEF *+3 
*     DEF SEQUENCE NUMBER 
*     DEF TIME TO START (FLOATING POINT VALUE HHMMSS) 
*     RETURN
* 
* NOTE: IF THE TIME SCHEDULING TABLE IS FULL, CONTROL 
*       WILL BE TRANSFERRED TO ERROR
* 
***** 
* 
TRNOB NOP 
TRNOA NOP 
TRNON NOP 
      JSB .ENTR 
      DEF TRNOB 
      DLD TRNOA,I 
      JSB CNVRT    GET TIME IN FLOAT PT SECONDS 
      DST TMPAR     THEN SET UP FOR PROCESSING
      LDA TRNOB,I  GET SEQ NBR TO PASS TO BSCED 
      JSB CKST#    CHECK FOR STATEMENT # RANGE *791228* 
      JMP TRNEE    OUT OF RANGE ERROR   *791228*
      JSB BSCED    SET UP TRAP & TIME SCHED TABLES
      JMP TRNON,I   THEN RETURN 
**********************CHANGED 800213*********************************** 
TRNEE JSB $LIBR 
      OCT 177777
      JSB BSERR     *791228*
      JSB $LIBX 
      DEF TRNON,I   *791228*
***************************800213************************************** 
* 
      SKP 
***** 
* 
** SSTRT ** ROUTINE TO START TASK AFTER GIVEN DELAY 
* 
*     JSB SSTRT 
*     JSB SSTRT 
*     DEF *+3 
*     DEF SEQUENCE NUMBER 
*     DEF DELAY (FLOAT POINT SECONDS) 
*     RETURN
* 
***** 
* 
SSTRB NOP 
SSTRA NOP 
SSTRT NOP 
      JSB .ENTR 
      DEF SSTRB 
      JSB TIME      GET CURRENT TIME
      DEF *+2 
      DEF TMPAR 
      JSB .FAD       THEN ADD DELAY 
      DEF SSTRA,I 
      DST TMPAR       TO SET UP AS TIME OF DAY CALL 
      JSB .FSB      IF GREATER THAN 2400 HOURS, 
      DEF FLDAY 
      SSA          SUBTRACT ONE DAY 
      JMP SSTR1 
      DST TMPAR 
SSTR1 LDA SSTRB,I 
      JSB CKST#     CHECK FOR STATEMENT # OUT OF RANGE *791228* 
      JMP SSTRE     OUT OF RANGE ISSUE ERROR
      JSB BSCED    SET UP TRAP & TIME SCHED TABLES
      JMP SSTRT,I 
***********************CHANGED 800212***************************
SSTRE JSB $LIBR 
      OCT 177777
      JSB BSERR    *791228* 
      JSB $LIBX    *800213* 
      DEF SSTRT,I  *791228* 
**********************************800212************************
* 
      SKP 
***** 
* 
** BSCED ** ROUTINE TO SET UP TRAP & TIME SCHED TABLES
*           FOR TRNON AND START ROUTINES
* 
*     DLD  TIME IN FLOATING POINT SECONDS 
*     DST TMPAR    IS PASSED IN TMPAR 
*     LDA SEQ NUMBER
*     JSB BSCED 
*     RETURN
* 
* NOTE: TABLE OVERFLOWS WILL CAUSE TRANSFER TO ERROR
* 
***** 
* 
BSCED NOP 
      JSB $LIBR 
      OCT 177777      *791228*
      STA SNPAR    SAVE SEQ NUMBER
      LDB TSNXT     IS TABLE
      CPB TSEND      ALREADY FULL ? 
      JMP TRNOE     YES 
      STB TSPTR     NO, INITIALIZE POINTER
      JMP NEXT1 
* 
** HERE TO EXAMINE NEXT ENTRY 
* 
NEXT  LDB TSPTR 
      ADB M1        MOVE
      LDA 1,I   LAST
      ADB B3          WORD
      STA 1,I          OF ENTRY 
      ADB M5        THEN MOVE 
      DLD 1,I        FIRST TWO WORDS
      DST TSPTR,I     OF ENTRY
      LDB TSPTR     MOVE POINTER
      ADB M3         TO NEXT ENTRY
      STB TSPTR 
NEXT1 CPB TSTBL     ARE WE AT OTHER END OF TABLE? 
      JMP INSRT     YES, MAKE ENTRY HERE
      ADB M3        NO, SET UP POINTER
      STB ENPTR      TO NEXT ENTRY TO BE CONSIDERED 
* 
** HERE TO TEST FOR TIME ORDERING 
* 
      DLD TMPAR     COMPARE GIVEN TIME
      JSB .FSB       TO CURRENT TIME
      DEF TSTIM 
      SSA 
      JMP ORDR1     GIVEN TIME < CURRENT TIME 
      DLD ENPTR,I   GIVEN TIME > OR = CURRENT TIME
      JSB .FSB
      DEF TSTIM 
      SSA 
      JMP INSRT     ENTRY TIME < CURRENT TIME 
ORDR2 DLD TMPAR     ENTRY TIME > CURRENT TIME 
      JSB .FSB
      DEF ENPTR,I 
      SSA 
      JMP INSRT     GIVEN TIME < ENTRY TIME 
      JMP NEXT      GIVEN TIME > OR = ENTRY TIME
ORDR1 DLD ENPTR,I 
      JSB .FSB
      DEF TSTIM 
      SSA 
      JMP ORDR2     ENTRY TIME < CURRENT TIME 
      JMP NEXT      GIVEN TIME > CURRENT TIME 
* 
** HERE TO INSERT NEW ENTRY AT TSPTR
* 
INSRT DLD TMPAR     SET UP
      DST TSPTR,I    TIME PART OF ENTRY 
      LDB TSPTR 
      ADB B2        SET UP
      LDA SNPAR     SEQUENCE NUMBER 
      STA 1,I         PART OF ENTRY 
      LDA TSNXT     UPDATE
      STA 1          TSNXT POINTER
      ADA B3
      STA TSNXT 
      CPB TSPTR     CHECK IF NEW ENTRY NEXT TO EXEC 
      RSS           YES 
      JMP INSR1     NOS MAKE TRAP ENTRY NOW 
* 
** HERE IF NEW ENTRY WILL EXECUTE NEXT
* 
      DLD TSTIM     GET NEW 
      JSB .FSB       MINUS TIME TILL NEXT EXECUTION 
      DEF TSPTR,I 
      SZA,RSS      IF TO GO NOW,
      JMP INSR3     ALLOW TSCNT TO BE ZERO
      SSA          IF POSITIVE
      JMP INSR3 
      JSB .FSB       SUBTRACT ONE DAY 
      DEF FLDAY 
INSR3 DST TSCNT     THEN SET UP COUNTER WITH NEW VAL
* 
** HERE TO MAKE TRAP TABLE ENTRY
* 
INSR1 LDA SNPAR 
      JSB FINDS     DOES A TRAP ENTRY ALREADY EXIST 
      JMP INSR2      NO, MAKE ONE 
      LDB TRPTR     YES, SET ENABLE BIT 
      INB 
      LDA 1,I 
      IOR BIT15 
      STA 1,I 
      JMP BSCE1     RETURN
INSR2 LDA SNPAR     SET UP
      STA SEQNO      SEQUENCE NUMBER
      CLA 
      STA TRPNO      TRAP NUMBER (DEFAULT = 0)
      LDA D99 
      STA PRINO      PRIORITY (DEFAULT = 99)
      JSB TRMAK     MAKE TRAP TABLE ENTRY 
       RSS           NO ROOM
      JMP BSCE1     DONE, RETURN
      LDA AD2 
      JSB BSERR 
      JMP BSCE1 
TRNOE LDA AD5     TIME SCHED TABLE FULL 
      JSB BSERR 
BSCE1 JSB $LIBX 
      DEF BSCED,I     *791228*
      SKP 
****************************************************
* 
**************** CONSTANTS *************************
SCHED DEC 5 
      ASC 3,SCHED 
ERRM  DEC 3 
      ASC  2,TTY
ENPTR NOP           POINTER TO NEXT ENTRY (IN TIMCK)
SNPAR NOP 
FLDAY DEC 86400.    FLOATIN POINT # SEC IN DAY
F.100 DEC 100.
F.60  DEC 60. 
TMPAR BSS 2 
WHOLE BSS 2 
HHMM  BSS 2 
HH    BSS 2 
MM    BSS 2 
SS    BSS 2 
B2    EQU .2
B3    EQU .3
B2000 OCT 2000
.5    DEC 5 
.7    DEC 7       *791228*
D99   DEC 99
AD2   DEF .2
AD4 DEF .4
AD5  DEF .5 
AD7  DEF .7       *791228*
****************************************************
      END