ASMB,R,Q,C
*     NAME:   STRNG 
*     SOURCE: 92070-18143 
*     RELOC:  92070-16143 
*     PGMR:   HLC 
* 
* 
*  **************************************************************** 
*  * (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.        * 
*  **************************************************************** 
* 
* 
      NAM STRNG,0  92070-16143  REV.1941  791022  
      ENT $ALCS,$EX14,$RTNS 
      ENT $SBLN,$STRN,$$STR,$.STR 
* 
      EXT $A,$B,$EXEX,$RQP8,$RQP9 
      EXT $RQCT,$SCXX,$RQP2 
      EXT $RQP3,$RQP4 
      EXT $WRTS,.MVW,$XQT 
      EXT $RTN,$ALC 
* 
A     EQU 0 
B     EQU 1 
* 
* 
$EX14 EQU *         STRING PASSING
      LDA $RQCT 
      ADA =D-3
      CLB,INB 
      SSA 
      JMP $SCXX     NOT ENOUGH PARAMETERS 
      STB $A,I      SET TO 1 IN CASE OF FAILURE 
      LDA $RQP4,I 
      SSA 
      CMA,INA,RSS   CONVERT LENGTH TO POSITIVE CHARS
      ALS 
      STA $RQP9 
      LDA $RQP2,I 
      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 $RQP9     SET E IF AVAILABLE IS LESS THAN REQUESTED 
      LDB A,I   
      SEZ,INA,RSS   USE WHICHEVER AMOUNT IS LESS
      LDB $RQP9 
      STB $RQP9 
      INB 
      BRS           CONVERT TO WORDS
      STB $B,I      SAVE WORD COUNT 
      LDB $RQP3 
      JSB .MVW      MOVE WORDS
      DEF $B,I
      NOP 
      LDB $XQT
      JSB $RTNS     RETURN STRING TO SAM
      CLA 
      STA $A,I      INDICATE SUCCESS
      LDA $RQP9     USE POSITIVE CHAR COUNT 
      LDB $RQP4,I 
      SSB              IF ORIGINAL REQUEST WAS NEGATIVE 
TLOG  STA $B,I            FOR THE TRANSMISSION LOG
      JMP $EXEX 
* 
* 
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 $RQP9 
      INA 
      ARS           CONVERT REQUEST TO WORDS
      STA RTSTW 
      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 $RQP9 
      INA 
      STB A,I       STORE LENGTH IN WORD 3
      INA 
      LDB A 
      LDA $RQP8     SOURCE ADDRESS
      JSB .MVW      MOVE WORDS
      DEF RTSTW 
      NOP 
      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 
                                                                                                                                    