ASMB,L,C
*     NAME  :  XLIB --MULTIPOINT PERIPHERAL SUBROUTINES 
*     SOURCE:  91730-18005  1926
*     RELOC:   91730-1X005  1926
*     PROGMR: G.W.J.
* 
*  **************************************************************** 
*  * (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.        * 
*  **************************************************************** 
* 
* 
      HED 2645 MP PERIPHERAL SUBROUTINES (XLIB) 05-08-79 1625 &XLIBX
      NAM XLIB,7 91730-1X005 REV 1926 PT. OF 91730-12001 790508 
      ENT XREAD,XWRIT,XCONT 
      EXT .ENTR,EXEC
* 
A     EQU 0 
B     EQU 1 
ILU   NOP 
UN    NOP 
IBF   NOP 
IBL   NOP 
ICN   EQU IBF 
IRP   EQU IBL 
* 
EXITP NOP           PERAMATER MOVER AND EXIT
MOVE  JSB .ENTR     MOVE THEM 
      DEF ILU 
      JMP START     CONTINUE
* 
XREAD NOP 
      LDA XREAD     MOVE EXIT POINTER 
      STA EXITP 
      LDB =B1        SET REQUEST TYPE 
      STB RQ
      JMP MOVE      START SETUP 
* 
XWRIT NOP 
      LDA XWRIT     MOVE EXIT POINTER 
      STA EXITP 
      LDB =B2        SET REQUEST TYPE 
      STB RQ
      JMP MOVE      START SETUP 
* 
XCONT NOP 
      LDA XCONT     MOVE EXIT POINTER 
      STA EXITP 
      LDB =B3        SET REQUEST TYPE 
      STB RQ
      JMP MOVE      START SETUP 
      SKP 
* 
*  R=XREAD(ILU,IUN,IBF,IBL) 
*  WHERE:  ILU=THE LOGICAL UNIT NUMBER OF THE TERMINAL
*          IUN=THE UNIT NUMBER OF THE PERIPHERAL ON THE 2645
*          IBF=THE ADDRESS OF THE BUFFER
*          IBL=THE LENGTH OF IBF(MAX OF -256 CH. OR 128 WD.)
*  ON RETURN: 
*             "A"=0...REQUEST COMPLETE
*             "A" NOT 0...ERROR STATUS
*             "B"=TRANSMITTION LOG OR ZERO IF ERROR 
* 
*  NOTE:  IF IBF IS NEGATIVE STATUS ONLY WILL BE TAKEN AND RETURNED 
*        IN THE "A" REG.. 
* 
*  STATUS:      CTU                PRINTER
* 
*  BIT 15...REQUEST ERROR          REQUEST ERROR
*      14...MP ERROR               MP ERROR 
*      13...BUF. LTH.>128 OR 256   BUF. LTH.>128 OR 256 
*      12...BUFF LENGTH = 0        BUFF LENGTH = 0
*      11...END OF FILE            UNASSIGNED 
*      10...LOAD POINT             UNASSIGNED 
*       9...END OF TAPE (EOT)      PAPER OUT
*       8...WRITE ERROR            PRINT ERROR
*       7...COMMAND PERFORMED      COMMAND PERFORMED
*       6...WRITE PROTECTED        UNASSIGNED 
*       5...READ ERROR             UNASSIGNED 
*       4...TAPE BUSY              PRINTER BUSY 
*       3...SOFT ERROR
*       2...HARD ERROR             BITS 1-3= PRINTER BAUD RATE
*       1...END OF VALID DATA 
*       0...TAPE INSERTED          PRINTER CONNECTED
* 
* 
      SKP 
* 
*  R=XWRIT(ILU,IUN,IBF,IBL) 
*  WHERE:  ILU=THE LOGICAL UNIT NUMBER OF THE TERMINAL
*          IUN=THE UNIT NUMBER OF THE PERIPHERAL ON THE 2645
*          IBF=THE ADDRESS OF THE BUFFER
*          IBL=THE LENGTH OF IBF(MAX OF -256 CH. OR 128 WD.)
*  ON RETURN: 
*             "A"=0...REQUEST COMPLETE
*             "A" NOT 0...ERROR STATUS
*             "B"=TRANSMITTION LOG OR ZERO IF ERROR 
* 
*  NOTE:  IF IBF IS NEGATIVE STATUS ONLY WILL BE TAKEN AND RETURNED 
*        IN THE "A" REG.. 
* 
*  STATUS:      CTU                 PRINTER 
* 
*  BIT 15...REQUEST ERROR           REQUEST ERROR 
*      14...MP ERROR                MP ERROR
*      13...BUF. LTH.>128 OR 256    BUF. LTH.>128 OR 256
*      12...BUFF LTNGTH = 0         BUFF LENGTH = 0 
*      11...END OF FILE             UNASSIGNED
*      10...LOAD POINT              UNASSIGNED
*       9...END OF TAPE (EOT)       PAPER OUT 
*       8...WRITE ERROR             PRINT ERROR 
*       7...COMMAND PERFORMED       COMMAND PERFORMED 
*       6...WRITE PROTECTED         UNASSIGNED
*       5...READ ERROR              UNASSIGNED
*       4...TAPE BUSY               PRINTER BUSY
*       3...SOFT ERROR
*       2...HARD ERROR              BITS 1-3 = PRINTER BAUD RATE
*       1...END OF VALID DATA 
*       0...TAPE INSERTED           PRINTER CONNECTED 
      SKP 
* 
*  R=XCONT(ILU,IUN,ICN,IRP) 
*  WHERE:  ILU=THE LOGICAL UNIT NUMBER OF THE TERMINAL
*          IUN=THE UNIT NUMBER OF THE PERIPHERAL ON THE 2645
*          ICN=THE CONTROL CODE TO BE EXECUTED
*          IRP=THE NUMBER OF TIMES THE REQUEST IS TO BE REPETED 
*  ON RETURN: 
*             "A"=0...REQUEST COMPLETE
*             "A" NOT 0...ERROR STATUS
*             "B"=TRANSMITTION LOG OR ZERO IF ERROR 
* 
*  NOTE:  IF ICN IS NEGATIVE STATUS ONLY WILL BE TAKEN AND RETURNED 
*        IN THE "A" REG.. 
* 
*  STATUS:    CTU                   PRINTER 
* 
*  BIT 15...REQUEST ERROR           REQUEST ERROR 
*      14...MP ERROR                MP ERROR
*      13...REP. CNT.>999OO LARGE A REP. CNT.>999 
*      12...FUNCTION CODE TOO BIG.  FUNCTION CODE TOO BIG 
*      11...END OF FILE             UNASSIGNED
*      10...LOAD POINT              UNASSIGNED
*       9...END OF TAPE (EOT)       PAPER OUT 
*       8...WRITE ERROR             PRINT ERROR 
*       7...COMMAND PERFORMED       COMMAND PERFORMED 
*       6...WRITE PROTECTED         UNASSIGNED
*       5...READ ERROR              UNASSIGNED
*       4...TAPE BUSY               PRINTER BUSY
*       3...SOFT ERROR
*       2...HARD ERROR              BITS 1-3 = PRINTER BAUD RATE
*       1...END OF VALID DATA 
*       0...TAPE INSERTED           PRINTER CONNECTED 
      SKP 
START LDA ILU,I     SETUP READ LU 
      LDB RQ
      AND =B77
      IOR =B400      FORCE "CR-LF-RS" STRIP 
      STA RLU 
      AND =B77      SETUP WRITE LU
      IOR =B100 
      STA WLU 
      LDA PUN       SETUP UNIT NUMBER 
      IOR UN,I
      STA SWTCH+1 
* 
* 
* 
      CPB =B3        DOING A CONT. RQ?
      JMP XC.00     YES, GO ON
      JMP CKBFS     NO, GO CHECK BUFF DIM 
      SKP 
* 
XC.00 LDA ICN,I     GET FUNCTION CODE 
      SSA           FC<0-->PULL STATUS ONLY.
      JMP STAT      YES, GO DO IT.
      LDA IRP,I       REP. CNT.?
      SZA,RSS 
      JMP XC.03       NO, GO ON 
      LDB UPOS        DEF. TO POSITIVE
      SSA,RSS         NEG. REP. CNT.? 
      JMP XC.01       NO, GO ON 
      CMA,INA         MAKE POS. 
      LDB UNEG        GET NEG. SIGN 
XC.01 STB SWTCH+2     PUT "U"-SIGN IN SWITCH BUF
      STA B           LEAGLE REP. COUNT 
      CMB,INB 
      ADB MXCC
      SSB,RSS         TOO BIG 
      JMP XC01A       NO, GO ON 
      JMP ER2         YES, ERROR
XC01A LDB ZZ          PRESET SWTCH
      STB SWTCH+3 
      CLB             CLEAR "B" FOR DIV 
      DIV D10         DEVIDE A BY 10
      BLF,BLF         MOVE TO LEFT BYTE 
      ADB ZP          ADD RES. IN "B"TO "60"-"P"
      STB SWTCH+4 
      SZA,RSS         "A"=0?
      JMP XC.02       YES, DONE 
      CLB             NO, CLEAR "B" FOR NEXT CONV 
      DIV D10 
      ADB SWTCH+3     ADD RES.
      STB SWTCH+3 
      SZA,RSS         "A"=0?
      JMP XC.02       YES, DONE 
      ALF,ALF 
      ADA SWTCH+3     NO, ADD RES. IN "A"TO SWTCH+3 
      STA SWTCH+3 
XC.02 LDA ICN,I       SET UP CONT. FUNCTION 
      ALF,ALF 
      IOR SIXC
      STA SWTCH+5 
      LDA DM12        SET CH. CNT.
      STA CNT 
      JMP SEND        GO ON 
* 
* 
XC.03 LDA DM7         SET CH. CNT.
      STA CNT 
      LDA ICN,I       SET UP CONT. FUNCTION 
      IOR U60 
      STA SWTCH+2 
      LDA CAPC        PUT CAP. "C" IN SWTCH 
      STA SWTCH+3 
      JMP SEND
      SKP 
* 
* 
CKBFS LDA IBL,I       CHECK FOA BUFF. LTH. OF 0 
      SZA,RSS 
      JMP ER1         YES, ERROR
      SSA             WORDS OR CH.
      JMP CC          CH. GO TO CH. CHECK 
      CMA,INA         CHECK TOO BIG 
      ADA MXW 
      SSA,RSS 
      JMP XR.01       OK, GO ON 
      JMP ER2         TOO BIG ERROR 
CC    ADA MXC         CHECK TOO BIG 
      SSA,RSS 
      JMP XR.01       OK, GO ON 
      JMP ER2         TOO BIG ERROR 
* 
* 
XR.01 CPB =B2        DOING A WRITE? 
      JMP XW.01     YES, GO TO WRITE SETUP
      LDA ILU,I     MUST BE DOING A READ
      AND =B100      SETUP READ CODE IN SWTCH 
      STA B 
      LDA S60       "S"-"0" 
      SZB           IF "M"BIT SET IN CALL 
      IOR =B2         FOCE TO A "2" 
      STA SWTCH+2 
      LDA R         SET "R" IN SWTCH
      STA SWTCH+3 
      LDA DM7       SET FOR A COUNT OF 7
      STA CNT 
      JMP SEND      GO SEND SWTCH 
      SKP 
* 
* 
XW.01 LDB UN,I      PUT UNIT NUMBER IN B
      LDA IBL,I       SET UP TO CONV TO ASCII 
      SSA,RSS         CH.?
      RAL             NO, A<--A*2 
      SSA             CH.?
      CMA,INA         MAKE POS. 
      STA CCNT        SAVE POS CH. CNT. 
      CPB D4          UNIT=4? (PRINTER) 
      ADA =D2         YES, ADD TWO FOR CR/LF
      LDB DC0         PRESET SWTCH
      STB SWTCH+2 
      LDB ZZ
      STB SWTCH+3 
      CLB             CLEAR "B" FOR DIV 
      DIV D10         DEVIDE A BY 10
      ADB SWTCH+3     ADD RES. IN "B"TO SWTCH+3 
      STB SWTCH+3 
      SZA,RSS         "A"=0?
      JMP XW.02       YES, DONE 
      CLB             NO, CLEAR "B" FOR NEXT CONV 
      DIV D10 
      BLF,BLF         MOVE TO LEFT BYTE 
      ADB SWTCH+3     ADD RES.
      STB SWTCH+3 
      SZA,RSS         "A"=0?
      JMP XW.02       YES, DONE 
      ADA SWTCH+2     NO, ADD RES. IN "A"TO SWTCH+2 
      STA SWTCH+2 
XW.02 LDB UN,I      CHECK FOR PRINTER 
      LDA CCNT
      ADA D9          ADD 9 TO COUNT FOR SWITCH 
      CPB D4        UNIT= PRINTER?
      ADA =D2       YES, ADD 2 FOR CR/LF
      CMA,INA         NEG.
      STA CNT 
      LDA W         SET A "W" IN SWTCH
      STA SWTCH+4 
      LDA IBF         SET UP FOR BYTE MOVE
      RAL             CH. ADD 
      LDB SWP 
      CCE             SET "E" FORCE RIGHT BYTE
      ELB             CH. ADD  START IN RIGHT BYTE
      MBT CCNT        MOVE BYTES
      LDA UN,I      SETUP WLU 
      CPA D4        UNIT .EQ. LINE PRINTER
      JMP XW.03     YES, GO ADD CRLF
      JMP SEND      NO GO SEND IT 
XW.03 LDA LFCR      MOVE CRLF INTO BUFF 
      SBT 
      ALF,ALF 
      SBT 
      SKP 
* 
* 
SEND  JSB EXEC        SEND SWTCH
      DEF *+4+1 
      DEF D2
      DEF WLU 
      DEF SWTCH 
      DEF CNT 
      JMP MPER        MP ERROR
      SZB,RSS         XLOG=0? 
      JMP STAT        YES, GO PULL STATUS 
      LDA RQ        DOING A READ? 
      CPA =B1        YES, GO GET DATA 
      JMP XR.02 
      JSB EXEC        GET WRITE RESP. CH. 
      DEF *+4+1 
      DEF D1          READ
      DEF RLU 
      DEF XSTBF 
      DEF DM1         1 CH. 
      JMP MPER        MP ERROR
      SZB,RSS         GET A CH.?
      JMP STAT        NO GO GET STATUS
      LDA XSTBF       CHECK CH. 
      AND  =B177400 
      CPA ASCS        =S
      JMP XW02A       YES, DO COMPLETION
      JMP STAT        NO, GET STATUS
XW02A CLB 
      LDA RQ        DOING A CONT. 
      CPA =B3 
      JMP CL.01     YES, RETURN XLOG=0
      LDB IBL,I       BUILD A XLOG
      SSB             WORDS.OR.CH.? 
      CMB,INB         CH. MAKE POSITIVE 
CL.01 CLA             CLEAR STAT IN "A" 
      JMP EXITP,I     RETURN
      SKP 
* 
* 
XR.02 LDA ILU,I     BINARY READ?
      AND =B100 
      SZA 
      JMP XR.03     YES, GO DO IT 
XR02A JSB EXEC      NO, DO READ INTO USER BUF 
      DEF *+4+1 
      DEF D1
      DEF RLU 
      DEF IBF,I 
      DEF IBL,I 
      JMP MPER
      SZB,RSS       XLOG=0? 
      JMP STAT      YES, PULL STATUS
      CLA           NO, RETURN
      JMP EXITP,I 
* 
* 
XR.03 JSB EXEC      READ INTO TEMP BUF
      DEF *+4+1 
      DEF D1
      DEF RLU 
      DEF RBUF
      DEF MXWP2 
      JMP MPER
      SZB,RSS       XLOG=0? 
      JMP STAT      YES, PULL STATUS
      ADB DM2       SUB. 2 FOR BC ON REC. 
      STB BSV 
      SZB,RSS       ANY DATA? 
      JMP XR02A     NO, ERROR - TRY TO GET DATA 
      LDA RBUFP     SETUP TO MOVE 
      LDB IBF 
      MVW BSV 
      NOP 
      LDB BSV 
      CLA 
      JMP EXITP,I   RETURN
      SKP 
* 
* 
STAT  LDA STATC      SETUP SWTCH
      STA SWTCH+2 
      JSB EXEC        SEND STAT RQ. 
      DEF *+4+1 
      DEF D2
      DEF WLU 
      DEF SWTCH 
      DEF DM5 
      JMP MPER        MP ERROR
      JSB EXEC        GET STAT BYT
      DEF *+4+1 
      DEF D1
      DEF RLU 
      DEF XSTBF 
      DEF DM7 
      JMP MPER        MP ERROR
      LDA XSTBF+2     BUILD STATUS WORD 
      AND  =B17 
      ALF 
      STA B 
      LDA XSTBF+2 
      AND =B7400
      IOR B 
      STA B 
      LDA XSTBF+3 
      AND =B7400
      ALF,ALF 
      IOR B 
      CLB 
      JMP EXITP,I 
      SKP 
* 
* 
ER1   LDA ER1C        SET STATUS TO ER1 
      CLB             SET XLOG=0
      JMP EXITP,I     RETURN
ER2   LDA ER2C        SET STATUS TO ER2 
      JMP ER1+1       CONT. 
MPER  LDA MPEC        SET BIT 15,14 
      JMP ER1+1 
RQ    NOP 
ER1C  OCT 110000
ER2C  OCT 120000
MPEC  OCT 140000
MXW   DEC 128 
MXWP2 DEC 130 
MXC   DEC 256 
MXCC  DEC 999 
D1    OCT 100001      READ NO ABORT 
D2    OCT 100002      WRITE NO ABORT
D4    DEC 4 
RLU   NOP 
WLU   NOP 
D9    DEC 9 
D10   DEC 10
CNT   NOP 
CCNT  NOP 
PUN   OCT 70060 
UPOS  OCT 072453
UNEG  OCT 072455
ZP    OCT 030160
SIXC  ASC 1,0C
U60   OCT 072460
CAPC  ASC 1,CC
R     ASC 1,RR
W     ASC 1,WW
S60   OCT 071460
STATC OCT 057000
DM1   DEC -1
ASCS  OCT 051400
DC0   OCT 062060
ZZ    ASC 1,00
LFCR  OCT 005015
SWP   DEF SWTCH+4 
DM2   DEC -2
DM5   DEC -5
DM7   DEC -7
DM12  DEC -12 
BSV   NOP 
RBUFP DEF RBUF+2
SWTCH OCT 15446 
      NOP 
      NOP 
      NOP 
      OCT 053400
RBUF  BSS 128 
XSTBF BSS 4 
      END 
  
                                                                                                                                                                                                