ASMB
      NAM SZONE,7 24306-60001 REV.2026 791206 
* 
* 
******************************************************************* 
* (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. 
******************************************************************* 
* 
* 
*     SOURCE:    24306-18021
*     RELOC:     24306-60001
* 
* 
* 
******************************************************************
* 
* 
* 
* 
*SZONE FINDS THE ZONE-PUNCH OF A CHARACTER AND SETS 
*A CODE TO INDICATE WHAT THE NEW ZONE IS. 
*CALLING SEQUENCE:  CALL SZONE(JSTR,JBEG,NEZ,NOZ) 
*JSTR=STRING INTEGER ARRAY CONTAINING THE CHARACTER 
*JBEG=POSITION OF THE CHARACTER IN JSTR 
*NEZ=CODE FOR NEW ZONE
*NOZ=CODE INDICATING THE ORIGINAL ZONE OF THE CHARACTER 
*ZONE CODES FOR NEZ AND NOZ ARE:
*ZONE 1 (12-ZONE):  A-I 
*ZONE 2 (11-ZONE):  J-R AND - 
*ZONE 3 (0-ZONE):   /S-Z
*ZONE 4 (NO-ZONE):  0-9 AND + 
*MORE THAN 4:  SPECIAL CHARACTERS 
*IF NEZ=2 AND JSTR(JBEG)='0' OR '+' THEN JSTR(JBEG) IS SET TO '-' 
*IF NEZ=4 AND JSTR(JBEG)='-' OR '+' THEN JSTR(JBEG) IS SET TO '0' 
* 
      ENT SZONE 
      EXT .ENTR,SGET,SPUT 
PARAM BSS 4 
SZONE NOP 
      JSB .ENTR     TRANSFER PARAMETERS 
      DEF PARAM 
      JSB SGET      CALL SGET(JSTR,JBEG,NCHAR)
      DEF *+4 
      DEF PARAM,I 
      DEF PARAM+1,I 
      DEF NCHAR 
      LDA NCHAR     NCHAR A-Z?
      ADA N101
      STA TEST
      SSA 
      JMP NOALF     ASCII CODE<101
      ADA N32 
      SSA,RSS 
      JMP SPEC      ASCII CODE>132
      LDA TEST      NCHAR IS A-Z;TEST=NCHAR-101 
      CLB 
      DIV NINE
      INA 
      STA PARAM+3,I NOZ=ZONE CODE OF NCHAR (TEST19) 
      STB TEST      TEST=(NCHAR-101)MOD9. 
      CPA THREE     NCHAR 0-ZONE? 
      JMP *+2 
      JMP ONE 
      ISZ TEST     IF SO, INCREMENT MOD 
      JMP ONE 
NOALF LDA NCHAR     NCHAR 0-9?
      ADA NSXTY 
      SSA 
      JMP SPEC      ASCII CODE<61 
      ADA N1
      STA TEST
      ADA N11 
      SSA,RSS 
      JMP SPEC      ASCII CODE>71 
      LDA FOUR     NCHAR IS 0-9,TEST=NCHAR-60 (0-9) 
      STA PARAM+3,I  NOZ=ORIGINAL ZONE CODE (4) 
      LDA NCHAR     NCHAR='0'?
      CPA SIXTY 
      JMP ZERO        IF SO 
      JMP ONE 
SPEC  LDA FIVE      NCHAR IS SPECIAL CHAR 
      STA PARAM+3,I  NOZ=ORIGINAL ZOME CODE (5) 
      LDA NCHAR      NCHAR='-'? 
      CPA FFIV
      JMP MIN       IF SO 
      CPA FTHRE 
      JMP PLUS
      CPA FSVN   NCHAR='/'? 
      JMP SLASH     IF SO 
      JMP SZONE,I   IF NOT, RETURN
ONE   LDA PARAM+2,I  NEW ZONE CODE 5? 
      ADA NFIVE 
      SSA,RSS 
      JMP SZONE,I   IF SO,NO CHANGE,RETURN
      LDA PARAM+2,I  NEZ=3? 
      CPA THREE 
      JMP *+2 
      JMP OK
      LDA TEST      IF SO, NCHAR(MOD 9)=0?
      SZA 
      JMP OK
      LDA FSVN       IF SO, NCHAR='/' 
      STA NCHAR 
      JMP PUT 
OK    LDB ADDR      GIVE NCHAR NEW ZONE 
      ADB PARAM+2,I  PICK UP BASE FROM ATAB NDXED BY NEZ
      LDA 1,I 
      ADA TEST      ADD NCHAR(MOD 9)
      STA NCHAR     REPLACE NCHAR WITH NEW ZONE 
PUT   JSB SPUT      CALL SPUT(JSTR,JBEG,NCHAR)
      DEF *+4 
      DEF PARAM,I   JSTR
      DEF PARAM+1,I JBEG
      DEF NCHAR 
      JMP SZONE,I   RETURN
ZERO  LDA PARAM+2,I 
      CPA TWO       NEZ=2?
      JMP *+2 
      JMP SZONE,I   IF NOT, RETURN
      LDA FFIV   IF SO NCHAR='-'
      STA NCHAR 
      JMP PUT 
MIN   LDA TWO 
      STA PARAM+3,I NOZ=2 (11-ZONE FOR '-') 
      LDA PARAM+2,I   NEZ=4?
      CPA FOUR
      JMP *+2 
      JMP SZONE,I   IF NOT, RETURN
CZER  LDA SIXTY 
      STA NCHAR     IF SO NCHAR='0' 
      JMP PUT 
PLUS  LDA FOUR
      STA PARAM+3,I  NOZ=4 (12-ZONE CODE FOR '+') 
      LDA PARAM+2,I  NEZ=4? 
      CPA FOUR
      JMP CZER      IF SO 
     JMP ZERO 
SLASH LDA THREE 
      STA PARAM+3,I  NOZ=3
      CLA 
      STA TEST      /=1ST CHAR,0-ZONE 
      JMP ONE 
ADDR  DEF ATAB
ATAB  OCT 0 
      OCT 101 
      OCT 112 
      OCT 122 
      OCT 61
N101  OCT -101
N32   OCT -32 
NINE  DEC 9 
NSXTY OCT -60 
N11   OCT -11 
FOUR  OCT 4 
FIVE  OCT 5 
NFIVE OCT -5
NCHAR OCT 0 
TEST  OCT 0 
TWO   OCT 2 
FFIV  OCT 55
FTHRE OCT 53
N1    OCT -1
FSVN  OCT 57
THREE OCT 3 
SIXTY OCT 60
      END 
      END$
                                                                                                                                                                  