ASMB,R,L,C
*     NAME:   SYCOM 
*     SOURCE: 92071-18149 
*     RELOC:  92071-16149 
*     PGMR:   HLC,DJN 
* 
* 
*  **************************************************************** 
*  * (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 SYCOM,0  92071-16149  REV.2041  800730
      ENT $MSEX,$PB,$XS4,$XS5,$MESS 
      ENT $MES. 
      ENT $TYPE,$ATTN,$XQLU,$P2 
      ENT $FIND,$LUDV,$XQC,$$SYC,$.SYC
* 
      EXT $RQP1,$RQP8,$RQ.9,$DB 
      EXT $INER,$IOUP,$UNAS,$DOWN,$A
      EXT $XEQ,$LUT#,$LUTA,$DIOC,$UIT 
      EXT $NOID,$BUSY,$ALCS,$NOSM 
      EXT $BRRQ,$DNRQ,$DSRQ,$GORQ,$PRRQ 
      EXT $PSRQ,$SSRQ,$ILCM,.XLA
      EXT $XQSB,$NAME,$WRKS,$XSIO 
      EXT $WORK,$TREM,$LDRS,$ZLST 
      EXT $IOFL,$LDAB,.CBX,.MWI,$MPSQ,$SUSP 
* 
A     EQU 0 
B     EQU 1 
* 
      HED  TERMINATE COMMAND (OF) 
OFRQ  JSB $FIND     FIND THE ID SEGMENT 
      STA $RQP1     SAVE STATUS 
      LDA $WRKS,I 
      IOR =B400     SET 'OF' BIT IN STATUS
      LDB $PB+9 
      SZB 
      CPB =AFL
      JMP STA       FLUSH OPTION
      CPB =AID
      JMP IDBIT 
      CPB =ADR
      RSS 
      JMP $INER     ILLEGAL OPTION
* 
      LDB $RQP1 
      SZB 
      JMP $BUSY     PROGRAM MUST BE DORMANT 
      LDB $WRKS 
      ADB =D2 
      LDB B,I 
      BLF,SLB 
      JMP $BUSY     MUST NOT BE IN THE TIME LIST
      LDB $WORK 
      ADB =D27
      LDB B,I 
      SZB,RSS 
      JMP $BUSY     MUST BE DISC-RESIDENT 
* 
IDBIT IOR =B2000    SET 'ID' BIT
STA   STA $WRKS,I   STORE NEW STATUS
* 
      LDB $WORK 
      JSB $TREM     REMOVE PROGRAM FROM TIME LIST 
      LDB $WORK 
      CPB $LDRS 
      JMP LDAB      ABORT LOAD OR SWAP
      LDA $RQP1 
      CPA =D2       IF NOT IO SUSPENDED,
      RSS 
      JSB $ZLST       LINK ID TO ABORT QUEUE
FLUSH LDA $WORK 
      JSB $IOFL     FLUSH IO
      JMP $XEQ
* 
LDAB  JSB $LDAB     ABORT LOAD OR SWAP
      JMP FLUSH 
* 
* 
* 
      HED  UP COMMAND (UP)
UPRQ  EQU *         UP COMMAND
      JSB $LUDV     FIND DVT ADDRESS IN LU TABLE
      JSB $IOUP     SET DEVICE 'UP' 
      JMP $XEQ
* 
* 
$LUDV NOP           SET UP POINTERS TO DVT
      LDA $PB+5 
      SSA 
      CMA,INA 
      STA B         MAKE POSITIVE 
      CMA,INA,SZA,RSS 
      JMP $UNAS     LU ZERO IS UNASSIGNED 
      ADA $LUT# 
      SSA 
      JMP $INER     TOO BIG 
      ADB =D-1
      ADB $LUTA 
      LDB B,I       DVT ADDRESS IN B
      SZB,RSS 
      JMP $UNAS     PRINT 'UNASSIGNED'
      CLA,INA 
      JSB $DIOC     SET UP DVT POINTERS 
      JMP $LUDV,I 
* 
* 
      HED  DEBUG COMMAND (DB) 
DBRQ  EQU *         DEBUG PROGRAM 
      LDA $PB+4     GET SECOND PARAM TYPE 
      SZA,RSS       ZERO TYPE MEANS NULL PARAM
      JMP NOPRG     NO PROGRAM NAME WAS GIVEN 
* 
      CPA =D1       NUMERIC PARAMETER?
      JMP $INER     YES, GIVE INPUT ERROR REPLY 
* 
* A PROGRAM NAME WAS GIVEN. 
* SEE IF IT WAS "RTE-L".
* 
      DLD $PB+5     GET FIRST 4 CHARS 
      CPA RTELB     CHECK FIRST TWO CHARS 
      JMP L1        SO FAR, CHECK SUCCEEDS
      JMP GETID     PROG NAME NOT RTE-L 
* 
L1    CPB RTELB+1   CHECK CHARS 3,4 
      JMP L2        SO FAR, CHECK SUCCEEDS
      JMP GETID     PROG NAME NOT RTE-L 
* 
L2    LDA $PB+7     GET LAST CHAR 
      CPA =AL 
      JMP ISSYS     YES, THE NAME WAS RTE-L 
      CPA =AL+      WAS NAME RTE-L+?
      JMP DBALL     YES, DEBUG SYSTEM AND PROGRAMS
      JMP GETID     ASSUME IT WAS AN RP'D PROGRAM NAME
* 
DBALL STA RTELB+2   FIX RTEL BUFFER IN CASE OF FUTURE DB
      LDA =D-1      CODE TO TELL SYSTEM TO DEBUG EVERYTHING 
      JMP STADB     JUMP TO STORE A IN $DB
* 
ISSYS STA RTELB+2   FIX RTELB IN CASE OF FUTURE DB
      CLA           THE SYSTEM IS TO BE DEBUGGED
STADB STA $DB       CODE THAT FACT IN $DB 
      STF 15B       ENABLE 1610 ANALYZER ON INTERRUPTS
      JMP $XEQ
* 
GETID JSB $FIND     TRY TO FIND ID SEGMENT ADDRESS
      STB $DB       IF $FIND RETURNS, B HAS ADDRESS 
      CLF 15B       DISABLE LOGIC ANALYZER ON INTERRUPTS
      JMP $XEQ
* 
NOPRG LDB $DB       FIND OUT WHAT IS BEING DEBUGGED 
      SZB,RSS       IF ZERO, THE SYSTEM IS
      JMP RTEL
      CPB =D-1      IS IT RTE-L+
      JMP RTELP     YES 
* 
* ASSUME B HAS A CORRECT ID SEGMENT ADDRESS 
* GET THE PROGRAM'S NAME, AND RETURN IT TO THE CALLER 
* 
      ADB =D12      MAKE B POINT TO NAME FIELD
      LDA B,I       GET NAME CHARACTERS 
      STA PRGB      SAVE FOR $MSEX CALL 
      INB 
      LDA B,I       GET CHARS 3,4 
      STA PRGB+1
      INB 
      LDA B,I       GET LAST CHAR 
      AND =B177400  MASK LOW BYTE 
      IOR =B40      PAD WITH SPACE
      STA PRGB+2
      JSB $MSEX     SEND OUT THE REPLY
      DEC -6
PRGB  BSS 3 
* 
RTELP LDA =AL+      FIX UP BUFFER FOR DISPLAY 
      STA RTELB+2 
RTEL  JSB $MSEX 
      DEC -6
RTELB ASC 3,RTE-L 
* 
* THE NEXT 24 WORDS ARE TWO XSIO PARAMATER BLOCKS 
* 
ATNLU DEC 0         LU - BUSY FLAGE 
      DEF TYP10     COMPLETION ADDRESS
      NOP           LINKAGE 
      OCT 10401     READ WITH ECHO AND PROMPT 
IBUF  DEF TYBUF     READ BUFFER 
      DEC -80       80 CHAR MAX 
      DEF PRMPT     PROMPT BUFFER 
      DEC -8        8 CHARACTERS
      DEC 0         PRIORITY
      DEC 0         STARTING PAGE # OF SYSTEM 
      NOP 
TLOG  NOP 
* 
MSGLU DEC 0         LU
      DEF TYP20     COMPLETION ADDRESS
      NOP           LINKAGE 
      DEC 2         WRITE REQUEST 
      DEF TYBUF     BUFFER
MSGLN DEC 0         MESSAGE LENGTH
      NOP           NO Z BUFFER 
      NOP 
      NOP           PRIORITY
      DEC 0         SYSTEM MAP
      NOP 
      NOP           TRANSMISSION LOG
* 
      HED  EXECUTE COMMAND (XQ) 
XQRQ  EQU *         EXECUTE PROGRAM 
      JSB $XQSB     SCHEDULE THE PROGRAM IF DORMANT 
      DEF $PB+5     NAME
      DEF $P2,I     PARAMETER ADDRESSES 
$XQLU NOP 
      SZB,RSS 
      JMP $NOID     NOT FOUND 
      SSA 
      JMP $DOWN     'PROGRAM DISC DOWN' 
      SZA 
      JMP $BUSY     ALREADY SCHEDULED 
* 
      LDA $PB+8 
      SZA 
      JMP $XQC      PARAMETERS PASSED 
      INB 
      LDA $XQLU     PASS LU IN FIRST PARAMETER
      STA B,I 
* 
$XQC  LDB $WORK 
      JSB $ALCS     PASS THE STRING 
      SZB           NOT ENOUGH MEMORY EVER
      JMP $NOSM     NOT ENOUGH MEMORY NOW 
      JMP $XEQ      SUCCESSFUL, OR NO MEMORY EVER 
* 
$P2   DEF $PB+9 
      DEF $PB+13
      DEF $PB+17
      DEF $PB+21
      DEF $PB+25
* 
* 
$FIND NOP           START PROGRAM NAME MESSAGE
      JSB $NAME     FIND ID SEGMENT ADDRESS 
      DEF $PB+5 
      SZB,RSS 
      JMP $NOID     PRINT 'NO PROGRAM ID' 
      JMP $FIND,I 
* 
* 
* 
      HED  MESSAGE INPUT AND OUTPUT 
* 
* 
$ATTN NOP           SET BY TERMINAL DRIVER
* 
* 
* 
$TYPE EQU *         HAS KEY BEEN STRUCK ON TERMINAL?
      LDA $ATTN 
      SZA,RSS 
      JMP $XEQ      NO
      CLB 
      STB $ATTN 
      LDB ATNLU 
      SZB 
      JMP $XEQ      BUFFER IN USE 
      STA ATNLU 
      STA MSGLU     SAVE LU NUMBER
$XS4  JSB $XSIO     PROMPT/READ REQUEST 
      DEF ATNLU     XSIO PARAMATER BLOCK
      JMP $XEQ      WAIT FOR INPUT
* 
TYP10 LDA ATNLU 
      STA $XQLU     TERMINAL LU 
      CLA 
      STA ATNLU     BUFFER AVAILABLE IF NO RESPONSE 
* 
*     $MESS REQUIRES THE ALTERNATE MAP TO BE SET UP 
*     DESCRIBING THE SOURCE OF THE REQUEST.  PARSE
*     AND $MSEX USE THIS ASSUMPTION TO ACCESS AND RETURN BUFFERS. 
* 
      JSB $MPSQ     SET MAPS TO DESCRIBE SYSTEM 
* 
* NOW THE MAPS DESCRIBE THE SYSTEM, SO WE CAN ASSUME
* THAT CROSS MAP ACCESS OF PARAMATERS WILL ALWAYS WORK. 
* 
      LDA IBUF
      LDB TLOG      TRANSMISSION LOG
      JSB $MESS     PROCESS MESSAGE 
      STA MSGLN     LENGTH OF RESPONSE
      STA ATNLU     BUFFER IN USE 
$XS5  JSB $XSIO     WRITE REQUEST 
      DEF MSGLU 
      JMP $XEQ      WAIT FOR OUTPUT 
* 
TYP20 CLA 
      STA ATNLU 
      JMP $XEQ
* 
TYBUF BSS 40        TERMINAL I/O BUFFER 
* 
PRMPT ASC 4,RTE-L: _   SYSTEM PROMPT
* 
      HED  SYSTEM COMMAND PROCESSOR 
* 
* THIS IS THE USER CALLED ENTRY POINT TO $MESS
* 
$MES. NOP 
      STA $MESS     USED AS TEMP WORD 
      CLA           ZERO WORD COUNT FOR NO RETURN CASE
      STA $A,I
      LDA $UIT      SET UP $SUSP FOR RETURN TO MESSS
      INA           POINT PAST THE DEF $MES.
      STA $SUSP,I   WILL RETURN TO MESSS ON NEXT DISPATCH 
      LDA $MESS     RETRIEVE PASSED BUFFER ADDRESS
      JSB $MESS     PROCESS MESSAGE 
      STA $A,I      SET UP RETURN TO USER CALL (MESSS)
      JMP $XEQ
* 
$MESS NOP           MESSAGE PROCESSOR 
      STA $RQP8     STRING BUFFER ADDRESS 
      STB $RQ.9     STRING BUFFER LENGTH
      JSB PARSE     PARSE THE REQUEST 
      DEF $PB 
      SPC 2 
* 
*        THIS SECTION CHECKS THE OPERATOR REQUEST CODE AGAINST THE
*    LEGAL REQUEST CODES AND JUMPS TO THE PROPER PROCESSOR. 
* 
* 
      LDA $PB+1 
      CPA =ABR
      JMP $BRRQ 
      CPA =ADB
      JMP DBRQ
      CPA =ADN
      JMP $DNRQ 
      CPA =ADS
      JMP $DSRQ 
      CPA =AEX
      JMP $XEQ      NO ACTION 
      CPA =AGO
      JMP $GORQ 
      CPA =AOF
      JMP OFRQ
      CPA =APR
      JMP $PRRQ 
      CPA =APS
      JMP $PSRQ 
      CPA =ARU
      JMP XQRQ
      CPA =ASS
      JMP $SSRQ 
      CPA =AUP
      JMP UPRQ
      CPA =AXQ
      JMP XQRQ
      JMP $ILCM     PRINT 'ILLEGAL COMMAND' 
* 
* 
*     CALLING SEQUENCE: 
*     JSB $MSEX 
*     DEC -2N 
*     ASC N,XXXXXXXXX 
* 
* 
$MSEX NOP           MOVE RESPONSE TO OUTPUT BUFFER
      LDB $MSEX,I 
      BRS 
      CMB,INB 
      JSB .CBX      POSITIVE NUMBER OF WORDS
      LDB $RQP8     GET STRING BUFFER ADDRESS 
      LDA $MSEX 
      INA 
      JSB .MWI      MOVE WORDS INTO WILL WORK ALWAYS
      LDA $MSEX,I   NEGATIVE NUMBER OF CHARACTERS 
      JMP $MESS,I   DONE
      SKP 
      HED PARSE SUBROUTINE FOR OPERATOR MESSAGES
* 
*     CALLING SEQUENCE: 
*     LDA BUFFER ADDRESS
*     LDB CHARACTER COUNT 
*     JSB PARSE 
*     DEF PRAM BUFFER 
*     -RETURN-
* 
*     THE PRAM BUFFER IS 33 WORDS LONG AND CONTAINS UP TO 8 
*     PRAMETER DESCRIPTERS FOLLOWED BY THE PRAMETER COUNT.
*     PARSE ASSUMES THE DATA COMES FROM THE ALTERNATE MAP.
*     WHEN $MESS IS SYSTEM CALLED, THE MAPS MUST BE SET UP
*     TO DESCRIBE THE SYSTEM.  WHEN MESSS IS USER CALLED, 
*     THE $MES. ENTRY AND ALTERNATE MAP CONVENTION ALLOWS 
*     THE CORRECT FUNCTIONALITY.
* 
*     EACH PARAMETER DESCRIPTER CONSISTS OF FOUR WORDS: 
* 
*     WORD          MEANING 
*     1             FLAG WORD 0=NULL PRAMETER 
*                             1=NUMERIC PRAMETER
*                             2=ASCII PRAMETER
*     2             0 IF NULL,VALUE IF NUMERIC,ASCII(1,2) IF ASCII
*     3             0 IF NOT ASCII ELSE ASCII(3,4)
*     4             0 IF NOT ASCII ELSE ASCII(5,6)
* 
*                                   TEMP USAGE IN PARSE SECTION:
* 
*                                   BUFAD = CHARACTER ADDRESS 
*                                   TYPE  = PARAMETER FLAG ADDRESS
*                                   FETCH = BUFFER FETCH ADD. 
*                                   STORE = BUFFER STORE ADD. 
*                                   BUFEN = LAST INPUT CHAR.+1 ADD. 
*                                   BASE  = RADIX (8 OR 10) 
*                                   TBUF  = DEF CHARS (6 LOCATIONS) 
*                                   TBUFS = DEF CHARS+7 
*                                   STOP  = DEF CHARS+6 
*                                   CHARS = 6 UNPACKED CHARACTERS 
*                                   PRCNT = PARAM COUNT ADDRESS 
* 
PARSE NOP 
      CLE,ELA       MAKE CHARACTER ADDRESS
      STA BUFAD     SET BUFFER CHAR ADD.
      ADA B         COMPUTE END ADDRESS.
      STA BUFEN     AND SET IT. 
      LDB =D-32     CLEAR PARAMETER AREA
      STB TYPE
      LDB PARSE,I 
      CLA 
CLEAR STA B,I 
      INB 
      ISZ TYPE
      JMP CLEAR 
* 
      STA B,I       CLEAR THE PRAM COUNT
      STB PRCNT     SET ADDRESS OF PRAM COUNT 
PARLP LDA TBUF
      STA FETCH 
      STA STORE 
* 
UNPAK JSB GET       GET THE NEXT CHARACTER
      CPA =B40     CHECK IF BLANK CHARACTER 
      JMP UNPAK    YES, SO SKIP CHARACTER 
      CPA =B72
      JMP SKIP      COLON, SKIP TO NEXT COMMA 
      LDB STORE     CHECK IF 6 CHARACTERS IN PRAM 
      CPB TBUFS     IF SO 
      JMP UNPAK     SKIP STORE
      STA STORE,I   STORE THE CHARACTER 
      STA LASTC     SAVE THE LAST CHARACTER 
      ISZ STORE     STEP FOR NEXT CHAR. 
* 
      JMP UNPAK     GO TO PROCESS NEXT CHARACTER
* 
*                                   ATTEMPT NUMERIC CONVERSION OF PRAM. 
* 
NUMBR LDA PRCNT,I   FIRST SET UP POINTERS 
      RAL,RAL       TAKE 4 TIMES THE PRAM NUMBER
      ADA PARSE,I   PLUS THE OP CODE ADDRESS-1
      STA TYPE      SET FLAG ADDRESS
      CLE,INA       ONE MORE AND WE HAVE
      STA VALOC     THE PRAMETER VALUE LOCATION 
      LDA STORE     IF NO CHARACTERS
      CPA TBUF      INPUT 
      JMP BUMP      GO TRY NEXT ONE 
* 
*                                   NOW TRY FOR A NUMBER
* 
      ISZ TYPE,I    SET FLAG TO 1 FOR NUMBER
      LDB FETCH,I   GET FIRST CHAR
      CPB DASH       MINUS SIGN?
      ISZ FETCH      YES, INCRE TO NEXT CHAR
      CPA FETCH     (A) STILL = STORE 
      JMP ASCII     IF "-" WAS ONLY CHAR, THEN ASCII
* 
      LDB =D10      SET UP CONVERSION BASE
      LDA LASTC 
      CPA "B"       IF B SUFFIX 
      LDB =D8        SET FOR BASE 8 
      STB BASE      SET BASE
DIGIT MPY VALOC,I   BUMP THE CURRENT VALUE
VALOC EQU *-1 
      LDB FETCH,I   GET THE NEXT CHAR.
      ADB =D-58     IF GREATER THAN "9" 
      SEZ           THEN NOT A NUMBER 
      JMP ASCII 
      ADB =D10      IF LESS THAN "0"
      SEZ,RSS       THEN
      JMP ASCII     NOT A NUMBER
      CLE 
      ADA B         ACCUMULATE THE
      STA VALOC,I   NUMBER
      ISZ FETCH     STEP THE BUFFER ADDRESS 
      LDA BASE      GET THE BASE
      LDB FETCH     AND THE NEXT CHAR. LOC. TO B
      CPB STORE     IF END THEN 
      JMP NEGCH     GO TO NEXT PRAM 
* 
      INB           IF BASE 8 CONVERSION
      CPB STORE     AND LAST
      CPA =D10      CHAR. THEN DONE SO SKIP 
      JMP DIGIT     ELSE GO GET THE NEXT ONE
* 
      SPC 1 
NEGCH LDB VALOC,I   GET VALUE 
      LDA TBUF,I    IF NEG NUMBER,
      CPA DASH
      CMB,INB        NEGATE VALUE 
      STB VALOC,I   STORE VALUE 
* 
BUMP  ISZ PRCNT,I   COUNT THE PRAMETER
      LDA PRCNT,I   IF
      LDB BUFEN      EOL OR 
      CPB BUFAD       8 PRAMS LINE
      JMP EXIT          THEN
      CPA =D8 
      JMP EXIT           GO PROCESS 
      JMP PARLP     ELSE GO GET NEXT CHARACTER
      SPC 1 
ASCII ISZ TYPE,I    SET NOT NUMBER FLAG 
      LDA =A        FILL THE PRAM WITH BLANKS 
      LDB VALOC     PRAM ADDRESS TO B 
      INB           DON'T WORRY ABOUT FIRST WORD
      STA B,I       SET SECOND WORD 
      CLE,INB       STEP TO THIRD WORD
      STA B,I       SET THIRD WORD TO DOUBLE BLANK. 
      LDB TBUF      GET THE CHAR BUFFER POINTER 
ASCLP CPB STORE     END OF INPUT? 
      JMP BUMP      YES GO PROCESS NEXT PRAM
      CPB STOP      SIXTH CHAR YET? 
      JMP BUMP       YES, END PARAM 
      LDA B,I       GET THE CHARACTER 
      SEZ,RSS       IF UPPER CHARACTER
      ALF,SLA,ALF   ROTATE AND SKIP 
      XOR VALOC,I   LOWER ADD THE UPPER CHAR. 
      XOR =B40      ADD/DELETE THE LOWER BLANK
      STA VALOC,I   STORE THE PACKED WORD 
      SEZ           SKIP IF UPPER 
      ISZ VALOC     ELSE STEP STORE ADDRESS.
      CME,INB       TOGGLE FLAG AND BUMP FETCH ADDRESS
      JMP ASCLP     GO GET OTHER CHAR.
      SPC 2 
EXIT  ISZ PARSE     STEP RETURN ADDRESS 
      JMP PARSE,I   RETURN
* 
SKIP  JSB GET       GET NEXT CHARACTER
      JMP SKIP      LOOP UNTIL COMMA OR END OF BUFFER 
* 
GET   NOP           GET NEXT CHARACTER
      LDB BUFAD 
      CPB BUFEN 
      JMP NUMBR     END OF BUFFER, GO PROCESS PARAMETER 
      ISZ BUFAD 
      CLE,ERB       WORD ADDRESS
      JSB .XLA      XLA WILL WORK WHEN SYSTEM OR USER CALLED
      DEF B,I 
      SEZ,RSS 
      ALF,ALF       HIGH BYTE 
      AND =B377 
      CPA =B54
      JMP NUMBR     COMMA, GO PROCESS 
      JMP GET,I 
      SPC 2 
* 
$PB   BSS 33        PARSE BUFFER
"B"   OCT 102       ASCII "B" 
DASH  OCT 55        ASCII "-" 
TYPE  NOP 
FETCH NOP 
STORE NOP 
BUFAD NOP 
BUFEN NOP 
PRCNT NOP 
TBUF  DEF CHARS 
STOP  DEF CHARS+6 
TBUFS DEF CHARS+7 
CHARS BSS 6 
LASTC NOP 
BASE  NOP 
* 
$$SYC EQU *         STANDARD MODULE 
$.SYC DEC 0         STANDARD MODULE 
* 
      END 
                                                                  