home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / archives / sperryunivac9060.zip / sp9ker.src next >
Text File  |  1988-08-16  |  43KB  |  930 lines
  1. **************************************************************
  2. ** MAIN ENTRY POINT - KERMIT ONLY RUNS AS A SERVER SINCE    **
  3. **              THE SPERRY 90/60 CAN NOT INITIATE   **
  4. **            USE OF AN RTIO LINE OTHER THAN THE  **
  5. **            TERMINAL LINE ITSELF                **
  6. ** MCC TABLES AND TRANSLATION MODULES MODIFIED IN SYSTEM    **
  7. **    THIS IS NECESSARY TO INSURE THAT ALL THE CHARACTERS **
  8. **    IN THE PRINTABLE ASCII RANGE AND THE ^A HAVE VALUES **
  9. **    WITHIN THE EBCDIC REPRESENTATION (SEE ATOE TABLE)   **
  10. **************************************************************
  11. SERVER   CSECT
  12.          STM   14,12,12(13)      SAVE CALLER REGISTERS
  13.          BALR  12,0              SET UP A BASE REGISTER
  14.          USING *,12
  15.          ST    13,SAVE+4         SAVE MY CALLERS SAVE AREA ADR
  16.          LA    13,SAVE           SET UP MY SAVE AREA TO CALL 
  17.          SETBF 200,N
  18. WAIT     LA    1,=A(PKNAK,REC)   SET UP PARAMATER LIST
  19. ERRSEN   L     15,=V(PACKETIO)   GET READY TO GO
  20.          BALR  14,15             GO DO A TRANSFER
  21.          LA    1,=A(REC)         ADDRESS OF PACKET RECIEVED
  22.          LA    14,CHCK           RETURN ADDRESS FOR FOLLOWING
  23. CHCK     CLI   RECTYP,C'S'       IS IT A SEND INIT PACKET
  24.          BNE   SKIPSEND          CHECK NEXT PACKET TYPE
  25.          L     15,=V(RECFILE)    REMOTE IS SENDING US A FILE
  26.          BR    15                GO TAKE FILE FROM REMOTE TO DISK
  27. SKIPSEND CLI   RECTYP,C'R'       IS IT A RECIEVE INIT PACKET
  28.          BNE   SKIPREC           NO GO TO CHECK OTHER TYPES
  29.          L     15,=V(SENFILE)    ROUTINE TO SEND FILE TO REMOTE
  30.          BR    15                AND OFF WE GO
  31. SKIPREC  CLI   RECTYP,C'I'       CHECK FOR AN INIT PACKET
  32.          BNE   SKIPINIT
  33.          L     15,=V(KRMTINI)    ADDRESS OF INIT HANDLER
  34.          BR    15
  35. SKIPINIT CLI   RECTYP,C'G'
  36.          BNE   SKIPGEN
  37.          CLI   RECDAT,C'L'       IS THIS A LOGOUT
  38.          BNE   SKIPGEN
  39.          LA    1,=A(PKYAK,0)
  40.          L     15,=V(PACKETIO)
  41.          BALR  14,15             ACK THE LOGOFF COMMAND
  42.          CMAND '/LOGOFF'
  43. SKIPGEN  CLI   RECTYP,C'Y'       IS THIS AN EXTRA ACK
  44.          BE    WAIT              YES SEND A NAK AND WAIT    
  45.          CLI   RECTYP,C'E'
  46.          BE    WAIT
  47.          LA    1,=A(PKERR,REC)
  48.          B     ERRSEN
  49. PKERR  DS  0F
  50. PKELEN DC  X'1B'
  51. PKESEQ DC  X'00'
  52. PKETYP DC  C'E'
  53. PKEDAT     DC  C'FUNCTION NOT IMPLEMENTED'
  54. PKNAK    DS    0F
  55.          DC    X'03'             LENGTH OF NAK PACKET TO SEND
  56.          DC    X'00'             SEQUENCE NUMBER
  57.          DC    C'N'
  58. PKYAK    DC    X'03'             PACKET LENGTH
  59.          DC    X'00'             PACKET NUMBER
  60.          DC    C'Y'              PACKET DATA
  61. REC      DS    0F
  62. RECLEN   DS    XL1
  63. RECSEQ   DS    XL1
  64. RECTYP   DS    XL1
  65. RECDAT   DS    CL150
  66. SAVE     DS    18F
  67.          END
  68. KRMTINI  CSECT
  69.          STM   14,12,12(13)      SAVE CALLER REGISTERS
  70.          BALR  12,0              SET UP MY BASE REGISTER
  71.          USING *,12
  72.          ST    13,SAVE+4         SAVE CALLERS SAVE ADDRESS LOCAL
  73.          LA    13,SAVE           SET UP A SAVE AREA FOR OTHER CALLS
  74. ***************************************************************
  75. **KERMIT INIT PACKER HANDLER                                 **
  76. **    ARGUMENTS (1) - 1 ADDRESS OF PACKET                    **
  77. **                  RECIEVED INIT PACKET ON INPUT            **
  78. **                  NEXT PACKET ON RETURN                    **
  79. **    EXTERNAL REFF POINT - (KRMTPARM) START OF KERMIT 
  80. **             PARAM LIST                                    **
  81. ***************************************************************
  82.          L     2,0(1)            ADDRESS OF PACKET
  83.          IC    3,0(2)            LENGTH OF PACKET
  84.          MVI   PARMPKT,C' '      BLANK OUT THE LOCAL PACKET
  85.          MVC   PARMPKT+1(152),PARMPKT
  86.          BCTR  3,0               DECREMENT FOR AN EX MOVE
  87.          EX    3,MOVEPKT         MOVE IT TO PARMPKT
  88.          MVI   CALLTYP,C' '      NORMAL CALL
  89.          CLI   PARMTYP,C'R'      IS THIS AN INIT REMOTE RECIEVE
  90.          BE    WESTART           IF SO WE START THE INIT
  91. SETMAXL  SR    11,11             CLEAR A REGISTER
  92.          IC    11,PARMDAT        GET MAX LENGTH
  93.          L     3,=V(ETOA)        NEED PACKETIO TRANS TABLE  
  94.          IC    11,0(11,3)        CHANGE CHARACTER TO ASCII
  95.          SH    11,=H'32'         LOWER FROM PRINTABLE RANGE
  96.          STC   11,PARMMAXL       STORE AMOUNT IN PARM TABLE
  97. SETTIME  SR    11,11
  98.          IC    11,=X'10'         SET TIME TO WAIT TO 16 SECONDS
  99.          AH    11,=H'32'         SET UP IN PRINTABLE RANGE
  100.          L     4,=V(ATOE)        TRANS FROM PACKETIO TO EBCDIC
  101.          IC    11,0(11,4)        CHANGE TIME TO EBCDIC
  102.          STC   11,PARMDAT+1      PUT IN PACKET TO SEND
  103. SETPAD   SR    11,11
  104.          IC    11,PARMDAT+2      GET NUMBER OF PADDING CHARS
  105.          IC    11,0(11,3)        CONVERT IT TO ASCII BITS
  106.          SH    11,=H'32'         ADJUST DOWN FROM PRINTABLE
  107.          STC   11,PARMNPAD       STORE IN MY PARM LIST
  108.          LH    11,=H'0'         PUT SOME FILL CHARS IN
  109.          AH    11,=H'32'         GET UP TO PRINTABLE RANGE
  110.          IC    11,0(11,4)        TRANSLATE TO EBCDIC
  111.          STC   11,PARMDAT+2      PUT IN PACKET TO SEND
  112. SETPADC  SR    11,11 
  113.          IC    11,PARMDAT+3      GET CHARACTER THEY ASKED FOR
  114.          IC    11,0(11,3)        TRANSLATE TO ASCII
  115.          X     11,XORWRD         USE CTL FUNCTION TO MOVE DOWN
  116.          IC    11,0(11,4)        TRANSLATE BACK TO EBCDIC
  117.          STC   11,PARMPADC       PUT IN PARM LIST
  118.          SR    11,11
  119.          X     11,XORWRD         USE CTL FUNCTION TO MOVE UP
  120.          IC    11,0(11,4)        SET TO EBCDIC CHAR
  121.          STC   11,PARMDAT+3      TELL HIM I WANT NULLS(WHO CARES)
  122. SETEOL   SR    11,11
  123.          IC    11,PARMDAT+4      GET EOL CHAR THEY WANT TO SEND
  124.          IC    11,0(11,3)        TRANSLATE TO ASCII
  125.          SH    11,=H'32'
  126.          IC    11,0(11,4)        TRANSLATE BACK TO EBCDIC
  127.          STC   11,PARMEOL        PUT IN PARM LIST
  128.          IC    11,=X'15'         PUT IN MY <NL> CHARACTER
  129.          IC    11,0(11,3)        TRANSLATE TO ASCII
  130.          AH    11,=H'32'         SET UP TO PRINTABLE
  131.          IC    11,0(11,4)        TRANSLATE BACK TO EBCDIC
  132.          STC   11,PARMDAT+4
  133. SETQCTL  IC    11,PARMDAT+5      GET QUOTE CHARACTER FOR CTL
  134.          STC   11,PARMQCTL       GOOD FOR ME TOO
  135. SETQBIN  MVI   PARMDAT+6,C'N'    WE DONT DO 8 BIT QUOTING
  136.          MVI   PARMDAT+7,C'1'    WE ONLY DO 1 BYTE CHECKSUMS
  137. SEQREPT  IC    11,PARMDAT+8      GET A REPT QUOTE CHARACTER
  138.          STC   11,PARMREPT       GOOD ENOUGH FOR M
  139.          MVI   PARMDAT+9,X'00'   WE HAVE NO EXTENSIONS
  140.          MVI   PARMTYP,C'Y'      CHANGE PACKET TO AN ACK
  141.          CLI   CALLTYP,C'R'      IS THIS INIT CAUSED BY A R PACKET
  142.          BE    ENDCALL           WE ALREADY SENT OUT INIT PARAMS
  143.          LA    1,ARGLIST
  144.          L     15,=V(PACKETIO)   CALL PACKET I/O FOR MESS SWAP
  145.          BALR  14,15
  146. ENDCALL  L     11,=V(PIOINIT)    GET PARAM LOCATION IN PACKETIO
  147.          MVC   0(3,11),PARMNPAD  MOVE NPAD, PADC, AND EOL CHARS
  148. GOBACK   SR    11,11             CLEAR IT
  149.          IC    11,PARMLEN        GET THE LENGTH
  150.          BCTR  11,0              DECREMENT BY 1 FOR EX MOVE
  151.          EX    11,MOVEBK         MOVE IT BACK TO CALLER
  152. RETURN   L     13,SAVE+4
  153.          LM    14,12,12(13)
  154.          SR    15,15
  155.          BR    14
  156. WESTART  LA    1,=A(PKINIT,PARMPKT)
  157.          L     15,=V(PACKETIO)   SEND BASIC INIT START
  158.          BALR  14,15
  159.          CLI   PARMTYP,C'E'
  160.          BE    GOBACK
  161.          CLI   PARMTYP,C'I'
  162.          BE    ISOK
  163.          CLI   PARMTYP,C'Y'
  164.          BE    ISOK
  165.          B     GOBACK
  166. ISOK     MVI   CALLTYP,C'R'      THIS IS AN R PACKET INIT
  167.          B     SETMAXL           GO UP AND GET PARAM
  168. ARGLIST  DC    A(PARMPKT)
  169.          DC    A(PARMPKT)
  170. XORWRD   DC    F'64'
  171. MOVEPKT  MVC   PARMPKT(1),0(2)
  172. MOVEBK   MVC   0(1,2),PARMPKT
  173. CALLTYP  DS    CL1
  174. SAVE     DS    18F
  175. PARMPKT  DS    0F
  176. PARMLEN  DS    XL1
  177. PARMSEQ  DS    XL1
  178. PARMTYP  DS    XL1
  179. PARMDAT  DS    CL150
  180.          ENTRY KRMTPARM
  181. KRMTPARM EQU   *
  182. PARMMAXL DS    XL1
  183. PARMTIME DS    XL1
  184. PARMNPAD DS    XL1
  185. PARMPADC DS    CL1
  186. PARMEOL  DS    CL1
  187. PARMQCTL DS    CL1
  188. PARMQBIN DS    CL1
  189. PARMCHKT DS    CL1
  190. PARMREPT DS    CL1
  191. PARMCAPS DS    X'00'
  192. PKINIT   DS    0F 
  193. PKILEN   DC    X'0C'
  194. PKISEQ   DC    X'00'
  195. PKITYP   DC    C'S'
  196. PKIMAXL  DC    X'FF'
  197. PKITIM   DC    C'-'
  198. PKINPAD  DC    C' '
  199. PKIPADC  DC    C'@'
  200. PKIEOL   DC    C'-'
  201. PKIQCTL  DC    C'#'
  202. PKIQBIN  DC    C'N'
  203. PKICKTYP DC    C'1'
  204. PKIQREPT DC    C'_'
  205.          END
  206. KRMTUC   CSECT
  207.          STM   14,12,12(13)
  208.          BALR  12,0
  209.          USING *,12
  210.          ST    13,SAVE+4
  211.          LA    13,SAVE
  212. ****************************************************
  213. *  ROUTINE TO CONVERT A 54 CHAR FIELD TO UPPER CS  *
  214. ****************************************************
  215.          L     2,0(1)            GET ADDRESS OF THE FIELD
  216.          LA    3,54              GET A COUNT IN REG 3
  217. LOOPUC   CLI   0(2),X'81'        CHECK LOWER RANGE TO CHANGE
  218.          BL    NOCHNG            IF LOW NO CHANGE
  219.          CLI   0(2),X'A9'        CHECK THE UPPER RANGE
  220.          BH    NOCHNG            IF HIGH NO CHANGE
  221.          OI    0(2),X'40'        SET THE BIT FOR UPPER CASE
  222. NOCHNG   LA    2,1(2)            INCREMENT 2 BY 1
  223.          CLI   0(2),X'40'        IS IS A BLANK
  224.          BE    RETURN            IF SO NO MORE TO CHECK
  225.          BCT   3,LOOPUC          GO CHECK NEXT CHAR
  226. RETURN   L     13,SAVE+4         GET THE SAVE AREA
  227.          LM    14,12,12(13)      SET REGISTERS BACK
  228.          SR    15,15             ALL OK
  229.          BR    14                AND BACK WE GO
  230. SAVE     DS    18F
  231.          END
  232. PACKETIO CSECT 
  233.          STM   14,12,12(13)
  234.          BALR  12,0
  235.          USING *,12
  236. **************************************************************
  237. **  KERMIT I/O HANDELER                                     **
  238. **  USE:                                                    **
  239. **      CONVERTS A PACKET FROM SIMPLE INTERNAL FORMAT       **
  240. **         TO KERMIT FORMAT AND SENDS IT                    **
  241. **      RECIEVES THE ANS PACKET AND CONVERTS IT TO SIMPLE   **
  242. **         INTERNAL FORMAT                                  **
  243. **      RETRANSMITS FOR I/O ERRORS UNTIL TRANSACTION FINISH **
  244. **  CALL FORMAT:                                            **
  245. **      STANDARD LINKAGE USAGE                              **
  246. **      ARG #1 - ADDRESS OF PACKET TO SEND                  **
  247. **      ARG #2 - ADDRESS OF PACKET TO RECIEVE               **
  248. **  INTERNAL PACKET FORMAT:                                 **
  249. **      <LENGTH> BINARY LENGTH INCLUSIVE                    **
  250. **      <SEQ>    PACKET SEQUENCE NUMBER IN BINARY           **
  251. **      <TYPE>   CHARACTER REPRESENTING PACKET TYPE         **
  252. **      <DATA>   VARIABLE LENGTH DATA FIELD                 **
  253. **                  LENGTH OF FIELD = <LENGTH>-3            **
  254. **  PROCEDURE:                                              **
  255. **       A) PREFIX PACKET WITH A ^A FOR START OF PACKET     **
  256. **       B) PREFIX PACKET WITH LENGTH AND STUFF FOR A       **
  257. **           UNIVAC V TYPE RECORD                           **
  258. **       C) CONVERT <LENGTH>&<SIZE> TO CHAR ADJUSTED FORM   **
  259. **       D) CALCULATE A CHECK SUM BASED ON ASCII REP        **
  260. **       F) SUFFIX PACKET WITH A CARRAGE RETURN             **
  261. **           EBCDIC <NL> X'15' = ASCII <CR> X'0D'           **
  262. **       G) SEND THE PACKET AND GET THE RETURN PACKET       **
  263. **       H) CONVERT THE RETURN PACKET TO SIMPLE FORM        **
  264. **       I) RETURN THE PACKET TO THE CALLER                 **
  265. **  ERRORS:                                                 **
  266. **       ALL ERRORS CAUSE THE ORIGINAL PACKET TO BE SENT    **
  267. **         AGAIN. (THIS SHOULD BE OK; DUPE PACKETS ARE DROP)**
  268. **       ERRORS WHICH ARE INTERCEPTED ARE:                  **
  269. **         RTIO ERROR - UNIVAC BUFFER OVERRUN               **
  270. **         CHECKSUM   - ERROR ON CHECKSUM ON RETURNING PACK **
  271. **         NAK        - PACKET SENT WAS NAK'ED BY REMOTE    **
  272. **************************************************************
  273.          SPACE
  274.          SPACE
  275. **************************************************************
  276. ** BUILD THE PACKET TO GO OUT                               **
  277. **************************************************************
  278.          L     3,0(1)            GET ADDRESS PACKET TO SEND
  279.          L     4,4(1)            GET ADDRESS OF PACKET 
  280.          SR    5,5               CLEAR A REG FOR ERROR COUNT
  281. SENDAGN  SR    11,11             CLEAR OUT A TEMP REG
  282.          C     5,=F'50'          CHECK FOR ERROR ABORT
  283.          BH    TERMD             LETS GET THAT DUMP
  284.          IC    11,0(3)           GET THE LENGTH OF PACKET
  285.          EX    11,MOVEPK         MOVE TO LOCAL(YES 1 EXTRA CHAR)
  286.          MVI   SENDMRK,X'27'     MOVE IN ^A FOR START OF PACKET
  287.          LA    11,8(11)          GET LENGTH FOR V RECORD
  288.          STH   11,SENDVREC       STORE IT IN BEGINNING OF BUFFER
  289.          MVC   SENDFIL,=X'4040'  BLANKS TO KEEP UNIVAC HAPPY
  290.          MVI   SENDNUL,X'00'     MOVE IN A NUL AT START OF LINE
  291.          SR    11,11             CLEAR IT AGAIN
  292.          IC    11,SENDLEN        GET THE LENGTH AGAIN
  293.          STC   11,SAVELEN        SAVE LENGTH FOR LATER USE
  294.          AH    11,=H'32'         MOVE UP TO PRINTABLE
  295.          STC   11,SENDLEN        PUT BACK IN PACKET
  296.          TR    SENDLEN,ATOE      TRANS TO EBCDIC FOR LATER ASCII
  297.          SR    11,11             CLEAR 11 FOR SAME TO SEQUENCE
  298.          IC    11,SENDSEQ        GET THE SEQUENCE NUMBER
  299.          AH    11,=H'32'         ADJUST UP TO PRINTABLE
  300.          STC   11,SENDSEQ        PUT BACK IN PACKET RECORD
  301.          TR    SENDSEQ,ATOE      TRANS TO EBCDIC FOR LATER ASCII CVT
  302.          SR    11,11             CLEAR TEMP REGISTER AGAIN
  303.          IC    11,SAVELEN        GET ORIGINAL BINARY LENGTH
  304.          EX    11,MOVETS         MOVE PACKET TO TEMP STORAGE
  305.          EX    11,TRANTS         TRANSLATE TEMPORARY TO ASCII
  306.          SR    10,10             CLEAR ANOTHER REGISTER FOR TEMP
  307.          SR    9,9               CLEAR A REGISTER FOR SUM
  308.          LR    8,11              POINT TO LAST CHAR (CHECKSUM)
  309. LOOPCKSM IC    10,TEMPS-1(8)     GET NEXT CHAR IN STRING
  310.          AR    9,10              ADD TO SUM
  311.          BCT   8,LOOPCKSM        GO BACK FOR MORE CHARS
  312.          N     9,ZAPHIGH         GET RID OF HIGH 3 BYTES
  313.          LR    8,9               COPY TO 8
  314.          SRL   8,6               SHIFT RIGHT 6 BITS TO LEAVE HIGH 2
  315.          AR    9,8               ADD IT TO THE SUM
  316.          N     9,ZAPBUT6         ZAP ALL BUT LAST 6 BITS
  317.          AH    9,=H'32'          MOVE UP TO PRINTABLE RANGE
  318.          IC    9,ATOE(9)         CONVERT TO EBCDIC
  319.          STC   9,SENDLEN(11)     PUT AT END OF PACKET
  320.          IC    8,CARRET          GET A CARRAGE RETURN/NEW LINE
  321.          STC   8,SENDLEN+1(11)   PUT AFTER THE CHECK SUM
  322. **************************************************************
  323. ** NOW THAT A PACKET IS READY TO GO WE WILL SEND IT TO      **
  324. ** THE REMOTE DEVICE VIA TERMINAL LINE AND WAIT FOR THE     **
  325. ** RETURN PACKET FROM THE REMOTE                            **
  326.          SR    11,11             CLEAR REG
  327.          IC    11,NPAD           GET NUMBER OF PAD CHARS
  328.          LTR   11,11             SEE IF ZERO
  329.          BZ    WTRD              DO THE WRITE NOW
  330.          MVC   TEMPS(1),PADC     MOVE IN PAD CHARACTER
  331.          MVC   TEMPS+1(150),TEMPS
  332.          AH    11,=H'5'          ADD FOR RECLEN
  333.          STH   11,TEMPS          PUT IN THE RECORD
  334.          MVC   TEMPS+2(2),=C'  ' PUT IN BLANKS KEEP UNI HAPPY
  335.          WROUT TEMPS,X'16'       WRITE OUT THE NULLS (NO CR)
  336. WTRD     LTR   4,4               CHECK RETURN PACKET ADDR
  337.          BZ    SENDONLY          IF ZERO WE SEND AND RETURN
  338.          WRTRD SENDPK,X'16',TEMPS,X'16',150,RTIOERR
  339. **************************************************************
  340. ** INPUT BUFFER (TEMPS) SHOULD HAVE A PACKET. FIRST WE MUST **
  341. ** FIND THE ^A TO START THE PACKET AND DROP TRASH           **
  342. **************************************************************
  343.          TRT   TEMPS+4(L'TEMPS-4),TABCTLA
  344.          BZ    RTIOERR           ^A NOT FOUND    
  345.          LA    11,TEMPS-1        ADDRESS OF START OF PACKET
  346.          LH    10,TEMPS          LENGTH OF STRING (V REC)
  347.          LR    9,1               ADDRESS OF ^A
  348.          N     9,ZAPADDR
  349.          N     11,ZAPADDR        GET RID OF FIRST BY ADDRESS CONST
  350.          SR    9,11              AMOUNT OF TRASH BEFORE ^A
  351.          AR    11,9              ADD LENGHT OF TRASH TO START
  352.          SR    10,9              GET LENGHTOF GOOD DATA
  353.          LR    8,10              SAVE LENGHT OF GOOD DATA(TEMP)
  354.          BCTR  10,0              DECREMENT BY 1 FOR EX TYPE MOVE
  355.          EX    10,MOVEGT         MOVE IT TO THE "GET" PACKET
  356. ***************************************************************
  357. ** THE GOOD PART OF THE PACKET IS IN THE "GET" AREA          **
  358. ** MUST BE CHECKED FOR CHECKSUM OR NAK                       **
  359. ***************************************************************
  360.          SR    11,11             CLEAR OUT A TEMP REG
  361.          IC    11,GETLEN         GET THE EBCDIC LENGTH(NOT READY)
  362.          IC    11,ETOA(11)       TRANSLATE CHAR TO ASCII
  363.          SH    11,=H'32'         DOWN FROM PRINTABLE TO BINARY
  364.          BM    RTIOERR           THIS PACKET LENGTH IS BAD
  365.          SR    8,11              GET DIFF BETWEEN V LEN AND PACKET
  366.          C     8,=F'5'           IS THE DIFF MORE THAN 5
  367.          BH    RTIOERR
  368.          C     8,=F'-5'          IS DIFF LESS THAN 5
  369.          BL    RTIOERR
  370.          EX    11,MOVEGTP        MOVE IT TO TEMP STORAGE
  371.          EX    11,TRANTS        TRANSLATE IT TO ASCII
  372.          LR    10,11             POINT TO LAST CHAR
  373.          SR    9,9               CLEAR FOR SUM
  374.          SR    8,8               CLEAR FOR TEMP USE
  375. LOOPCK   IC    8,TEMPS-1(10)     GET A CHARACTER
  376.          AR    9,8               ADD IT TO THE SUM
  377.          BCT   10,LOOPCK         GO BACK FOR MORE CHARS?
  378.          N     9,ZAPHIGH         CLEAR ALL BUT LAST BYTE
  379.          LR    10,9              COPY TO REG 10
  380.          SRL   10,6              MOVE HIGH 2 BITS OF BYTE TO LOW BITS
  381.          AR    9,10              ADD THOSE BITS TO THE SUM
  382.          N     9,ZAPBUT6         CLEAR ALL BUT LAST 6 BITS
  383.          AH    9,=H'32'          ADD TO COMPAIR IN PRINTABLE RANGE
  384.          IC    10,TEMPS(11)      GET THE CHECKSUM RECIEVED
  385.          CR    9,10              ARE THEY THE SAME
  386.          BNE   RTIOERR           IF NOT LETS TRY AGAIN
  387. **************************************************************
  388. ** THIS LOOKS LIKE A GOOD PACKET. NEXT TO CHANGE THE BINARY **
  389. ** FIELDS FROM THEIR EBCDIC CHAR TRANSLATION                **
  390. **************************************************************
  391.          CLI   GETTYP,C'N'       IS THE PACKET A NAK
  392.          BE    RTIOERR           IF SO LETS TRY AGAIN
  393.          SR    11,11             CLEAR IT
  394.          IC    11,TEMPS+1        GET ASCII REP FOR SEQUENCE
  395.          SH    11,=H'32'         MOVE IT DOWN
  396.          STC   11,GETSEQ         PUT IT IN THE PACKET TO RETURN
  397.          IC    11,TEMPS          GET THE ASCII REP FOR LENGTH
  398.          SH    11,=H'32'         MOVE IT DOWN FROM PRINTABLE
  399.          STC   11,GETLEN         PUT IN PACKET TO RETURN
  400.          BCTR  11,0              DECREMENT IT FOR THE MOVE
  401.          EX    11,MOVEBK         MOVE IT BACK TO CALLER
  402. RETURN   LM    14,12,12(13)      RESTORE CALLERS REGISTERS
  403.          SR    15,15             ALL IS OK
  404.          BR    14                AND BACK TO THE CALLER
  405. RTIOERR  LA    5,1(5)            INCREMENT I/O ERROR COUNT
  406.          B     SENDAGN           GO BACK AND SEND AGAIN
  407. SENDONLY WROUT SENDPK,X'16'
  408.          B     RETURN            AND BACK WE GO
  409. TERMD    TERMD      
  410.          ENTRY ATOE,ETOA
  411. ATOE     DC    X'00270303030303030303030303150303'
  412.          DC    X'03030303030303030303030303030303'
  413.          DC    X'405A7F7B5B6C507D4D5D5C4E6B604B61'
  414.          DC    X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'
  415.          DC    X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'
  416.          DC    X'D7D8D9E2E3E4E5E6E7E8E9B4BCB56A6D'
  417.          DC    X'4A818283848586878889919293949596'
  418.          DC    X'979899A2A3A4A5A6A7A8A9C04FD0FF07'
  419.          DC    X'03030303030303030303030303030303'
  420.          DC    X'03030303030303030303030303030303'
  421.          DC    X'03030303030303030303030303030303'
  422.          DC    X'03030303030303030303030303030303'
  423.          DC    X'03030303030303030303030303030303'
  424.          DC    X'03030303030303030303030303030303'
  425.          DC    X'03030303030303030303030303030303'
  426.          DC    X'03030303030303030303030303030303'
  427. ETOA     DC    X'000303030303037F0303030303030303'
  428.          DC    X'03030303030D03030303030303030303'
  429.          DC    X'03030303030303010303030303030303'
  430.          DC    X'03030303030303030303030303030303'
  431.          DC    X'20030303030303030303602E3C282B7C'
  432.          DC    X'2603030303030303030321242A293B03'
  433.          DC    X'2D2F03030303030303035E2C255F3E3F'
  434.          DC    X'030303030303030303033A2340273D22'
  435.          DC    X'03616263646566676869030303030303' 
  436.          DC    X'026A6B6C6D6E6F707172030303030303'
  437.          DC    X'0303737475767778797A030303030303'
  438.          DC    X'030303035B5D0303030303035C030303'
  439.          DC    X'7B414243444546474849030303030303'
  440.          DC    X'7D4A4B4C4D4E4F505152030303030303'
  441.          DC    X'0303535455565758595A030303030303'
  442.          DC    X'3031323334353637383903030303037E'
  443. TABCTLA  DC    256X'00'
  444.          ORG   TABCTLA+X'27'
  445. CTRLA    DC    X'27'
  446.          ORG
  447. SAVELEN  DS    CL1
  448.          ENTRY PIOINIT
  449. PIOINIT  EQU   *
  450. NPAD     DS    XL1
  451. PADC     DS    CL1
  452. CARRET   DC    X'15'
  453. MOVETS   MVC   TEMPS(1),SENDLEN
  454. MOVEGTP  MVC   TEMPS(1),GETLEN
  455. TRANTS   TR    TEMPS(1),ETOA
  456. MOVEPK   MVC   SENDLEN(1),0(3)
  457. MOVEGT   MVC   GETLEN(1),1(11)
  458. MOVEBK   MVC   0(1,4),GETLEN
  459.          DS    0F
  460. ZAPHIGH  DC    X'000000FF'
  461. ZAPBUT6  DC    X'0000003F'
  462. ZAPADDR  DC    X'00FFFFFF'
  463.          LTORG
  464. SENDPK   DS    0F
  465. SENDVREC DS    H
  466. SENDFIL  DS    XL2
  467. SENDNUL  DS    XL1
  468. SENDMRK  DS    CL1
  469. SENDLEN  DS    CL1
  470. SENDSEQ  DS    CL1
  471. SENDTYP  DS    CL1
  472. SENDDATA DS    CL150
  473. SAFE1    DS    CL256
  474.          DS    0F
  475. TEMPS    DS    CL150
  476. SAFE2    DS    CL256
  477. GETPK    DS    0F
  478. GETLEN   DS    CL1
  479. GETSEQ   DS    CL1
  480. GETTYP   DS    CL1
  481. GETDATA  DS    CL150
  482. SAFE3    DS    CL256
  483.          END
  484. SENFILE  CSECT
  485.          STM   14,12,12(13)
  486.          BALR  12,0
  487.          USING *,12
  488.          ST    13,SAVE+4
  489.          LA    13,SAVE
  490. ***********************************************************
  491. ** ROUTINE TO SEND A FILE                                **
  492. ***********************************************************
  493.          L     3,0(1)            GET THE ADDRESS OF PACKET
  494.          SR    11,11             CLEAR IT
  495.          IC    11,0(3)           GET THE LENGTH
  496.          BCTR  11,0              DECREMENT BY 1 FOR MVC
  497.          EX    11,MOVELCL        MOVE THE PACKET TO LOCAL
  498.          MVI   INFCB+X'2E',C' '
  499.          MVC   INFCB+X'2F'(53),INFCB+X'2E'
  500.          SH    11,=H'3'          SUBTRACT FOR LEN,SEQ,TYP
  501.          EX    11,MOVEFIL        MOVE THE FILE NAME TO FCB
  502.          LA    1,=A(INFCB+X'2E')
  503.          L     15,=V(KRMTUC)
  504.          BALR  14,15
  505.          MVC   FILECMD+12(54),INFCB+X'2E'
  506.          LA    1,=A(PACKET)      SET UP PARM FOR SUB CALL
  507.          L     15,=V(KRMTINI)    GET READY TO DO AN INIT
  508.          BALR  14,15             AND OFF WE GO
  509.          CLI   PKTYP,C'E'
  510.          BE    RETURN
  511.          CLI   PKTYP,C'Y'        IS IT AN ACK FOR INIT
  512.          BE    ISOKACK           YES WE CAN GO ON
  513.          B     RETURN
  514. ABORT    TERMD 
  515. ISOKACK  MVI   PKTYP,C'F'        START BUILDING A FILE PACKET
  516.          MVC   PKDAT(54),FILECMD+12
  517.          LA    11,PKDAT+53       POINT TO THE END OF PACKET
  518. LOOKEND  CLI   0(11),C' '        IS THIS A BLANK CHAR
  519.          BNE   HAVEEND 
  520.          BCT   11,LOOKEND        LOOK FOR THE END OF FILENAME
  521. HAVEEND  LA    10,PACKET         GET START OF PACKET
  522.          SR    11,10             GET LENGTH IN 11
  523.          LA    11,1(11)          INCREMENT TO MAKE INCLUSIVE
  524.          STC   11,PKLEN          PUT IT IN THE LENGTH
  525.          BAL   14,INCSEQ
  526.          SR    10,10             CLEAR A TEMP REGISTER
  527.          SR    11,11             CLEAR A SECOND TEMP REGISTER
  528.          LA    1,ARGLIST         SEND ARG LIST OF PACKET,PACKET
  529.          L     15,=V(PACKETIO)
  530.          BALR  14,15             SEND THE F PACKET
  531.          CLI   PKTYP,C'Y'        DID WE GET FILE ACK
  532.          BNE   RETURN
  533.          PRINT NOGEN
  534. FILECMD  FILE  DUMMYFILE
  535.          PRINT GEN
  536.          OPEN INFCB,INPUT        OPEN THE INPUT FILE
  537.          L     11,=V(KRMTPARM)
  538.          SR    7,7
  539.          IC    7,0(11)           GET MAX PACKET LENGTH
  540.          SH    7,=H'3'           SUBTRACT LEN,TYP,SEQ
  541. ***************************************************************
  542. ** WE HAVE SENT AN INIT PACKET (SEE KRMTINI)                 **
  543. ** ALSO HAVE SENT AN F PACKET WITH THE FILE NAME IN IT       **
  544. ** AND THE FILE SHOULD BE OPEN FOR INPUT AT THIS POINT       **
  545. ***************************************************************
  546.          SR    11,11
  547.          SR    4,4               CLEAR A POINTER TO RECORD
  548.          SR    5,5               CLEAR A POINTER TO DATA
  549.          SR    9,9
  550. GETREC   GET   INFCB,RECLEN      GET A RECORD FROM THE FILE
  551.          LH    6,RECLEN          GET LENGTH OF RECORD
  552.          SH    6,=H'4'           SUBTRACT LENGTH OF V REC FORMAT
  553. MOVECHR  IC    11,RECORD(4)      GET NEXT CHARACTER FROM RECORD
  554.          L     8,=V(ETOA)        NEED ADDRESS OF TRANSLATION TABLE
  555.          IC    10,0(11,8)        GET ASCII VALUE OF CHARACTER
  556.          EX    10,TESTBAD        CHECK FOR A NON PRINTABLE CHAR
  557.          BNE   NOZAP             NOT CHANGED TO TILD
  558. ZAPIT    IC    11,=X'6D'         MAKE THIS A TILD CHARACTER
  559. NOZAP    STC   11,TESTCHR        PUT IT IN MEMORY
  560.          CLI   TESTCHR,X'00'     GET RID OF NULLS
  561.          BE    ZAPIT
  562.          CLI   TESTCHR,X'0D'     IS IT A DEL CHARACTER
  563.          BE    ZAPIT             GET RID OF THAT ALSO
  564.          CLI   TESTCHR,X'01'     IS IT A CONTROL A
  565.          BE    ZAPIT
  566.          CLI   TESTCHR,X'FF'
  567.          BE    ZAPIT
  568.          CLI   TESTCHR,C'#'      IS THIS A #
  569.          BNE   NORMCH            NO PROCESS NORMAL
  570.          STC   11,PKDAT(5)       PUT IN FIRST #
  571.          LA    5,1(5)            INCREMENT IN BUFFER
  572.          CR    5,7               WILL THERE BE ROOM FOR NEXT #
  573.          BL    STORECH           YES GO PUT IT IN
  574.          BCTR  5,0               TAKE OFF THE ONE WE PUT IN
  575.          BAL   2,WRITEPK         WRITE THE SHORT PACKET
  576.          IC    11,=C'#'          GET BACK THE #
  577.          STC   11,PKDAT(5)       PUT ONE IN
  578.          LA    5,1(5)            INCREMENT POINTER
  579.          B     STORECH           PUT IN THE SECOND ONE
  580. NORMCH   CLC   TESTCHR,LASTCHR   IS THIS THE SAME AS LAST
  581.          BE    INCCNT            IF SO INC THE REPT COUNT
  582.          SR    9,9               SET CHAR COUNT TO ZERO
  583.          MVC   LASTCHR,TESTCHR   MOVE THIS TO LAST
  584. INCCNT   LA    9,1(9)            INCREMENT BY 1
  585.          CH    9,=H'4'           HOW MANY DO WE HAVE
  586.          BL    STORECH           NOT ENOUGH
  587.          STC   11,PKDAT-1(5)     PUT THE CHAR IN
  588.          IC    11,=X'FF'          GET A TILD
  589.          STC   11,PKDAT-3(5)     PUT TILD IN FOR QUOTE
  590.          L     8,=V(ATOE)        TRANS TO EBCDIC CHAR
  591.          IC    11,32(8,9)        GET ASCII VALUE OF AMT
  592.          STC   11,PKDAT-2(5)
  593.          CH    9,=H'94'
  594.          BL    INCDPTR
  595.          MVI   LASTCHR,X'FE'
  596.          B     INCDPTR
  597. STORECH  STC   11,PKDAT(5)       PUT THE CHARACTER IN OUTPUT
  598.          LA    5,1(5)            INCREMENT DATA POINTER
  599. INCDPTR  LA    4,1(4)            INCREMENT RECORD POINTER
  600.          CR    5,7               IS MORE ROOM IN PACKET
  601.          BL    CHECKREC          IF YES IS MORE DATA IN REC
  602. SKIPWRT  BAL   2,WRITEPK         WRITE A PACKET
  603. CHECKREC CR    4,6               IS MORE DATA IN CURRENT RECORD
  604.          BL    MOVECHR           PROCESS REST OF RECORD
  605.          SR    9,9               SET REPT COUNT TO ZERO
  606.          LR    11,5              GET LENGTH USED IN PACKET
  607.          LA    11,4(11)           WILL THERE BE ROOM FOR QUOTED CHAR
  608.          CR    11,7
  609.          BNL   SKIPWRT           WE HAVE ROOM NO NEED TO WRITE
  610.          IC    11,=C'#'          GET A PREFIX CHAR
  611.          STC   11,PKDAT(5)       PUT IT IN THE RECORD
  612.          IC    11,=C'M'          GET A 'M' FOR ^M
  613.          LA    5,1(5)            INCREMENT BY 1
  614.          STC   11,PKDAT(5)       PUT IT IN THE RECORD
  615.          IC    11,=C'#'          QUOTE AGAIN
  616.          LA    5,1(5)            GO TO NEXT POSITION
  617.          STC   11,PKDAT(5)
  618.          LA    5,1(5)
  619.          IC    11,=C'J'
  620.          STC   11,PKDAT(5)
  621.          LA    5,1(5)            RECORD IS FINISHED
  622.          SR    4,4               CLEAR RECORD POINTER FOR NEXT
  623.          CR    5,7               DID WE FILL THE BUFFER
  624.          BL    GETREC
  625.          BAL   2,WRITEPK         GO TO LOCAL RTN TO WRITE PACKET
  626.          B     GETREC            GO GET ANOTHER RECORD
  627. INCSEQ   IC    11,PKSEQ
  628.          LA    11,1(11)
  629.          STC   11,PKSEQ
  630.          NI    PKSEQ,63
  631.          BR    14
  632. WRITEPK  MVI   PKTYP,C'D'        SET PACKET TYPE TO DATA
  633.          SR    11,11
  634.          BAL   14,INCSEQ
  635.          LA    5,3(5)            ADD FOR LEN,TYPE,SEQ
  636.          STC   5,PKLEN           STORE IT IN THE LENGTH
  637.          LA    1,ARGLIST         GET ADDRESS LIST FOR SUB CALL
  638.          L     15,=V(PACKETIO)   GET ROUTINE TO WRITE PACKET
  639.          BALR  14,15             AND WRITE IT OUT
  640.          CLI   PKTYP,C'Y'        DID WE GET AN ACK
  641.          BNE   ERRCLS            NO ABORT THIS RUN
  642.          SR    5,5               THE NEW PACKET IS EMPTY
  643.          SR    9,9               REPT COUNT IS ZERO
  644.          BR    2                 GO BACK TO CALLER
  645. EOF      LTR   5,5               WAS THERE DATA IN A PACKET
  646.          BZ    WRITEZ            NO CLOSE THE TRANSMISSION
  647.          BAL   2,WRITEPK         WRITE LAST PACKET
  648. WRITEZ   MVI   PKTYP,C'Z'        END OF FILE PACKET
  649.          CLOSE INFCB             REMEMBER TO CLOSE THE INPUT 
  650.          SR    11,11
  651.          BAL   14,INCSEQ
  652.          MVI   PKLEN,X'03'       SET LENGTH TO 3
  653.          LA    1,ARGLIST         GET READY TO CALL PACKETIO
  654.          L     15,=V(PACKETIO)
  655.          BALR  14,15             SEND THAT PACKET GET AN ACK
  656.          CLI   PKTYP,C'E'
  657.          BE    RETURN
  658.          CLI   PKTYP,C'Y'        WAS IT AN ACK
  659.          BNE   RETURN            LETS GET A DUMP
  660.          MVI   PKTYP,C'B'        BUILD A BREAK PACKET
  661.          BAL   14,INCSEQ
  662.          MVI   PKLEN,X'03'       SET THE LENGTH TO 3
  663.          L     15,=V(PACKETIO)
  664.          BALR  14,15
  665.          CLI   PKTYP,C'E'
  666.          BE    RETURN
  667.          CLI   PKTYP,C'Y'        THE BREAK SHOULD BE ACKED
  668.          BNE   RETURN            IF NOT ABORT AGAIN
  669. RETURN   SR    11,11
  670.          IC    11,PKLEN          GET THE LENGTH
  671.          BCTR  11,0              DECREMENT BY 1
  672.          EX    11,MOVEBK         MOVE THE PACKET BACK TO CALLER
  673.          L     13,SAVE+4         GET WHERE I PUT CALLERS REGISTERS
  674.          LM    14,12,12(13)      RESTORE THOSE REGISTERS
  675.          SR    15,15             ALL OK
  676.          BR    14
  677. NOFILE   LA    1,=A(D33ERR,PACKET)
  678.          L     15,=V(PACKETIO)
  679.          BALR  14,15
  680.          B     RETURN
  681. ERRCLS   CLOSE INFCB
  682.          B     RETURN
  683. SAVE     DS    18F
  684. D33ERR   DC    YL1(ED33-*)
  685. D33PKN   DC    X'00'
  686. D33PKT   DC    C'E'
  687. D33PKD   DC    C'OPEN ERROR OCCURED ON FILE OPEN'
  688. ED33     EQU   *
  689. ARGLIST  DC    A(PACKET)
  690.          DC    A(PACKET)
  691. PACKET   DS    0F
  692. PKLEN    DS    XL1
  693. PKSEQ    DS    XL1
  694. PKTYP    DS    CL1
  695. PKDAT    DS    CL150
  696. MOVELCL  MVC   PACKET(1),0(3)    TARGET MOVE TO GO TO LOCAL STORAGE
  697. MOVEBK   MVC   0(1,3),PACKET     TARGET MOVE TO GOT BACK TO CALLER
  698. MOVEFIL  MVC   INFCB+X'2E'(1),PKDAT
  699. TESTBAD  CLI   BADCHR,X'00'
  700. BADCHR   DC    X'03'
  701. TESTCHR  DS    CL1
  702. LASTCHR  DS    CL1
  703.          PRINT NOGEN
  704.          DS    0D
  705. INFCB    FCB   LINK=KRMOUT,FCBTYPE=SAM,RECFORM=V,EXIT=EXLST
  706. EXLST    EXLST COMMON=NOFILE,EOFADDR=EOF
  707. UNIREC   DS    0F
  708. RECLEN   DS    H
  709. REDFIL   DS    CL2
  710. RECORD   DS    CL1000
  711.          END
  712. RECFILE  CSECT
  713.          STM   14,12,12(13)
  714.          BALR  12,0
  715.          USING *,12
  716.          ST    13,SAVE+4
  717.          LA    13,SAVE           SET UP MY SAVE AREA
  718. ***********************************************************
  719. ** ROUTINE TO RECIEVE A FILE FROM REMOTE KERMIT          **
  720. ** FIRST WE MUST CHECK FOR AN S TYPE PACKET WHICH WOULD  **
  721. ** REQUIRE WE ACK WITH INIT PARAMS USING KRMTINI ROUTINE **
  722. ***********************************************************
  723.          L     2,0(1)            GET ADDRESS OF PACKET
  724.          IC    11,0(2)           GET THE LENGTH OF THE PACKET
  725.          BCTR  11,0              DECREMENT BY 1 FOR MVC
  726.          EX    11,MOVELCL        MOVE TO LOCAL STORAGE
  727.          CLI   PKTYP,C'S'        IS IT THE INIT PACKET
  728.          BNE   SKIPINI           IF NOT WE DONT NEED INIT
  729.          LA    1,=A(PACKET)      SET UP AN ARG LIST FOR CALL
  730.          L     15,=V(KRMTINI)    GET ADDRESS OF INIT ROUTINE
  731.          BALR  14,15             OFF WE GO FOR THE INIT
  732.          CLI   PKTYP,C'E'
  733.          BE    RETURN
  734. ************************************************************
  735. ** HAVING INIT THE CONNECTION IT IS TIME TO SET UP THE    **
  736. ** FILE TO BE TRANSFERED                                  **
  737. ************************************************************
  738. SKIPINI  CLI   PKTYP,C'F'        SHOULD BE A FILE NAME
  739.          BNE   RETURN            WE REALLY NEED A FILE NAME
  740.          L     11,=V(KRMTPARM)   GET ADDRESS OF INIT PARAM
  741.          MVC   CTLCHR,5(11)      GET THE CONTROL QUOTE CHAR
  742.          MVC   REPTCHR,8(11)     GET THE REPT QUOTE CHAR
  743.          MVI   FILEFCB+X'2E',C' ' 
  744.          MVC   FILEFCB+X'2F'(53),FILEFCB+X'2E'
  745.          IC    11,PKLEN          GET LENGTH OF PACKET
  746.          SH    11,=H'4'          SUBTRACT LEN,SEQ,TYP,+1
  747.          EX    11,MOVENAME       MOVE NAME IN CLEAN FIELD
  748.          LA    1,=A(FILEFCB+X'2E')
  749.          L     15,=V(KRMTUC)
  750.          BALR  14,15             CONVERT FILENAME TO UPPER CASE
  751.          MVC   FILECMD+12(54),FILEFCB+X'2E'
  752. FILECMD  FILE  DUMMYFILE
  753. OPENFL   OPEN  FILEFCB,OUTPUT    OPEN THE FILE
  754. *************************************************************
  755. ** FILE IS OPEN AND WE ARE READY TO START THE TRANSFER     **
  756. ** WE SHOULD BE PROCESSING 'D' PACKETS AT THIS TIME        **
  757. **  P.S. SORRY ABOUT THE SLOPPY WAY OF REFF FILE NAME IN   **
  758. **       UNIVAC FCB = FCB+X'2E' IT WASN'T WORTH THE COMPILE**
  759. **       TIME TO INCLUDE THE IDFCB AND COVER IT WITH A REG **
  760. *************************************************************
  761.          MVC   PKASEQ,PKSEQ
  762.          LA    1,=A(PKACK,PACKET)
  763.          L     15,=V(PACKETIO)   ACK FILE NAME GET FIRST D
  764.          BALR  14,15
  765.          CLI   PKTYP,C'D'
  766.          BNE   ERRCLS
  767.          SR    10,10             CLEAR RECORD POINTER
  768.          SR    8,8               CLEAR TEMP REG
  769.          SR    9,9               START AT BEG OF DATA FIELD
  770.          SR    11,11             CLEAR REG FOR COUNT
  771.          IC    11,PKLEN          PUT IN THE LENGTH
  772.          SH    11,=H'3'          REMOVE LEN TYP AND SEQ FIELDS
  773. LOOPCHR  BAL   4,GETNEXT         GET THE NEXT CHARACTER IN 8
  774.          EX    8,TESTCTL         TEST FOR A CONTROL PREFIX
  775.          BE    PROCCTL           PROCESS A CONTROL CHAR
  776.          EX    8,TESTREPT        TEST FOR REPT
  777.          BE    PROCREPT          PROCESS THE REPT CHAR
  778.          EX    8,TESTEND
  779.          BE    PROCEND           PROCESS AN END OF FILE
  780. TAKECHR  STC   8,RECORD(10)      PUT IT IN THE RECORD
  781.          LA    10,1(10)          INCREMENT RECORD POINTER
  782.          C     10,=F'2000'       HAVE WE REACHED THE END OF REC
  783.          BE    ENDFILE           PRETEND WE HAD A LINE FEED
  784.          B     LOOPCHR           GO FOR MORE 
  785. PROCCTL  BAL   4,GETNEXT         GET NEXT CHARACTER
  786.          STC   8,TEMPCHR         PUT IN MEMORY FOR CLI
  787.          CLI   TEMPCHR,C'M'      IS IT A CARRAGE RETURN ^M
  788.          BE    LOOPCHR           WE DONT NEED IT
  789.          CLI   TEMPCHR,C'J'      IS IT A LINE RETURN
  790.          BE    ENDREC            YES WRITE THE RECORD
  791.          CLI   TEMPCHR,C'#'      IS THIS A # SIGN QUOTED WITH A #
  792.          BE    TAKECHR           WELL WE WILL KEEP IT
  793.          IC    8,=X'FF'          GIVE THEM A FLAG OF BAD CHAR
  794.          B     TAKECHR           PUT IT IN THE OUTPUT REC
  795. ENDREC   LTR   10,10             IS THERE ANY LENGTH TO REC
  796.          BNZ   WRITEOK           YES NO BLANK NEEDED
  797.          LA    10,1(10)          ADD 1 TO LENGTH
  798.          IC    1,=C' '
  799.          STC   1,RECORD(10)      PUT A BLANK IN THE RECORD
  800. WRITEOK  AH    10,=H'4'          ADD FOR UNIVAC V REC
  801.          STH   10,RECLEN         PUT IT IN THE LENGTH
  802.          MVC   RECFIL,=C'   '    PUT IN V FILL CHARS
  803.          PUT   FILEFCB,RECLEN    WRITE THE RECORD (USING MOVE MODE)
  804.          SR    10,10             CLEAR THE RECORD POINTER
  805.          B     LOOPCHR           GO PROCESS MORE CHARACTERS
  806. PROCREPT BAL   4,GETNEXT         GET THE NEXT CHAR(REPT COUNT)
  807.          L     5,=V(ETOA)        NEED IT IN ASCII
  808.          IC    8,0(5,8)          CHANGE IT
  809.          SH    8,=H'32'          MOVE IT DOWN FROM PRINTABLE
  810.          LR    7,8               HOLD THAT COUNT
  811.          BAL   4,GETNEXT         AND WHAT CHAR DO WE NEE
  812.          EX    8,TESTCTL         IS THE REPT CHAR A CTL
  813.          BNE   LOOPINS           GOOD NO INSERT IT
  814.          BAL   4,GETNEXT         WHAT IS THE UNCTL CHAR
  815.          STC   8,TEMPCHR         PUT IN MEMORY
  816.          CLI   TEMPCHR,C'J'      IS IT A LINEFEED
  817.          BE    WRITEBLK          WRITE THIS AND BLANK LINES
  818.          CLI   TEMPCHR,C'#'      IS THIS A LOUSY # SIGN
  819.          BE    LOOPINS           WELL WE WILL KEEP IT
  820.          IC    8,=X'FF'          CHANGE IT TO FLAG CHAR
  821. LOOPINS  STC   8,RECORD(10)      PUT IT IN THE RECORD
  822.          LA    10,1(10)          GO UP BY 1
  823.          BCT   7,LOOPINS         KEEP DOING IT FOR COUNT IN 7
  824.          B     LOOPCHR           GO FOR MORE
  825. WRITEBLK AH    10,=H'4'          MAKE THE UNIVAC V RECORD LENGHT
  826.          STH   10,RECLEN         PUT IN RECORD
  827.          MVC   RECFIL,=C'   '    AND BLANKS
  828.          PUT   FILEFCB,RECLEN    WRITE IT
  829.          BCT   7,LOOPBLK         GO FOR MORE(REPT OF 1 LOOSER)
  830.          B     LOOPCHR 
  831. LOOPBLK  PUT   FILEFCB,BLKREC    WRITE A PREFORMATTED BLANK REC
  832.          BCT   7,LOOPBLK         GO BACK FOR MORE
  833.          B     LOOPCHR           GO FOR MORE CHARS.  
  834. ***********************************************************
  835. ** ROUTINE (GETNEXT) TO GET THE NEXT CHARACTER FROM INPUT**
  836. **  IF NECESSARY IT WILL ACK THE LAST PACKET AND GET NEXT**
  837. ***********************************************************
  838. GETNEXT  CR    9,11              ARE THERE MORE IN BUFFER
  839.          BL    TAKENEXT          YES GO GET THE NEXT CHAR
  840. ACKPACK  MVC   PKASEQ,PKSEQ      MOVE THE SEQ NUMBER TO ACK
  841.          LA    1,=A(PKACK,PACKET)
  842.          L     15,=V(PACKETIO)   GO FOR ANOTHER PACKER
  843.          BALR  14,15
  844.          CLI   PKTYP,C'E'
  845.          BE    ERRCLS
  846.          SR    9,9               SET POINTER TO BEG OF PACKET
  847.          IC    11,PKLEN          PUT LENGTH IN 11
  848.          SH    11,=H'3'          DECREMENT FOR LEN,TYP,SEQ
  849. TAKENEXT CLI   PKTYP,C'D'        IS THIS A DATA PACKET
  850.          BNE   ENDFILE           YES SEND A ^B TO END FILE
  851.          IC    8,PKDAT(9)        GIVE HIM THE CHARACTER
  852.          LA    9,1(9)            INCREMENT DATA POINTER
  853.          BR    4                 GO BACK TO CALLER
  854. ENDFILE  IC    8,=X'02'          GIVE HIM A ^B
  855.          BR    4                 AND GO BACK
  856. ***********************************************************
  857. ** ROUTINE ON END OF FILE                                **
  858. ***********************************************************
  859. PROCEND  LTR   10,10             IS ANYTHING IN BUFFER
  860.          BZ    SKIPWRT           NOTHING TO WRITE
  861.          AH    10,=H'4'          ADD FOR V TYPE REC
  862.          STH   10,RECLEN         PUT IN THE RECORD
  863.          MVC   RECFIL,=C'   '    PUT IN BLANK FOR FILL
  864.          PUT   FILEFCB,RECLEN    AND WRITE IT TO THE FILE
  865. SKIPWRT  CLOSE FILEFCB           CLOSE THE FILE
  866.          CLI   PKTYP,C'Z'        IS THIS A REAL END OF FILE
  867.          BNE   RETURN            DONT KNOW WHAT ELSE IT IS  
  868.          MVC   PKASEQ,PKSEQ      ACK THE END OF FILE
  869.          LA    1,=A(PKACK,PACKET)
  870.          L     15,=V(PACKETIO)   GET THE NEXT PACKET
  871.          BALR  14,15
  872.          CLI   PKTYP,C'E'
  873.          BE    RETURN
  874. DONEXT   CLI   PKTYP,C'F'        IS THIS A NEW FILE HEADER
  875.          BE    SKIPINI           START ANOTHER FILE
  876.          CLI   PKTYP,C'B'        IS THIS A BREAK IN TRANS
  877.          BNE   RETURN
  878.          MVC   PKASEQ,PKSEQ      GET READY TO ACK BREAK
  879.          LA    1,=A(PKACK,PACKET)
  880.          L     15,=V(PACKETIO)
  881.          BALR  14,15
  882. RETURN   IC    11,PKLEN          GET THE LENGTH OF PACKET
  883.          BCTR  11,0              DECREMENT BY 1
  884.          EX    11,MOVEBK         MOVE IT BACK (REM REG 2)
  885.          L     13,SAVE+4         GET ADDRESS OF OUT REGS
  886.          LM    14,12,12(13)      RESTORE THE REGISTERS
  887.          SR    15,15             ALL IS OK
  888.          BR    14                BACK WE GO TO CALLER
  889. BADOPN   LA    1,=A(BADPK,PACKET)
  890.          L     15,=V(PACKETIO)
  891.          BALR  14,15
  892.          B     RETURN
  893. ERRCLS   CLOSE FILEFCB
  894.          B     RETURN
  895. ABORT    TERMD 
  896.          LTORG
  897. SAVE     DS    18F
  898. TEMPCHR  DS    CL1
  899. MOVEBK   MVC   0(1,2),PACKET
  900. TESTCTL  CLI   CTLCHR,X'00'
  901. TESTREPT CLI   REPTCHR,X'00'
  902. TESTEND  CLI   ENDCHR,X'00'
  903. MOVELCL  MVC   PACKET(0),0(2)
  904. MOVENAME MVC   FILEFCB+X'2E'(1),PKDAT
  905. CTLCHR   DC    C'#'
  906. REPTCHR  DC    C'_'
  907. ENDCHR   DC    X'02'
  908. BADPK    DC    YL1(ENDBAD-*)
  909.          DC    X'00'
  910.          DC    C'E'
  911.          DC    C'OPEN FAILED FOR OUTPUT FILE'
  912. ENDBAD   EQU   *
  913. PACKET   DS    0F
  914. PKLEN    DS    XL1
  915. PKSEQ    DS    XL1
  916. PKTYP    DS    XL1
  917. PKDAT    DS    CL150
  918. PKACK    DS    0F
  919. PKALEN   DC    X'03'
  920. PKASEQ   DS    XL1 
  921. PKATYP   DC    C'Y'
  922. BLKREC   DC    H'5'
  923.          DC    C'    '
  924. EXPRM    EXLST COMMON=BADOPN,OPENER=BADOPN
  925. FILEFCB  FCB   FCBTYPE=SAM,LINK=KRMFL,RECFORM=V,EXIT=EXPRM
  926. RECLEN   DS    H
  927. RECFIL   DS    CL2
  928. RECORD   DS    CL2000
  929.          END
  930.