ASMB,R,Q,C
*     NAME:   STRNG 
*     SOURCE: 92071-18143 
*     RELOC:  92071-16143 
*     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 STRNG,0  92071-16143  REV.2041  800328  
      ENT $ALCS,$EX14,$RTNS 
      ENT $SBLN,$STRN,$$STR,$.STR 
* 
      EXT $A,$B,$EXEX,$RQP8,$RQ.9 
      EXT $RQCT,$SCXX,$RQ.2,$VBUF 
      EXT $RQP3,$RQ.4,.MWI
      EXT .CAX,.CBX,.MWF  
      EXT $WRTS,$XQT  
      EXT $RTN,$ALC 
* 
A     EQU 0 
B     EQU 1 
* 
* 
$EX14 EQU *         STRING PASSING
      LDB $XQT
      JSB $VBUF     CHECK BUFFER RANGE
      DEF $RQP3,I 
      DEF $RQ.4 
      JMP SC04      ILLEGAL BUFFER
* 
      LDA $RQCT 
      ADA =D-3
      CLB,INB 
      SSA 
      JMP $SCXX     NOT ENOUGH PARAMETERS 
      STB $A,I      SET TO 1 IN CASE OF FAILURE 
      LDA $RQ.4   
      SSA 
      CMA,INA,RSS   CONVERT LENGTH TO POSITIVE CHARS
      ALS 
      STA $RQ.9 
      LDA $RQ.2   
      ADA =D-2
      SZA,RSS 
      JMP $WRTS     2 -- WRITE STRING TO FATHER 
      INB 
      INA,SZA 
      JMP $SCXX     BAD REQUEST CODE, PRINT 'SC02'
      LDB $XQT      1 -- READ STRING
      JSB STSH      FIND THE STRING 
      JMP TLOG      INDICATE FAILURE (A=0)
      ADA =D2 
      LDB A,I 
      CMB,CLE,INB   COMPARE AVAILABLE TO REQUESTED
      ADB $RQ.9     SET E IF AVAILABLE IS LESS THAN REQUESTED 
      LDB A,I   
      SEZ,INA,RSS   USE WHICHEVER AMOUNT IS LESS
      LDB $RQ.9 
      STB $RQ.9 
      INB 
      BRS           CONVERT TO WORDS
      STB $B,I      SAVE WORD COUNT 
      JSB .CBX      COPY TO INDEX REGISTER
      LDB $RQP3 
      JSB .MWI      MOVE WORDS INTO USER BUFFER 
      LDB $XQT
      JSB $RTNS     RETURN STRING TO SAM
      CLA 
      STA $A,I      INDICATE SUCCESS
      LDA $RQ.9     USE POSITIVE CHAR COUNT 
      LDB $RQ.4   
      SSB              IF ORIGINAL REQUEST WAS NEGATIVE 
TLOG  STA $B,I            FOR THE TRANSMISSION LOG
      JMP $EXEX 
* 
* 
SC04  LDB =D4 
      JMP $SCXX 
* 
* 
STSH  NOP           FIND A STRING BLOCK 
      STB ID
      ADB =D15
      STB STAT
      LDB STRNG     POINTER TO START OF STRING
STSHL LDA B,I 
      CLE,SZA,RSS 
      JMP STSH,I    END OF LIST 
      INA 
      LDA A,I       OWNER'S ADDRESS IN A
      ELA,RAR 
      CPA ID
      JMP FND       FOUND IT
      LDB B,I 
      JMP STSHL     KEEP LOOKING
* 
FND   LDA B,I       BLOCK ADDRESS IN A
      ISZ STSH
      JMP STSH,I
* 
* 
* 
$RTNS NOP           RETURN A STRING TO SAM
      JSB STSH      FIND STRING 
      JMP $RTNS,I   NONE FOUND
      STA RTSTA     SAVE ADDRESS
      LDA A,I 
      STA B,I       REMOVE FROM LINKED LIST 
      LDA RTSTA 
      ADA =D2 
      LDB A,I       POS. NO. OF CHARS 
      SEZ,INB 
      ADB =D2       $ALC ALLOCATED 2 CHARS MORE THAN REQUESTED
      BRS           CONVERT TO WORDS
      ADB =D3       CONTROL WORDS 
      STB RTSTW     TOTAL SIZE OF BLOCK 
      LDA STAT,I
      AND =B157777  CLEAR THE 'ST' BIT
      STA STAT,I
      JSB $RTN      RETURN TO SAM 
RTSTA NOP 
RTSTW NOP 
      JMP $RTNS,I 
* 
* 
$ALCS NOP           ALLOCATE STRING TO PROGRAM
      JSB $RTNS     RETURN ANY PREVIOUS STRING
      LDA $RQ.9 
      INA 
      ARS           CONVERT REQUEST TO WORDS
      JSB .CAX      COPY COUNT TO INDEX REGISTER
      ADA =D3 
      STA $SBLN     LENGTH OF SAM REQUIRED
      JSB $ALC      REQUEST SAM 
$SBLN NOP 
      JMP $ALCS,I   NOT ENOUGH EVER 
      JMP ALCST     NOT ENOUGH NOW
      CCE 
      CPB $SBLN     SET E-REG IF EXTRA WORD WAS RETURNED
      CLE 
      LDB STRNG,I 
      STB A,I       LINK INTO TOP OF LIST 
      STA STRNG,I 
      LDB ID
      RBL,ERB       ADD 'EXTRA WORD' BIT
      INA 
      STB A,I       STORE OWNER'S ADDRESS IN WORD 2 
      LDB $RQ.9 
      INA 
      STB A,I       STORE LENGTH IN WORD 3
      INA 
      LDB A 
      LDA $RQP8     SOURCE ADDRESS
      JSB .MWF      MOVE WORDS FROM USER MAP
      LDA STAT,I
      IOR =B20000   SET 'ST' BIT
      STA STAT,I
      ISZ $ALCS 
ALCST ISZ $ALCS 
      JMP $ALCS,I 
* 
* 
STRNG DEF *+1       
* 
$STRN NOP           START OF PROGRAM STRINGS
* 
* 
ID    NOP 
STAT  NOP 
* 
$$STR EQU *         STANDARD MODULE 
$.STR DEC 0         STANDARD MODULE 
* 
      END 
                                                                                                                                