LEX 'STRIPASM'
*  A routine to modify a string by clearing the high order bit,
*    and eliminating non-printing control codes.
*     By Ronald B. Johnson
   TITLE STRING PROCESSING FUNCTION
   ID #5E
   MSG 0
   POLL 0
POP1S EQU #0BD38 pop one string  14-4
EXPR  EQU #0F23C   fn return  8-3
   ENTRY START
   CHAR #F
   KEY 'STRIP$'
   TOKEN 4
   ENDTXT
   NIBHEX 411 one string input
START
   CD0EX    copy d0 to r0 to be restored
   R0=C
   CD0EX
   CD1EX  copy d1 to r1 to be restored
   R1=C
   D1=C   leave old d1 in c
   SETHEX
   GOSBVL POP1S get string data from stack
   ?A#0 A  test for null string
   GOYES PROC
   D1=D1- 16 reset d1 ptr
   GOVLNG EXPR return if null
PROC
   CD1EX   Get new string ptr
   B=A A copy length to B
   B=B-1 A  subtract 2
   B=B-1 A
   C=C+B A add to ptr = ptr to first char
   D1=C  destination ptr
   D0=C  source pointer
   B=A A  save length
   C=0 W set nib 5 to 0 for csrb below
   C=A A copy length
   CSRB divide by two = # bytes
   D=C A  loop counter
LOOP
   A=DAT0 B  read byte from source
   P= 0
   LCHEX 7F  load C with mask
   A=A&C B  set high order bit to 0
   LCHEX 20  load ascii space
   ?A<C B   if < 32 prob a ctrl chat
   GOYES LT32
   LCHEX 7F char 127 not legal
   ?A=C B
   GOYES NOPRT
   GOTO PRT  skip around
LT32
   LCHEX 0A  linefeed
   ?A=C B
   GOYES PRT
   LCHEX 0D  carriage return 
   ?A#C B
   GOYES NOPRT
PRT
   DAT1=A B  write byte at destination ptr
   D1=D1- 2  decrement dest ptr one byte
NOPRT
   D0=D0- 2  decr source ptr one byte
   D=D-1 A  decr loop counter
   ?D#0 A
   GOYES LOOP
   AD0EX  move src to a
   CD1EX  move dest to c
   C=C-A A  dest-src
   B=B-C A  new string length in nibs
   A=R1 old D1
   C=C+A A  new D1
   D1=C
   C=R0  old D0
   D0=C
   LCHEX 0F part of string header
   DAT1=C B  write to stack
   D1=D1+ 2 move stack ptr
   C=B A
   DAT1=C A  write string length
   D1=D1- 2  restore stack ptr
   GOVLNG EXPR
   END