home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / mtsasm / mtsker.asm next >
Assembly Source File  |  2020-01-01  |  44KB  |  1,635 lines
  1. KERMIT     TITLE 'Kermit -- MTS Version'
  2. *     The Kermit protocol was designed at Columbia University in
  3. *     in New York by Frank da Cruz, Bill Catchings and Daphne Tzoar.
  4. *
  5. *     Copyright (c) 1983  Myrias Research Corporation
  6. *     All rights reserved.
  7. *
  8. *     This grotty piece of trash thrown together by Chris Thomson.
  9.      SPACE 2
  10. *     This program is invoked by:
  11. *
  12. *     $run kermit [scards=in] [sprint=out] [0=*net*] [par={s|m}]
  13. *
  14. *           s=server mode; m=master mode
  15. *
  16. *     If no par= is given, and 0 is assigned, then the default is
  17. *     master mode; if 0 is not assigned, the default is server.
  18. *     In master mode, commands are read from scards and output is
  19. *     sent to sprint.  If you want to set any non-default parameters
  20. *     before entering server mode, use par=m.  See set command for
  21. *     parameters.
  22.      TITLE 'Initialization'
  23.      PRINT NOGEN
  24. KERMIT     CSECT
  25.      REQU  TYPE=DEC
  26.      SAVE  (14,12),,*      Standard linkage
  27.      LR    R12,R15
  28.      USING KERMIT,R12
  29.      LA    R11,2048(,R12)
  30.      LA    R11,2048(,R11)
  31.      USING KERMIT+4096,R11
  32.      LA    R10,2048(,R11)
  33.      LA    R10,2048(,R10)
  34.      USING KERMIT+8192,R10
  35.      LA    R15,SAVEAREA
  36.      ST    R13,4(,R15)
  37.      ST    R15,8(,R13)
  38.      LR    R13,R15
  39.      LR    R2,R1          Save parameter, if any
  40.      MVI   SERVER,1       Server if no unit 0
  41.      MVI   NETDEV,X'FF'      Assume no net device
  42.      MVI   FILETYPE,C'T'      Default to filetype=text
  43.      MVI   EOLCHAR,13      Default to eolchar=13 (CR)
  44.      MVI   EOLCHAR2,13
  45.      XC    NPAD,NPAD      No outbound padding
  46.      MVI   PADCHAR,0      Pad character of NUL
  47.      MVI   DEBUG,0          Debugging output off
  48.      LA    R1,=C'-DEBUG(*L+1) ' But set up unit just in case
  49.      CALL  GETFD
  50.      ST    R0,DEBUNIT
  51.      SR    R0,R0          Get info about unit 0
  52.      CALL  GDINFO
  53.      LTR   R15,R15
  54.      BNZ   INIT30
  55.      MVI   SERVER,0
  56.      CLI   13(R1),9       Error if not net
  57.      BE    INIT10
  58.      SPRINT ' Unit 0 must be a network device'
  59.      B     ERREXIT
  60. INIT10     L     R3,36(,R1)      FDname of device
  61.      LH    R4,0(,R3)      Length of it
  62.      S     R4,=F'1'
  63.      C     R4,=F'31'
  64.      BNH   INIT20
  65.      SPRINT ' Unit 0 FDname too long'
  66.      B     ERREXIT
  67. INIT20     MVC   NETDEV(32),=CL32' ' Copy device name for connect cmd
  68.      EX    R4,NDMVC
  69.      SR    R0,R0          Free gdinfo area
  70.      CALL  FREESPAC
  71.      B     INIT30
  72. NDMVC     MVC   NETDEV(*-*),2(R3)
  73. INIT30     LTR   R2,R2
  74.      BZ    INIT60          No parameter
  75.      L     R2,0(,R2)
  76.      LTR   R2,R2
  77.      BZ    INIT60
  78.      CLC   0(2,R2),=H'0'
  79.      BE    INIT60
  80.      CLC   0(2,R2),=H'1'      Parameter must be 1 character
  81.      BNE   INIT50
  82.      CLI   2(R2),C'S'      Parameter can override server/master
  83.      BNE   INIT40          default value
  84.      MVI   SERVER,1
  85.      B     INIT60
  86. INIT40     CLI   2(R2),C'M'
  87.      BNE   INIT50
  88.      MVI   SERVER,0
  89.      B     INIT60
  90. INIT50     SERCOM ' Invalid par field'
  91.      B     ERREXIT
  92. INIT60     LA    R1,PFXPAR      Set prefix to Kermit-MTS>
  93.      CALL  CUINFO
  94.      B     MAINLOOP
  95.      TITLE 'Main command loop'
  96. MAINLOOP CLI   SERVER,0       Are we a server?
  97.      BZ    LOCCMD          No -- read a local command
  98.      B     REMCMD          Yes -- read a remote command
  99.      SPACE 1
  100. ABORT     CLI   NETDEV,X'FF'
  101.      BE    ABORT10
  102.      SPRINT ' Aborted -- try again'
  103.      MVI   PACKET,ASCB      Send break packet
  104.      MVI   WPCKTNUM,0
  105.      LA    R1,1
  106.      BAL   R9,WRPACKET
  107.      B     MAINLOOP
  108. ABORT10  MVC   PACKET(21),=C'EAborted -- try again'
  109.      MVI   WPCKTNUM,0
  110.      LA    R1,21
  111.      BAL   R9,TRETOA
  112.      BAL   R9,WRPACKET
  113.      B     MAINLOOP
  114.      SPACE 1
  115. ERRPCKT  BAL   R9,TRATOE
  116.      MVC   SCBUF(15),=C' Remote error: ' Use scards buffer
  117.      S     R1,=F'2'
  118.      BL    ERRP10
  119.      EX    R1,ERRPMVC
  120. ERRP10     LA    R1,16(,R1)
  121.      STH   R1,SCLEN
  122.      CALL  SPRINT,(SCBUF,SCLEN,SCMOD,SCLNUM)
  123.      B     MAINLOOP
  124. ERRPMVC  MVC   SCBUF+15(*-*),PACKET+1
  125.      SPACE 1
  126. WRTFERR  CLI   NETDEV,X'FF'
  127.      BE    WRTFE10
  128.      SPRINT ' Bad return code writing to file'
  129.      MVI   PACKET,ASCB      Send break packet
  130.      MVI   WPCKTNUM,0
  131.      LA    R1,1
  132.      BAL   R9,WRPACKET
  133.      B     MAINLOOP
  134. WRTFE10  MVC   PACKET(32),=C'EBad return code writing to file'
  135.      MVI   WPCKTNUM,0
  136.      LA    R1,32
  137.      BAL   R9,TRETOA
  138.      BAL   R9,WRPACKET
  139.      B     MAINLOOP
  140.      SPACE 1
  141. PTOOLONG CLI   NETDEV,X'FF'
  142.      BE    PTL10
  143.      SPRINT ' Packet too long -- aborting'
  144.      MVI   PACKET,ASCB      Send break packet
  145.      MVI   WPCKTNUM,0
  146.      LA    R1,1
  147.      BAL   R9,WRPACKET
  148.      B     MAINLOOP
  149. PTL10     MVC   PACKET(28),=C'EPacket too long -- aborting'
  150.      MVI   WPCKTNUM,0
  151.      LA    R1,28
  152.      BAL   R9,TRETOA
  153.      BAL   R9,WRPACKET
  154.      B     MAINLOOP
  155.      SPACE 1
  156. ERREXIT  LA    R15,4
  157.      B     COMEXIT
  158. EXIT     SR    R15,R15
  159. COMEXIT  L     R13,4(,R13)      Standard return sequence
  160.      L     R14,12(,R13)
  161.      LM    R0,R12,20(R13)
  162.      BR    R14
  163.      TITLE 'Server command loop'
  164. REMCMD     MVI   WPCKTNUM,0
  165.      BAL   R9,RDPACKET      Get a packet -- this may take a while
  166.      BNZ   REMCMDE
  167.      BAL   R9,TRATOE
  168.      CLI   PACKET,C'S'      Send-initiate
  169.      BE    GOTS
  170.      CLI   PACKET,C'R'      Receive-initiate
  171.      BE    GOTR
  172.      CLI   PACKET,C'C'
  173.      BE    DOCMD
  174.      CLI   PACKET,C'G'
  175.      BE    GOTG
  176.      MVC   PACKET(38),=C'EUnsupported or invalid server request'
  177.      LA    R1,38
  178.      BAL   R9,TRETOA
  179.      BAL   R9,WRPACKET
  180.      B     MAINLOOP
  181. REMCMDE  MVI   PACKET,ASCN
  182.      LA    R1,1
  183.      BAL   R9,WRPACKET
  184.      B     MAINLOOP
  185.      SPACE 1
  186. GOTR     LR    R2,R1          Set up to merge with SEND
  187.      LA    R1,PACKET+1
  188.      S     R2,=F'1'
  189.      LA    R3,0(R1,R2)
  190.      MVI   0(R3),X'FF'
  191.      BH    SENDSRV          *** cc set above ***
  192.      MVC   PACKET(37),=C'EMissing file spec in rcv-init packet'
  193.      LA    R1,37
  194.      BAL   R9,TRETOA
  195.      BAL   R9,WRPACKET
  196.      B     MAINLOOP
  197.      SPACE 1
  198. DOCMD     S     R1,=F'1'       Execute an MTS command
  199.      ST    R1,CMDLEN
  200.      LA    R1,PACKET+1
  201.      ST    R1,CMDPTR
  202.      LA    R1,CMDPTR
  203.      CALL  CMD
  204.      MVI   PACKET,ASCY      Send ack
  205.      LA    R1,1
  206.      BAL   R9,WRPACKET
  207.      B     MAINLOOP
  208.      SPACE 1
  209. GOTG     CLI   PACKET+1,C'L'
  210.      BE    SLOGOUT
  211.      CLI   PACKET+1,C'F'
  212.      BE    SFINISH
  213.      MVC   PACKET(42),=C'EOnly F and L server generics supported'
  214.      LA    R1,42
  215.      BAL   R9,TRETOA
  216.      BAL   R9,WRPACKET
  217.      B     MAINLOOP
  218.      SPACE 1
  219. SFINISH  MVI   PACKET,ASCY      Send acknowledgement
  220.      LA    R1,1
  221.      BAL   R9,WRPACKET
  222.      B     EXIT
  223.      SPACE 1
  224. SLOGOUT  MVI   PACKET,ASCY      Send acknowledgement
  225.      LA    R1,1
  226.      BAL   R9,WRPACKET
  227.      CMD   '$SIGNOFF $'
  228.      DC    H'0'
  229.      TITLE 'Master command loop'
  230. LOCCMD     CALL  SCARDS,(SCBUF,SCLEN,SCMOD,SCLNUM)
  231.      LA    R1,SCBUF
  232.      LH    R2,SCLEN
  233.      EX    R2,CMDTR
  234.      LA    R3,0(R1,R2)
  235.      MVI   0(R3),X'FF'      Delimit the command for easy parsing
  236.      BAL   R9,SPNBL       Span blanks on the front
  237.      CLI   0(R1),C'$'      Check for MTS command
  238.      BNE   CMD10
  239.      CMD   (R1),(R2)      Perform MTS command
  240.      B     MAINLOOP
  241. CMD10     LR    R3,R1
  242.      BAL   R9,BRKBL       Break on a blank
  243.      LR    R4,R1          Length of word
  244.      SR    R4,R3
  245.      S     R4,=F'1'       (-1 for ex)
  246.      BL    MAINLOOP       Line was all blank
  247.      LA    R5,CMDTAB      Point at command table
  248. CMD20     C     R4,4(,R5)      Meet minimum length requirement?
  249.      BL    CMD30          No
  250.      EX    R4,CMDCLC      Match prefix of command?
  251.      BNE   CMD30          No
  252.      L     R3,0(,R5)      Yes -- branch to handler
  253.      BR    R3
  254. CMD30     LA    R5,CMDELEN(,R5)      Next command table entry
  255.      CLC   0(4,R5),=F'0'      Error if end of table
  256.      BNE   CMD20
  257.      SPRINT ' Invalid command.  Valid commands are:'
  258.      SPRINT ' bye, connect, display, exit, finish, help, logout,'
  259.      SPRINT ' receive, set, send, server, show, stop, and ?'
  260.      B     MAINLOOP
  261. CMDTR     TR    0(*-*,R1),LCUC
  262. CMDCLC     CLC   0(*-*,R3),8(R5)
  263.      SPACE 1
  264. SPNBL     CLI   0(R1),C' '      Skip over blanks to end of line
  265.      BNER  R9
  266.      LA    R1,1(,R1)
  267.      S     R2,=F'1'
  268.      BH    SPNBL
  269.      BR    R9
  270.      SPACE 1
  271. BRKBL     CLI   0(R1),C' '      Stop at a blank or end of line
  272.      BER   R9
  273.      LTR   R2,R2
  274.      BZR   R9
  275.      LA    R1,1(,R1)
  276.      S     R2,=F'1'
  277.      BH    BRKBL
  278.      BR    R9
  279.      SPACE 1
  280. BRKEQ     CLI   0(R1),C'='      Stop at an = or end of line
  281.      BER   R9
  282.      LTR   R2,R2
  283.      BZR   R9
  284.      LA    R1,1(,R1)
  285.      S     R2,=F'1'
  286.      BH    BRKEQ
  287.      BR    R9
  288.      SPACE 1
  289. *     First word is handler address
  290. *     Second word is minimum abbreviation length minus one
  291. *     Third part is string; must have at least one trailing blank
  292. *     for the parsing code to work correctly
  293. CMDTAB     DC    A(BYE),F'0',CL16'BYE'
  294.      DC    A(CONNECT),F'0',CL16'CONNECT'
  295.      DC    A(SHOW),F'0',CL16'DISPLAY'
  296.      DC    A(EXIT),F'0',CL16'EXIT'
  297.      DC    A(FINISH),F'0',CL16'FINISH'
  298.      DC    A(HELP),F'0',CL16'HELP'
  299.      DC    A(LOGOUT),F'0',CL16'LOGOUT'
  300.      DC    A(RECEIVE),F'0',CL16'RECEIVE'
  301.      DC    A(SET),F'2',CL16'SET'
  302.      DC    A(SEND),F'2',CL16'SEND'
  303.      DC    A(ENSERV),F'2',CL16'SERVER'
  304.      DC    A(SHOW),F'1',CL16'SHOW'
  305.      DC    A(EXIT),F'1',CL16'STOP'
  306.      DC    A(HELP),F'0',CL16'?'
  307.      DC    A(0)
  308. CMDELEN  EQU   24
  309.      TITLE 'Commands -- server, bye, logout, finish'
  310. ENSERV     MVI   SERVER,1
  311.      B     MAINLOOP
  312.      SPACE 1
  313. BYE     XC    RETRYCNT,RETRYCNT
  314. BYEL     L     R1,RETRYCNT
  315.      LA    R1,1(,R1)
  316.      ST    R1,RETRYCNT
  317.      C     R1,MAXRETRY
  318.      BH    ABORT
  319.      MVC   PACKET(2),=C'GL'   Send generic logout packet
  320.      MVI   WPCKTNUM,0
  321.      LA    R1,2
  322.      BAL   R9,TRETOA
  323.      BAL   R9,WRPACKET
  324.      BAL   R9,RDPACKET      Read response
  325.      BNZ   BYEL
  326.      BAL   R9,TRATOE
  327.      CLI   PACKET,C'Y'
  328.      BE    EXIT          Shut down if ack
  329.      CLI   PACKET,C'N'      Loop if nak
  330.      BE    BYEL
  331.      B     ABORT          Others are errors
  332.      SPACE 1
  333. LOGOUT     XC    RETRYCNT,RETRYCNT
  334. LOGOUTL  L     R1,RETRYCNT
  335.      LA    R1,1(,R1)
  336.      ST    R1,RETRYCNT
  337.      C     R1,MAXRETRY
  338.      BH    ABORT
  339.      MVC   PACKET(2),=C'GL'   Send generic logout packet
  340.      MVI   WPCKTNUM,0
  341.      LA    R1,2
  342.      BAL   R9,TRETOA
  343.      BAL   R9,WRPACKET
  344.      BAL   R9,RDPACKET      Read response
  345.      BNZ   LOGOUTL
  346.      BAL   R9,TRATOE
  347.      CLI   PACKET,C'Y'
  348.      BE    MAINLOOP       Next command if ack
  349.      CLI   PACKET,C'N'
  350.      BE    LOGOUTL
  351.      B     ABORT
  352.      SPACE 1
  353. FINISH     XC    RETRYCNT,RETRYCNT
  354. FINISHL  L     R1,RETRYCNT
  355.      LA    R1,1(,R1)
  356.      ST    R1,RETRYCNT
  357.      C     R1,MAXRETRY
  358.      BH    ABORT
  359.      MVC   PACKET(2),=C'GF'   Send generic finish packet
  360.      LA    R1,2
  361.      BAL   R9,TRETOA
  362.      BAL   R9,WRPACKET
  363.      BAL   R9,RDPACKET      Read response
  364.      BNZ   FINISHL
  365.      BAL   R9,TRATOE
  366.      CLI   PACKET,C'Y'
  367.      BE    MAINLOOP       Next command if ack
  368.      CLI   PACKET,C'N'
  369.      BE    FINISHL
  370.      B     ABORT
  371.      TITLE 'Commands -- help, connect, show'
  372. HELP     SPRINT ' The following commands are supported:'
  373.      SPRINT '   $...    an MTS command'
  374.      SPRINT '   bye     log out remote and exit local kermit'
  375.      SPRINT '   connect    emulate terminal on remote system'
  376.      SPRINT '   display    display various set parameters'
  377.      SPRINT '   exit    exit local kermit; remote unaffected'
  378.      SPRINT '   finish    exit but don''t log out remote kermit'
  379.      SPRINT '   help    what you''re reading'
  380.      SPRINT '   receive    receive one or more files'
  381.      SPRINT '   send    send one or more files'
  382.      SPRINT '   server    make local kermit into a server'
  383.      SPRINT '   set     set various parameters'
  384.      SPRINT '   show    save as display'
  385.      SPRINT '   stop    same as exit'
  386.      SPRINT '   ?        same as help'
  387.      SPRINT ' For more on parameters, enter set ?'
  388.      B     MAINLOOP
  389.      SPACE 1
  390. CONNECT  CLI   NETDEV,X'FF'      Is there a network device?
  391.      BNE   CONN10          Yes
  392.      SPRINT ' Unit 0 not assigned to network device'
  393.      B     MAINLOOP
  394. CONN10     SPRINT ' Calling net dsr; use @stop to return to kermit'
  395.      LA    R1,NETCMD
  396.      CALL  CMD
  397.      B     MAINLOOP
  398.      SPACE 1
  399. SHOW     SPRINT ' The following parameter values are set:'
  400.      MVC   SCBUF(12),=C'   filetype='
  401.      CLI   FILETYPE,C'T'
  402.      BNE   SHOW10
  403.      MVC   SCBUF+12(5),=C'text '
  404.      B     SHOW20
  405. SHOW10     MVC   SCBUF+12(5),=C'saved'
  406. SHOW20     LA    R1,17
  407.      STH   R1,SCLEN
  408.      CALL  SPRINT,(SCBUF,SCLEN,SCMOD,SCLNUM)
  409.      MVC   SCBUF(13),=C'   endofline='
  410.      SR    R1,R1
  411.      IC    R1,EOLCHAR
  412.      CVD   R1,WORK
  413.      UNPK  SCBUF+13(2),WORK(8)
  414.      OI    SCBUF+14,C'0'
  415.      LA    R1,15
  416.      STH   R1,SCLEN
  417.      CALL  SPRINT,(SCBUF,SCLEN,SCMOD,SCLNUM)
  418.      MVC   SCBUF(9),=C'   debug='
  419.      CLI   DEBUG,0
  420.      BNE   SHOW30
  421.      MVC   SCBUF+9(3),=C'off'
  422.      B     SHOW40
  423. SHOW30     MVC   SCBUF+9(3),=C'on '
  424. SHOW40     LA    R1,12
  425.      STH   R1,SCLEN
  426.      CALL  SPRINT,(SCBUF,SCLEN,SCMOD,SCLNUM)
  427.      B     MAINLOOP
  428.      TITLE 'Commands -- set'
  429. SET     BAL   R9,SPNBL       Extract parameter=value pair
  430.      CLI   0(R1),C'?'
  431.      BNE   SET10
  432.      SPRINT ' Set parameters are:'
  433.      SPRINT '   filetype    set to text for normal, readable files,+
  434.            '
  435.      SPRINT '        or saved for unformatted byte streams'
  436.      SPRINT '        that have originated on another system'
  437.      SPRINT '        and contain embedded formatting data;'
  438.      SPRINT '        default is text'
  439.      SPRINT '   endofline    set to decimal value of a control'
  440.      SPRINT '        character to be used as end of line'
  441.      SPRINT '        (packet) terminator in send operations;+
  442.            '
  443.      SPRINT '        default is 13 (CR), some systems want'
  444.      SPRINT '        10 (LF); must be 0-31'
  445.      SPRINT '   debug    on or off; puts all packets in -debug'
  446.      B     MAINLOOP
  447. SET10     LR    R3,R1
  448.      BAL   R9,BRKEQ
  449.      LR    R4,R1          Length of parameter
  450.      SR    R4,R3
  451.      S     R4,=F'1'       (-1 for ex)
  452.      BL    SETERR          No operand
  453.      CLI   0(R1),C'='      Must be an =
  454.      BNE   SETERR
  455.      LA    R1,1(,R1)
  456.      S     R2,=F'1'
  457.      LA    R5,SETTAB      Point at parameter table
  458. SET20     C     R4,4(,R5)      Meet minimum length requirement?
  459.      BL    SET30          No
  460.      EX    R4,SETCLC      Match prefix of parameter?
  461.      BNE   SET30          No
  462.      L     R3,0(,R5)      Yes -- branch to handler
  463.      BR    R3
  464. SET30     LA    R5,SETELEN(,R5)      Next parameter table entry
  465.      CLC   0(4,R5),=F'0'      Error if end of table
  466.      BNE   SET20
  467. SETERR     SPRINT ' Invalid set parameter.  Valid parameters are:'
  468.      SPRINT '   filetype=text, filetype=saved'
  469.      SPRINT '   endofline=dd  (dd=0-31)'
  470.      SPRINT '   debug=on, debug=off'
  471.      B     MAINLOOP
  472. SETCLC     CLC   0(*-*,R3),8(R5)
  473.      SPACE 1
  474. *     Parameter table.  Same format as command table.
  475. SETTAB     DC    A(SETFT),F'0',CL16'FILETYPE'
  476.      DC    A(SETEOL),F'0',CL16'ENDOFLINE'
  477.      DC    A(SETDEB),F'0',CL16'DEBUG'
  478.      DC    A(0)
  479. SETELEN  EQU   24
  480.      SPACE 1
  481. SETFT     LTR   R2,R2          Must be something there
  482.      BNH   SETERR
  483.      CLI   0(R1),C'T'      Accept anything that starts with
  484.      BE    SETFTOK          t or s
  485.      CLI   0(R1),C'S'
  486.      BNE   SETERR
  487. SETFTOK  MVC   FILETYPE(1),0(R1)
  488.      BAL   R9,BRKBL       Might be more parameters to set
  489.      BAL   R9,SPNBL
  490.      LTR   R2,R2
  491.      BNH   MAINLOOP
  492.      B     SET10
  493.      SPACE 1
  494. SETEOL     LTR   R2,R2          Must be something there
  495.      BNH   SETERR
  496.      SR    R3,R3          Convert from decimal to binary
  497. SETEOL10 CLI   0(R1),C'0'      the hard way
  498.      BL    SETERR
  499.      CLI   0(R1),C'9'
  500.      BH    SETERR
  501.      MH    R3,=H'10'
  502.      SR    R4,R4
  503.      IC    R4,0(R1)
  504.      S     R4,=A(C'0')
  505.      AR    R3,R4
  506.      C     R3,=F'31'      Maximum allowed is 31
  507.      BH    SETERR
  508.      LA    R1,1(,R1)
  509.      S     R2,=F'1'
  510.      BNH   SETEOL20
  511.      CLI   0(R1),C' '
  512.      BNE   SETEOL10
  513. SETEOL20 STC   R3,EOLCHAR
  514.      BAL   R9,BRKBL       Might be more parameters to set
  515.      BAL   R9,SPNBL
  516.      LTR   R2,R2
  517.      BNH   MAINLOOP
  518.      B     SET10
  519.      SPACE 1
  520. SETDEB     LTR   R2,R2          Must be something there
  521.      BNH   SETERR
  522.      CLC   0(2,R1),=C'ON'      Accept anything that starts with
  523.      BE    SETDEB10       on or of
  524.      CLC   0(2,R1),=C'OF'
  525.      BNE   SETERR
  526.      MVI   DEBUG,0
  527.      B     SETDEB20
  528. SETDEB10 MVI   DEBUG,1
  529. SETDEB20 BAL   R9,BRKBL       Might be more parameters to set
  530.      BAL   R9,SPNBL
  531.      LTR   R2,R2
  532.      BNH   MAINLOOP
  533.      B     SET10
  534.      TITLE 'Commands -- send'
  535. SEND     BAL   R9,SPNBL
  536. SENDSRV  LR    R3,R1          Extract filespec
  537.      BAL   R9,BRKBL
  538.      LR    R4,R1
  539.      BAL   R9,SPNBL
  540.      LTR   R2,R2
  541.      BNH   SEND20
  542.      CLI   SERVER,1
  543.      BE    SEND10
  544.      SPRINT ' Send takes a single file spec argument'
  545.      B     MAINLOOP
  546. SEND10     MVC   PACKET(37),=C'EExtra junk at end of rcv-init packet'
  547.      MVI   WPCKTNUM,0
  548.      LA    R1,37
  549.      BAL   R9,TRETOA
  550.      BAL   R9,WRPACKET
  551.      B     MAINLOOP
  552. SEND20     LR    R1,R3          Point at filespec
  553.      LR    R2,R4
  554.      SR    R2,R1
  555.      BAL   R9,EXPFSPC      Expand filespec
  556.      CLC   NFILES(4),=F'0'
  557.      BH    SEND40
  558.      CLI   SERVER,1
  559.      BE    SEND30
  560.      SPRINT ' File not found'
  561.      B     MAINLOOP
  562. SEND30     MVC   PACKET(15),=C'EFile not found'
  563.      MVI   WPCKTNUM,0
  564.      LA    R1,15
  565.      BAL   R9,TRETOA
  566.      BAL   R9,WRPACKET
  567.      B     MAINLOOP
  568. SEND40     MVI   WPCKTNUM,0      Reset output packet number
  569.      XC    RETRYCNT,RETRYCNT  and retry counter
  570. SEND50     L     R1,RETRYCNT
  571.      LA    R1,1(,R1)
  572.      ST    R1,RETRYCNT
  573.      C     R1,MAXRETRY
  574.      BH    ABORT
  575.      MVI   PACKET,ASCS      Send-init packet
  576.      MVI   PACKET+1,94+32      My max packet length
  577.      MVI   PACKET+2,5+32      Time out in 5 seconds
  578.      MVI   PACKET+3,4+32      4 turnaround pad characters needed
  579.      MVI   PACKET+4,0+64      Use null for pad character
  580.      MVI   PACKET+5,13+32      End of line character (CR)
  581.      MVI   PACKET+6,35      Control character quote (#)
  582.      MVI   PACKET+7,ASCY      I can do 8-bit quoting
  583.      MVI   PACKET+8,49      1-character checksum (1)
  584.      MVI   PACKET+9,126      Repeat prefix character (tilde)
  585.      LA    R1,10
  586.      BAL   R9,WRPACKET
  587.      BAL   R9,RDPACKET
  588.      BNZ   SEND50
  589.      CLI   PACKET,ASCN
  590.      BE    SEND50
  591.      CLI   PACKET,ASCY
  592.      BNE   ABORT
  593.      CLC   RPCKTNUM(1),WPCKTNUM
  594.      BNE   SEND50
  595.      MVC   MPLEN(4),=F'94'      Set defaults
  596.      MVC   NPAD(4),=F'0'
  597.      MVI   PADCHAR,0
  598.      MVC   EOLCHAR2(1),EOLCHAR
  599.      MVI   CTLQT,35
  600.      MVI   BINQT,ASCN
  601.      MVI   RPTCHAR,32
  602.      LR    R2,R1
  603.      S     R2,=F'1'
  604.      BNH   SENDNXTF
  605.      SR    R1,R1          Copy his parameters
  606.      IC    R1,PACKET+1
  607.      S     R1,=F'32'
  608.      ST    R1,MPLEN       Maximum packet length
  609.      S     R2,=F'2'
  610.      BNH   SENDNXTF
  611.      IC    R1,PACKET+3
  612.      S     R1,=F'32'
  613.      ST    R1,NPAD          Number of pad characters
  614.      S     R2,=F'1'
  615.      BNH   SENDNXTF
  616.      IC    R1,PACKET+4
  617.      X     R1,=F'64'
  618.      STC   R1,PADCHAR      Pad character
  619.      S     R2,=F'1'
  620.      BNH   SENDNXTF
  621.      IC    R1,PACKET+5
  622.      S     R1,=F'32'
  623.      STC   R1,EOLCHAR2      End of line character
  624.      S     R2,=F'1'
  625.      BNH   SENDNXTF
  626.      MVC   CTLQT(1),PACKET+6  Control character quote
  627.      S     R2,=F'1'
  628.      BNH   SENDNXTF
  629.      MVC   BINQT(1),PACKET+7  Binary (8-bit) quote character
  630.      S     R2,=F'2'
  631.      BNH   SENDNXTF
  632.      MVC   RPTCHAR(1),PACKET+9 Compression prefix character
  633. SENDNXTF L     R1,NFILES      Open next file
  634.      S     R1,=F'1'
  635.      ST    R1,NFILES
  636.      BL    SBREAK          Sent all of them
  637.      SLL   R1,6          Point at FDname (64 characters)
  638.      A     R1,=A(FILES)
  639.      MVC   FILENAME(64),0(R1) Copy name for file header
  640.      LA    R1,FILENAME
  641.      CALL  GETFD
  642.      LTR   R15,R15
  643.      BZ    SEND80
  644. SEND60     CLI   NETDEV,X'FF'
  645.      BE    SEND70
  646.      SPRINT ' Unable to open file'
  647.      B     SBREAK
  648. SEND70     MVC   PACKET(20),=C'EUnable to open file'
  649.      MVI   WPCKTNUM,0
  650.      LA    R1,20
  651.      BAL   R9,TRETOA
  652.      BAL   R9,WRPACKET
  653.      B     MAINLOOP
  654. SEND80     ST    R0,FDUB
  655.      CALL  GDINFO          Open the file
  656.      LTR   R15,R15
  657.      BNZ   SEND60
  658.      MVC   WORK(1),13(R1)
  659.      SR    R0,R0          Free gdinfo block
  660.      CALL  FREESPAC
  661.      CLI   WORK,X'FF'      Check for type=none
  662.      BE    SEND60
  663.      XC    BUFFCNT,BUFFCNT      File buffer is empty
  664.      MVI   EOFFLAG,0      Not at end of file
  665.      XC    RETRYCNT,RETRYCNT
  666.      IC    R1,WPCKTNUM
  667.      LA    R1,1(,R1)
  668.      STC   R1,WPCKTNUM
  669.      NI    WPCKTNUM,63
  670.      CLI   NETDEV,X'FF'
  671.      BE    SENDFHDR
  672.      MVC   SCBUF(9),=C' Sending '
  673.      MVC   SCBUF+9(64),FILENAME
  674.      LA    R2,73
  675.      SPRINT SCBUF,(R2)
  676. SENDFHDR L     R1,RETRYCNT
  677.      LA    R1,1(,R1)
  678.      ST    R1,RETRYCNT
  679.      C     R1,MAXRETRY
  680.      BH    ABORT
  681.      MVI   PACKET,C'F'      Send file header packet
  682.      MVC   PACKET+1(64),FILENAME
  683.      LA    R1,PACKET+64      Trim trailing blanks off name
  684. SEND90     CLI   0(R1),C' '
  685.      BNE   SEND100
  686.      S     R1,=F'1'
  687.      B     SEND90
  688. SEND100  S     R1,=A(PACKET)
  689.      LA    R1,1(,R1)
  690.      BAL   R9,TRETOA
  691.      BAL   R9,WRPACKET
  692.      BAL   R9,RDPACKET
  693.      BNZ   SENDFHDR
  694.      CLI   PACKET,ASCN
  695.      BNE   SEND110
  696.      IC    R2,RPCKTNUM      Nak for next packet is same as
  697.      A     R2,=F'63'      ack for this packet
  698.      STC   R2,WORK
  699.      NI    WORK,63
  700.      CLC   WORK(1),WPCKTNUM
  701.      BNE   SENDFHDR
  702.      B     SEND120
  703. SEND110  CLI   PACKET,ASCY
  704.      BNE   ABORT
  705.      CLC   WPCKTNUM(1),RPCKTNUM
  706.      BNE   SENDFHDR
  707. SEND120  XC    RETRYCNT,RETRYCNT
  708.      IC    R1,WPCKTNUM
  709.      LA    R1,1(,R1)
  710.      STC   R1,WPCKTNUM
  711.      NI    WPCKTNUM,63
  712.      XC    PCKTLEN,PCKTLEN
  713. SEND130  L     R1,BUFFCNT      Get next character from file
  714.      LTR   R1,R1
  715.      BNZ   SEND160
  716.      CLI   EOFFLAG,0      End of line; also end of file?
  717.      BE    SEND140
  718.      CLC   PCKTLEN(4),=F'0'   End of file; anything in packet?
  719.      BE    SENDEOF
  720.      B     SENDDATA
  721. SEND140  CALL  READ,(BUFFER,BUFLEN,BUFMOD,BUFLNUM,FDUB)
  722.      LTR   R15,R15
  723.      BZ    SEND150
  724.      MVI   EOFFLAG,1
  725.      B     SEND130
  726. SEND150  LH    R1,BUFLEN
  727.      ST    R1,BUFFCNT
  728. SEND160  LH    R0,BUFLEN      Point at next char in buffer
  729.      SR    R0,R1
  730.      A     R0,=A(BUFFER)
  731.      LR    R4,R0
  732.      CLI   RPTCHAR,32      Is compression allowed?
  733.      BE    SEND180          No
  734.      IC    R3,0(,R4)      Tricky clcl to see how many of
  735.      SLL   R3,24          this character there are
  736.      CLCL  R0,R2
  737.      SR    R0,R4          There are this many
  738.      C     R0,=F'4'
  739.      BL    SEND180          Not worth the bother
  740.      C     R0,=F'94'      Can't have too many either
  741.      BNH   SEND170
  742.      LA    R0,94
  743. SEND170  L     R1,BUFFCNT      Consume this many characters
  744.      SR    R1,R0
  745.      ST    R1,BUFFCNT
  746.      L     R1,PCKTLEN      Put out prefix and count
  747.      LA    R2,PACKET+1(R1)
  748.      MVC   0(1,R2),RPTCHAR
  749.      A     R0,=F'32'
  750.      STC   R0,1(,R2)
  751.      LA    R1,2(,R1)
  752.      ST    R1,PCKTLEN
  753.      B     SEND190
  754. SEND180  L     R1,BUFFCNT      Consume one character
  755.      S     R1,=F'1'
  756.      ST    R1,BUFFCNT
  757. SEND190  MVC   WORK(1),0(R4)      Translate char if filetype=text
  758.      CLI   FILETYPE,C'T'
  759.      BNE   SEND200
  760.      TR    WORK(1),ETOA
  761.      B     SEND210          No parity quoting needed
  762. SEND200  TM    WORK,X'80'
  763.      BZ    SEND210
  764.      CLI   BINQT,ASCN      Is binary quoting allowed?
  765.      BE    SEND210          No -- send it the way it is
  766.      L     R1,PCKTLEN      Put out 8-bit prefix
  767.      LA    R2,PACKET+1(R1)
  768.      MVC   0(1,R2),BINQT
  769.      LA    R1,1(,R1)
  770.      ST    R1,PCKTLEN
  771.      NI    WORK,X'7F'
  772. SEND210  CLI   WORK,127       See if control quoting needed
  773.      BE    SEND220
  774.      CLI   WORK,31
  775.      BNH   SEND220
  776.      CLC   WORK(1),CTLQT
  777.      BE    SEND230
  778.      CLI   BINQT,ASCN
  779.      BE    SEND215
  780.      CLC   WORK(1),BINQT
  781.      BE    SEND230
  782. SEND215  CLI   RPTCHAR,32
  783.      BE    SEND240
  784.      CLC   WORK(1),RPTCHAR
  785.      BNE   SEND240
  786.      B     SEND230
  787. SEND220  XI    WORK,64          Not a control char anymore
  788. SEND230  L     R1,PCKTLEN      Put out control prefix
  789.      LA    R2,PACKET+1(R1)
  790.      MVC   0(1,R2),CTLQT
  791.      LA    R1,1(,R1)
  792.      ST    R1,PCKTLEN
  793. SEND240  L     R1,PCKTLEN      Finally, put in the character
  794.      LA    R2,PACKET+1(R1)
  795.      MVC   0(1,R2),WORK
  796.      LA    R1,1(,R1)
  797.      ST    R1,PCKTLEN
  798.      CLC   BUFFCNT(4),=F'0'   One last thing -- put crlf at eol
  799.      BNE   SEND250
  800.      CLI   FILETYPE,C'T'      if filetype=text
  801.      BNE   SEND250
  802.      L     R1,PCKTLEN
  803.      LA    R2,PACKET+1(R1)
  804.      MVC   0(1,R2),CTLQT
  805.      MVI   1(R2),77
  806.      MVC   2(1,R2),CTLQT
  807.      MVI   3(R2),74
  808.      LA    R1,4(,R1)
  809.      ST    R1,PCKTLEN
  810. SEND250  L     R1,PCKTLEN      Have we about filled a packet?
  811.      A     R1,=F'10'
  812.      C     R1,MPLEN
  813.      BL    SEND130          No, loop
  814. SENDDATA L     R1,RETRYCNT
  815.      LA    R1,1(,R1)
  816.      ST    R1,RETRYCNT
  817.      C     R1,MAXRETRY
  818.      BH    ABORT
  819.      MVI   PACKET,ASCD      Send data packet
  820.      L     R1,PCKTLEN
  821.      A     R1,=F'1'
  822.      BAL   R9,WRPACKET
  823.      BAL   R9,RDPACKET
  824.      BNZ   SENDDATA
  825.      CLI   PACKET,ASCN
  826.      BNE   SEND260
  827.      IC    R2,RPCKTNUM      Nak for next packet is same as
  828.      A     R2,=F'63'      ack for this packet
  829.      STC   R2,WORK
  830.      NI    WORK,63
  831.      CLC   WORK(1),WPCKTNUM
  832.      BNE   SENDDATA
  833.      B     SEND120
  834. SEND260  CLI   PACKET,ASCY
  835.      BNE   ABORT
  836.      CLC   WPCKTNUM(1),RPCKTNUM
  837.      BNE   SENDDATA
  838.      XC    PCKTLEN,PCKTLEN      Packet now empty
  839.      B     SEND120          Loop through whole file
  840. SENDEOF  XC    RETRYCNT,RETRYCNT
  841. SENDEOFL L     R1,RETRYCNT
  842.      LA    R1,1(,R1)
  843.      ST    R1,RETRYCNT
  844.      C     R1,MAXRETRY
  845.      BH    ABORT
  846.      MVI   PACKET,ASCZ      Send end of file packet
  847.      LA    R1,1
  848.      BAL   R9,WRPACKET
  849.      BAL   R9,RDPACKET
  850.      BNZ   SENDEOFL
  851.      CLI   PACKET,ASCN
  852.      BNE   SEND270
  853.      IC    R2,RPCKTNUM      Nak for next packet is same as
  854.      A     R2,=F'63'      ack for this packet
  855.      STC   R2,WORK
  856.      NI    WORK,63
  857.      CLC   WORK(1),WPCKTNUM
  858.      BNE   SENDEOFL
  859.      B     SEND280
  860. SEND270  CLI   PACKET,ASCY
  861.      BNE   ABORT
  862.      CLC   WPCKTNUM(1),RPCKTNUM
  863.      BNE   SENDEOFL
  864. SEND280  L     R0,FDUB          Close the file
  865.      CALL  FREEFD
  866.      B     SENDNXTF       Send next file, if any
  867. SBREAK     XC    RETRYCNT,RETRYCNT
  868.      IC    R1,WPCKTNUM
  869.      LA    R1,1(,R1)
  870.      STC   R1,WPCKTNUM
  871.      NI    WPCKTNUM,63
  872. SBREAKL  L     R1,RETRYCNT
  873.      LA    R1,1(,R1)
  874.      ST    R1,RETRYCNT
  875.      C     R1,MAXRETRY
  876.      BH    ABORT
  877.      MVI   PACKET,ASCB      Send break (EOT) packet
  878.      LA    R1,1
  879.      BAL   R9,WRPACKET
  880.      BAL   R9,RDPACKET
  881.      BNZ   SBREAKL
  882.      CLI   PACKET,ASCN
  883.      BNE   SEND290
  884.      IC    R2,RPCKTNUM      Nak for next packet is same as
  885.      A     R2,=F'63'      ack for this packet
  886.      STC   R2,WORK
  887.      NI    WORK,63
  888.      CLC   WORK(1),WPCKTNUM
  889.      BNE   SBREAKL
  890.      B     MAINLOOP
  891. SEND290  CLI   PACKET,ASCY
  892.      BNE   ABORT
  893.      CLC   WPCKTNUM(1),RPCKTNUM
  894.      BNE   SBREAKL
  895.      B     MAINLOOP
  896.      TITLE 'Commands -- receive'
  897. RECEIVE  BAL   R9,SPNBL       Extract file spec, if any
  898.      LR    R3,R1
  899.      BAL   R9,BRKBL
  900.      CR    R1,R3
  901.      BE    REC10          No file spec
  902.      LR    R4,R1
  903.      SR    R4,R3
  904.      S     R4,=F'1'       Copy file spec into packet
  905.      EX    R4,RECFSMVC
  906.      MVI   PACKET,C'R'
  907.      MVI   WPCKTNUM,0
  908.      LA    R1,2(,R4)
  909.      BAL   R9,TRETOA
  910.      BAL   R9,WRPACKET      Send rcv-init packet
  911. REC10     XC    RETRYCNT,RETRYCNT
  912. REC20     L     R1,RETRYCNT
  913.      LA    R1,1(,R1)
  914.      ST    R1,RETRYCNT
  915.      C     R1,MAXRETRY
  916.      BH    ABORT
  917.      BAL   R9,RDPACKET      Wait for send-init packet
  918.      BNE   REC20
  919.      CLI   PACKET,ASCN
  920.      BE    REC20
  921.      CLI   PACKET,ASCS
  922.      BNE   ABORT
  923.      XC    RETRYCNT,RETRYCNT
  924.      B     REC30
  925. RECFSMVC MVC   PACKET+1(*-*),0(R3)
  926. GOTS     BAL   R9,TRETOA
  927.      XC    RETRYCNT,RETRYCNT
  928. REC30     L     R1,RETRYCNT
  929.      LA    R1,1(,R1)
  930.      ST    R1,RETRYCNT
  931.      C     R1,MAXRETRY
  932.      BH    ABORT
  933.      MVC   MPLEN(4),=F'94'      Set defaults
  934.      MVC   NPAD(4),=F'0'
  935.      MVI   PADCHAR,0
  936.      MVC   EOLCHAR2(1),EOLCHAR
  937.      MVI   CTLQT,35
  938.      MVI   BINQT,ASCN
  939.      MVI   RPTCHAR,32
  940.      LR    R2,R1
  941.      S     R2,=F'1'
  942.      BNH   REC50
  943.      SR    R1,R1          Copy his parameters
  944.      IC    R1,PACKET+1
  945.      S     R1,=F'32'
  946.      ST    R1,MPLEN       Maximum packet length
  947.      S     R2,=F'2'
  948.      BNH   REC50
  949.      IC    R1,PACKET+3
  950.      S     R1,=F'32'
  951.      ST    R1,NPAD          Number of pad characters
  952.      S     R2,=F'1'
  953.      BNH   REC50
  954.      IC    R1,PACKET+4
  955.      X     R1,=F'64'
  956.      STC   R1,PADCHAR      Pad character
  957.      S     R2,=F'1'
  958.      BNH   REC50
  959.      IC    R1,PACKET+5
  960.      S     R1,=F'32'
  961.      STC   R1,EOLCHAR2      End of line character
  962.      S     R2,=F'1'
  963.      BNH   REC50
  964.      MVC   CTLQT(1),PACKET+6  Control character quote
  965.      S     R2,=F'1'
  966.      BNH   REC50
  967.      MVC   BINQT(1),PACKET+7  Binary (8-bit) quote character
  968.      CLI   BINQT,ASCY
  969.      BNE   REC40
  970.      MVI   BINQT,38       Use & if he said Y
  971. REC40     S     R2,=F'2'
  972.      BNH   REC50
  973.      MVC   RPTCHAR(1),PACKET+9 Compression prefix character
  974. REC50     MVI   PACKET,ASCY      Send back ack with parameters
  975.      L     R1,MPLEN
  976.      A     R1,=F'32'
  977.      STC   R1,PACKET+1      Use his max packet length
  978.      MVI   PACKET+2,5+32      Time out in 5 seconds
  979.      MVI   PACKET+3,4+32      4 turnaround pad characters needed
  980.      MVI   PACKET+4,0+64      Use null for pad character
  981.      MVI   PACKET+5,13+32      End of line character I want (CR)
  982.      MVC   PACKET+6(1),CTLQT  Control character quote
  983.      MVC   PACKET+7(1),BINQT  8-bit quote
  984.      MVI   PACKET+8,49      1-character checksum (1)
  985.      MVC   PACKET+9(1),RPTCHAR Repeat prefix character
  986.      MVI   WPCKTNUM,0
  987.      LA    R1,10
  988.      BAL   R9,WRPACKET
  989.      BAL   R9,RDPACKET      Read for first F packet
  990.      BNZ   REC30
  991.      CLI   PACKET,ASCN
  992.      BE    REC30
  993.      CLI   PACKET,ASCS
  994.      BE    REC30
  995.      CLI   PACKET,ASCF
  996.      BNE   ABORT
  997. REC60     MVC   FILENAME(64),=CL64' ' Extract file name from packet
  998.      BAL   R9,TRATOE
  999.      S     R1,=F'2'
  1000.      BH    REC70
  1001.      MVC   PACKET(18),=C'EMissing file name'
  1002.      MVI   WPCKTNUM,0
  1003.      LA    R1,18
  1004.      BAL   R9,WRPACKET
  1005.      B     ABORT
  1006. RECFMVC  MVC   FILENAME(*-*),PACKET+1
  1007. REC70     EX    R1,RECFMVC
  1008. REC80     LA    R1,FILENAME
  1009.      CALL  GETFD          Attempt to open the file
  1010.      LTR   R15,R15
  1011.      BZ    REC110
  1012. REC90     CLI   NETDEV,X'FF'
  1013.      BE    REC100
  1014.      SPRINT ' Unable to open file'
  1015.      B     ABORT
  1016. REC100     MVC   PACKET(20),=C'EUnable to open file'
  1017.      MVI   WPCKTNUM,0
  1018.      LA    R1,20
  1019.      BAL   R9,TRETOA
  1020.      BAL   R9,WRPACKET
  1021.      B     MAINLOOP
  1022. REC110     ST    R0,FDUB
  1023.      CALL  GDINFO          Open the file
  1024.      LTR   R15,R15
  1025.      BNZ   REC90
  1026.      MVC   WORK(1),13(R1)
  1027.      SR    R0,R0          Free gdinfo block
  1028.      CALL  FREESPAC
  1029.      CLI   WORK,X'FF'      Check for type=none
  1030.      BNE   REC120
  1031.      CALL  CREATE,(FILENAME,CRESIZE,CREVOL,CRETYPE) Try to create
  1032.      LTR   R15,R15          the file
  1033.      BNZ   REC90          Too bad
  1034.      B     REC80          Try the open again
  1035. REC120     L     R0,FDUB          Empty the file
  1036.      CALL  EMPTY
  1037.      XC    BUFLEN,BUFLEN
  1038.      MVI   CRFLAG,0
  1039.      IC    R1,WPCKTNUM
  1040.      LA    R1,1(,R1)
  1041.      STC   R1,WPCKTNUM
  1042.      NI    WPCKTNUM,63
  1043.      XC    RETRYCNT,RETRYCNT
  1044.      CLI   NETDEV,X'FF'
  1045.      BE    REC130
  1046.      MVC   SCBUF(11),=C' Receiving '
  1047.      MVC   SCBUF+11(64),FILENAME
  1048.      LA    R2,75
  1049.      SPRINT SCBUF,(R2)
  1050. REC130     L     R1,RETRYCNT
  1051.      LA    R1,1(,R1)
  1052.      ST    R1,RETRYCNT
  1053.      C     R1,MAXRETRY
  1054.      BH    ABORT
  1055.      MVI   PACKET,ASCY
  1056.      LA    R1,1
  1057.      BAL   R9,WRPACKET      Ack the F packet
  1058.      BAL   R9,RDPACKET
  1059.      BNZ   REC130
  1060.      CLI   PACKET,ASCN
  1061.      BE    REC130
  1062.      CLC   WPCKTNUM(1),RPCKTNUM Ack again if F again
  1063.      BE    REC130
  1064. RECDATA  CLI   PACKET,ASCD      Expecting D or Z packet
  1065.      BE    REC140
  1066.      CLI   PACKET,ASCZ
  1067.      BE    RECEOF
  1068.      B     ABORT          Sequence error
  1069. REC140     LR    R2,R1          Length of packet
  1070.      S     R2,=F'1'       Account for D at front
  1071.      LA    R3,PACKET+1
  1072. REC150     LTR   R2,R2          Anything left in packet?
  1073.      BNH   REC290          No
  1074.      MVC   WORK(1),0(R3)      Copy char with/out parity
  1075.      MVC   WORK+1(1),0(R3)
  1076.      NI    WORK+1,X'7F'
  1077.      LA    R4,1          Default repeat count
  1078.      CLI   RPTCHAR,32      Compression allowed?
  1079.      BE    REC160          No
  1080.      CLC   WORK+1(1),RPTCHAR  Repetition prefix?
  1081.      BNE   REC160          No
  1082.      IC    R4,1(,R3)      Get repeat count
  1083.      N     R4,=F'127'
  1084.      S     R4,=F'32'
  1085.      S     R2,=F'2'
  1086.      BNH   ABORT
  1087.      LA    R3,2(,R3)
  1088.      MVC   WORK(1),0(R3)
  1089.      MVC   WORK+1(1),0(R3)
  1090.      NI    WORK+1,X'7F'
  1091. REC160     SR    R5,R5          Default high-order bit value
  1092.      CLI   BINQT,ASCN      8-bit quoting enabled?
  1093.      BE    REC170          No
  1094.      CLC   WORK+1(1),BINQT
  1095.      BNE   REC170
  1096.      LA    R5,128          Turn on high bit later
  1097.      S     R2,=F'1'
  1098.      BNH   ABORT
  1099.      LA    R3,1(,R3)
  1100.      MVC   WORK(1),0(R3)
  1101.      MVC   WORK+1(1),0(R3)
  1102.      NI    WORK+1,X'7F'
  1103. REC170     CLC   WORK+1(1),CTLQT      Is it a control quote?
  1104.      BNE   REC210          No
  1105.      MVC   WORK(1),1(R3)
  1106.      MVC   WORK+1(1),1(R3)
  1107.      NI    WORK+1,X'7F'
  1108.      CLC   WORK+1(1),CTLQT      May be quoting a literal
  1109.      BE    REC200
  1110.      CLI   RPTCHAR,32
  1111.      BE    REC180
  1112.      CLC   WORK+1(1),RPTCHAR
  1113.      BE    REC200
  1114. REC180     CLI   BINQT,ASCN
  1115.      BE    REC190
  1116.      CLC   WORK+1(1),BINQT
  1117.      BE    REC200
  1118. * Will not get here if control quote is followed by
  1119. * quote with high order bit on (eg X'23A3').
  1120. REC190     XI    WORK,64          Make it into a control char
  1121. REC200     S     R2,=F'1'
  1122.      BNH   ABORT
  1123.      LA    R3,1(,R3)
  1124. REC210     SR    R6,R6
  1125.      IC    R6,WORK          Diddle with high bit
  1126.      CLI   BINQT,ASCN      Straight through if no bin quote
  1127.      BE    REC215
  1128.      N     R6,=F'127'      Otherwise 0 if no quote seen
  1129.      OR    R6,R5          or 1 if quote seen
  1130. REC215     CLI   FILETYPE,C'T'      Translate to ebcdic if filetype=text
  1131.      BNE   REC220
  1132.      IC    R6,ATOE(R6)
  1133. REC220     STC   R6,WORK          WORK has char, R4 has count
  1134.      LA    R3,1(,R3)      Account for the character
  1135.      S     R2,=F'1'
  1136.      BL    ABORT
  1137.      CLI   FILETYPE,C'T'      Look for CRLF in text files
  1138.      BNE   REC260
  1139.      CLI   WORK,13          Is this a CR?
  1140.      BNE   REC230          No
  1141.      C     R4,=F'1'       Better not be repeated
  1142.      BNE   ABORT
  1143.      MVI   CRFLAG,1       Set flag to say we've seen CR
  1144.      B     REC150
  1145. REC230     CLI   WORK,X'25'      Is this a LF?
  1146.      BNE   REC250
  1147.      C     R4,=F'1'       Better not be repeated
  1148.      BNE   ABORT
  1149.      CLI   CRFLAG,1       Was last char a CR?
  1150.      BNE   ABORT          Don't like LF's without CR's
  1151.      LH    R1,BUFLEN
  1152.      LTR   R1,R1          Replace zero-length lines with blank
  1153.      BH    REC240
  1154.      LA    R1,1
  1155.      STH   R1,BUFLEN
  1156.      L     R1,=A(BUFFER)
  1157.      MVI   0(R1),C' '
  1158. REC240     CALL  WRITE,(BUFFER,BUFLEN,BUFMOD,BUFLNUM,FDUB)
  1159.      LTR   R15,R15
  1160.      BNE   WRTFERR          Error writing to file
  1161.      XC    BUFLEN,BUFLEN
  1162.      MVI   CRFLAG,0
  1163.      B     REC150
  1164. REC250     CLI   CRFLAG,0       Don't like CR's without LF's
  1165.      BNE   ABORT
  1166. REC260     LH    R5,BUFLEN      Point into buffer
  1167.      LR    R6,R5
  1168.      A     R6,=A(BUFFER)
  1169. REC270     MVC   0(1,R6),WORK      Copy character to buffer
  1170.      LA    R6,1(,R6)
  1171.      LA    R5,1(,R5)
  1172.      C     R5,=F'32767'      Don't overflow buffer
  1173.      BL    REC280
  1174.      STH   R5,BUFLEN
  1175.      CALL  WRITE,(BUFFER,BUFLEN,BUFMOD,BUFLNUM,FDUB)
  1176.      LTR   R15,R15
  1177.      BNE   WRTFERR          Error writing to file
  1178.      SR    R5,R5
  1179.      L     R6,=A(BUFFER)
  1180. REC280     BCT   R4,REC270      Repeat as necessary
  1181.      STH   R5,BUFLEN      New buffer length
  1182.      B     REC150          Next character from packet
  1183. REC290     IC    R1,WPCKTNUM      Bump write packet number
  1184.      LA    R1,1(,R1)
  1185.      STC   R1,WPCKTNUM
  1186.      NI    WPCKTNUM,63
  1187.      XC    RETRYCNT,RETRYCNT
  1188. REC300     L     R1,RETRYCNT
  1189.      LA    R1,1(,R1)
  1190.      ST    R1,RETRYCNT
  1191.      C     R1,MAXRETRY
  1192.      BH    ABORT
  1193.      MVI   PACKET,ASCY
  1194.      LA    R1,1
  1195.      BAL   R9,WRPACKET      Ack the D packet
  1196.      BAL   R9,RDPACKET
  1197.      BNZ   REC300
  1198.      CLI   PACKET,ASCN
  1199.      BE    REC300
  1200.      CLC   WPCKTNUM(1),RPCKTNUM Ack again if last packet again
  1201.      BE    REC300
  1202.      B     RECDATA          Loop until Z packet
  1203. RECEOF     CLC   BUFLEN(2),=H'0'      Write out contents of buffer, if any
  1204.      BE    REC310
  1205.      CALL  WRITE,(BUFFER,BUFLEN,BUFMOD,BUFLNUM,FDUB)
  1206.      LTR   R15,R15
  1207.      BNZ   WRTFERR
  1208. REC310     L     R0,FDUB          Close the file
  1209.      CALL  FREEFD
  1210.      IC    R1,WPCKTNUM      Bump write packet number
  1211.      LA    R1,1(,R1)
  1212.      STC   R1,WPCKTNUM
  1213.      NI    WPCKTNUM,63
  1214.      XC    RETRYCNT,RETRYCNT
  1215. REC320     L     R1,RETRYCNT
  1216.      LA    R1,1(,R1)
  1217.      ST    R1,RETRYCNT
  1218.      C     R1,MAXRETRY
  1219.      BH    ABORT
  1220.      MVI   PACKET,ASCY
  1221.      LA    R1,1
  1222.      BAL   R9,WRPACKET      Ack the Z packet
  1223.      BAL   R9,RDPACKET
  1224.      BNZ   REC320
  1225.      CLI   PACKET,ASCN
  1226.      BE    REC320
  1227.      CLC   WPCKTNUM(1),RPCKTNUM Ack again if last packete again
  1228.      BE    REC320
  1229.      CLI   PACKET,ASCF      Expecting F or B packet
  1230.      BE    REC60          Process next file
  1231.      CLI   PACKET,ASCB
  1232.      BNE   ABORT
  1233.      IC    R1,WPCKTNUM      Bump write packet number
  1234.      LA    R1,1(,R1)
  1235.      STC   R1,WPCKTNUM
  1236.      NI    WPCKTNUM,63
  1237.      MVI   PACKET,ASCY
  1238.      LA    R1,1
  1239.      BAL   R9,WRPACKET      Ack the B packet
  1240.      B     MAINLOOP       All done the receive
  1241.      TITLE 'WRPACKET -- write out a packet'
  1242. WRPACKET LA    R2,PACKET2      Build output packet here
  1243.      L     R3,NPAD          Put pads in first
  1244.      LTR   R3,R3
  1245.      BZ    WRP20
  1246. WRP10     MVC   0(1,R2),PADCHAR
  1247.      LA    R2,1(,R2)
  1248.      BCT   R3,WRP10
  1249. WRP20     MVI   0(R2),1          SOH character
  1250.      SR    R4,R4          Checksum
  1251.      LA    R3,34(,R1)      Length byte (R1+2+32)
  1252.      STC   R3,1(,R2)
  1253.      AR    R4,R3
  1254.      IC    R3,WPCKTNUM      Sequence id
  1255.      LA    R3,32(,R3)
  1256.      STC   R3,2(,R2)
  1257.      AR    R4,R3
  1258.      LA    R2,3(,R2)
  1259.      LA    R5,PACKET      Copy the packet proper
  1260. WRP30     MVC   0(1,R2),0(R5)
  1261.      IC    R3,0(,R5)
  1262.      AR    R4,R3
  1263.      LA    R2,1(,R2)
  1264.      LA    R5,1(,R5)
  1265.      BCT   R1,WRP30
  1266.      N     R4,=F'255'      Crunch checksum to 6 bits
  1267.      LR    R3,R4
  1268.      SRL   R3,6
  1269.      AR    R4,R3
  1270.      N     R4,=F'63'
  1271.      A     R4,=F'32'
  1272.      STC   R4,0(,R2)
  1273.      MVC   1(1,R2),EOLCHAR2   Line terminator
  1274.      LA    R2,2(,R2)
  1275.      LA    R1,PACKET2      Length of finished packet
  1276.      SR    R2,R1
  1277.      CLI   SERVER,1       Select unit based on server flag
  1278.      BE    WRP40          Server always uses sprint,
  1279.      CLI   NETDEV,X'FF'      non-server uses 0 if assigned,
  1280.      BE    WRP40          and sprint otherwise
  1281.      MVC   RWPKUNIT(4),=F'0'
  1282.      B     WRP50
  1283. WRP40     MVC   RWPKUNIT(8),=C'SPRINT  '
  1284. WRP50     STH   R2,RWPKLEN
  1285.      CALL  WRITE,(PACKET2,RWPKLEN,RWPKMOD,RWPKLNUM,RWPKUNIT)
  1286.      CLI   DEBUG,0
  1287.      BER   R9
  1288.      LA    R2,1(,R2)
  1289.      STH   R2,DEBLEN
  1290.      CALL  WRITE,(DEBPK2,DEBLEN,DEBMOD,DEBLNUM,DEBUNIT)
  1291.      BR    R9
  1292.      TITLE 'RDPACKET -- read a packet'
  1293. RDPACKET CLI   SERVER,1       Select unit based on server flag
  1294.      BE    RDP10          Server always uses scards,
  1295.      CLI   NETDEV,X'FF'      non-server uses 0 if assigned,
  1296.      BE    RDP10          and scards otherwise
  1297.      MVC   RWPKUNIT(4),=F'0'
  1298.      B     RDP20
  1299. RDP10     MVC   RWPKUNIT(8),=C'SCARDS  '
  1300. RDP20     CALL  READ,(PACKET3,RWPKLEN,RWPKMOD,RWPKLNUM,RWPKUNIT)
  1301.      LH    R1,RWPKLEN
  1302. *
  1303. *#### Merit READ@BIN returns data in EBCDIC so restore to ASCII
  1304. *
  1305.      L     R4,=V(EBCMASC)
  1306. STEP#1     EX    R1,TREBMASC
  1307. *
  1308.      CLI   DEBUG,0
  1309.      BE    RDP30
  1310.      LA    R2,1(,R1)
  1311.      STH   R2,DEBLEN
  1312.      CALL  WRITE,(DEBPK3,DEBLEN,DEBMOD,DEBLNUM,DEBUNIT)
  1313.      LH    R1,RWPKLEN
  1314. RDP30     LTR   R1,R1
  1315.      BNH   RDPFAIL
  1316.      C     R1,=F'120'      Generous overlength check
  1317.      BH    PTOOLONG
  1318.      MVI   WORK+1,X'7F'      Mask to turn off parity, as nec
  1319.      CLI   FILETYPE,C'T'
  1320.      BE    RDP40
  1321.      CLI   BINQT,ASCN
  1322.      BNE   RDP40
  1323.      MVI   WORK+1,X'FF'
  1324. RDP40     LA    R2,PACKET3
  1325. RDP50     MVC   WORK(1),0(R2)
  1326.      NC    WORK(1),WORK+1
  1327.      CLI   WORK,1          Look for soh
  1328.      BE    RDP60
  1329.      LA    R2,1(,R2)
  1330.      BCT   R1,RDP50
  1331.      B     RDPFAIL
  1332. RDP60     LA    R2,1(,R2)
  1333.      S     R1,=F'1'
  1334.      BNH   RDPFAIL
  1335.      MVC   WORK(1),0(R2)
  1336.      NC    WORK(1),WORK+1
  1337.      SR    R3,R3          Length byte
  1338.      IC    R3,WORK
  1339.      LR    R4,R3          This will be checksum
  1340.      S     R3,=F'34'
  1341.      BNH   RDPFAIL
  1342.      ST    R3,PCKTLEN      Save packet length
  1343.      LA    R2,1(,R2)
  1344.      S     R1,=F'1'
  1345.      BNH   RDPFAIL
  1346.      MVC   WORK(1),0(R2)
  1347.      NC    WORK(1),WORK+1
  1348.      SR    R5,R5          Packet sequence number
  1349.      IC    R5,WORK
  1350.      AR    R4,R5
  1351.      S     R5,=F'32'
  1352.      STC   R5,RPCKTNUM
  1353.      LA    R2,1(,R2)
  1354.      S     R1,=F'1'
  1355.      BNH   RDPFAIL
  1356.      LA    R6,PACKET
  1357. RDP70     MVC   WORK(1),0(R2)      Copy the packet proper
  1358.      NC    WORK(1),WORK+1
  1359.      IC    R5,WORK
  1360.      AR    R4,R5
  1361.      STC   R5,0(,R6)
  1362.      LA    R6,1(,R6)
  1363.      LA    R2,1(,R2)
  1364.      S     R1,=F'1'
  1365.      BNH   RDPFAIL
  1366.      BCT   R3,RDP70
  1367.      MVC   WORK(1),0(R2)      Check the checksum
  1368.      NC    WORK(1),WORK+1
  1369.      IC    R5,WORK
  1370.      S     R5,=F'32'
  1371.      N     R4,=F'255'
  1372.      LR    R6,R4
  1373.      SRL   R6,6
  1374.      AR    R4,R6
  1375.      N     R4,=F'63'
  1376.      CR    R4,R5
  1377.      BNE   RDPFAIL
  1378.      L     R1,PCKTLEN      Return with CC Z and len in R1
  1379.      CLI   PACKET,ASCE      Is it an error packet?
  1380.      BE    ERRPCKT          Boom
  1381.      SR    R0,R0
  1382.      BR    R9
  1383. RDPFAIL  SR    R1,R1          Return with CC NZ
  1384.      LTR   R11,R11
  1385.      BR    R9
  1386.      TITLE 'Translation from/to ascii/ebcdic'
  1387. TRETOA     S     R1,=F'1'
  1388.      BL    TRETOA10
  1389.      EX    R1,TRETOATR
  1390. TRETOA10 A     R1,=F'1'
  1391.      BR    R9
  1392. TRETOATR TR    PACKET(*-*),ETOA
  1393.      SPACE 1
  1394. TRATOE     S     R1,=F'1'
  1395.      BL    TRATOE10
  1396.      EX    R1,TRATOETR
  1397. TRATOE10 A     R1,=F'1'
  1398.      BR    R9
  1399. TRATOETR TR    PACKET(*-*),ATOE
  1400.      SPACE 1
  1401. TREBMASC TR    PACKET3(*-*),0(R4)
  1402.      TITLE 'Routine to expand a file spec'
  1403. EXPFSPC  XC    NFILES,NFILES      Init number of files found
  1404.      MVC   FILESPEC(64),=CL64' ' Copy the file spec
  1405.      S     R2,=F'1'
  1406.      BLR   R9
  1407.      C     R2,=F'59'
  1408.      BH    EXPFERR
  1409.      EX    R2,EXPFMVC
  1410.      A     R2,=F'1'
  1411.      TR    FILESPEC(64),LCUC
  1412.      CALL  GUINFO,(TWO,MYUID) Determine current signon userid
  1413.      CLI   FILESPEC,C'*'
  1414.      BNE   EXPF10
  1415.      MVC   USERID(4),=C'*SYS'
  1416.      B     EXPF60
  1417. EXPFMVC  MVC   FILESPEC(*-*),0(R1)
  1418. EXPF10     CLI   FILESPEC,C'-'
  1419.      BNE   EXPF20
  1420.      MVC   USERID(4),=C'*TMP'
  1421.      B     EXPF60
  1422. EXPF20     LA    R1,FILESPEC      Copy userid if any
  1423.      LA    R2,4
  1424.      MVC   USERID(4),=C'$.$.' Userid pad characters
  1425. EXPF30     CLI   0(R1),C':'
  1426.      BE    EXPF40
  1427.      MVC   0(1,R3),0(R1)
  1428.      LA    R1,1(,R1)
  1429.      LA    R3,1(,R3)
  1430.      BCT   R2,EXPF30
  1431.      CLI   0(R1),C':'      If no colon here, no userid given
  1432.      BNE   EXPF50
  1433. EXPF40     MVC   FILESPEC(60),1(R1) Crunch out userid
  1434.      B     EXPF60
  1435. EXPF50     MVC   USERID(4),MYUID      Default is current signonid
  1436. EXPF60     XC    GFINFR(24),GFINFR
  1437. EXPF70     CALL  GFINFO,(USERID,GFINFR,THREE,GFINFZ,GFINFZ,GFINFZ),VL
  1438.      LTR   R15,R15
  1439.      BNZR  R9          No more files
  1440.      MVC   FILENAME(64),=CL64' '
  1441.      CLC   USERID(4),MYUID      Gfinfo includes userid only if it's
  1442.      BE    EXPF80          not for this task (sweet, eh)
  1443.      CLC   USERID(4),=C'*SYS'
  1444.      BE    EXPF80
  1445.      CLC   USERID(4),=C'*TMP'
  1446.      BE    EXPF80
  1447.      MVC   FILENAME(4),GFINFR
  1448.      MVI   FILENAME+4,C':'
  1449.      MVC   FILENAME+5(16),GFINFR+4
  1450.      LA    R1,FILENAME+5
  1451.      B     EXPF90
  1452. EXPF80     MVC   FILENAME(20),GFINFR
  1453.      LA    R1,FILENAME
  1454. *     Allow single ? in file spec -- matches any substring
  1455. EXPF90     LA    R2,FILESPEC
  1456.      SR    R3,R3          No ? yet
  1457.      SR    R4,R4
  1458. EXPF100  CLI   0(R1),C' '      End of filename?
  1459.      BNE   EXPF110          No
  1460.      CLI   0(R2),C' '      End of file spec?
  1461.      BNE   EXPF70          No -- doesn't match
  1462.      L     R1,NFILES      Found a matching file name
  1463.      LR    R2,R1
  1464.      SLL   R2,6
  1465.      A     R2,=A(FILES)
  1466.      MVC   0(64,R2),FILENAME
  1467.      LA    R1,1(,R1)
  1468.      C     R1,=F'64'      Check for too many
  1469.      BH    EXPFERR
  1470.      ST    R1,NFILES
  1471.      B     EXPF70          Look for more
  1472. EXPF110  CLC   0(1,R1),0(R2)      Characters match?
  1473.      BNE   EXPF120          No
  1474.      LA    R1,1(,R1)      Yes -- move along
  1475.      LA    R2,1(,R2)
  1476.      B     EXPF100          Loop
  1477. EXPF120  CLI   0(R2),C'?'      ? in file spec?
  1478.      BNE   EXPF130
  1479.      LTR   R3,R3          Seen one before?
  1480.      BNZ   EXPFERR          Yes -- error
  1481.      LA    R2,1(,R2)      Point past ?
  1482.      LR    R3,R2          and save this address
  1483.      LA    R4,1(,R1)      This is where to continue after fail
  1484.      B     EXPF100          Continue matching
  1485. EXPF130  LTR   R3,R3          Mismatch -- have we seen a ?
  1486.      BZ    EXPF70          No -- names can't match
  1487.      LR    R2,R3          Lengthen string matched by ?
  1488.      LR    R1,R4
  1489.      LA    R4,1(,R1)
  1490.      B     EXPF100          and try again
  1491.      SPACE 1
  1492. EXPFERR  CLI   NETDEV,X'FF'
  1493.      BE    EXPF140
  1494.      SPRINT ' Error expanding file spec'
  1495.      MVI   PACKET,ASCB      Send break packet
  1496.      MVI   WPCKTNUM,0
  1497.      LA    R1,1
  1498.      BAL   R9,WRPACKET
  1499.      B     MAINLOOP
  1500. EXPF140  MVC   PACKET(26),=C'EError expanding file spec'
  1501.      MVI   WPCKTNUM,0
  1502.      LA    R1,26
  1503.      BAL   R9,TRETOA
  1504.      BAL   R9,WRPACKET
  1505.      B     MAINLOOP
  1506.      TITLE 'Constants and variable storage'
  1507. SAVEAREA DS    18F
  1508. TWO     DC    F'2'
  1509. THREE     DC    F'3'
  1510. PFXPAR     DC    A(PFXITEM,PFXDATA)
  1511. PFXITEM  DC    CL8'PFXSTR  '
  1512. PFXDATA  DC    F'19',F'11',CL11'Kermit-MTS>'
  1513. WORK     DS    D
  1514. NETCMD     DC    A(*+12),A(*+4),F'37',C'$NET '
  1515. NETDEV     DS    CL32
  1516. SERVER     DS    X
  1517. FILETYPE DS    X
  1518. DEBUG     DS    X
  1519. RETRYCNT DS    F
  1520. MAXRETRY DC    F'10'
  1521. CMDPTR     DS    A
  1522.      DC    A(CMDLEN)      MUST FOLLOW CMDPTR
  1523. CMDLEN     DS    F
  1524. SCBUF     DS    CL256
  1525. SCLEN     DC    H'0',H'255',H'0'
  1526. SCMOD     DC    A(X'08000000')      Maxlen
  1527. SCLNUM     DS    F
  1528. NFILES     DS    F
  1529. FILENAME DS    CL64
  1530. FILESPEC DS    CL64
  1531. USERID     DS    CL4
  1532. MYUID     DS    CL4
  1533.      DS    0F
  1534. CRESIZE  DC    H'0',H'1'
  1535. CREVOL     DC    XL6'00'
  1536. CRETYPE  DC    F'256'
  1537. RPCKTNUM DS    X
  1538. WPCKTNUM DS    X
  1539. PCKTLEN  DS    F
  1540. PACKET     DS    CL150
  1541. DEBPK2     DC    X'E2'          MUST PRECEED PACKET2
  1542. PACKET2  DS    CL150
  1543. DEBPK3     DC    X'D9'          MUST PRECEED PACKET3
  1544. PACKET3  DS    CL150
  1545. RWPKLEN  DC    H'0',H'150',H'0'
  1546. RWPKMOD  DC    A(X'08000008')      Maxlen, binary
  1547. RWPKLNUM DS    F
  1548. RWPKUNIT DS    CL8
  1549. DEBLEN     DS    H
  1550. DEBMOD     DC    F'0'
  1551. DEBLNUM  DC    F'0'
  1552. DEBUNIT  DS    A
  1553. MPLEN     DS    F
  1554. NPAD     DS    F
  1555. PADCHAR  DS    X
  1556. EOLCHAR  DS    X          What user wants me to send
  1557. EOLCHAR2 DS    X          What other kermit wants me to send
  1558. CTLQT     DS    X
  1559. BINQT     DS    X
  1560. RPTCHAR  DS    X
  1561. FDUB     DS    A
  1562. EOFFLAG  DS    X
  1563. CRFLAG     DS    X
  1564. BUFFCNT  DS    F
  1565. BUFLEN     DS    H
  1566. BUFMOD     DC    A(X'40000000')
  1567. BUFLNUM  DS    F
  1568. GFINFZ     DC    F'0'
  1569. GFINFR     DS    6F
  1570.      LTORG
  1571.      SPACE 1
  1572. LCUC     DC    X'000102030405060708090A0B0C0D0E0F'
  1573.      DC    X'101112131415161718191A1B1C1D1E1F'
  1574.      DC    X'202122232425262728292A2B2C2D2E2F'
  1575.      DC    X'303132333435363738393A3B3C3D3E3F'
  1576.      DC    X'404142434445464748494A4B4C4D4E4F'
  1577.      DC    X'505152535455565758595A5B5C5D5E5F'
  1578.      DC    X'606162636465666768696A6B6C6D6E6F'
  1579.      DC    X'707172737475767778797A7B7C7D7E7F'
  1580.      DC    X'80C1C2C3C4C5C6C7C8C98A8B8C8D8E8F'
  1581.      DC    X'90D1D2D3D4D5D6D7D8D99A9B9C9D9E9F'
  1582.      DC    X'A0A1E2E3E4E5E6E7E8E9AAABACADAEAF'
  1583.      DC    X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'
  1584.      DC    X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'
  1585.      DC    X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'
  1586.      DC    X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'
  1587.      DC    X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'
  1588.      SPACE 1
  1589. ATOE     DC    X'00010203372D2E2F1605250B0C0D0E0F' Use AD/BD for sq br
  1590.      DC    X'101112133C3D322618193F271C1D1E1F' Use 8B/9B for braces
  1591.      DC    X'405A7F7B5B6C507D4D5D5C4E6B604B61' Use 4F for stick
  1592.      DC    X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' Use E0 for backslash
  1593.      DC    X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' Use 5F for tilde
  1594.      DC    X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD716D' Use 71 for circumflx
  1595.      DC    X'79818283848586878889919293949596' Use 79 for grave
  1596.      DC    X'979899A2A3A4A5A6A7A8A98B4F9B5F07' NOTE: This mapping
  1597.      DC    X'00000000000000000000000000000000'     is not the
  1598.      DC    X'00000000000000000000000000000000'     same as in the
  1599.      DC    X'00000000000000000000000000000000'     kermit manual.
  1600.      DC    X'00000000000000000000000000000000'
  1601.      DC    X'00000000000000000000000000000000'
  1602.      DC    X'00000000000000000000000000000000'
  1603.      DC    X'00000000000000000000000000000000'
  1604.      DC    X'00000000000000000000000000000000'
  1605.      SPACE 1
  1606. ETOA     DC    X'000102030009007F0000000B0C0D0E0F' Use AD/BD for sq br
  1607.      DC    X'1011121300000800181900001C1D1E1F' Use 8B/9B for braces
  1608.      DC    X'00000000000A171B0000000000050607' Use 4F for stick
  1609.      DC    X'0000160000000004000000001415001A' Use E0 for backslash
  1610.      DC    X'20000000000000000000002E3C282B7C' Use 5F for tilde
  1611.      DC    X'2600000000000000000021242A293B7E' Use 71 for circumflx
  1612.      DC    X'2D2F00000000000000007C2C255F3E3F' Use 79 for grave
  1613.      DC    X'005E00000000000000603A2340273D22' Also use:
  1614.      DC    X'00616263646566676869007B00000000'   C0/D0 for braces
  1615.      DC    X'006A6B6C6D6E6F707172007D00000000'   A1 for tilde
  1616.      DC    X'007E737475767778797A0000005B0000' NOTE: This mapping
  1617.      DC    X'000000000000000000000000005D0000'     is not the
  1618.      DC    X'7B414243444546474849000000000000'     same as in the
  1619.      DC    X'7D4A4B4C4D4E4F505152000000000000'     kermit manual.
  1620.      DC    X'5C00535455565758595A000000000000'
  1621.      DC    X'303132333435363738397C0000000000'
  1622.      SPACE 1
  1623. FILES     DS    64CL64
  1624. BUFFER     DS    32768X
  1625.      SPACE 1
  1626. ASCB     EQU   66
  1627. ASCD     EQU   68
  1628. ASCE     EQU   69
  1629. ASCF     EQU   70
  1630. ASCN     EQU   78
  1631. ASCS     EQU   83
  1632. ASCY     EQU   89
  1633. ASCZ     EQU   90
  1634.      END   KERMIT
  1635.