ASMB
  HED .                      T M S    L I B R A R Y 
      NAM TMLIB,7 92903-16100 REV.1913  781215
  SPC 3 
**********************************************************************
*                                                                    *
*     NAME:   TMLIB     TMS LIBRARY                                  *
*     ENT:    TMDFN,TMCBE,TMCBD,TMCBL,TMRD,TMWR,TMBWR,TMCTL,TMBCT    *
*             TMWRD,TMCWR,TMSUB,TMSAB,TMPZ,TMPRO,TMSOP,TMLOG         *
*     SOURCE: &TMLIB    92903-18106                                  *
*     BINARY: %TMLIB    ----NONE---    PART OF  %TMSLB  92903-16100  *
*                                                                    *
*     PGMR:   FRANCOIS GAULLIER                                      *
*                                                                    *
**********************************************************************
      SPC 2 
*     **************************************************************
*     * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  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.  *
*     **************************************************************
  SPC 3 
      ENT TMDFN,TMCBE,TMCBD,TMCBL 
      ENT TMRD,TMWR,TMBWR,TMCTL,TMBCT,TMWRD,TMCWR 
      ENT TMSUB,TMSAB,TMPZ,TMPRO,TMSOP,TMLOG
      ENT TMSTP,TMSIF 
      ENT $TML0,$TML3,$TML5,$TML7,$TML8 
* 
*                   DUMMY ENT:   TMLIB FOR 'TMSAN' A PRINT-OUT UTILITY
*                                $TMSA (EMA NAME) TO RESOLVE UNDEF AT 
*                                      RTE-IV GENERATION TIME IN %TMSLB.
* 
      ENT TMLIB,$TMSA 
      EXT .ENTR,EXEC,&MVW,KLCLS,PNAME,RMPAR 
  SPC 1 
A     EQU 0 
B     EQU 1 
      SUP 
$TMSA EQU * 
  SPC 2 
TMLIB EQU * 
  HED ***  DATA RECEIVED BY TMLIB, FROM TMSYS.  *** 
* 
  SPC 2 
*                   FIVE PARAMETERS OF THE PROGRAM
  SPC 1 
LU    NOP           LU USED TO START THE APPLICATION (TMSOP)
CLASS NOP           TMS EXTERNAL CLASS I/O WORD 
MCLAS NOP           TMS MAIN CLASS I/O WORD 
ICLAS NOP           TMS INTERNAL CLASS I/O WORD 
CLAS0 NOP           TMS CB0 SPECIAL CLASS I/O WORD
  SPC 2 
*                   BUFFER PASSES USING THE STRING PASSING FEATURE
  SPC 1 
SCODZ NOP           TMS INTERNAL SUBROUTINE CODE
FMPCL NOP           FMP-TMS CLASS I/O WORD
LEN0  NOP           LENGTH OF THE CB0 (0 MEANS NO CB0)
#DFCB NOP           MINUS # OF DEFINED CB'S 
EPAOS NOP           'ENTRY POINT ADDR. OF SUBROUTINE' 
RTRN  NOP           RETURN ADDR./ABORT CODE 
RNLCK NOP           RN USED BY LU-LOCK ROUTINE
STKPT NOP           STACK POINTER (PARAM#1 OF REQUEST ON: CLASS)
* 
LULOG BSS 5         LU OF LOG DEVICE (MT OR FILE NAME)
* 
FPAR1 NOP           THREE WORDS USED BY THE TMS FUNCTION
FPAR2 NOP 
FPAR3 NOP 
* 
.CB1  NOP           LOCAL ADDR OF CB1 
.LEN1 BSS 10        CURRENT & LOCAL LENGTH OF ALL CB'S
   SPC 1
PARLG EQU *-SCODZ 
   HED T-M  LIBRARY  <--->   T-M  SOFTWARE   COMMUNICATION MODULE 
EXIT2 CLA           DEFAULT VALUE IS 0
      LDA .PAR1,I 
      STA .PAR1     SET 1ST PARAMETER VALUE 
EXIT3 CCB 
      STB SRFLG     SET SEND MAIL BOX FLAG
  SPC 1 
      LDB LEN0      TRUE COMMON 
      SZB,RSS       DEFINED ? 
      JMP EXIT5     NO, SKIP
      JSB GACB0     GET CB0 ADDR
      STB EXIT4 
      JSB EXEC      YES, SAVE TRUE COMMON.
      DEF *+8 
      DEF D20       WRITE/READ CLASS I/O
      DEF D0        DUMMY LU
EXIT4 NOP           BUFFER ADDR 
      DEF LEN0      BUFFER LENGTH 
      DEF D1        BIT0 MEANS CB0 ENABLED
      DEF TEMP
      DEF CLAS0     CLASS I/O WORD
      SZA           WAS IT OK 
      JMP ERR01     NO, ABORT TMS WITH INTERNAL ERROR 01
  SPC 1 
EXIT5 JSB SRCB      SEND ALL NECESSARY CB 
  SPC 1 
EXIT6 LDA SWFLG     LOCAL CLASS I/O 
      SLA,RSS       NEEDED ?
      JMP EXIT7     NO
      LDA LCLAS     LOCAL CLASS I/O 
      SZA,RSS       ALREADY ALLOCATED ? 
      JSB GTCLW     NO, GET ONE CLASS I/O WORD
      STA LCLAS     STORE IT BACK 
* 
EXIT7 LDA MCLAS     SWAP THE MAIN & THE INTERNAL
      LDB ICLAS     CLASS I/O WORD
      STA ICLAS 
      STB MCLAS 
      JSB MAILB     RESTART TMSYS BY SENDING THIS MAIL-BOX
      DEF LCLAS     SEND SUBROUTINE SPECIFIC PARAMETER
      ABS PARLN 
      LDA MCLAS     SWAP BACK THE MAIN & INTERNAL 
      LDB ICLAS     CLASS I/O WORD
      STA ICLAS 
      STB MCLAS 
   SPC 1
      LDB SWFLG     PROGRAM MUST ALLOW SWAPPING 
      SLB,RSS 
      JMP EXIT9     NO, GO TERMINATE 'SERIALLY REUSABLE'
  SPC 1 
      LDB LCLAS     SWAP THE LOCAL & INTERNAL CLASS I/O 
      STB ICLAS     TO USE MAILB SUBROUTINE 
      STA LCLAS 
* 
      CLA 
      STA SRFLG     SET MAIL BOX RECEIVE FLAG 
* 
      JSB MAILB     SUSPEND THIS PROGRAM (--> STATE =3) 
      DEF SCODZ     WITH THE GET COMMON DESCRIPTOR
#PARG ABS PARLG 
* 
      LDA ICLAS     RESTORE BOTH THE LOCAL AND THE INTERNAL 
      LDB LCLAS     CLASS I/O, BY SWAPPING THEM AGAIN 
      STA LCLAS 
      STB ICLAS 
* 
      JMP RSTR4 
  SPC 1 
EXIT9 JSB EXEC      COMPLETE THIS PROGRAM 
      DEF *+4       SERIALLY REUSABLE 
      DEF D6
.D0   DEF D0
      DEF DM1 
  SPC 1 
****************************************************************
  SPC 1 
$TML0 JSB RMPAR     TM SYSTEM RETURN TO USER PROGRAM
      DEF *+2       SAVE PARAMETER
      DEF LU
  SPC 2 
   IFZ
      JSB .DBUG     CALL DBUG: INTERNAL USE ONLY !!!!!!!!!!!!!!!!!!!!!
      EXT .DBUG     CALL DBUG: INTERNAL USE ONLY !!!!!!!!!!!!!!!!!!!!!
   XIF
  SPC 2 
      JSB EXEC      GET STRING REQUEST
      DEF *+5 
      DEF D14       GET STRING
      DEF D1
      DEF SCODZ     BUFFER ADDR 
      DEF #PARG     BUFFER LENGTH 
      SZA           STRING GET SUCCED ? 
      JMP ILSHR     NO, PRINT ERROR MESSAGE 
      CPB #PARG     GET RIGHT LENGTH ?
      RSS           YES 
      JMP ILSHR     NO, PRINT ERROR MESSAGE 
* 
      LDA XEQT      GET PRIMARY ENTRY POINT 
      ADA D7        FROM ID SEGMENT 
      XLA A,I       RTE-IV !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      ADA D2        SKIP THE  JMP &  NOP
      STA .NTUS     SAVE ADDR OF '# OF TUS' 
      ADA A,I       TO SKIP ALL DEF'S 
      INA           TO ACCESS THE SWAP FLAG 
      LDA A,I       GET SWAP FLAG 
      STA SWFLG     SAVE SWAPPING FLAG
* 
      CLA 
      STA SRFLG     SET MAIL BOX RECEIVE FLAG 
   SPC 1
RSTR4 LDA SCODZ     RECALL SUBROUTINE CODE
      STA SCODE     TO SET IT LOCALLY 
      CPA A.RU      RUN COMMAND ? 
      JMP ILSHR     YES, PRINT ERROR MESSAGE
      CPA A.ON      ON COMMAND ?
      JMP ILSHR     YES, PRINT ERROR COMMAND
      CPA ABTCD     ABORT TMS REQUEST ? 
      JMP RSTR5     YES, DO NOT CHECK MCLAS 
* 
      LDA MCLAS     CHECK IF IT IS A GOOD REQUEST 
      SZA,RSS       MAIN CLASS I/O DEFINED ?
      JMP ILSHR     NO, PRINT ERROR MESSAGE 
   SPC 1
RSTR5 JSB SRCB      NO, RECEIVE ALL ENABLE COMMON BLOCK DATA
* 
      LDB .CB1      GET CB1 ADDR
      LDA #DFCB     GET # OF DEFINED CB'S 
      SZA,RSS       CB DEFINED ?
      JMP RSTR7     NO, USE DUMMY CB1 
      LDA .LEN1     RECALL CB1 LOCAL LENGTH 
      SSA           CB1 ENABLED ? 
RSTR7 LDB .DCB1 
      STB .COM1     SET LOCAL COPY OF CB1 ADDR
* 
      LDB .SBRT     SETUP THE RETURN ADDR. (EPAOS=0 IF
      STB EPAOS,I   NOT DEFINED ) 
  SPC 1 
      LDA SCODE     RECALL SUBROUTINE CODE
      ADA C.TAB     INDEX IN TABLE
      JMP A,I 
   SPC 1
.DCB1 DEF DCB1
.SBRT DEF TMRTN 
ABTCD DEC 17        ABORT CODE (TERMINATE THIS PROGRAM) 
A.RU  ASC 1,RU
A.ON  ASC 1,ON
.NTUS NOP           ADDR OF '# OF TUS' IN THIS UPT
.COM1 NOP           LOCAL COPY OF CB1 ADDR
* 
DCB1  BSS 6         DUMMY CB1 
   SKP
ILSHR LDA LU        SET UP LU 
      SZA,RSS 
      INA 
      STA LU
      JSB PNAME     RETREIVE PROGRAM NAME 
      DEF *+2       FROM IDSEG
      DEF MES+1     TO MOVE IT INTO ERROR MESSAGE 
      LDA MES+3     REPLACE 6TH BYTE WITH 
      IOR A:        THE ":" (WAS ALREADY A SPACE) 
      STA MES+3 
      JSB EXEC      OUTPUT
      DEF *+5         " /XXXXX: ILLEGAL SHEDULE REQUEST ! " 
      DEF D2
      DEF LU
      DEF MES 
      DEF D18 
* 
      LDA MCLAS     CHECK IF THE TMS APPLICATION
      SZA           IS RUNNING ?
      JMP EXIT9     YES, DO NOT TERMINATE ! 
      JMP ABORT     NO, TERMINATE PROGRAM 
* 
MES   ASC 4, /XXXXX:
      ASC 14, ILLEGAL SCHEDULE REQUEST !
A:    OCT 72
D0    DEC 0 
D1    DEC 1 
D2    DEC 2 
DM1   DEC -1
D7    DEC 7 
   HED  TERMINAL-MONITOR LIBRARY EXIT TO USER PROGRAM 
RTN90 CCA,RSS       SET CB INDIC. FLAG TO SET STATUS
RTN92 CLA           SET CB INDIC. FLAG TO NOT SET STATUS
      STA CBINF     SET CB INDICATOR FLAG 
* 
      LDA LEN0      IS TRUE COMMON  (CB0) 
      SZA,RSS       DEFINED ? 
      JMP RTN96     NO, SKIP RESTORE
      JSB GACB0     GET CB0 ADDR
      STB RTN93 
      JSB EXEC      RESTORE TRUE COMMON 
      DEF *+6 
      DEF D21       CLASS I/O GET 
      DEF CLAS0     CLASS I/O WORD
RTN93 NOP 
      DEF LEN0
      DEF TEMP      CB INDICATOR UPDATE WORD
      SSA 
      JMP ERR01     ABORT TMS WITH ERROR 01 
      LDA CBIND     MERGE CB INDICATOR FOR CB0
      IOR TEMP      INTO  CBIND 
      STA CBIND 
  SPC 1 
RTN96 ISZ CBINF     DOES CB INDIC. NEED TO BE STORE ? 
      JMP RTN99     NO, EXIT
      CLA           YES, SET UP STATUS WORD 
      LDB LULOG 
      SZB           LOGGING USED ?
      IOR BIT7      YES, SET BIT 7 FOR LOGGING
      IOR CBIND     MERGE WITH CB'S ENABLE FLAG 
      LDB .COM1     AND STORE THE STATUS INTO 
      ADB D3        CB1(3)
      STA B,I 
  SPC 1 
RTN99 LDA .COM1     SAVE CB1(1) & CB1[6:13] TO VERIFY 
      LDB .SCB1     THAT THE USER DO NOT MODIFY THEM. 
      MVW D1        SAVE LU 
      ADA D4        SKIP CTLBIT, TYPE, STAT, ITL
      MVW D8        SAVE CB1[6:13]
      ADA DM10      TO GET STATUS 
      DLD 0,I       A=STATUS, B=TLOG
      JMP RTRN,I      EXIT TO CALLING PROGRAM ! 
  SPC 2 
D21   DEC 21
CBINF NOP 
SWFLG NOP           SWAP FLAG 
.SCB1 DEF *+1 
      NOP           HOLD CB1(1) WHILE USER IS EXECUTING 
$TML3 BSS 8         HOLD CB1[6:13] WHILE USER IS EXECUTING
BIT7  OCT 200 
   SKP
*             ABORT TMS APPLICATION:
*                TERMINATE THIS PROGRAM WITHOUT ANY OPTION
*                TO MAKE IT ACTUALLY DORMANT. 
  SPC 1 
ABT   LDB .CLS      CHECK IF CLOSE FMP FILE REQUESTED 
      LDA FMPCL     RECALL FMP CLASS I/O WORD 
      SZB           CLOSE REQUESTED ? 
      JSB B,I       YES, GO DO THE CLOSE
  SPC 1 
ABORT JSB KLCLS     RELEASE THE LOCAL CLASS I/O 
      DEF *+2       IF ANY
      DEF LCLAS 
* 
      LDA .D0 
      STA .D0+1     SUPPRESS TERMINATE OPTION 
      JMP EXIT9     AND TERMINATE PROGRAM.
  SPC 2 
IMEXT LDB ..PA1     SAVE IMAGE PARAMETERS ADDR INTO 
      MVW PARL      STANDARD PARAMETERS LOCATION
      JMP EXIT3     SAVE CB'S AND GO TO TMSYS 
  SPC 2 
DM3   DEC -3
DM10  DEC -10 
  HED GENERAL TRANSFERT PARAMETER 
GETPA NOP 
      LDB GETPA 
      ADB DM3 
      LDB B,I 
      STB RTRN. 
      ADB DM1 
      STB XSUSP 
      STA SCODE     SET UP TMS INTERNAL SUBROUTINE CODE 
      LDX PAR#
      CLA           CLEAR FUTUR PARAMETERS ADRESSES 
      SAX .PAR1-1   TO KNOW HOW MANY PARAMETERS ARE 
      DSX           PASSED
      JMP *-3 
      JMP RTRN.+1 
   HED ***  DATA SEND BY TMLIB, TO TMSYS.  ***
* 
  SPC 2 
*                   BUFFER PASSES USING A MAIL BOX
  SPC 1 
LCLAS OCT 0         LOCAL CLASS I/O WORD USED TO SUSP. ITSELF 
.PAR1 NOP           USER PARAMETERS ADDR. ARE SET UP
.PAR2 NOP           HERE BY  .ENTR
.PAR3 NOP 
.PAR4 NOP 
.PAR5 NOP 
      BSS 10
RQCNT NOP 
XSUSP NOP 
SCODE NOP           SUBROUTINE CODE TO BE SEND TO TMSYS 
RTRN. NOP           RETURN ADDR. TO BE SEND TO TMSYS
  SPC 1 
PARLN EQU RTRN.-LCLAS+1 
  SPC 3 
      JSB .ENTR     GET PARAMETERS ADDRESS
..PA1 DEF .PAR1     (HOPE IT IS MICRO-CODED)
* 
      CLA 
      STA RQCNT     TO BE SURE THAT THE LOOP WILL END 
      LDX D0
GETP7 LAX .PAR1 
      SZA,RSS       PARAMETER HERE ?
      JMP GETP8     NO, END OF LIST REACHED 
      ISX           YES, INCREMENT X REG
      JMP GETP7     AND LOOP
* 
GETP8 CXA           SAVE # OF PARAMETERS
      STA RQCNT 
      ADA DM10      NEVER MORE THAN 9 PARAMETERS
      SSA,RSS 
      JMP ERR04     ABORT TMS WITH INTERNAL ERROR 04
      LDA SCODE     IF IT IS NOT
      SZA           COMMON BLOCK DEFINITION CALL
      CPA D9
      JMP GETPA,I   IT IS, EXIT 
      LDA #DFCB     IT IS NOT, SO AT LEAST
      SZA,RSS       ONE CB MUST BE DEFINED
      JMP ERR05     ABORT TMS WITH INTERNAL ERROR 05
* 
      LDA .SCB1,I   VERIFY THAT CB1(1) HAS NOT BEEN MODIFIED
      CPA .COM1,I   OK ?
      JMP GETPA,I   YES, EXIT 
      JMP ERR08     NO, ABORT TMS WITH ERROR # 28 
  SPC 1 
PAR#. EQU RQCNT-.PAR1 
PAR#  ABS PAR#. 
PARL. EQU RTRN.-.PAR1+1 
PARL  ABS PARL. 
   HED TERMINAL-MONITOR  READ/WRITE REQUEST  REQUEST
TMRD  NOP 
      CLA,INA       SUBROUTINE CODE=1 FOR READ
      JSB GETPA     GO GET PARAMETER
* 
      LDX D17       EXEC I/O CODE FOR READ
READ3 JSB CB1?      CB1 DEFINED ? 
      LDA .PAR1     A=BUFF. ADDR. 
      LDB .PAR2,I   B=BUFF. LEN.
      STB .PAR2     SAVE BUFFER LENGTH FOR THE GET LATER
      JSB GI/O      EXECUTE I/O 
      JMP EXIT3 
* 
D17   DEC 17
  SPC 2 
READ5 JSB EXEC      THE PHYSICAL I/O IS DONE
      DEF *+5       RETURN FROM PRG: TMSYS IS HERE. 
      DEF D21       CLASS I/O GET TO GET THE INPUT BUFFER 
      DEF ICLAS     INTERNAL CLASS I/O WORD 
      DEF FPAR1,I   USER BUFFER ADDR. (SAVED & RETURNED BY TMSYS) 
      DEF FPAR2     USER BUFFER LEN. (SAVED & RETURNED BY TMSYS)
      SSA           WAS IT OK ? 
      JMP ERR02     ABORT TMS WITH INTERNAL ERROR 02
* 
      JSB SVST      SAVE STATUS & TLOG. 
      JMP RTN92     RESTORE TRUE COMMON 
  SPC 2 
TMWR  NOP 
      LDA D2        SUBROUTINE CODE=2 FOR WRITE 
      JSB GETPA 
* 
      LDX D18 
      JMP READ3 
* 
D18   DEC 18
   SPC 2
TMBWR NOP           BUFFERED WRITE  I.E.: DO NOT
      LDA D4        SUBROUTINE CODE=4 FOR BUFFERED WRITE
      JSB GETPA 
      JSB CB1?      CB1 DEFINED ? 
* 
      LDX D18       EXECUTE THE BUFFERED WRITE
      LDA .PAR1 
      LDB .PAR2,I 
      JSB GI/O
TMBW6 LDA RTRN.     RETURN OF BUFFERED CALL, I.E.:
      STA RTRN      RETURN DIRECTLY TO THE USER (SETUP RTRN ADDR) 
      JMP RTN99     AND RETURN WITHOUT RESTORING TRUE COMMON
* 
D4    DEC 4 
   HED TERMINAL-MONITOR  WRITE-READ-REQUEST REQUEST 
TMWRD NOP 
      LDA D11       SUBROUTINE CODE=11 FOR WRITE/READ 
      JSB GETPA 
* 
      LDA .PAR1     GET WRITE BUFFER ADDR.
      LDB .PAR3     GET READ BUFFER ADDR. AND SAVE
      STB .PAR1     IT INTO 1ST PARAM FOR LATER USE 
      LDB .PAR5     GET OPTIONAL (RD/WR CTL BITS) ADDR
      STB .PAR3     AND SAVE IT IN 3RD PARAM FOR GI/O 
      LDB .PAR2,I   GET WRITE BUF LENGTH
      LDX D18       WRITE REQUEST 
      JSB GI/O      PERFORM THE WRITE PART OF THE REQUEST 
* 
      CLA 
      LDA .PAR4,I   GET READ BUF LENGTH AND SAVE
      STA .PAR2     IT INTO 2ND PARAM FOR TMSYS 
      CLA 
      LDA .PAR3,I   GET WR/RD CTL BITS
      STA .PAR3     AND SAVE INTO 3RD PARAM FOR TMSYS 
* 
      JMP EXIT3     EXIT TO TMSYS 
* 
D11   DEC 11
  SPC 2 
TMCWR NOP           CLASS I/O WRITE/READ REQUEST FROM TMS !!
      CLA,INA       SAME AS A READ REQUEST
      JSB GETPA 
* 
      LDX D20       EXEC I/O CODE FOR  WRITE/READ RQ
      JMP READ3 
                                                                          