****************************
* 
ANSR3 LDB WHICH     IF PRESENTLY EXECUTING
      RBR,SLB       TIMER SEGMENT,
      JMP EXIT      THEN EXIT.
* 
* CHECK IF CARRIER IS ON.
* 
      JSB .IO.      GET STATUS
      OCT 100003   FROM I/O BOARD
* 
      ALF           CARRIER
      SSA,RSS       ON?
      JMP C3
      LDA =D-120    YES, RESET DISCONNECT
      STA CONT2     TIME BACK TO 30 SECS.
* 
* TEST RECEIVED CHARACTER FOR "ENQ".
* 
      JSB .IO.      GET CHARACTER
      OCT 100010     FROM I/O BOARD
* 
      CPA ENQ       CHARACTER AN "ENQ"?
      JMP SANSR     YES, ENABLE "WABT" MODULE.
* 
* CHARACTER NOT AN "ENQ", ENABLE INTERRUPT FOR NEXT CHARACTER.
* 
      IOR =B40000
      CPA SYNC      SYNC CHAR
      JMP *+4       YES
      JSB .IO.      NO/PUT BOARD BACK
      OCT 6         IN "HUNT FOR SYNC."
      JMP RESYN
* 
      JSB .IO.      ENABLE
      OCT 100002    INTERRUPTS
* 
      JMP EXIT      RETURN.
* 
* TERMINAL SENT "ENQ" CHARACTER, UPDATE STATUS.
* 
SANSR CLA           ZERO
      STA RCSND     SET "RECEIVE".
      STA EOF       LAST RECORD NOT AN END-OF-FILE.
      STA RQ2SD     REMOTE NOT REQUESTING TO SEND.
      STA BCONT     SET REPLY FOR ACK0.
* 
* ENABLE "WABT" MODULE.
* 
      JSB OLNE      SET "ON LINE".
      CLA,INA       ACTIVATE
      JSB WACTV     "WABT" GENERATOR MODULE.
* 
      JMP COMPT     FREE THE DRIVER.
      SPC 3
* 
*           *** DATA ***
* 
A1    BSS 1         FUNCTION/SUBFUNCTION CODE.
ADAN2 DEF ANSR2
ADAN3 DEF ANSR3
ADAN4 DEF ANSR4
ADAN5 DEF ANSR5
ADAN6 DEF ANSR6
CONT2 BSS 1         COUNTER.
      HED STATISTICS SECTION.
      SPC 3
* 
*           *** EXTENDED STATISTICS SECTION. ***
* 
* 
* THIS MODULE MAINTAINS THE FOLLOWING STATISTICS DURING A
* TRANSMISSION:
* 
*     1. NUMBER OF LINE ERRORS:
*        A. BLOCKS WITH PARITY ERRORS.
*        B. 3 SECOND TIME-OUTS.
*        C. "NAK" IN RESPONSE TO A TRANSMISSION.
*        D. INCORRECT REPLIES.
* 
*     2. NUMBER OF CHARACTERS SENT.
* 
*     3. NUMBER OF CHARACTERS RECEIVED.
* 
*     4. ERROR CODE
*        A. A VALUE OF 1 - MSG SENT/REC 8 TIMES WITH ERRORS.
*        B. A VALUE OF 2 - IMPROPER RESPONSE FROM TERMINAL.
*        C. A VALUE OF 3 - REMOTE TIMED OUT.
*        D. A VALUE OF 4 - RECEIVED "DLE EOT" FROM REMOTE.
* 
* STATISTICS ARE INITIALIZED BY CALLING "ISTAT".
* 
* STATISTICS ARE AVAILABLE TO THE USER BY THE FOLLOWING CALL:
* 
*     JSB .IOC.
*     OCT 0107XX
*     REJ ADRS      (REJECTED IF LOGICAL UNIT IS NOT THE SAME AS
*                    THE "ON-LINE" LOGICAL UNIT).
*     DEF BUFER     POINTS TO START ADRS OF USER'S BUFFER.
*     DEC 6         BUFFER LENGTH.
* 
* 
* UPON RETURN THE BUFFER WILL BE FILLED WITH THE BINARY VALUES OF
* THE FOUR STATISTICS.
* 
* WORD 1       NUMBER OF LINE ERRORS.
* WORDS 2,3  NUMBER OF CHARACTERS SENT (DBL PRECISION)
* WORDS 4,5  NUMBER OF CHARACTERS RECEIVED (DBL PRECISION)
* WORD 6       ERROR CODE.
      SPC 5
**************************
* INITIALIZATION SEGMENT *******************************************
**************************
* 
* 
ISTAT NOP           ENTRY POINT.
* 
      CLA           ZERO
      STA NERR      "NUMBER OF LINE ERRORS".
      STA NRECV     ZERO
      STA NRECV+1   "NUMBER OF CHAR'S RECEIVED".
      STA NSENT     ZERO
      STA NSENT+1   "NUMBER OF CHAR'S SENT".
      STA LERR      ZERO "ERROR CODE".
* 
      JMP ISTAT,I   RETURN TO CALL.
      SPC 3
******************
* UPDATE SEGMENT ***************************************************
******************
* 
* 
* NO. OF LINE ERRORS.
* 
IERR  NOP           ENTRY POINT.
      ISZ NERR      INCREMENT NO. OF LINE ERRORS.
      JMP IERR,I    RETURN TO CALL.
* 
* NO. OF CHAR'S RECEIVED.
* 
IRECV NOP           ENTRY POINT.
* 
      CLE           ADD
      LDA NRECV     ONE
      INA           TO LEAST SIG WORD.
      STA NRECV     SAVE.
      SEZ           CARRY TO MOST SIG WORD?
      ISZ NRECV+1   YES, INCREMENT MOST SIG WORD.
* 
      JMP IRECV,I   RETURN TO CALL.
* 
* NO. CHAR'S TRANSMITTED.
* 
ISENT NOP           ENTRY POINT.
* 
      CLE           ADD
      LDA NSENT     ONE
      INA           TO LEAST SIG WORD.
      STA NSENT     SAVE.
      SEZ           CARRY TO MOST SIG WORD?
      ISZ NSENT+1   YES, INCREMENT MOST SIG WORD.
* 
      JMP ISENT,I   RETURN TO CALL.
      SPC 3
*************************
* "STATUS READ" PORTION ********************************************
*************************
* 
* 
* LOCATE USER'S BUFFER.
* 
STATS LDB TEMP6     GET USER CALL ADRS + 1.
      INB
      INB
      LDB B,I       FORM BUFFER ADRS.
* 
* PUT STATISTICS IN USER'S BUFFER.
* 
      LDA NERR      PUT "NO LINE ERRORS"
      STA B,I       IN 1ST WORD OF USER'S BUFFER.
      INB           PUT
      LDA NSENT     "NUMBER OF CHAR'S TRANSMITTED"
      STA B,I       (DOUBLE PRECISION)
      INB           IN
      LDA NSENT+1   WORDS 4 & 5
      STA B,I       OF USER'S BUFFER.
      INB           PUT
      LDA NRECV     "NUMBER OF CHAR'S RECEIVED"
      STA B,I       (DOUBLE PRECISION)
      INB           IN
      LDA NRECV+1   WORDS 2 & 3
      STA B,I       OF USER'S BUFFER.
      INB           FORM WORD 6 ADDRESS IN B-REG.
      LDA LERR      GET AND SAVE
      STA B,I       ERROR CODE.
* 
      LDA =B100000  RETURN
      JMP D.50,I    TO .IOC..
      SPC 3
* 
*           *** DATA ***
* 
LERR  BSS 1         ERROR CODE.
NERR  BSS 1         NO. OF LINE ERRORS DETECTED.
NRECV BSS 2         NO. OF CHAR'S RECEIVED.
NSENT BSS 2         NO. OF CHAR'S TRANSMITTED.
      HED SEND END-OF-FILE PROCESSOR.
      SPC 3
* 
*           *** SEND END-OF-FILE PROCESSOR. ***
* 
* 
* THIS MODULE SENDS  A LOGICAL END-OF-FILE SEQUENCE (PAD, END OF TAPE
* CHARACTER, PAD) TO THE REMOTE.  IT THEN WAITS FOR A REPLY FROM THE
* REMOTE.  THE NEXT STEP IS DEPENDENT ON THE REMOTE'S RESPONSE.
* 
*     REMOTE RESPONSE    ACTION TAKEN
*     ---------------    ---------------------------------
* 
*     "ENQ"              1. CHANGE STATE TO "RECEIVE".
*                        3. ENABLE "WABT" MODULE.
*                        2. XLOG = 1, BCONT = 0.
* 
*     "ACK" OR "RVI"     1. XLOG = 1, BCONT = NOT BCONT.
*                        2. ENABLE "TTD" MODULE.
* 
*     ANY OTHER CHAR     1. RESEND END-OF-FILE UP TO 7 MORE TIMES.
*     OR NO RESPONSE     2. ON 8TH TRY, SEND "DLE EOT" AND DROP THE
*                           LINE.
      SPC 3
*********************
* INITIATOR SEGMENT ************************************************
*********************
* 
* 
*           *** TEST FOR REJECT CONDITIONS. ***
* 
SEOF  LDA EQT2A,I   GET WORD #2 OF DEVICE'S EQT TBLE
      CLB,INB       SET B-REG TO "OFF-LINE" REJECT.
      ALF,ALF       IS
      RAL,RAL       TERMINAL
      SLA,RSS       "OFF-LINE"?
      JMP REJEC     YES, REJECT THE REQUEST.
      INB           SET B-REG TO "INCORRECT MODE".
      RAL           IS TERMINAL
      SSA,RSS       IN "RECEIVE" MODE?
      JMP REJEC     YES, REJECT THE REQUEST.
* 
      CLA           REQUEST WILL BE HONORED,
      STA ASAVE     SET-UP
      LDA D.50      RETURN
      STA I.50      LINKAGE.
* 
      JSB EBUSY     SET DRIVER TO BUSY.
      SPC 3
* 
*           *** INITIALIZE ***
* 
      CLA,INA       SET TRANSMISSION LOG
      STA TLOG      TO 1 CHARACTER SENT.
      STA EOF       SET "END-OF-FILE SENT/RECEIVED".
      LDA =D-8     INITIALIZE
      STA CEOF      ERROR COUNTING VARIABLE.
* 
SEOF1 JSB UPCAR     BRING UP CARRIER.
      CCA           SET LOGIC IN "CNTRL" SUBROUTINE.
      STA SCASE     TO RETURN IF "ENQ" IS RECEIVED.
* 
*     *** PATCH FOR IBM SYSTEMS*
      CCB           SET LOGIC TO NOT LOOK FOR
      STB EOTCK     A RESPONCE TO EOT.
* 
      LDA PAD       PUT
      STA RSEND     "PAD EOT" CHARACTER SEQUENCE
      STA SEOFB     IN
      LDA EOT       CONTROL
      STA SEOFB+1   BUFFER.
      LDA ENQ       PUT "PAD ENQ" CHAR SEQUENCE
      STA RSEND+1   IN "RESEND" BUFFER.
      LDA SEOFA     GET BUFFER ADDRESS IN A-REG.
      LDB =B2       GET
      STB RESLN     BUFFER LENGTH IN B-REG.
* 
      JSB CNTRL     SEND END-OF-FILE TO THE REMOTE.
*     *** PATCH FOR IBM SYSTEMS*
      CLB           RESET ACK0,1 LOGIC
      STB BCONT
      STB EOTCK     ALSO LOGICAL FLAG.
      LDA STOR
OTA7S OTA 0,C       TURN OFF RTS.
      JMP COMPT     GO COMPLETE FUNCTION.
EOTCK NOP
* 
      SPC 3
***************
* CONTINUATOR ******************************************************
***************
* 
* 
*           *** CHECK FOR "ENQ" CHARACTER. ***
* 
      CLB           SET CNTRL SUBROUTINE LOGIC
      STB SCASE     BACK TO NORMAL MODE.
* 
      CPA ENQ       IS RECEIVED CHAR AN "ENQ"?
      RSS           YES, SKIP NEXT INSTRUCTION.
      JMP SEOF2     NO, CONTINUE PROCESSING
* 
      CLA           SET STATE
      STA RCSND     TO "RECEIVE".
      STA BCONT     INITIALIZE "BCONT" FOR ACKO.
      JSB WACTV     ACTIVATE "WABT" GENERATOR.
      JMP COMPT     UPDATE STATUS & END THE REQUEST.
      SPC 3
* 
*           *** CHECK FOR "NAK" CHARACTER. ***
* 
      CPA NAK       RECEIVED CHARACTER A "NAK"?
      JMP SEOF6     YES, INCREMENT ERROR COUNT.
      SPC 3
* 
*           *** CHECK FOR "ACK" OR "RVI" CHARACTER. ***
* 
SEOF2 CPA RVI       CHARACTER A "REVERSE INTERRUPT".
      JMP SEOF4     YES, SET "REMOTE REQ TO SEND".
* 
      LDB BCONT     EXPECT
      SZB,RSS       AN "ACKO"?
      JMP SEOF3     YES, SEE IF "ACKO" WAS SENT.
      CPA ACK1      CHARACTER AN "ACK1"?
      JMP SEOF5     YES, SET STATUS AND EXIT.
      JMP SEOF7     NO, SEE IF SHOULD SEND AN ENQ.
* 
SEOF3 CPA ACK0      CHARACTER AN "ACK0"?
      JMP SEOF5     YES, SET STATUS AND EXIT.
      JMP SEOF7     NO, SEE IF SHOULD SEND AN ENQ.
* 
SEOF4 CLA,INA       RECEIVED CHAR WAS AN "RVI",
      STA RQ2SD     SET "REQUEST TO SEND".
* 
SEOF5 LDB BCONT     COMPLEMENT
      CMB           THE VALUE
      STB BCONT     OF BCONT.
* 
      JSB DACTV     ENABLE "TEMP TEXT DELAY" MODULE.
* 
      JMP COMPT     SET STATUS & END THE REQUEST.
      SPC 3
* 
*           *** REMOTE SENT "NAK" CHARACTER CHECK IF
*               RESEND OR DROP THE LINE. ***
* 
SEOF6 JSB IERR      INCREMENT # OF LINE ERRORS.
      ISZ CEOF      SENT END-OF-FILE EIGHT TIMES?
      JMP SEOF1     NO, SEND AGAIN.
* 
SEOF8 LDA =B2     SET "REMOTE SENT IMPROPER
      STA LERR      RESPONSE" BIT.
      JSB ENDAL     SEND "DLE EOT" AND DROP THE LINE
      SPC 3
* 
*           *** REMOTE SENT UNACCEPTABLE REPLY, CHECK IF SHOULD
*               SEND ENQ CHARACTER OR DROP THE LINE. ***
* 
SEOF7 JSB IERR      INCREMENT ERROR COUNTER.
      ISZ CEOF      IS THIS THE EIGTH ERROR?
      RSS           NO, SEND AGAIN.
      JMP SEOF8     YES, SEND "DLE EOT" DROP LINE.
      LDA RESH      GET ENQ BUFFER START ADRS.
      LDB =B2       GET ENQ BUFFER LENGTH.
      JMP SEOF1     SEND ENQ TO THE REMOTE.
      SPC 3
* 
*           *** DATA ***
* 
CEOF  BSS 1         COUNTS NO. OF TIMES EOF RESENT.
SEOFA DEF SEOFB     STARTIGN ADDRESS OF BUFFER.
SEOFB BSS 2         CONTAINS "PAD EOT".
      HED CLEAR PROCESSOR.
      SPC 3
* 
*           *** CLEAR PROCESSOR ***
* 
* 
* EXECUTION SEQUENCE:
* 
*     1. CLEARS CONTROL ON I/O BOARD.
* 
* 
*     4. SETS DRIVER AND EQT ENTRY TO "NOT BUSY".
* 
*  NOTE: THE INTERRUPT SYSTEM IS TURNED OFF WHILE THE CLEAR
*        PROCESSOR IS EXECUTING.
      SPC 3
* 
CLEAR CLA           INTERRUPT SYSTEM
      SFC 0         ACTIVE?
      INA           YES, SET A-REG TO 1.
      STA IST       SAVE ANSWER.
      CLF 0         DISABLE INTERRUPT SYSTEM.
* 
      LDB TEMP5     GET AND SAVE
      STB EQT1A     WORD 1 ADRS IN EQT TABLE.
      INB           FORM EQT WORD #2 ADRS
      STB EQT2A     AND SAVE.
      CLA           ZERO
      STA EOF       EOF FLAG,
      STA RCSND     RECEIVE/SEND FLAG
      STA INERR     IN ERROR FLAG,
      STA RQ2SD     REQUEST TO SEND FLAG,
      STA TLOG      TRANSMISSION LOG,
      STA OVRFL     AND BUFFER OVERFLOW FLAG.
      JSB .IOI.     INITIALIZE I/O
      JSB OFLNE     TAKE TERMINAL OFF LINE.
      JSB .IO.      CLEAR CONTROL & FLAG
      OCT 100011    ON RECIEVE AND
      JSB .IO.      SEND BOARDS.
      OCT 11
      JSB ISTAT     INITIALIZE STATUS.
      LDA =B100000  SET EXIT ROUTINE
      STA ASAVE     FOR
      LDA D.50      GOOD RETURN
      STA I.50      TO .IOC..
* 
      LDA IST   ENABLE
      SLA           INTERRUPT SYSTEM?
      STF 0         YES, DO IT.
* 
* 
      JMP COMPT     UPDATE STATUS IN EQT TABLE.
* 
* 
IST   BSS 1
      HED RECEIVE TO SEND PROCESSOR.
      SPC 3
* 
*           *** RECEIVE TO SEND PROCESSOR ***
* 
* 
* EXECUTION STEPS:
* 
* 1. SEND "ENQ" CHARACTER TO THE REMOTE.
* 2. WAIT FOR "ACKO" OR "RVI" CHARACTER TO BE RECEIVED.
* 3. ACTIVATE THE "TEMPORARY TEXT DELAY" GENERATOR.
* 4. CHANGE EQUIPMENT STATE TO "SEND" MODE.
* 
RC2SD JSB EBUSY     SET DRIVER & EQT BUSY.
* 
      JSB SGEN
      SZA
      JMP *-2
      CLA           SET-UP
      STA ASAVE     RETURN
      LDA D.50      LINKAGE.
      STA I.50
      JSB UPCAR     BRING UP CARRIER.
      JMP SENQ      EXECUTE STEP'S 1 - 4.
      HED SHUT-DOWN PROCESSOR.
      SPC 3
* 
*           *** SHUT-DOWN PROCESSOR ***
* 
* 
* EXECUTION SEQUENCE:
* 
*  1. SEND "DLE EOT" TO THE REMOTE.
* 2. TURN OFF I/O BOARD.
* 3. UPDATE STATUS.
* 
OFF   LDA LINE      IS TERMINAL
      SZA           ALREADY "OFF-LINE"?
      JMP XXX       NO, SEND "DLE EOT".
      LDA =B100000  YES,
      JMP D.50,I    RETURN TO CALL.
* 
XXX   CLA           SET-UP
      STA ASAVE     RETURN
      LDA D.50      LINKAGE.
      STA I.50
      JSB UPCAR
      JMP EDALL     SEND "DLE EOT" AND DROP THE LINE
      HED PARITY CALCULATION MODULE.
      SPC 3
* 
*           *** PARITY CALCULATOR ***
* 
* 
* THIS MODULE CALCULATES A BLOCK CHECK CHARACTER FROM A CHARACTER
* STRING.
* 
* 
*     A. CALLING SEQUENCE
* 
*        JSB PCALI
*        A-REG START ADRS OF BUFFER
*        B-REG LENGTH OF BUFFER (+ = WORDS, - = CHAR'S),
* 
* 
*     B. RETURN: A-REG CONTAINS FIRST PARITY CHARACTER, RIGHT-JUST.
*                B-REG - FOR EBCDIC & TRANSCODE : 2ND PARITY CHAR,
*                                                 RIGHT-JUSTIFIED.
*                        FOR ASCII : CONTENTS MEANINGLESS.
* 
* 
* THE 1ST TWO CHARACTERS ARE IGNORED IN THE PARITY
* ACCUMULATION. (SHOULD BE EITHER 'PAD,STX OR DLE,STX).
* 
* 
* 
* 
      SPC 3
PCALI NOP           ENTRY POINT.
* 
* SET UP BUFFER STARTING ADDRESS AND LENGTH.
* 
      STA PCAL1     SAVE BUFFER START ADRS.
* 
      SSB,RSS       CONVERT LENGTH
      RBL           TO CHARACTERS
      SSB,RSS       IF
      CMB,INB       NECESSARY.
      ADB =D3       ADJUST COUNT FOR SCANNING LOGIC.
      SSB,SZB,RSS   LENGTH LESS THAN 4?
      JMP PCALI,I   YES, ERROR, JUST RETURN.
      STB PCAL2     SAVE LENGTH.
* 
* SET CALL TO PROPER PARITY CALCULATOR.
* 
      LDA CODE      GET
      ADA CTYPE     POINTER
      LDA A,I       TO CORRECT SUB.
      STA CALL      SAVE POINTER.
* 
* INITIALIZE.
* 
      LDA PCAL1,I   ISOLATE FIRST
      ISZ PCAL1     CHARACTER OF BUFFER.
      ALF,ALF       (IGNORE 2ND).
      AND MASK
      CLB
      CPA DLE       CHARACTER A 'DLE'?
      CCB           YES, SET TRANSPARENT TEXT SCAN.
      STB TSCAN
      SZB           IF TRANS PARENT MODE ALLOW FOR
      ISZ PCAL2     'DLE' , 'ETX' AT BUF END.
      LDA FUNCT     IS CALL FROM
      AND =B300     "READ" PROCESSOR?
      CLB
      CPA =B100     IF SO, RESET
      STB TSCAN     TRANSPARENT SCAN LOGIC.
* 
      CLA           SET CHARACTER
      STA SID       JUSTIFICATION TO LEFT SIDE.
      SPC 3
* 
* PARITY CALCULATION LOOP
* 
PCLL1 STA PCAL5     SAVE PARITY WORD.
      LDA BCNT      RESTORE
      STA PCAL6     BIT COUNTER.
      LDA PCAL1,I   GET BUFFER WORD.
      LDB SID       CHARACTER
      CMB,SLB       IN LEFT-SIDE OF WORD?
      ALF,ALF       YES, RIGHT JUSTIFY.
      STB SID       SAVE CHAR JUSTIFICATION CODE.
      SLB,RSS       INCREMENT BUFFER ADRS?
      ISZ PCAL1     YES.
      AND MASK      ISOLATE CHARACTER.
PCLL2 LDB A         PUT CHAR IN B-REG.
      LDA TSCAN     IN
      SZA,RSS       TRANSPARENT MODE?
      JMP PCCL6     NO, CLACULATE CHAR'S PARITY.
      CPB DLE       CHARACTER A "DLE"?
      RSS           YES, SKIP NEXT INSTRUCTION.
      JMP PCCL4     NO, CALCULATE ITS PARITY.
      LDA DLEFL     LAST CHARACTER
      SZA           A "DLE"?
      JMP PCCL4     YES, CALCULATE THIS CHAR PARITY
      CCA           NO,
      STA DLEFL     SET "LAST CHAR A DLE" FLAG.
      LDA PCAL5     GET PARITY CHAR IN A-REG.
      JMP PCLL3     IGNORE CHAR IN PARITY CALC.
* 
PCCL4 CLA           CLEAR
      STA DLEFL     "LAST CHARACTER WAS A DLE" FLAG.
PCCL6 LDA PCAL5     GET PARITY WORD.
      JSB CALL,I    CALCULATE PARITY.
PCLL3 ISZ PCAL2     FINISHED ENTIRE BUFFER.
      JMP PCLL1     NO, CALC PARITY ON NEXT CHAR.
      SPC 3
* 
* FORMAT PARITY CHAR'S IN A & B REGISTERS.
* 
      STA PCAL5     SAVE PARITY WORD.
      LDA PCAL1,I   GET FINAL 2 CHARACTERS
      LDB A         OF BUFFER.
      ALF,ALF       IF EITHER IS AN
      AND MASK      'ETX' OR 'ETB' THEN
      CPA ETB       INCLUDE IT IN
      JMP .LAST     THE PARITY ACCUMULATION.
      CPA ETX
      JMP .LAST
      LDA B
      AND MASK
      CPA ETB
      JMP .LAST
      CPA ETX
      JMP .LAST
      LDA PCAL5
      JMP .DONE
* 
.LAST LDB BCNT      RESET BIT
      STB PCAL6     COUNTER.
      LDB A         GET ETX OR ETB CHAR IN B-REG.
      LDA PCAL5     GET PARITY CHAR IN A-REG.
      JSB CALL,I    CALCULATE ITS PARITY.
      STA PCAL5     SAVE PARITY WORD.
* 
.DONE AND MASK      MASK RIGHT HALF.
      STA PCAL6     1ST CHARACTER.
      LDB CODE      GET CHARACTER CODE IN B-REG.
      LDA PCAL5     GET PARITY CODE IN A.
      CPB =B2       IN 6-BIT TRANSCODE?
      RAL,RAL       YES, ALIGN UPPER BYTE INTO 8 MSB
      ALF,ALF       RIGHT-JUSTIFY UPPER CHARACTER.
      AND MASK      ISOLATE SECOND PARITY CHAR
      LDB A         AND PLACE IN B-REG.
      LDA PCAL6     GET 1ST CHAR IN A-REG.
      JMP PCALI,I   RETURN TO CALL.
      SPC 2
      SPC 3
* 
*           *** PARITY GENERATING ALGORITHMS ***
* 
* 
* CALCULATE EBCDIC "CRC-16".
* 
EBCLC NOP           ENTRY POINT.
* 
      SLB           SKIP IF DATA BIT IS 0.
      XOR =B1       EXCLUSIVE OR DATA BIT AND CRC 0.
      RAR
      SSA           SKIP IF FEEDBACK DATA IS ZERO.
      XOR =B20001   XOR CONSTANT DEVISOR INTO CRC.
      RBR
      ISZ PCAL6     FINISHED CALCULATION?
      JMP EBCLC+1   NO, PROCESS ANOTHER BIT.
24380-18033 1409