ASMB,R,L,C,Q   ** SCB BUILD MODULE ** 
      HED SCB BUILD MODULE
*     NAME:   MKSCB 
*     SOURCE: 92067-18444 
*     RELOC:  PART OF 92067-16261 
*     PGMR:   G.L.M.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  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 MKSCB,7 92067-16261 REV.1903 780518 
      EXT $LIBR,$LIBX,$SHED,$SMST,.ENTR,$SALC,$SMVE,$SMLK 
* 
      ENT MKSCB 
* 
      SKP 
* 
IBUFA NOP 
IBUFL NOP 
IADDR NOP 
IERR  OCT -1
* 
MKSCB NOP 
      JSB .ENTR 
      DEF IBUFA     FETCH PARMS 
* 
      LDA IERR      IF NOT ENOUGH 
      SSA              PARMS
      JMP MKSCB,I          DO A NOP 
* 
      LDA IBUFL,I   FETCH SCB LENGTH
      ADA .3        AND ADD LINKAGE OVERHEAD
      STA RQLEN        SAVE FOR $SALC CALL
* 
      LDA IBUFA,I   FETCH REQUEST IDENT 
      CMA,INA       SET IT NEGATIVE 
      STA NEGID     AND SAVE FOR SCAN 
* 
      LDA DSHED     FETCH ADDRESS OF SCB LIST 
      STA OLDLK      AND SET IT AS OLD LINK ADDR
* 
      JSB $LIBR     GO PRIV TO AVOID CONTENTION 
      NOP 
* 
      XLA $SHED     FETCH FIRST SCB ADDR
      SZA,RSS       IF ZERO (LIST EMPTY), 
      JMP ENDLS           GO ADD NEW SCB
* 
      STA CPNTR     SET CURRENT SCB ADDR
* 
NXLNK JSB $SMVE 
      DEF SMRTN 
      DEF .1        READ
      DEF CPNTR      AT THIS LOCATION 
      DEF NOP         WITH THIS OFFSET
      DEF NXTLK        PUT IT HERE
      DEF .4            MOVE FOUR WORDS 
SMRTN EQU * 
* 
      LDA NXTID     FETCH NXT ID
      ADA NEGID               AND TEST AGAINST NEG REQUEST IDENT
* 
      SZA,RSS       IF EQUAL
      JMP ERR3        EXIT ERROR=-3 
* 
      SSA,RSS       IF NEW > REQUEST ID 
      JMP GLINK        THIS MUST BE THE PLACE 
* 
      LDA CPNTR     FETCH ADDR OF CURRENT SCB 
      STA OLDLK     SAVE AS PREVIOUS SCB FOR NEXT PASS
      LDA NXTLK     SET THE LINK ADDR AS ADDR OF
      STA CPNTR          NEW "CURRENT" SCB
      SZA           UNLESS END OF LIST
      JMP NXLNK           GO FETCH 1ST 4 WORDS OF NEXT SCB
      SKP 
* 
* 
*    GET MEMORY-- THEN SET ADDRESS OF BLOCK RETURNED INTO LOCATION
*    DEFINED BY OLDLK. MOVE CONTENTS OF CPNTR (POINTER TO NEXT SCB
*    OR ZERO) ALONG WITH BUFFER SIZE AND EXTENSION ADDRESS OF ZERO
*    TO THE FIRST 3 WORDS OF NEW SCB. THEN MOVE USER DEFINED SCB INTO 
*    NEW SCB, STARTING WITH THE SESSION IDENTIFIER (WORD 4).
* 
ENDLS STA CPNTR     END OF LIST. FORCE LINK TO ZERO 
GLINK SJS $SALC 
RQLEN NOP           REQUEST LENGTH+3
       LDA N1       NO MEM EVER RETURN
       JMP NOMEM    NO MEM NOW RTN ($SALC RTNS A=0) 
       STA RQBLK     GOT IT. A=ADDR, B=SIZE 
      STB REQLN     SET LENGTH INTO SCB HEADER
* 
      LDB $SMLK     FETCH NEGATIVE COUNT TO SST LEN WD
      CMB,INB       SET IT POSITIVE 
      ADA B         BUMP SCB ADDR TO SST LEN WD 
      STA IADDR,I   RETURN IT TO CALLER 
* 
      CLA           THEN
      STA REQEX       SET EXTENSION ADDR=0
      STA IERR,I  AND ERROR CODE=0
* 
      JSB $SMVE 
      DEF SMRT2 
      DEF .2        WRITE 
      DEF RQBLK     TO THE NEW BLOCK
      DEF NOP       WITH A ZERO OFFSET
      DEF CPNTR     FROM TEMP BUFFER(LINK,SIZE AND EXT SIZE SET)
      DEF .3        THREE WORDS 
SMRT2 EQU * 
* 
*   MOVE CALLER'S DATA OUT
* 
      JSB $SMVE 
      DEF SMRT3 
      DEF .2        WRITE 
      DEF RQBLK     TO THE NEW BLOCK
      DEF $SMST     OFFSET TO IDENT WORD
      DEF IBUFA,I   FROM USER'S BUFFER
      DEF IBUFL,I   USER'S LENGTH 
SMRT3 EQU * 
* 
*   UPDATE OLD LINK 
* 
      JSB $SMVE 
      DEF SMRT4 
      DEF .2        WRITE 
      DEF OLDLK     TO OLD BLOCK OR $SHED 
      DEF NOP       ZERO OFFSET 
      DEF RQBLK     ADDR OF NEW BLOCK 
      DEF .1        WRITE ONE WORD
SMRT4 EQU * 
* 
      CCA           PRESET ERROR PARM 
      STA IERR       FOR NEXT ENTRY 
* 
      JSB $LIBX 
      DEF MKSCB 
* 
* 
ERR3  LDA N3        DUPLICATE IDENTIFIER ERROR
      RSS 
NOMEM ADA N1        NO MEM EVER=-2, NO MEM NOW=-1 
      STA IERR,I
      JMP SMRT4     GET OUT 
      SKP 
DSHED DEF $SHED+0 
RQBLK NOP 
OLDLK NOP 
NEGID NOP 
* 
*   CAUTION! THE FOLLOWING BUFFER MUST BE STRUCTURED AS FOLLOWS:
* 
*  WORD 1        CPNTR
*  WORD 2  NXTLK&REQLN
*  WORD 3        REQEX
*  WORD 4 
*  WORD 5  NXTID
* 
CPNTR BSS 5 
NXTLK EQU CPNTR+1 
REQLN EQU CPNTR+1 
REQEX EQU CPNTR+2 
NXTID EQU NXTLK+3 
* 
****************************************************
A     EQU 0 
B     EQU 1 
.1    OCT 1 
.2    OCT 2 
.3    OCT 3 
.4    OCT 4 
N1    OCT -1
N3    OCT -3
NOP   NOP 
      END 
                                                                                                                                                                  