ASMB,R,Q,C
*     NAME:   EXEC
*     SOURCE: 92071-18136 
*     RELOC:  92071-16136 
*     PGMR:   HLC 
* 
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  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 EXEC,0  92071-16136  REV.2041  800801 
* 
      ENT EXEC
      ENT $A,$B,$BASE 
      ENT $BC#,$BCOM,$BGPR  
      ENT $BL,$BOOT,$CD#,$CDA,$CDSZ 
      ENT $CKSM,$CL,$CLCK,$CLTA,$CMAP 
      ENT $CON,$CPU,$CSEG,$DATC 
      ENT $DB,$DISC,$DN,$DS1K 
      ENT $DSCS,$DVSZ,$DVT#,$DVTA 
      ENT $EO,$ERAB,$EXEX 
      ENT $FWSY,$HIBP 
      ENT $HIGH,$ID#,$IDA 
      ENT $IDNO,$IDSQ,$IDSZ,$IFSZ 
      ENT $IFT#,$IFTA,$INT#,$INTA 
      ENT $LCBP,$LCOM,$LD 
      ENT $LIBR,$LIBX,$LICE,$LIST 
      ENT $LK,$LUT#,$LUTA 
      ENT $MAP,$MAPF,$MAPS,$MASZ
      ENT $MAT#,$MATA,$MATV,$MM 
      ENT $MP,$MPFN,$MPTF,$N1.2 
      ENT $N3.4,$N5.F,$NAME,$NAMX 
      ENT $OPSY,$OPXX,$PART,$PAS5,$PENT 
      ENT $PIMK,$PNAM,$PRAM 
      ENT $PRIO,$PVCN,$QU,$RES
      ENT $RN,$RNTA,$ROM,$RQCT
      ENT $RQ.1,$RQ.2,$RQ.3 
      ENT $RQ.4,$RQ.5,$RQ.6 
      ENT $RQ.7,$RQ.8,$RQ.9 
      ENT $RQP1,$RQP2,$RQP3 
      ENT $RQP4,$RQP5,$RQP6 
      ENT $RQP7,$RQP8,$RQP9 
      ENT $RQRT,$SAM
      ENT $SAM#,$SC,$SC#,$SC0 
      ENT $SCHD,$SCCK,$SCPG,$SCXX 
      ENT $SEGS,$SISZ,$SJP,$SJS0  
      ENT $SJS1,$SJS2,$SJS3 
      ENT $SR,$STAT 
      ENT $STRT,$SUSP,$SWTA,$SYBP 
      ENT $TDB,$TEST,$TICK
      ENT $TIM1,$TIM2 
      ENT $TIME,$TLNK,$TM,$TMP1,$TMP2 
      ENT $TMP3,$TMP4,$TMP5 
      ENT $TRAK,$TSPR,$TSQU 
      ENT $UIT,$USER
      ENT $WORK,$WRKS,$XECM,$XEQ  
      ENT $XEQ1,$XQSB,$XQSX,$XQT
      ENT $ZPCN,$ZLST 
* 
      ENT .JLA,.JLB 
* 
* 
      EXT $CVT1,PI.43 
      EXT $DREL,$ERMG 
      EXT $EX08 
      EXT $EX09,$EX10,$EX11 
      EXT $EX12,$EX14,$EX22 
      EXT $EX23,$EX24,$EX28 
      EXT $F.CL,$G.CL,$IORQ 
      EXT $IRT,$LDRS,$MAX,$PREL 
      EXT $RTN,$RTNS,$STMG
      EXT $TLST,$TRRN,$WTSC,$XEQ2 
      EXT .CAX,.MWF,.XLD,.XST 
* 
A     EQU 0 
B     EQU 1 
SC.00 EQU 0 
SC.02 EQU 2 
SC.03 EQU 3 
SC.04 EQU 4 
SC.06 EQU 6 
SC.07 EQU 7 
SC.10 EQU 10B 
SC.11 EQU 11B 
SC.12 EQU 12B 
SC.13 EQU 13B 
SC.14 EQU 14B 
SC.15 EQU 15B 
      SKP 
* 
$DATC DEC 2041      REV. CODE OF OPERATING SYSTEM 
* 
EXEC  RPL 101712B   'JSB EXEC' OP CODE
EXECC OCT 101712    (PAA) 
* 
* 
$LIBR RPL 105712B   'JSB $LIBR' OP CODE 
LIBRC OCT 105712    (PAB) 
* 
$LIBX RPL 101713B   'JSB $LIBX' OP CODE 
LIBXC OCT 101713    (PBA) 
* 
* 
$SJP  RPL 105713B   'JSB $SJP' OP CODE
SJPC  OCT 105713    (PBB) 
* 
* 
$SJS0 RPL 101727B   'JSB $SJS0' OP CODE 
SJS0C OCT 101727    (LFA) 
* 
$SJS1 RPL 105727B   'JSB $SJS1' OP CODE 
SJS1C OCT 105727    (LFB) 
* 
$SJS2 RPL 101722B   'JSB $SJS2' OP CODE 
SJS2C OCT 101722    (XMA) 
* 
$SJS3 RPL 105722B   'JSB $SJS3' OP CODE 
SJS3C OCT 105722    (XMB) 
* 
* 
.JLA  RPL 100600B   JUMP AND LOAD A-REGISTER
.JLB  RPL 104600B   JUMP AND LOAD B-REGISTER
* 
* 
* 
*     BASE PAGE 
* 
      ORB 
JSTAR ASL 16        IDLE LOOP ON BASE PAGE
      JMP JSTAR 
* 
DPOWR DEF PI.43     POWER FAIL/AUTORESTART DRIVER 
      ORR 
* 
* 
*     ID SEGMENT POINTERS OVERLAY SYSTEM INITIALIZATION CODE
* 
$XQT  NOP           POINTERS TO CURRENTLY EXECUTING PROGRAM 
$TMP1 EQU $XQT+1
$TMP2 EQU $XQT+2
$TMP3 EQU $XQT+3
$TMP4 EQU $XQT+4
$TMP5 EQU $XQT+5
$PRIO EQU $XQT+6
$PENT EQU $XQT+7
$SUSP EQU $XQT+8
$A    EQU $XQT+9
$B    EQU $XQT+10 
$EO   EQU $XQT+11 
$N1.2 EQU $XQT+12 
$N3.4 EQU $XQT+13 
$N5.F EQU $XQT+14 
$STAT EQU $XQT+15 
$TLNK EQU $XQT+16 
$RES  EQU $XQT+17 
$TIM1 EQU $XQT+18 
$TIM2 EQU $XQT+19 
$TICK EQU $XQT+20 
$HIGH EQU $XQT+21 
$CSEG EQU $XQT+22 
$SEGS EQU $XQT+23 
$HIBP EQU $XQT+24 
$PART EQU $XQT+25 
$TRAK EQU $XQT+26 
$DISC EQU $XQT+27 
$CON  EQU $XQT+28 
$TDB  EQU $XQT+29 
* 
* 
*     EXEC REQUEST PARAMETERS 
* 
$RQCT EQU $XQT+30 
$RQP1 EQU $XQT+31 
$RQP2 EQU $XQT+32 
$RQP3 EQU $XQT+33 
$RQP4 EQU $XQT+34 
$RQP5 EQU $XQT+35 
$RQP6 EQU $XQT+36 
$RQP7 EQU $XQT+37 
$RQP8 EQU $XQT+38 
$RQP9 EQU $XQT+39 
$RQRT EQU $XQT+40 
$RQ.1 EQU $XQT+41 
$RQ.2 EQU $XQT+42 
$RQ.3 EQU $XQT+43 
$RQ.4 EQU $XQT+44 
$RQ.5 EQU $XQT+45 
$RQ.6 EQU $XQT+46 
$RQ.7 EQU $XQT+47 
$RQ.8 EQU $XQT+48 
$RQ.9 EQU $XQT+49 
* 
* 
*     SYSTEM INITIALIZATION CODE OVERLAID BY ID SEGMENT POINTERS
* 
$STRT CLC SC.00,C   MASTER RESET
      DST ASAVE 
      LDA $PIMK 
      OTA SC.00     SET INTERRUPT MASK
      LDA JSBPF     SET TO ENTER POWER-FAIL DRIVER
      SFS SC.04 
      JMP *-2       WAIT FOR POWER TO STABILIZE 
      STA SC.04 
      CLA 
      OTA SC.07     SET MP FENCE TO ZERO
* 
      STF SC.00     ALLOW PRIVILEGED INTERRUPTS 
      STC SC.06,C   START TBG 
* 
* 
      LDA $SAM
      STA SAM0      START OF SAM
      LDA $SAM# 
      STA SAMSZ     SIZE OF SAM 
      CMA           ONE'S COMPLEMENT OF 
      STA $MAX        MAXIMUM EVER AVAILABLE
      JSB $RTN      INITIALIZE SAM
SAM0  NOP 
SAMSZ NOP 
* 
* 
      LDB $BOOT     IS THERE A BOOT-UP PROGRAM? 
      SZB,RSS 
      JMP $STMG     NO, PRINT THE STARTING MESSAGE
* 
      ADB =D9 
      LDA ASAVE 
      STA B,I 
      INB 
      LDA BSAVE 
      STA B,I 
* 
      LDB $BOOT 
      JSB $LIST     YES, SCHEDULE THE BOOT-UP PROGRAM 
      OCT 60
      JMP $STMG     AND THEN PRINT THE MESSAGE
* 
ASAVE NOP 
BSAVE NOP 
* 
JSBPF JSB DPOWR,I   IF LOCATION 4 IS ZERO, BOOTSTRAP FAILED 
* 
* 
      BSS $STRT+49-*   SAVE SPACE FOR ID SEGMENT POINTERS 
*                   AND EXEC REQUEST PARAMETERS 
* 
* 
      SKP 
* 
* 
* 
*     END OF SYSTEM INITIALIZATION AREA 
* 
* 
      SKP 
* 
* 
* 
* 
*     THE FOLLOWING VALUES ARE INITIALIZED BY THE GENERATOR 
* 
$BC#  NOP           SIZE OF BLANK COMMON IN WORDS 
$BCOM NOP           LOGICAL START OF BLANK COMMON 
$BGPR NOP           STARTING PRIORITY FOR BACKGROUND
$BOOT NOP           START-UP PROGRAM ID SEG ADDRESS 
$CD#  NOP           NUMBER OF DISC CARTRIDGE ENTRIES
$CDA  NOP           POINTER TO CARTRIDGE DIRECTORY
$CKSM NOP           SYSTEM ENTRY POINT CHECKSUM 
$CLTA NOP           START OF CLASS TABLE
$DVT# NOP           NUMBER OF DEVICE TABLES 
$DVTA NOP           POINTER TO FIRST DEVICE TABLE 
$FWSY NOP           START OF SYSTEM CODE    
$ID#  NOP           NUMBER OF ID SEGMENTS IN SYSTEM 
$IDA  NOP           POINTER TO FIRST ID SEGMENT 
$IFT# NOP           NUMBER OF INTERFACE TABLES
$IFTA NOP           POINTER TO FIRST INTERFACE TABLE
$INT# NOP           NUMBER OF INTERRUPT TABLE ENTRIES 
$INTA NOP           POINTER TO THE INTERRUPT TABLE
$LCBP NOP           LOGICAL START OF LABELED COMMON BASE PAGE 
$LCOM NOP           LOGICAL START OF LABELED COMMON 
$LUT# NOP           NUMBER OF LU TABLE ENTRIES
$LUTA NOP           POINTER TO THE LU TABLE 
$MAT# NOP           NUMBER OF PARTITIONS
$MATA NOP           POINTER TO THE PARTITION TABLE
$MATV NOP           NUMBER OF VALID PARTITIONS
$PIMK NOP           PRIVILEGED INTERRUPT MASK 
$RNTA NOP           POINTER TO THE RESOURCE NUMBER TABLE
$SAM  NOP           START OF SYSTEM AVAILABLE MEMORY
$SAM# NOP           SIZE OF SYSTEM AVAILABLE MEMORY IN WORDS
$SC#  NOP           SIZE OF SYSTEM COMMON IN WORDS  
$SC0  NOP           START PAGE - 1 OF SYSTEM COMMON PARTITION 
$SCCK NOP           SYSTEM COMMON CHECKSUM
$SCPG NOP           SIZE OF SYSTEM COMMON IN PAGES  
$SWTA NOP           POINTER TO THE SWAP TABLE 
$TSPR NOP           STARTING PRIORITY FOR TIME SLICE
$TSQU NOP           TIME QUANTUM FOR TIME SLICE 
$USER NOP           STARTING PAGE OF USER PARTITION SPACE 
$XECM NOP           SYSTEM SECURITY CODE
* 
* 
*     END OF GENERATOR-INITIALIZED AREA 
* 
* 
$BASE DEF 140B      START OF DMA BASE REGISTERS 
$CPU  DEC 1         CPU NUMBER
$MAP  DEF 100B      START OF MAPPING REGISTERS
$MPFN DEF 0         MEMORY PROTECT FENCE
$ROM  DEF 1700B     START OF ROM-RESERVED MEMORY
$SYBP DEF 200B      START OF SYSTEM BASE PAGE 
* 
*     SYSTEM CONSTANTS
* 
* 
$CDSZ DEC 4         SIZE OF EACH CARTRIDGE ENTRY
$DSCS DEC -1        SESSION MONITOR SOFTWARE NOT AVAILABLE
$DVSZ DEC 22        SIZE OF EACH DEVICE TABLE ENTRY 
$IDSZ DEC 30        SIZE OF ID SEGMENT
$IFSZ DEC 7         SIZE OF EACH INTERFACE TABLE ENTRY
$MASZ DEC 3         SIZE OF EACH PARTITION TABLE ENTRY
$OPSY DEC -29       SYSTEM IDENTIFICATION 
$SISZ DEC 8         SIZE OF SEGMENT IDENTIFIER
* 
* 
*     SYSTEM VARIABLES
* 
$CMAP DEC 2         ID ADDRESS OF CURRENTLY MAPPED PROGRAM
*                   0=SEQUENTIAL VALUES 
*                   1=IDLE LOOP (FIRST REG = 0) 
*                   2=NOT VALID 
*                   ID+1=NOT VALID
* 
$DB   DEC -1        ID ADDRESS FOR HARDWARE DEBUGGER
*                   -1=RTE-L + ALL PROGRAMS 
*                   0=RTE-L ONLY
$LICE NOP           POINTER TO CURRENT TIME SLICE CLOCK 
$MAPF DEC 1         STATE OF MAPPING (1 = OFF, 0 = ON)
$MPTF DEC 1         STATE OF MEMORY PROTECT (1 = OFF, 0 = ON) 
$PVCN NOP           PRIVILEGED SUBROUTINE NESTING LEVEL 
$TEST NOP           ID OF LAST PROGRAM DISPATCHED 
$WORK NOP           ID OF LAST PROGRAM NAME FOUND 
$WRKS NOP           STATUS ADDRESS OF LAST PROGRAM NAME FOUND 
$ZPCN NOP           .ZPRV SUBROUTINE NESTING LEVEL
* 
* 
* 
* 
* 
* 
* 
* 
*     PROGRAM LIST HEADERS
* 
$TM   NOP           (47) TIME SUSPEND 
$LK   NOP           (50) LOCKED DEVICE LIST 
$RN   NOP           (51) RESOURCE NUMBER LIST 
$CL   NOP           (52) CLASS LIST 
$QU   NOP           (53) QUEUE LIST 
$DN   NOP           (54) DOWN DEVICE LIST 
$BL   NOP           (55) BUFFER LIMIT LIST
$LD   NOP           (56) LOAD LIST
$SR   NOP           (57) SHARED SUBROUTINE LIST 
$SC   NOP           (60) SCHEDULED LIST 
$MM   NOP           (61) MEMORY LIST
* 
* 
ZZZZZ NOP           ABORT LIST  
* 
      HED  MEMORY PROTECT HANDLER 
* 
$MP   NOP 
      CLC SC.04     TURN OFF INTERRUPTS 
      ISZ $MAPF     MAPPING IS DISABLED 
      LDA $PIMK 
      OTA SC.00     MASK ALL NON-PRIVILEGED INTERRUPTS
      STC SC.04     TURN ON INTERRUPTS
*     INTERRUPTS HELD OFF UNTIL AFTER 'ISZ $MPTF' 
      ISZ $MPTF     INDICATE INTERRUPTS MASKED
      LIB SC.07,C   VIOLATION ADDRESS 
      LDA =AMP
ERMSS STB $SUSP,I   SAVE THE POINT OF SUSPENSION  
ERMSG LDB =A
      JSB $ERMG     PRINT 'PROGA ABORTED MP   37732'
      JMP $XEQ
* 
      HED  SYSTEM COMMON ENTRY AND EXIT 
* 
* 
LIBRP LDA $UIT      GET $LIBR PARAMETER 
      JSB .XLD
      DEF A,I 
      SZA 
      JMP ZPRV? 
      ISZ $PVCN     LEAVE MEMORY PROTECT OFF
BUMPL ISZ $UIT        AND MASK NON-PRIVILEGED INTERRUPTS
* 
OK    CLA 
      CLC SC.04     TURN OFF ALL INTERRUPTS 
      STA $MAPF     INDICATE MAPPING ON 
      STC SC.11     TURN MAPPING ON 
* 
      CLC SC.15     TURN OFF HARDWARE DEBUGGER
      LDA $DB 
      SSA,RSS 
      CPA $XQT
      STC SC.15,C   TURN BACK ON IF DEBUGGING THIS PROGRAM
* 
      DLD $A,I      RESTORE REGISTERS 
      STC SC.04     TURN ON INTERRUPTS
      JMP $UIT,I
* 
* 
* 
ZPRV? SSA,RSS 
      JMP ZRNT? 
      ISZ $ZPCN     DO NOT DISPATCH ANY OTHER PROGRAM 
      LDA $PVCN 
      SZA 
      JMP BUMPL     MEMORY PROTECT IS OFF 
      JSB SAVEO     SAVE E AND O REGISTERS
BUMPS LDA $UIT  
      INA 
      STA $SUSP,I   ENTRY POINT TO SUBROUTINE 
      JMP $IRT      RETURN TO USER PROGRAM
* 
* 
SAVEO NOP           SAVE E AND O REGISTERS
      ERB,BLS 
      SOC 
      INB 
      STB $EO,I 
      JMP SAVEO,I 
* 
* 
ZRNT? STA TDB       SAVE TDB ADDRESS
      JSB  SAVEO    SAVE E AND O REGISTERS
      LDB $ZPCN 
      ADB $PVCN 
      SZB 
      JMP SRERR     ILLEGAL SUBROUTINE CALL 
* 
*     MAKE SURE THE TDB IS IN SYSTEM COMMON 
* 
      LDB $STAT,I 
      BLF 
      SSB,RSS 
      JMP SRERR     THE PROGRAM DOES NOT ACCESS SYS COM 
* 
      LDB $LCOM 
      CMB,INB 
      ADB TDB 
      SSB 
      JMP SRERR     STARTS BELOW SYSTEM COMMON
* 
      CMB 
      ADB $SC#
      SSB 
      JMP SRERR     STARTS ABOVE SYSTEM COMMON
* 
      LDB $LCOM 
      ADB $SC#
      CMB 
      ADB =D3       (SIZE OF TDB HEADER)
      ADB TDB 
      SSB,RSS 
      JMP SRERR     EXTENDS PAST END OF SYSTEM COMMON 
* 
* 
      ADA =D2       TDB BUFFER ADDRESS IS OK
      STA RTN       
      JSB .XLD
      DEF A,I       GET RETURN ADDRESS FROM TDB 
      SZA,RSS 
      JMP ENTER     SUBROUTINE NOT OCCUPIED 
* 
      LDB SUSP
      STB $SUSP,I   SAVE THE POINT OF SUSPENSION
      LDA TDB 
      LDB $XQT
      JSB $LIST     SUSPEND HIM 
      OCT 57
      JMP $XEQ
* 
* 
ENTER LDB $UIT  
      ADB =D-2
      JSB .XLD
      DEF B,I       GET SUBROUTINE RETURN ADDRESS 
      JSB .XST        AND SAVE IT IN THE TDB
RTN   NOP 
      LDA $TDB,I
      JSB .XST      UPDATE LIST OF TDB'S
TDB   NOP 
      LDA TDB 
      STA $TDB,I      STARTING IN ID SEGMENT
      JMP BUMPS     BUMP THE POINT OF SUSPENSION
* 
* 
SRERR LDA =ASR
      LDB SUSP
      JMP ERMSS     PRINT 'PROGA ABORTED SR   34475'
* 
* 
      SKP 
* 
* 
LIBXP LDA $UIT      EXIT FROM LIBRARY ROUTINE 
      JSB .XLD
      DEF A,I       GET THE ADDRESS AFTER 'JSB $LIBX' 
      SSA 
      JMP ZPEX?     .ZPRV ROUTINE DONE
      LDB $PVCN 
      SZB,RSS 
      JMP ZREX?     INTERRUPTS ARE ON 
      CMB,INB       INTERRUPTS ARE OFF
      CMB,SZB,RSS   SUBTRACT 1 WITHOUT AFFECTING E AND O
      JMP PVEX      NEED TO RESTORE INTERRUPTS
      STB $PVCN     STILL IN PRIVILEGED ROUTINE 
      JSB .XLD      GET THE RETURN ADDRESS
      DEF A,I 
      STA $UIT  
      JMP OK
* 
* 
PVEX  STB $PVCN     NESTING COUNT IS ZERO 
      JSB SAVEO     SAVE E AND O
      JSB .XLD
      DEF A,I 
      STA $SUSP,I   SAVE POINT OF SUSPENSION
      JMP $IRT      RESTORE INTERRUPTS
* 
* 
ZPEX? LDB $ZPCN     HAS .ZPRV BEEN CALLED?
      SZB,RSS 
      JMP SRERR     NO, EXIT BEFORE ENTRY 
      CMB,INB       SUBTRACT ONE WITHOUT CHANGING E & O 
      CMB 
      STB $ZPCN 
      ELA,CLE,ERA   CLEAR BIT 15
      JSB .XLD      GET THE RETURN ADDRESS
      DEF A,I 
      STA $UIT
      LDB $PVCN 
      SZB 
      JMP OK        INTERRUPTS OFF
      JSB SAVEO     SAVE E AND O REGISTERS
      STA $SUSP,I   ADVANCE POINT OF SUSPENSION 
      JMP $XEQ
* 
* 
ZREX? JSB SAVEO     SAVE E AND O REGISTERS
      LDB $ZPCN 
      CPA $TDB,I    MUST EXIT THE MOST RECENTLY CALLED
      SZB           MUST NOT BE PRIVILEGED
      JMP SRERR     ILLEGAL EXIT ORDER
* 
      ADA =D2 
      JSB .XLD      GET THE RETURN ADDRESS
      DEF A,I 
      STA TEMP
* 
      LDA $UIT
      INA 
      JSB .XLD
      DEF A,I 
      ADA TEMP      ADD CONSTANT TO RETURN ADDRESS
      STA $SUSP,I   SAVE POINT OF SUSPENSION
      JSB POP       UNLOCK TOP ROUTINE ON STACK 
      JMP $XEQ      DISPATCH HIGHEST PRIORITY PROGRAM 
* 
* 
POP   NOP           UNLOCK LAST ENTERED REENTRANT ROUTINE 
      LDA $TDB,I    POINTER TO TOP OF STACK 
      STA TDBP
      JSB .XLD      GET POINTER TO NEXT TDB ON STACK
TDBP  NOP 
      STA $TDB,I    UPDATE POINTER IN ID SEGMENT
      LDB TDBP
      ADB =D2 
      CLA 
      JSB .XST      CLEAR THE LOCK FLAG IN THE TDB
      DEF B,I 
* 
      LDA TDBP
      JSB $SCHD     SCHEDULE WAITERS FOR THIS ROUTINE 
      OCT 57
      JMP POP,I 
* 
      HED  CROSS MAP SUBROUTINE CALLS AND JUMPS 
* 
* 
SJPP  JSB OK?       CHECK MEMORY PROTECT
      DLD $A,I
      JMP TEMP,I    DO THE JUMP 
* 
* 
* 
SJS0P JSB OK?       CHECK MEMORY PROTECT
      DLD $A,I
      JSB TEMP,I    DO THE JSB
      JMP BUMP1 
      JMP BUMP2 
BUMP3 ISZ $UIT
BUMP2 ISZ $UIT
BUMP1 ISZ $UIT
      DST $A,I      SAVE A AND B
      JSB SAVEO     SAVE E AND O
* 
      LDB $XQT
      JSB $MAPS     RESTORE MAP REGISTERS 
* 
      LDB $EO,I     RESTORE E AND O 
      CLO 
      SLB,ELB 
      STO 
      CLA 
      CLC SC.04     TURN OFF ALL INTERRUPTS 
      STA $MAPF     INDICATE MAPPING ON 
      STC SC.11     TURN MAPPING ON 
* 
      CLC SC.15     TURN OFF HARDWARE DEBUGGER
      LDA $DB 
      SSA,RSS 
      CPA $XQT
      STC SC.15,C   TURN BACK ON IF DEBUGGING THIS PROGRAM
* 
      DLD $A,I      RESTORE A AND B REGISTERS 
      STC SC.04     TURN ON INTERRUPTS
      JMP $UIT,I
* 
* 
SJS1P JSB OK?       CHECK MEMORY PROTECT
      ISZ $UIT
      LDA $UIT
      JSB .XLD      GET THE FIRST PARAMETER 
      DEF A,I 
      STA P1.1
      DLD $A,I
      JSB TEMP,I    DO THE JSB
P1.1  NOP 
      JMP BUMP1 
      JMP BUMP2 
      JMP BUMP3 
* 
* 
SJS2P JSB OK?       CHECK MEMORY PROTECT
      ISZ $UIT
      LDA $UIT
      JSB .XLD      GET THE FIRST PARAMETER 
      DEF A,I 
      STA P1.2
      ISZ $UIT
      LDA $UIT
      JSB .XLD      GET THE SECOND PARAMETER
      DEF A,I 
      STA P2.2
      DLD $A,I
      JSB TEMP,I    DO THE JSB
P1.2  NOP 
P2.2  NOP 
      JMP BUMP1 
      JMP BUMP2 
      JMP BUMP3 
* 
* 
SJS3P JSB OK?       CHECK MEMORY PROTECT
      ISZ $UIT
      LDA $UIT
      JSB .XLD      GET THE FIRST PARAMETER 
      DEF A,I 
      STA P1.3
      ISZ $UIT
      LDA $UIT
      JSB .XLD      GET THE SECOND PARAMETER
      DEF A,I 
      STA P2.3
      ISZ $UIT
      LDA $UIT
      JSB .XLD      GET THE THIRD PARAMETER 
      DEF A,I 
      STA P3.3
      DLD $A,I
      JSB TEMP,I    DO THE JSB
P1.3  NOP 
P2.3  NOP 
P3.3  NOP 
      JMP BUMP1 
      JMP BUMP2 
      JMP BUMP3 
* 
* 
* 
OK?   NOP           CHECK MEMORY PROTECT
      CLB,INB 
      CPB $MPTF     WAS MEMORY PROTECT ON BEFORE INTERRUPT? 
      JMP SRERR     YES, ILLEGAL INSTRUCTION SEQUENCE 
* 
      LDA $UIT
      JSB .XLD      GET THE TARGET ADDRESS  
      DEF A,I 
      STA TEMP      SAVE IT 
      JMP OK?,I 
* 
      HED  UNIMPLEMENTED INSTRUCTION HANDLER
* 
$UIT  NOP           UNIMPLEMENTED INSTRUCTION TRAP  
      CLC SC.04     TURN OFF INTERRUPTS 
      DST $A,I      SAVE A- AND B-REGISTERS 
      ISZ $MAPF     INDICATE THAT MAPPING IS OFF
      LDA $PIMK 
      OTA SC.00     PRIVILEGED INTERRUPT MASK 
      STC SC.04     RESTORE INTERRUPTS  
      ISZ $MPTF     INDICATE THAT MEMORY PROTECT IS OFF 
* 
*     INTERRUPTS ARE HELD OFF UNTIL AFTER 'ISZ $MPTF' 
* 
      LDA $UIT  
      CMA,INA       SUBTRACT ONE WITHOUT AFFECTING E AND O
      CMA 
      STA SUSP      SAVE ADDRESS OF VIOLATION 
* 
      JSB .XLD      GET THE INTERRUPTING INSTRUCTION
      DEF A,I 
      CPA LIBRC 
      JMP LIBRP     JSB $LIBR 
      CPA LIBXC 
      JMP LIBXP     JSB $LIBX 
      CPA EXECC 
      JMP EXECP     JSB EXEC
* 
      CPA SJS0C 
      JMP SJS0P     JSB $SJS0 
      CPA SJS1C 
      JMP SJS1P     JSB $SJS1 
      CPA SJS2C 
      JMP SJS2P     JSB $SJS2 
      CPA SJS3C 
      JMP SJS3P     JSB $SJS3 
      CPA SJPC
      JMP SJPP      JSB $SJP  
* 
      LDA =AUI  
      LDB SUSP
      JMP ERMSS     PRINT 'PROGA ABORTED UI   56111'  
* 
SUSP  NOP 
* 
      HED  EXEC CALL PROCESSOR  
*   
*   
EXECP LDA $PVCN 
      IOR $ZPCN 
      SZA 
      JMP SRERR     ILLEGAL SUBROUTINE CALL 
* 
      LDA SUSP
      STA $SUSP,I   SAVE POINT OF SUSPENSION
      JSB SAVEO     SAVE E AND O REGISTERS
      LDA $UIT
      JSB .XLD      GET RETURN ADDRESS
      DEF A,I 
      ISZ $UIT
      STA $RQRT     SAVE RETURN ADDRESS 
      LDB $UIT
      CMB,CLE 
      ADB A 
      STB $RQCT     NUMBER OF PARAMETERS
      STB A 
      CMB,SEZ,RSS 
      JMP RQERR     BAD NO. OF PARAMETERS OR RETURN ADDRESS 
      STB TEMP
      CLE 
      ADA =D-9
      CLA,SEZ 
      JMP RQERR     BAD NO. OF PARAMETERS OR RETURN ADDRESS 
* 
      STA $RQ.2     INITIALIZE OPTIONAL PARAMETERS
      STA $RQ.3 
      STA $RQ.4 
      STA $RQ.5 
      STA $RQ.6 
      STA $RQ.7 
      STA $RQ.8 
      STA $RQ.9 
* 
      STA $RQP2 
      STA $RQP3 
      STA $RQP4 
      STA $RQP5 
      STA $RQP6 
      STA $RQP7 
      STA $RQP8 
      STA $RQP9 
* 
      LDB DRQP1     SET TO RESOLVE INDIRECTS
      STB POP 
      LDB DRQ.1       AND COPY PARAMETERS TO SYSTEM 
      STB TDB 
* 
R2D2  LDA $UIT      GET ADDR OF PARAM ADDR
R1D1  JSB .XLD      GET ACTUAL PARAM ADDR 
      DEF A,I 
      RAL,CLE,ERA   CLEAR INDIRECT BIT
      SZA 
      CPA =D1       IS IT POINTING TO A OR B REGS?
      JMP RQERR      YES, REGISTERS CANNOT BE EXEC PARAMETERS 
      SEZ           WAS INDIRECT BIT SET? 
      JMP R1D1      YES, GO GET DIRECT ADDR 
* 
      STA POP,I     SAVE DIRECT ADDR
      JSB .XLD      GET ACTUAL PARAMETER
      DEF A,I 
      STA TDB,I 
      ISZ TDB 
      ISZ POP       NEXT PARAMETER
      ISZ $UIT
      ISZ TEMP     DONE YET?
      JMP R2D2       NO 
* 
* CHECK LEGALITY OF REQUEST CODE
* 
      LDA $RQ.1 
      AND =B137777  MASK OFF 'NS' BIT 
      LDB A 
* 
      LDA $STAT,I 
      RBL,CLE,SLB,ERB   CHECK ABORT OPTION BIT
      JMP NO.AB     NO ABORT
      AND =B137777  CLEAR 'NA' BIT IN ID SEGMENT
RQ.1  STB $RQ.1      SAVE THE REQUEST CODE. 
      STA $STAT,I     AND THE 'NA' BIT
      SZB           IF ZERO SKIP TO REJECT
      ADB CODE#     IF RQUEST CODE IS NOT DEFINED 
      SSB,RSS      -THEN
      JMP RQERR     UNDEFINED EXEC REQUEST CODE 
* 
      ADB RQTBL     GET ADDRESS OF PROCESSOR TO A 
      LDA B,I       GET ADDRESS 
* 
      STA NEXT      SAVE THE ADDRESS
* 
*     RELEASE THE PROGRAM STRING IF NOT EXEC 14 OR 8
* 
      LDA $STAT,I 
      RAL,RAL 
      SSA,RSS 
      JMP NORTN     NO STRING (OR 'SAVST' WAS CALLED) 
      LDB $RQ.1 
      CPB =D14
      JMP NORTN     EXEC 14, SAVE STRING
      CPB =D8 
      JMP NORTN     EXEC 8, SAVE STRING 
      LDB $XQT
      JSB $RTNS     DISCARD STRING
* 
NORTN JMP NEXT,I    YES, DO THE REQUEST 
* 
* 
NO.AB IOR =B40000   SET 'NA' BIT
      ISZ $RQRT     AND BUMP RETURN ADDRESS 
      JMP RQ.1
* 
* 
* 
* 
RQERR LDA =ARQ
      JMP ERMSG     PRINT 'PROGA ABORTED RQ   57622'
* 
* 
CODE# ABS TBL-TBLE-1 NEGATIVE OF NUMBER OF REQUEST+1
RQTBL DEF TBLE      ADDRESS INDIRECT OF LAST + 1. 
DRQP1 DEF $RQP1 
DRQ.1 DEF $RQ.1 
* 
* 
      HED  *  EXEC -- REQUEST CODE TABLE
*  ***  REQUEST CODE TABLE  *** 
* 
* EACH WORD CONTAINS THE ENTRY POINT ADDRESS
* OF THE PROCESSOR CORRESPONDING TO THE REQUEST CODE. 
* 
TBL   DEF $IORQ     CODE  1   I/O READ
      DEF $IORQ     CODE  2   I/O WRITE 
      DEF $IORQ     CODE  3   I/O CONTROL 
      DEF RQERR     CODE  4   (DISC TRACK ALLOCATION) 
      DEF RQERR     CODE  5   (DISC TRACK RELEASE)
      DEF EX06      CODE  6   PROGRAM COMPLETION
      DEF EX07      CODE  7   OPERATOR SUSPENSION 
      DEF $EX08     CODE  8   LOAD PROGRAM SEGMENT
      DEF $EX09     CODE  9   SCHEDULE WITH WAIT
      DEF $EX10     CODE 10   SCHEDULE PROGRAM
      DEF $EX11     CODE 11   REAL TIME/DATE
      DEF $EX12     CODE 12   TIME SCHEDULE 
      DEF $IORQ     CODE 13   I/O DEVICE STATUS 
      DEF $EX14     CODE 14   PARAMETER STRING
      DEF RQERR     CODE 15   (GLOBAL TRACK ASSIGNMENT) 
      DEF RQERR     CODE 16   (GLOBAL TRACK RELEASE)
      DEF $IORQ     CODE 17   READ CLASS I/O
      DEF $IORQ     CODE 18   WRITE CLASS I/O 
      DEF $IORQ     CODE 19   CONTROL CLASS I/O 
      DEF $IORQ     CODE 20   WRITE-READ CLASS I/O
      DEF $G.CL     CODE 21   GET CLASS I/O 
      DEF $EX22     CODE 22   SWAP/CORE USAGE REQUEST 
      DEF $EX23     CODE 23   SCHEDULE WITH WAIT/WAIT 
      DEF $EX24     CODE 24   SCHEDULE NO WAIT/WAIT 
      DEF RQERR     CODE 25   (PARTITION STATUS)
      DEF RQERR     CODE 26   (MEMORY STATUS) 
      DEF RQERR     CODE 27   (UNDEFINED) 
      DEF $EX28     CODE 28   PROGRAM LOAD
* 
* 
*   -ADDITIONAL REQUESTS MAY BE INSERTED
*     AT THIS POINT.
* 
TBLE  EQU * 
* 
      HED  EXEC 6 (STOP) AND EXEC 7 (PAUSE) 
* 
* 
EX07  LDB $XQT
      JSB $LIST     SUSPEND CURRENT PROGRAM 
      OCT 7 
      JMP $EXEX     DONE
* 
* 
* 
* 
EX06  LDB $XQT
      JSB $PRAM     PASS PARAMETERS TO CALLER 
      DEF $RQ.4 
      LDA $RQ.3 
      CPA =D1 
      JMP SAVER     SAVE RESOURCES TERMINATION
* 
      LDB $XQT      NORMAL TERMINATION
      JSB $ZLST     MOVE TO ABORT LIST
      LDA $XQT
      JSB $F.CL     SOFT TERMINATION OF CLASS I/O 
      NOP 
      JMP $XEQ  
* 
* 
SAVER JSB $WTSC     SCHEDULE WAITING PROGRAMS 
* 
$EXEX LDA $RQRT 
      STA $SUSP,I   ADVANCE POINT OF SUSPENSION 
* 
*     FALL THROUGH TO $XEQ
* 
      HED  DISPATCHER 
* 
* 
$XEQ  LDB ZZZZZ 
      SZB 
      JMP ABORT     PROGRAM TERMINATED, CLEAN IT UP 
      CPB $LIST 
      JMP $IRT      NO NEW PROGRAMS IN SCHEDULED LIST 
      LDA $ZPCN 
      SZA 
      JMP ZP        DISPATCH CURRENT PRIVILEGED PROGRAM 
      STA $LIST 
      LDA $SC       TOP OF LIST 
XEQ1  STA $TEST 
      SZA,RSS 
      JMP IDLE      CANNOT DISPATCH ANY PROGRAM NOW 
      ADA =D15
      LDA A,I       STATUS
      LDB $TEST 
      SSA,RSS       TEST 'MR' BIT 
      JMP $XEQ2     PROGRAM NOT IN MEMORY 
      JSB $IDSQ     SET UP POINTERS TO ID SEGMENT 
      JSB $DREL     RELEASE ANY SWAP TRACKS OWNED 
      LDA $SUSP,I 
      LDB $PENT,I 
      SZA,RSS 
      STB $SUSP,I   FIRST DISPATCH, SET POINT OF SUSPENSION 
* 
      LDA $TSPR 
      CMA,INA 
      ADA $PRIO,I   SHOULD THIS PROGRAM BE TIME SLICED? 
      SSA,RSS 
      JMP SLICE     YES 
* 
      STA $TICK,I   NO, SET COUNT NEGATIVE
      LDB DUMRG     POINT TO DUMMY REGISTER SAVE AREA 
SETS  STB $LICE 
      JMP $IRT      JUMP TO USER PROGRAM
* 
* 
SLICE LDB $TICK 
      LDA B,I       IS THE COUNT INITIALIZED? 
      SSA 
      JMP SETS      YES 
      LDA $TSQU     NO, USE FULL QUANTUM
      STA B,I 
      JMP SETS
* 
* 
ZP    LDB $TEST 
      JSB $IDSQ     SET UP POINTERS TO ID SEGMENT 
      JMP $IRT      GO DISPATCH IT
* 
$XEQ1 LDA $TEST,I   NEXT PROGRAM IN LIST
      JMP XEQ1
* 
      SKP 
* 
IDLE  STA $XQT
      LDB DUMID     SET UP POINTERS TO DUMMY ID 
      STB $SUSP     FOR REGISTER SAVE 
      LDB DUMRG 
      STB $A
      STB $B
      STB $EO 
      JMP SETS      SET UP TIME SLICE POINTER 
* 
DUMID DEF *+1       DUMMY ID SEGMENT
      DEF JSTAR     POINT OF SUSPENSION 
* 
DUMRG DEF *+1 
      OCT 0         REGISTERS FOR IDLE LOOP 
      OCT 0 
* 
* 
$IDSQ NOP           SET UP POINTERS TO ID SEGMENT 
      CPB $XQT
      JMP $IDSQ,I   ASSUME ALL SET IF FIRST IS SET
      LDA DXQT
IDSQL STB A,I 
      CPA DTDB
      JMP $IDSQ,I   DONE
      INB 
      INA 
      JMP IDSQL 
DXQT  DEF $XQT
DTDB  DEF $TDB
* 
      SKP 
* 
$MAPS NOP           SET UP MAPS FOR PROGRAM 
      CPB $CMAP 
      JMP $MAPS,I   MAPS ALREADY SET UP 
      SZB,RSS 
      JMP IDLP      IDLE LOOP 
* 
      STB $CMAP 
      ADB =D15
      LDA B,I 
      STA STATS 
      ADB =D9 
      LDA B,I 
      ALF 
      RAL,RAL 
      AND =B37      SIZE IN PAGES 
      CMA,INA 
      STA PAGES 
      INB 
      LDA B,I 
      AND =B377     PARTITION NUMBER
      ADA =D-1
      MPY $MASZ 
      ADA $MATA 
      ADA =D2 
      LDA A,I       START PAGE OF PARTITION 
* 
      LDB $MAP
      STA B,I       SET UP BASE PAGE MAP REGISTER 
      INB 
      LDA STATS 
      ALF 
      SSA,RSS 
      JMP NO.SC     NO SYSTEM COMMON
* 
      LDA $SCPG     NO. OF PAGES OF SYSTEM COMMON 
      CMA,INA 
      STA SCSZ
      LDA $SC0      STARTING PHYSICAL PAGE OF SYSTEM COMMON 
SCLP  INA 
      STA B,I 
      INB           NEXT MAP REGISTER 
      ISZ SCSZ
      JMP SCLP
* 
NO.SC LDA PAGES 
      SZA,RSS 
      JMP DUMLP     BASE PAGE IS ONLY PAGE
      LDA $MAP,I    STARTING PAGE OF PARTITION
PAGLP INA 
      STA B,I       STORE PAGE NUMBERS
      INB           NEXT REGISTER 
      CPB $BASE 
      JMP $MAPS,I   DONE
      ISZ PAGES     END OF PARTITION? 
      JMP PAGLP     NO  
* 
DUMLP STA B,I       SET ANY REMAINING LOGICAL PAGES 
      INB             TO MAP THE LAST PHYSICAL PAGE 
      CPB $BASE 
      JMP $MAPS,I   DONE!!
      JMP DUMLP 
* 
STATS NOP 
SCSZ  NOP 
PAGES NOP 
* 
IDLP  STB $MAP,I    SET LOGICAL PAGE 0 = PHYSICAL PAGE 0  
      CLB,INB 
      STB $CMAP     INDICATE THAT ONLY ONE REGISTER SET 
      JMP $MAPS,I   
* 
* 
* 
* 
      HED  PROGRAM TERMINATION PROCESSOR
* 
ABORT LDA B,I       ADVANCE TO NEXT PROGRAM IN ABORT LIST 
      STA ZZZZZ 
      ADB =D-8
      JSB $IDSQ     SET UP POINTERS TO ID 
$DS1K NOP           DISTRIBUTED SYSTEMS ABORT PROCESSOR 
      JSB $WTSC     SET PROGRAM DORMANT AND SCHEDULE WAITERS
* 
      LDA $TDB,I
      SZA,RSS 
      JMP NORNT     NO ACTIVE REENTRANT ROUTINES
      LDB $XQT
      JSB $MAPS     SET UP MAP REGISTERS FOR SYSTEM COMMON
* 
RELP  JSB POP       UNLOCK THE TOP TEMPORARY DATA BLOCK 
      LDA $TDB,I
      SZA 
      JMP RELP      NEXT
* 
NORNT LDB $STAT,I   CHECK THE 'OF' BIT
      BLF,BLF 
      SLB,RSS 
      JMP NORM      NORMAL TERMINATION
* 
      STA $TIM1,I   CLEAR THE ABORT PARAMETERS
      STA $TIM2,I     (ALREADY PASSED TO FATHER'S ID) 
      LDB $XQT
      JSB $PRAM     CLEAR OWN PARAMETERS  
      DEC 0 
* 
NORM  CLA 
      STA $SUSP,I   CLEAR POINT OF SUSPENSION 
* 
      LDB $XQT
      CPB $TEST 
      STA $PVCN     THE CURRENT PRIVILEGED PROGRAM WAS ABORTED
      CPB $TEST 
      STA $ZPCN     THE CURRENT PRIVILEGED PROGRAM WAS ABORTED
* 
* 
      JSB $RTNS     RELEASE ANY OWNED STRING
      JSB $TRRN        RELEASE ANY OWNED OR LOCKED RN'S 
* 
      LDA $HIGH,I 
      STA $CSEG,I   RESET START OF FREE MEMORY  
      LDA $HIBP,I 
      RAL,CLE,ERA   CLEAR 'AM' BIT
      STA $HIBP,I 
* 
      LDA $STAT,I 
      AND =B167277  CLEAR THE 'BR', 'OF' AND 'ML' BITS
      LDB $DISC,I   IF THE PROGRAM WAS LOADED FROM THE DISC,
      SZB 
      RAL,CLE,ERA       CLEAR THE 'MR' BIT
      LDB $RES,I
      BLF,ERB       T BIT IN E-REG
      CME 
      LDB $STAT,I 
      BLF,RBL       ID BIT IN SIGN
      SEZ,SSB       SKIP IF ID BIT NOT SET, OR IN TIME LIST 
      JMP IDCLR     CLEAR ID SEGMENT
STA   STA $STAT,I 
      SSA,RSS       IF NOT IN MEMORY, 
      JSB $PREL       RELEASE THE PARTITION 
* 
      JSB $DREL     RELEASE ANY OWNED SWAP TRACKS 
* 
      LDA $CON,I
      ADA =B10000   INCREMENT SEQUENCE COUNT
      STA $CON,I
      JMP $XEQ
* 
IDCLR CLA 
      STA $N1.2,I   CLEAR ALL FIVE CHARACTERS OF THE NAME 
      STA $N3.4,I     TO HELP 'IDGET' 
      STA $N5.F,I 
      JMP STA 
* 
* 
* 
      HED  LIST PROCESSOR 
* 
$LIST DEC 1         NON-ZERO FOR BOOT-UP
      STB ID        SET UP POINTERS TO ID SEGMENT 
      INB 
      STB TEMP
      ADB =D5 
      STB PRIO
      ADB =D9 
      STB STAT
      STA B 
      LDA $LIST,I 
      CPA B60 
      JMP SCHD      SCHEDULE REQUEST
      SSA 
      JMP PRSW      PRIORITY SWITCH 
      AND B60 
      CPA =B40      IF STATE 40-57, 
      STB TEMP,I      STORE RESOURCE IDENTIFIER 
NOSW  LDA $LIST,I 
SWTCH STA TEMP      NEW STATE 
      LDA STAT,I
      AND =B77
      STA B         B=OLD STATE 
      XOR STAT,I
      IOR TEMP
      STA STAT,I
      AND =B77      A=NEW STATE 
* 
      RRR 5 
      SLB           SKIP IF OLD STATE 0-37  (NOT LINKED)
      JMP REMOV     REMOVE FROM OLD STATE 
ADCHK SLA           SKIP IF NEW STAT 0-37  (NOT LINKED) 
      JMP ADD       ADD TO NEW STATE LIST 
EXIT  ISZ $LIST 
      JMP $LIST,I 
* 
* 
      SKP 
* 
REMOV RRL 5 
      ADB LIS0      POINTER TO LIST HEADERS 
RLP   STB TEMP
      LDB B,I 
      CPB ID
      RSS           FOUND IT, REMOVE FROM LIST
      JMP RLP       KEEP LOOKING
      LDB B,I 
      STB TEMP,I
      RRR 5 
      JMP ADCHK 
* 
* 
ADD   RRL 5 
      ADA LIS0      POINTER TO LIST HEADERS 
ADLP  STA TEMP
      LDA A,I 
      SZA,RSS 
      JMP ADDIT     END OF LIST, ADD IT HERE
      STA B 
      ADB =D6 
      LDB B,I       COMPARE PRIORITIES
      CMB,INB 
      ADB PRIO,I
      SSB,RSS 
      JMP ADLP      KEEP LOOKING
ADDIT STA ID,I
      LDA ID
      STA TEMP,I    LINK IT IN
      JMP EXIT      DONE
* 
* 
ID    NOP 
TEMP  NOP 
PRIO  NOP 
STAT  NOP 
LIS0  DEF $SC-60B   POINTER TO LIST HEADERS 
* 
      SKP 
* 
* 
SCHD  LDA STAT,I    CHECK OF AND SS BITS
      ALF,ALF 
      SLA 
      JMP OF        OF BIT SET, ABORT HIM 
      SSA,RSS 
      JMP NOSW
      RAL,CLE,ERA   CLEAR SS BIT
      ALF,ALF       POSITION IT 
      STA STAT,I
      LDA =B6       NEW STATE 6 
      JMP SWTCH 
* 
OF    LDB ID        SET TO ABORT
      CPB $LDRS 
      RSS           SWAPPING, DO NOT ADD TO LIST
      JSB $ZLST     MOVE TO DISPATCHER ABORT LIST 
      CLA,INA       FORCE TO 'AB' STATE (1) 
      JMP SWTCH     
* 
* 
PRSW  STB PRIO,I    STORE NEW PRIORITY
      LDA STAT,I    RE-LINK IN OLD STATE BY NEW PRIORITY
      AND =B77
      JMP SWTCH 
* 
* 
      HED  PARAMETER PASSING
* 
$PRAM NOP           STORE PARAMETERS IN ID SEGMENT
      INB             (BUFFER IN SYSTEM MEMORY) 
      STB ID        DESTINATION ADDRESS 
      ADB =D9 
      LDA ID
      STA B,I       SET B-REG TO POINT TO TEMPS 
      LDA =D-5
      STA TEMP
      LDB $PRAM,I   SOURCE ADDRESS
      ISZ $PRAM 
PLP   CLA 
      LDA B,I       IF THE ADDRESS IS ZERO, 
      STA ID,I        STORE ZERO
      ISZ ID        BUMP THE DESTINATION ADDRESS
      SZB           IF THE ADDRESS IS ZERO, DON'T CHANGE IT 
      INB           BUMP THE SOURCE ADDRESS 
      ISZ TEMP
      JMP PLP 
      JMP $PRAM,I 
* 
* 
$PAS5 NOP           STORE PARAMETERS IN ID SEGMENT
      INB             (BUFFER IN USER MEMORY) 
      STB ID        DESTINATION ADDRESS 
      LDA =D5 
      JSB .CAX
      LDA $PAS5,I   SOURCE ADDRESS
      ISZ $PAS5 
      JSB .MWF      MOVE FROM ALTERNATE MAP 
      LDA ID
      ADB =D4 
      STA B,I       MAKE SAVED B-REGISTER POINT TO TEMPS
      JMP $PAS5,I 
* 
      HED  SCHEDULING OF SUSPENDED PROGRAMS 
* 
$SCHD NOP           SCHEDULE ALL PROGRAMS WAITING FOR RESOURCE
      STA RES       SAVE RESOURCE IDENTIFIER
      LDB $SCHD,I 
      ISZ $SCHD 
      ADB LIS0      POINTER TO LIST HEADERS 
SLP   LDB B,I 
      SZB,RSS 
      JMP $SCHD,I   END OF LIST 
      LDA B 
      INA 
      LDA A,I       COMPARE RESOURCE IDENTIFIERS
      CPA RES 
      RSS 
      JMP SLP 
      LDA B,I 
      STA NEXT      SAVE POINTER TO NEXT PROGRAM
      JSB $LIST     SCHEDULE IT 
B60   OCT 60
      LDB NEXT
      JMP SLP+1 
* 
* 
      HED  SCHEDULING OF DORMANT PROGRAMS 
* 
$XQSB NOP           SCHEDULE THE PROGRAM IF IT IS DORMANT 
      LDB $XQSB,I     (BUFFERS IN SYSTEM MEMORY)
      ISZ $XQSB 
      STB RES       POINTER TO PROGRAM NAME 
      LDB $XQSB,I 
      ISZ $XQSB 
      STB NEXT      POINTER TO PARAMETERS 
      JSB $NAME     FIND ID SEGMENT ADDRESS 
RES   NOP 
      SZA 
      JMP OUT       NOT DORMANT OR NOT FOUND
* 
      LDA $WRKS,I   IS IT IN MEMORY?
      SSA 
      JMP MEM       YES, 'MR' BIT SET 
* 
      LDA B         NO
      ADA =D27      INDEX TO DISC LU
      LDA A,I 
      AND =B377 
      SZA,RSS 
      JMP MEM       IN MEMORY ONLY, NOT ON DISC 
* 
      ADA =D-1
      ADA $LUTA 
      LDA A,I       DVT ADDRESS 
      ADA =D5 
      LDA A,I 
      RAL 
      SSA 
      JMP OUT       DISC LU FOR THIS PROGRAM IS DOWN
* 
MEM   JSB $LIST     SCHEDULE IT 
      OCT 60
      LDB $WORK 
      JSB $PRAM     PASS PARAMETERS 
NEXT  NOP 
      LDB $WORK 
      LDA $XQSB,I 
      SZA,RSS 
      JMP OUT       DO NOT CHANGE TERMINAL LU 
      ADB =D28
      LDA B,I 
      AND =B177400  MASK OLD LU 
      IOR $XQSB,I     AND INCLUDE NEW LU
      STA B,I 
      CLA 
      LDB $WORK 
OUT   ISZ $XQSB 
      JMP $XQSB,I 
* 
      SKP 
* 
$XQSX NOP           SCHEDULE THE PROGRAM IF IT IS DORMANT 
      LDA =D3         (BUFFERS IN USER MEMORY)
      JSB .CAX
      LDA $XQSX,I 
      ISZ $XQSX 
      LDB DNAM
      JSB .MWF      MOVE NAME TO SYSTEM MEMORY
* 
      LDA =D5 
      JSB .CAX
      LDA $XQSX,I 
      ISZ $XQSX 
      LDB DPRM
      JSB .MWF      MOVE PARMS TO SYSTEM MEMORY 
* 
      LDA $XQSX,I 
      ISZ $XQSX   
      STA LU
* 
      JSB $XQSB     CALL LOCAL ROUTINE
DNAM  DEF XNAM
DPRM  DEF XPRM
LU    NOP 
      JMP $XQSX,I 
* 
* 
XNAM  BSS 3 
XPRM  BSS 5 
* 
      HED  FIND PROGRAM NAME
* 
$NAME NOP           SEARCH ID SEGMENTS
      LDB $NAME 
      ISZ $NAME 
      LDB B,I 
      RBL,CLE,SLB,ERB  REMOVE INDIRECT REFERENCES 
      JMP *-2 
      SZB,RSS 
      JMP NOTFN     NO NAME PASSED
      STB ID
      INB 
      STB PRIO
      INB 
      LDA B,I 
      AND =B177400
      STA STAT
      LDB $IDA      ADDRESS OF FIRST ID SEGMENT 
NLP   STB $WORK 
      ADB =D12
      LDA B,I 
      CPA ID,I
      SZA,RSS       ZERO IF NO PROGRAM IN THIS ID 
      JMP NEXTP     NOT THIS ONE
      INB 
      LDA B,I 
      CPA PRIO,I
      INB,RSS       SO FAR, SO GOOD 
      JMP NEXTP     NOT THIS ONE
      LDA B,I 
      AND =B177400
      CPA STAT
      JMP FND       FOUND IT! 
NEXTP LDB $WORK 
      ADB $IDSZ 
      CPB $SWTA     END OF TABLE? 
      CLB,RSS       YES 
      JMP NLP       TRY NEXT ID 
NOTFN CCA 
      JMP $NAME,I 
* 
* 
FND   INB 
      STB $WRKS 
      LDA B,I 
      AND =B77      STATUS IN A 
      LDB $WORK     ID SEGMENT ADDRESS IN B 
      JMP $NAME,I 
* 
      SKP 
* 
$NAMX NOP           FIND PROGRAM NAME IN ID SEGMENTS
      LDA =D3         (BUFFER IN USER MEMORY) 
      JSB .CAX
      LDA $NAMX 
      ISZ $NAMX 
      LDA A,I 
      RAL,CLE,SLA,ERA 
      JMP *-2 
      LDB DNAM
      JSB .MWF      MOVE NAME TO SYSTEM MEMORY
      JSB $NAME     CALL LOCAL ROUTINE
      DEF XNAM
      JMP $NAMX,I 
* 
* 
      HED  NUMERIC ERROR MESSAGES 
* 
*     ABORT WITH NUMERIC ERROR MESSAGE
* 
$OPXX LDA =AOP      OPTIONAL EXEC CALL NOT PRESENT
      LDB $RQ.1 
      RSS 
$SCXX LDA =ASC      SCHEDULING ERROR
$ERAB SWP           DECIMAL CONVERSION, PUT VALUE IN A
      CCE 
      JSB $CVT1     CONVERT NUMBER TO ASCII 
      IOR =B10000   CHANGE LEADING SPACE TO ZERO
      SWP 
      JSB $ERMG     ABORT PROGRAM 
      JMP $XEQ
* 
* 
* 
* 
*     ABORT LIST LINKING ROUTINE
* 
$ZLST NOP           ADD PROGRAM TO ABORT LIST 
      ADB =D8       LINK THROUGH POINT OF SUSPENSION
      LDA ZZZZZ 
      STA B,I 
      STB ZZZZZ 
      JMP $ZLST,I 
* 
      HED  CONVERSION OF ID SEG NO. TO ID ADDRESS 
* 
$IDNO NOP           CONVERT NUMBER TO ADDRESS 
      LDA $IDA
      CMA,INA 
      ADA B 
      CLB 
      DIV $IDSZ 
      INA 
      STA B 
      JMP $IDNO,I 
* 
* 
      HED  MOVE PROGRAM NAME TO BUFFER
* 
$PNAM NOP           MOVE PROGRAM NAME TO BUFFER 
      LDA $PNAM,I     (BUFFER IN SYSTEM MEMORY) 
      ISZ $PNAM 
      STA TEMP      ADDRESS OF BUFFER 
      ADB =D12
      LDA B,I       FIRST TWO CHARS 
      STA TEMP,I
      INB 
      ISZ TEMP
      LDA B,I       THIRD & FOURTH CHARS
      STA TEMP,I
      INB 
      ISZ TEMP
      LDA B,I       LAST CHAR 
      ALF,ALF 
      LDB =A
      RRL 8         PUT BLANK IN LOW BYTE 
      STA TEMP,I
      JMP $PNAM,I 
* 
* 
      HED  TBG INTERRUPT PROCESSING 
* 
$CLCK EQU * 
      ISZ $TIME 
      JMP $TLST     CHASE TIME LIST 
      ISZ $TIME+1   BUMP TIME 
      JMP $TLST     CHASE TIME LIST 
      LDA RS1       RESET THE COUNTER 
      LDB RS2         TO THE FULL 
      STA $TIME         DAY'S WORTH OF
      STB $TIME+1         TENS OF MS
      ISZ $TIME+2   NEXT DAY
      LDA $TIME+2 
      CLB,CLE 
      DIV =D366     COMPUTE YEAR
      AND =B3 
      ADB =D-365
      SEZ,SZA       IF DAY 365 AND NOT LEAP YEAR
      ISZ $TIME+2     MAKE UP FOR FEB 29
      JMP $TLST     CHASE TIME LIST 
* 
* 
$TIME OCT 003310    NUMBER OF TBG TICKS UNTIL MIDNIGHT
      OCT 177664      (2-WORD NEGATIVE INTEGER) 
      OCT 003323    (YEAR - 1976) * 366 + (DAYS SINCE JAN 1)
* 
RS1   OCT 25000 
RS2   OCT 177574
* 
      END 
                                                                        