ASMB,R,L,B,C
* 
* HP92404A CODE CONVERSION PACKAGE
* 
* SOURCE TAPE 92404-80001 REV. A
* RELOC. TAPE 92404-60001 REV. A
* 
* AUTHOR T.A. SAPONAS 
* 
* VERSION 4 OCTOBER 1973
* 
* 
      HED ASCII TO BCDIC CODE CONVERSION ROUTINE
      NAM ASCBC,7 
      ENT ASCBC 
      EXT .ENTR 
      SUP 
A     EQU 0 
TEMP  BSS 1          TEMPORARY STORAGE
NCHAR BSS 1         NUMBER CHARS. TO BE CONVERTED 
SOURC BSS 1         ADDRESS OF ARRAY TO BE CONVERTED
DESTN BSS 1         DESTINATION ADDRESS OF CHARS. 
ERROR BSS 1         BAD CHARACTER COUNTER 
ASCBC NOP 
      JSB .ENTR     GET ADDRESSES OF CALLING PARAMS.
      DEF NCHAR 
      LDA NCHAR,I   FETCH NUMBER OF CHARACTERS
      CMA,SSA,INA,SZA IF < OR = 0 RETURN
      CLB,RSS       ELSE,  CLEAR CHARACTER COUNTER
      JMP ASCBC,I 
      STB ERROR,I   CLEAR BAD CHARACTER COUNTER 
NXCHR LDA SOURC,I     / 
      SLB,RSS        / GET NEXT CHARACTER TO BE 
      ALF,ALF        \   CONVERTED
      AND =B177       \ 
      CLE,ERA         / GET WORD CONTAINING NEW 
      ADA TABLE      <  CHARACTER 
      LDA A,I         \ 
      SEZ            UPPER BYTE?
      ALF,ALF        NO,SHIFT TO UPPER BYTE 
      AND =B177400  / EXTRACT AND SAVE NEW
      STA TEMP      \ CHARACTER 
      SSA           / IF HIGH ORDER BIT SET, THEN 
      ISZ ERROR,I   \ INCREMENT BAD CHAR. COUNTER 
      LDA DESTN,I    GET DESTINATION WORD 
      SLB            UPPER BYTE?
      ALF,ALF        NO,SHIFT TO UPPER BYTE 
      AND =B377      MASK DESTINATION BYTE
      IOR TEMP       INSERT NEW CHARACTER 
      SLB,INB         / 
      ALF,ALF        < STORE DESTINATION WORD 
      STA DESTN,I     \ 
      CPB NCHAR,I    LAST CHARACTER?
      JMP ASCBC,I    YES, RETURN
      SLB            ANOTHER CHARACTER IN SOURCE WORD?
      JMP NXCHR      YES, GO TO NEXT CHARACTER
      ISZ SOURC       / 
      ISZ DESTN      < NO, INCREMENT SOURC, DESTN 
      JMP NXCHR       \ POINTERS AND GO TO NEXT CHAR. 
* 
* 
*  THE FOLLOWING TABLE CONTAINS THE TRANSLATION OF ASCII TO BCDIC 
* 
* XXX INDICATES THERE IS NO CORESPONDING CODE IN BCDIC AND THE CODE 
*      GIVEN IS THE ASCII CODE WITH THE HIGH ORDER BIT OF THE 8 BIT 
*      BYTE SET TO 1.  THE LOWER CASE ASCII CHARACTERS ARE TRANSLATED 
*      TO UPPER CASE BCDIC. 
* 
* 
TABLE DEF A000      LOCATION OF TRANSLATION TABLE 
* 
*                ASCII  _  0  1   2  3   4  5   6  7
*                ^^^
A000  OCT 100201,101203,102205,103207 
*                BCDIC--> XXXXXX XXXXXX XXXXXX XXXXXX 
* 
A010  OCT 104035,015213,106077,107217 
*                         XXX       XXX XXX    XXXXXX 
* 
A020  OCT 110221,111223,112225,113227 
*                         XXXXXX XXXXXX XXXXXX XXXXXX 
* 
A030  OCT 114231,115233,116235,117237 
*                         XXXXXX XXXXXX XXXXXX XXXXXX 
* 
A040  OCT 010052,017417,025457,030035 
*                          SP !          $      & 
* 
A050  OCT 016074,026060,015440,035421 
*                          (  )   *  +   ,  -   .  /
* 
A060  OCT 005001,001003,002005,003007 
*                          0  1   2  3   4  5   6  7
* 
A070  OCT 004011,006456,037013,007072 
*                          8  9   :  ;   <  =   >  ?
* 
A100  OCT 006061,031063,032065,033067 
*                          @  A   B  C   D  E   F  G
* 
A110  OCT 034071,020442,021444,022446 
*                          H  I   J  K   L  M   N  O
* 
A120  OCT 023450,024422,011424,012426 
*                          P  Q   R  S   T  U   V  W
* 
A130  OCT 013430,014475,017055,156337 
*                          X  Y   Z  [   \  ]  XXXXXX 
* 
*  THE FOLLOWING TRANSLATION IS FROM LOWER CASE ASCII 
*    TO UPPER CASE BCDIC
A140  OCT 160061,031063,032065,033067 
*                         XXX A   B  C   D  E   F  G
* 
A150  OCT 034071,020442,021444,022446 
*                          H  I   J  K   L  M   N  O
* 
A160  OCT 023450,024422,011424,012426 
*                          P  Q   R  S   T  U   V  W
* 
A170  OCT 013430,014773,176375,177377 
*                          X  Y   Z XXX XXXXXX XXXXXX 
      END 
ASMB,R,L,B,C
      HED ASCII TO EBCDIC CODE CONVERSION ROUTINE 
      NAM ASCEB,7 
      ENT ASCEB 
      EXT .ENTR 
      SUP 
A     EQU 0 
TEMP  BSS 1          TEMPORARY STORAGE
NCHAR BSS 1         NUMBER CHARS. TO BE CONVERTED 
SOURC BSS 1         ADDRESS OF ARRAY TO BE CONVERTED
DESTN BSS 1         DESTINATION ADDRESS OF CHARS. 
ASCEB NOP 
      JSB .ENTR     GET ADDRESSES OF CALLING PARAMS.
      DEF NCHAR 
      LDA NCHAR,I   FETCH NUMBER OF CHARACTERS
      CMA,SSA,INA,SZA  IF < OR = 0 RETURN 
      CLB,RSS       ELSE,  CLEAR CHARACTER COUNTER
      JMP ASCEB,I 
NXCHR LDA SOURC,I     / 
      SLB,RSS        / GET NEXT CHARACTER TO BE 
      ALF,ALF        \   CONVERTED
      AND =B177       \ 
      CLE,ERA         / GET WORD CONTAINING NEW 
      ADA TABLE      <  CHARACTER 
      LDA A,I         \ 
      SEZ            UPPER BYTE?
      ALF,ALF        NO,SHIFT TO UPPER BYTE 
      AND =B177400   /EXTRACT AND SAVE NEW
      STA TEMP       \ CHARACTER
      LDA DESTN,I    GET DESTINATION WORD 
      SLB            UPPER BYTE?
      ALF,ALF        NO,SHIFT TO UPPER BYTE 
      AND =B377      MASK DESTINATION BYTE
      IOR TEMP       INSERT NEW CHARACTER 
      SLB,INB         / 
      ALF,ALF        < STORE DESTINATION WORD 
      STA DESTN,I     \ 
      CPB NCHAR,I    LAST CHARACTER?
      JMP ASCEB,I    YES, RETURN
      SLB            ANOTHER CHARACTER IN SOURCE WORD?
      JMP NXCHR      YES, GO TO NEXT CHARACTER
      ISZ SOURC       / 
      ISZ DESTN      < NO, INCREMENT SOURC, DESTN 
      JMP NXCHR       \ POINTERS AND GO TO NEXT CHAR. 
* 
* 
TABLE DEF A000      LOCATION OF TRANSLATION TABLE 
* 
*  THIS IS THE TABLE FOR CONVERSION FROM ASCII TO EBCDIC
* 
*                ASCII  _  0  1   2  3   4  5   6  7
*                ^^^
A000  OCT 000001,001003,033455,027057 
*                EBCDIC-->NULSOH STXETX EOTENQ ACKBEL 
* 
A010  OCT 013005,022413,006015,007017 
*                          BS HT  LF VT  FF CR  SO IC 
* 
A020  OCT 010021,011023,036075,031046 
*                         DLEDC1 DC2DC3 DC4NAK SYNETB 
* 
A030  OCT 014031,037447,016035,017037 
*                         CAN EM SUBESC IFSIGS IRSIUS 
* 
A040  OCT 040117,077573,055554,050175 
*                          SP !   "  #   $  %   &  '
* 
A050  OCT 046535,056116,065540,045541 
*                          (  )   *  +   ,  -   .  /
* 
A060  OCT 170361,171363,172365,173367 
*                          0  1   2  3   4  5   6  7
* 
A070  OCT 174371,075136,046176,067157 
*                          8  9   :  ;   <  =   >  ?
* 
A100  OCT 076301,141303,142305,143307 
*                          @  A   B  C   D  E   F  G
* 
A110  OCT 144311,150722,151724,152726 
*                          H  I   J  K   L  M   N  O
* 
A120  OCT 153730,154742,161744,162746 
*                          P  Q   R  S   T  U   V  W
* 
A130  OCT 163750,164512,160532,057555 
*                          X  Y   Z  [   \  !   ]  -
* 
*  THE FOLLOWING TRANSLATION IS FROM LOWER CASE ASCII 
*    TO LOWER CASE EBCDIC 
A140  OCT 074601,101203,102205,103207 
*                          \  A   B  C   D  E   F  G
* 
A150  OCT 104211,110622,111624,112626 
*                          H  I   J  K   L  M   N  O
* 
A160  OCT 113630,114642,121644,122646 
*                          P  Q   R  S   T  U   V  W
* 
A170  OCT 123650,124700,065320,120407 
*                          X  Y   Z      !        DEL 
* 
      END 
ASMB,R,L,B,C
      HED BCDIC TO ASCII CODE CONVERSION ROUTINE
      NAM BCDAS,7 
      ENT BCDAS 
      EXT .ENTR 
      SUP 
A     EQU 0 
TEMP  BSS 1          TEMPORARY STORAGE
NCHAR BSS 1         NUMBER CHARS. TO BE CONVERTED 
SOURC BSS 1         ADDRESS OF ARRAY TO BE CONVERTED
DESTN BSS 1         DESTINATION ADDRESS OF CHARS. 
BCDAS NOP 
      JSB .ENTR     GET ADDRESSES OF CALLING PARAMS.
      DEF NCHAR 
      LDA NCHAR,I   FETCH NUMBER OF CHARACTERS
      CMA,SSA,INA,SZA IF < OR = 0 RETURN
      CLB,RSS       ELSE, CLEAR CHARACTER COUNTER 
      JMP BCDAS,I 
NXCHR LDA SOURC,I     / 
      SLB,RSS        / GET NEXT CHARACTER TO BE 
      ALF,ALF        \   CONVERTED
      AND =B77        \ 
      CLE,ERA         / GET WORD CONTAINING NEW 
      ADA TABLE      <  CHARACTER 
      LDA A,I         \ 
      SEZ            UPPER BYTE?
      ALF,ALF        NO,SHIFT TO UPPER BYTE 
      AND =B177400   /EXTRACT AND SAVE NEW
      STA TEMP       \ CHARACTER
      LDA DESTN,I    GET DESTINATION WORD 
      SLB            UPPER BYTE?
      ALF,ALF        NO,SHIFT TO UPPER BYTE 
      AND =B377      MASK DESTINATION BYTE
      IOR TEMP       INSERT NEW CHARACTER 
      SLB,INB         / 
      ALF,ALF        < STORE DESTINATION WORD 
      STA DESTN,I     \ 
      CPB NCHAR,I    LAST CHARACTER?
      JMP BCDAS,I    YES, RETURN
      SLB            ANOTHER CHARACTER IN SOURCE WORD?
      JMP NXCHR      YES, GO TO NEXT CHARACTER
      ISZ SOURC       / 
      ISZ DESTN      < NO, INCREMENT SOURC, DESTN 
      JMP NXCHR       \ POINTERS AND GO TO NEXT CHAR. 
* 
*     THE FOLLOWING TABLE CONTAINS THE TRANSLATION OF BCDIC TO ASCII
* 
TABLE DEF B00       LOCATION OF TRANSLATION TABLE 
* 
*                BCDIC  _  0  1   2  3   4  5   6  7
*                ^^^
B00   OCT 020061,031063,032065,033067 
*                ASCII-->  SP 1   2  3   4  5   6  7
* 
B10   OCT 034071,030075,040072,035043 
*                          8  9   0  =   @  :   >  #
* 
B20   OCT 020057,051524,052526,053530 
*                          SP /   S  T   U  V   W  X
* 
B30   OCT 054532,005054,024011,056042 
*                          Y  Z  LF  ,   ( HT   \  "
* 
B40   OCT 026512,045514,046516,047520 
*                          -  J   K  L   M  N   O  P
* 
B50   OCT 050522,020444,025135,035445 
*                          Q  R   !  $   *  ]   ;  %
* 
B60   OCT 025501,041103,042105,043107 
*                          +  A   B  C   D  E   F  G
* 
B70   OCT 044111,037456,024533,036015 
*                          H  I   ?  .   )  [   < CR
      END 
ASMB,R,L,B,C
      HED EBCDIC TO ASCII CODE CONVERSION ROUTINE 
      NAM EBCAS,7 
      ENT EBCAS 
      EXT .ENTR 
      SUP 
A     EQU 0 
TEMP  BSS 1          TEMPORARY STORAGE
NCHAR BSS 1         NUMBER CHARS. TO BE CONVERTED 
SOURC BSS 1         ADDRESS OF ARRAY TO BE CONVERTED
DESTN BSS 1         DESTINATION ADDRESS OF CHARS. 
ERROR BSS 1         BAD CHARACTER COUNTER 
EBCAS NOP 
      JSB .ENTR     GET ADDRESSES OF CALLING PARAMS.
      DEF NCHAR 
      LDA NCHAR,I   FETCH NUMBER OF CHARACTERS
      CMA,SSA,INA,SZA IF < OR = 0 RETURN
      CLB,RSS       ELSE, CLEAR CHARACTER COUNTER 
      JMP EBCAS,I 
      STB ERROR,I   CLEAR BAD CHARACTER COUNTER 
NXCHR LDA SOURC,I     / 
      SLB,RSS        / GET NEXT CHARACTER TO BE 
      ALF,ALF        \   CONVERTED
      AND =B377       \ 
      CLE,ERA         / GET WORD CONTAINING NEW 
      ADA TABLE      <  CHARACTER 
      LDA A,I         \ 
      SEZ            UPPER BYTE?
      ALF,ALF        NO,SHIFT TO UPPER BYTE 
      AND =B177400  /EXTRACT AND SAVE NEW 
      STA TEMP       \ CHARACTER
      SSA           /IF HIGH ORDER BIT SET, THEN
      ISZ ERROR,I   \ INCREMENT BAD CHAR. COUNTER 
      LDA DESTN,I    GET DESTINATION WORD 
      SLB            UPPER BYTE?
      ALF,ALF        NO,SHIFT TO UPPER BYTE 
      AND =B377      MASK DESTINATION BYTE
      IOR TEMP       INSERT NEW CHARACTER 
      SLB,INB         / 
      ALF,ALF        < STORE DESTINATION WORD 
      STA DESTN,I     \ 
      CPB NCHAR,I    LAST CHARACTER?
      JMP EBCAS,I    YES, RETURN
      SLB            ANOTHER CHARACTER IN SOURCE WORD?
      JMP NXCHR      YES, GO TO NEXT CHARACTER
      ISZ SOURC       / 
      ISZ DESTN      < NO, INCREMENT SOURC, DESTN 
      JMP NXCHR       \ POINTERS AND GO TO NEXT CHAR. 
* 
* 
TABLE DEF E000      LOCATION OF TRANSLATION TABLE 
* 
*  THIS IS THE TABLE FOR CONVERSION FROM EBCDIC TO ASCII
*   XXX INDICATES NO TRANSLATION, THE RESULTING CHARACTER 
*   HAS BIT 7 SET (HIGH ORDER BIT) AND BITS 0 THRU 6 REMAIN 
*   THE SAME AS THE SOURCE CODE 
* 
*                EBCDIC _  0  1   2  3   4  5   6  7
*                ^^^
E000  OCT 000001,001003,102011,103177 
*                ASCII--> NULSOH STXETX XXX HT XXXDEL 
* 
E010  OCT 104211,105013,006015,007017 
*                         XXXXXX XXX VT  FF CR  SO SI 
* 
E020  OCT 010021,011023,112012,004000 
*                         DLEDC1 DC2DC3 XXX LG BS NUL 
* 
E030  OCT 014031,115233,016035,017037 
*                         CAN EM XXXXXX  FS GS  RS US 
* 
E040  OCT 120241,121243,122012,013433 
*                         XXXXXX XXXXXX XXX LF ETBESC 
* 
E050  OCT 124251,125253,126005,003007 
*                         XXXXXX XXXXXX XXXENQ ACKBEL 
* 
E060  OCT 130261,013263,132265,133004 
*                         XXXXXX SYNXXX XXXXXX XXXEOT 
* 
E070  OCT 134271,135273,012025,137032 
*                         XXXXXX XXXXXX DC4NAK XXXSUB 
* 
E100  OCT 020301,141303,142305,143307 
*                         SP XXX XXXXXX XXXXXX XXXXXX 
* 
E110  OCT 144311,055456,036050,025441 
*                           XXXXXX  [  .   <  (   +  !
* 
E120  OCT 023321,151323,152325,153327 
*                          & XXX XXXXXX XXXXXX XXXXXX 
* 
E130  OCT 154331,056444,025051,035536 
*                         XXXXXX  ]  $   :  )   :  7
* 
E140  OCT 026457,161343,162345,163347 
*                          -  /  XXXXXX XXXXXX XXXXXX 
* 
E150  OCT 164351,076054,022537,037077 
*                         XXXXXX  !  ,   %  -   >  ?
* 
E160  OCT 170361,171363,172365,173367 
*                         XXXXXX XXXXXX XXXXXX XXXXXX 
* 
E170  OCT 174140,035043,040047,036442 
*                         XXX \   :  #   @  '   =  "
* 
*  THE FOLLOWING TRANSLATION IS FROM LOWER CASE EBCDIC
*    TO LOWER CASE ASCII
E200  OCT 100141,061143,062145,063147 
*                         XXX A   B  C   D  E   F  G
* 
E210  OCT 064151,105213,106215,107217 
*                          H  I  XXXXXX XXXXXX XXXXXX 
* 
E220  OCT 110152,065554,066556,067560 
*                         XXX J   K  L   M  N   O  P
* 
E230  OCT 070562,115233,116235,117237 
*                          Q  R  XXXXXX XXXXXX XXXXXX 
* 
E240  OCT 120176,071564,072566,073570 
*                         XXXESC  S  T   U  V   W  X
* 
E250  OCT 074572,125253,126255,127257 
*                          Y  Z  XXXXXX XXXXXX XXXXXX 
* 
E260  OCT 130261,131263,132265,133267 
*                         XXXXXX XXXXXX XXXXXX XXXXXX 
* 
E270  OCT 134271,135273,136275,137277 
*                         XXXXXX XXXXXX XXXXXX XXXXXX 
* 
*  THE FOLLOWING TRANSLATION IS FROM UPPER CASE EBCDIC
*    TO UPPER CASE ASCII
E300  OCT 075501,041103,042105,043107 
*                             A   B  C   D  E   F  G
* 
E310  OCT 044111,145313,146315,147134 
*                          H  I  XXXXXX XXXXXX XXX \
* 
E320  OCT 076512,045514,046516,047520 
*                          \  J   K  L   M  N   O  P
* 
E330  OCT 050522,155333,156335,157337 
*                          Q  R  XXXXXX XXXXXX XXXXXX 
* 
E340  OCT 160134,051524,052526,053530 
*                         XXX \   S  T   U  V   W  X
* 
E350  OCT 054532,165353,166355,167357 
*                          Y  Z  XXXXXX XXXXXX XXXXXX 
* 
E360  OCT 030061,031063,032065,033067 
*                          0  1   2  3   4  5   6  7
* 
E370  OCT 034071,175373,176375,177377 
*                          8  9  XXXXXX XXXXXX XXXXXX 
* 
      END