home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pick / picpr.bas < prev    next >
BASIC Source File  |  2020-01-01  |  72KB  |  2,155 lines
  1.  
  2.     DKPARSE
  3. 001 SUBROUTINE (token,COM.index)
  4. 002 *PARSE a symbol table for a minimally unique (U/L case) token match
  5. 003 *6/25/87 JF3 0.3.0
  6. 004 *
  7. 005 COM P(64),index(3);EQU a TO index(1),v TO index(2),s TO index(3)
  8. 006 s=0;i=1;LOOP WHILE index(i) DO i=i+1 REPEAT
  9. 007 t.len=LEN(token);check.unique=0;3 LOOP
  10. 008   index(i)=index(i)+1
  11. 009   SYM=FIELD(P(COM.index)<a,v,s>," ",1)
  12. 010 UNTIL SYM="" DO
  13. 011   c=1;LOOP T=token[c,1] UNTIL T="" DO
  14. 012     S=SEQ(T);IF 97<=S AND S<=122 THEN T=CHAR(S-32)
  15. 013     IF T=SYM[c,1] THEN c=c+1 ELSE
  16. 014       IF check.unique THEN GO 7 ELSE GO 6
  17. 015     END
  18. 016   REPEAT;IF check.unique THEN GO 8 ELSE SYM1=SYM;ix=index(i);check.unique=1
  19. 017 6 REPEAT;IF check.unique THEN
  20. 018 7 token=SYM1;index(i)=ix
  21. 019 END ELSE
  22. 020 8 index(i)=0
  23. 021 END;9 RETURN
  24. 022 * * * * * Interface info * * * * *
  25. 023 *Entry: token  := char. string for search.
  26. 024 *       c      := index of COM variable containing dynamic array
  27. 025 *                 of symbol data. Each element must begin
  28. 026 *                 with a symbol in all caps terminated
  29. 027 *                 by a space; additional data may follow.
  30. 028 *       a      := attr# wherein to restrict match search.
  31. 029 *                 Zero means search by attributes.
  32. 030 *       v      := value# as above but values.
  33. 031 *       s      := Set to zero.
  34. 032 *
  35. 033 *Exit:  token  := Symbol that matched; unchanged otherwise.
  36. 034 *       c      := unchanged
  37. 035 *       a      := attr# where token match found; zero if not found.
  38. 036 *       v      := value# where found.
  39. 037 *       s      := subvalue# where found.
  40. 038 *
  41. 039 *Use:   check.unique := true means check next symbol for match
  42. 040 *                    to determine if token is unique.
  43. 041 * * * * * Revision history * * * * *
  44. 042 *.0 - 6/25/87 JF3
  45. 043 END
  46.  
  47.     DKTC
  48. 001 SUBROUTINE (STATUS)
  49. 002 *Test Conversion routines
  50. 003 *6/29/87 JF3 0.3
  51. 004 *
  52. 005 COM P(64)
  53. 006 PRINT "idx":;INPUT idx
  54. 007 LOOP PRINT "cnv":;INPUT cnv UNTIL cnv="END" DO
  55. 008   LOOP
  56. 009     DEBUG
  57. 010     PRINT "arg":;INPUT arg
  58. 011   UNTIL arg="END" DO
  59. 012     CALL DKCNV(arg,cnv,idx)
  60. 013     PRINT "arg(hex)=":OCONV(arg,"MX"):"   ":arg;PRINT
  61. 014   REPEAT
  62. 015 REPEAT;STATUS=1;RETURN;END
  63.  
  64.     DKNFN
  65. 001 SUBROUTINE (MAT N)
  66. 002 *Normalize File Names (in Kermit sense)
  67. 003 *7/8/87 JF3 0.3.0
  68. 004 *
  69. 005 DIM N(3)
  70. 006 EQU name TO N(1),type TO N(2),sep TO N(3)
  71. 007 FOR p=1 TO 2
  72. 008   string="";c=1;LOOP C=N(p)[c,1] UNTIL C="" DO
  73. 009     s=SEQ(C);BEGIN CASE
  74. 010     CASE s<=47;C="X"
  75. 011     CASE 58<=s AND s<=64;C="X"
  76. 012     CASE 91<=s AND s<=96;C="X"
  77. 013     CASE 97<=s AND s<=122;C=CHAR(s-32)
  78. 014     CASE (123<=s);C="X"
  79. 015     END CASE;string=string:C;c=c+1
  80. 016   REPEAT;N(p)=string
  81. 017 NEXT p;IF type="" THEN sep="" ELSE sep="."
  82. 018 RETURN
  83. 019 * * * * * Interface info * * * * *
  84. 020 *Entry: name := file name in Kermit sense
  85. 021 *       type :=  "   type "    "      "
  86. 022 *       sep  := seperator character
  87. 023 *
  88. 024 *Exit:  as above but normalized per Kermit Protocol Manual
  89. 025 * * * * * Revision history * * * * *
  90. 026 *.0 - 7/8/87 JF3
  91. 027 END
  92.  
  93.     DKA09
  94. 001 SUBROUTINE (status)
  95. 002 *check received Attribute 9 (access)
  96. 003 *6/29/87 JF3 0.3.0
  97. 004 *
  98. 005 COM X1(41),item
  99. 006 EQU Access TO status
  100. 007 BEGIN CASE
  101. 008 CASE Access="N"
  102. 009 CASE Access="S"
  103. 010 CASE Access="A"
  104. 011 CASE 1;status=0
  105. 012 END CASE
  106. 013 RETURN
  107. 014 * * * * * Interface info * * * * *
  108. 015 *Entry:  status := file access character
  109. 016 *
  110. 017 *Exit:   status := 1 if ok; 0 otherwise
  111. 018 * * * * * Revision history * * * * *
  112. 019 *.0 - 6/29/87 JF3
  113. 020 END
  114.  
  115.     DKCNV
  116. 001 SUBROUTINE (arg,cnv,index)
  117. 002 *Convert parameters to COM format
  118. 003 *5/8/87 JF3 0.3.0
  119. 004 !]DKcnv]DKCTL
  120. 005 COM P(64);I=index<1>;RETREIVE=(I<0);I=ABS(I)
  121. 006 IF RETREIVE THEN
  122. 007   GOSUB 10;IF a THEN arg=P(I)<a,v> ELSE arg=P(I)
  123. 008 END;IF NUM(cnv) THEN c=ABS(cnv) ELSE
  124. 009   IF cnv="" THEN c=0 ELSE
  125. 010     SUBR="DK":cnv<1,1>;c=cnv<1,2>;CALL @SUBR(arg,c,index)
  126. 011   END
  127. 012 END;BEGIN CASE
  128. 013 CASE c=1;IF cnv>0 THEN arg=CHAR(arg+32) ELSE arg=SEQ(arg)-32
  129. 014 CASE c=2;IF cnv>0 THEN
  130. 015     IF arg="ON" THEN arg=1 ELSE arg=0
  131. 016   END ELSE
  132. 017     IF arg=1 THEN arg="ON" ELSE arg="OFF"
  133. 018   END
  134. 019 CASE c=3;IF cnv>0 THEN arg=CHAR(arg) ELSE arg=SEQ(arg)
  135. 020 CASE c=4;*[0<=arg<=31 or arg=127] or OCONV[]
  136. 021 * DK1.2="U2":P(47)<1,1>;*Microdata/Ultimate
  137. 022 * arg=OCONV(arg,DK1.2); *Microdata/Ultimate
  138. 023   CALL DKCTL(arg);      *PICK
  139. 024 CASE 1;cnv=c
  140. 025 END CASE;IF index<1>>0 THEN
  141. 026   GOSUB 10;IF arg="x" THEN arg=""
  142. 027   IF a THEN
  143. 028     P(I)<a,v>=arg;IF s#"" THEN P(I)<2,v>=s
  144. 029   END ELSE P(I)=arg
  145. 030 END;RETURN
  146. 031 10 s=index<2>;IF s="" THEN a=0;v=0 ELSE
  147. 032   IF s<99 THEN
  148. 033     a=1
  149. 034 *   LOCATE s IN P(I)<2> SETTING v ELSE NULL;*Microdata/Ultimate
  150. 035     LOCATE(s,P(I),2;v) ELSE NULL;           *PICK
  151. 036   END ELSE a=s-100;v=1;s=""
  152. 037 END;RETURN
  153. 038 * * * * * Interface info * * * * *
  154. 039 * Entry:
  155. 040 *   arg       := contains data to be operated upon or
  156. 041 *                is destination of data retrieved.
  157. 042 *   cnv       := DK conversion code:
  158. 043 *                  null or 0 means no conversion
  159. 044 *                  numeric means convert here:
  160. 045 *                    >0 : convert to internal/packet
  161. 046 *                    <0 : convert to external
  162. 047 *                  non-numeric means call external subroutine
  163. 048 *   index  <1>:= COM position: Neg. means retreive data; pos. means
  164. 049 *                store data, 0 means ignore COM data.
  165. 050 *          <2>:= <=99 means code associated with subparameter
  166. 051 *                else 100+attr# within COM variable of data
  167. 052 *                Null means single valued data.
  168. 053 * Exit:
  169. 054 *   arg       := data as converted
  170. 055 *   cnv       := }modified only on
  171. 056 *   index     := } error detection.
  172. 057 * * * * * Revision history * * * * *
  173. 058 *.0 - 5/8/87 JF3
  174. 059 END
  175.  
  176.     DKXPKTS
  177. 001 SUBROUTINE (STATUS)
  178. 002 *eXchange PacKeTS (send or receive)
  179. 003 *10/22/88 JF3 0.3.1
  180. 004 *]DKIO]DKVPKT]DKRETRY]DKACK]DKERR]DKFPKT
  181. 005 COM X1(4),n,DATA,CHECK,TYPE,LIMIT,X2(11),EOL,X3(2),CHKT,X4(12),r
  182. 006 EQU LEN TO STATUS,ok TO STATUS,AM TO CHAR(254)
  183. 007 xmt.pkt=DATA:CHECK;function=STATUS;ok=0;r=0;LOOP
  184. 008   DATA=xmt.pkt;PROMPT EOL;IF function>=0 THEN
  185. 009     STATUS=2;CALL DKIO(STATUS);STATUS=function;CALL DKVPKT(STATUS)
  186. 010     IF STATUS>0 THEN
  187. 011       IF TYPE="E" THEN
  188. 012 *       If local mode then print msg on screen
  189. 013         DATA="";CALL DKACK("Y");CALL DKIO(-2);STATUS=0;ok=0
  190. 014       END ELSE ok=STATUS;DATA=DATA[5,LEN-2-CHKT]
  191. 015     END
  192. 016   END ELSE CALL DKIO(-2);STATUS=1;ok=STATUS
  193. 017 UNTIL STATUS=ok DO
  194. 018   CALL DKRETRY(STATUS);IF NOT(ok) THEN GO 9
  195. 019 REPEAT;9 RETURN
  196. 020 * * * * * Interface info * * * * *
  197. 021 *Entry: DATA    := DATA field of packet to send
  198. 022 *       CHECK   := check code the packet
  199. 023 *       STATUS  := function indicator:
  200. 024 *                  >=0 means input a response packet after sending a packet
  201. 025 *                   -1   "   do not wait for answer; just terminate packet
  202. 026 *
  203. 027 *Exit:  DATA    := disassembled received packet data
  204. 028 *       STATUS  := 0 means retry limit exceeded
  205. 029 *                  1   "   received packet ok
  206. 030 *                 -1   "   E packet received
  207. 031 * * * * * Revision history * * * * *
  208. 032 *.1 - 10/22/88 JF3
  209. 033 *
  210. 034 *.0 - 10/21/88 JF3
  211. 035 END
  212.  
  213.     DKVPKT
  214. 001 SUBROUTINE (STATUS)
  215. 002 *Verify a received packet
  216. 003 *3/27/89 JF3 0.3.1
  217. 004 *]DKCHECK]CKCNV
  218. 005 COM X1(3),MARK,CTRL.SEQ,PACKET,CHECK,TYPE,X2,DEBUG.MODE,X3(13),CHKT
  219. 006 EQU LEN TO STATUS;RECEIVER=STATUS;TYPE=""
  220. 007 STATUS=INDEX(PACKET,MARK,1);IF STATUS THEN
  221. 008   IF STATUS>1 THEN PACKET=PACKET[STATUS,99999]
  222. 009   CHECK=1;CALL DKCHECK(CHECK);IF CHECK="" THEN STATUS=-6 ELSE
  223. 010     LEN=PACKET[2,1];CALL DKCNV(LEN,-1,0)
  224. 011     IF CHECK=PACKET[LEN+3-CHKT,CHKT] THEN
  225. 012       TYPE=PACKET[4,1];BEGIN CASE
  226. 013       CASE TYPE="D";CASE TYPE="Y";CASE TYPE="N";CASE TYPE="S"
  227. 014       CASE TYPE="B";CASE TYPE="F";CASE TYPE="Z";CASE TYPE="E"
  228. 015       CASE TYPE="A"
  229. 016       CASE 1;STATUS=-4;GO 9;END CASE
  230. 017       PACKET.SEQ=PACKET[3,1];CALL DKCNV(PACKET.SEQ,-1,0)
  231. 018       IF PACKET.SEQ#MOD(CTRL.SEQ+RECEIVER,64) THEN STATUS=-3
  232. 019     END ELSE STATUS=-2
  233. 020   END
  234. 021 END ELSE STATUS=-1
  235. 022 9 IF DEBUG.MODE THEN
  236. 023   PRINTER ON;PRINT ON 1;PRINT ON 1 "DKVPKT: ":STATUS
  237. 024   PRINT ON 1 OCONV(PACKET,"MX");PRINT ON 1;PRINTER OFF
  238. 025 END;RETURN
  239. 026 * * * * * Interface info * * * * *
  240. 027 *Entry: STATUS := false means send mode; true means receive mode
  241. 028 *       PACKET := packet data as received from the line and
  242. 029 *                 as described in the Protocol Manual chapter 6.
  243. 030 *
  244. 031 *Exit:  STATUS := LEN field (dec.) of packet if packet all ok;
  245. 032 *                 neg. error code if not.
  246. 033 END
  247. 034 * * * * * Revision history * * * * *
  248. 035 *.1 - 3/27/89 JF3 - Scan for MARK
  249. 036 *
  250. 037 *.0 - 10/21/88 JF3
  251.  
  252.     DKXMTA
  253. 001 SUBROUTINE (STATUS)
  254. 002 *XMiT file Attribute packet(s)
  255. 003 *7/29/87 JF3 0.3.0
  256. 004 *]DKFPKT]DKXPKTS]DKFATAL
  257. 005 COM X1(5),PACKET,X2,RCV.PKT.TYPE,X3(8),MAXL,X4(6),CHKT,X5(23),F.A
  258. 006 EQU XMT.PKT.TYPE TO STATUS,OK TO STATUS
  259. 007 max.len=MAXL-2-CHKT;pkt.len=0;PACKET="";v=0;LOOP
  260. 008   IF v THEN attribute=F.A<2,v> ELSE attribute=14
  261. 009 UNTIL attribute="" DO
  262. 010   IF v THEN DATA=F.A<1,v> ELSE DATA=PAR.LIST<10>
  263. 011   length=LEN(DATA)
  264. 012   pkt.len=pkt.len+length+2;IF pkt.len>max.len THEN GOSUB 5;PACKET=""
  265. 013   CALL DKCNV(attribute,1,0);CALL DKCNV(length,1,0)
  266. 014     PACKET=PACKET:attribute:length:DATA
  267. 015 v=v+1;REPEAT
  268. 016 5 XMT.PKT.TYPE="A";CALL DKFPKT(XMT.PKT.TYPE);IF OK THEN
  269. 017     RECEIVER=0;CALL DKXPKTS(RECEIVER)
  270. 018     IF RCV.PKT.TYPE="E" THEN CALL DKFATAL(STATUS)
  271. 019   END
  272. 020 RETURN
  273. 021 * * * * * Interface info * * * * *
  274. 022 *Entry: F.A     := dynamic array of settable File Attribute data
  275. 023 *        <1>    := multivalued list of attribute data
  276. 024 *        <2>    := assoc. m.v. list of attr. codes
  277. 025 * * * * * Revision history * * * * *
  278. 026 *.0 - 7/29/87 JF3
  279. 027 END
  280.  
  281.     DKACK
  282. 001 SUBROUTINE (STATUS)
  283. 002 *set up an ACKnowledge packet
  284. 003 *10/21/88 JF3 0.3.0
  285. 004 *]DKFPKT
  286. 005 COM X1(4),n,DATA,X2(30),r
  287. 006 BEGIN CASE
  288. 007 CASE STATUS="Y"
  289. 008 CASE STATUS="E"
  290. 009 CASE STATUS="N";DATA="";GO 9
  291. 010 CASE 1;STATUS="Y":STATUS
  292. 011 END CASE;n=MOD(n+1,64);r=0;9 CALL DKFPKT(STATUS);RETURN
  293. 012 * * * * * Interface info * * * * *
  294. 013 *Entry:  STATUS := "E" if error msg for acknowledgement
  295. 014 *                  "Y" for plain ack.
  296. 015 *                  otherwise carry packet type thru to FormPacKeT
  297. 016 *
  298. 017 *Exit:   STATUS    See DKFPKT.
  299. 018 *        r      := retry counter set to 0
  300. 019 * * * * * Revision history * * * * *
  301. 020 *.0 - 10/21/88 JF3
  302. 021 END
  303.  
  304.     DKXMTB
  305. 001 SUBROUTINE (STATUS)
  306. 002 *Transmit a Break Transmission pkt.
  307. 003 *1/29/87 JF3 0.3.0
  308. 004 *]DKFPKT]DKXPKTS]DKFATAL
  309. 005 COM X1(5),DATA,X2,RCV.PKT.TYPE
  310. 006 EQU XMT.PKT.TYPE TO STATUS,OK TO STATUS
  311. 007 XMT.PKT.TYPE="B";DATA="";CALL DKFPKT(XMT.PKT.TYPE);IF OK THEN
  312. 008   STATUS=0;CALL DKXPKTS(STATUS)
  313. 009   IF OK<=0 OR RCV.PKT.TYPE="E" THEN CALL DKFATAL(STATUS) ELSE
  314. 010     PROMPT">"
  315. 011 *   ECHO.ON=OCONV(0,"U70E0");*Microdata
  316. 012     ECHO ON;                 *PICK/Ultimate
  317. 013   END
  318. 014 END;RETURN
  319. 015 * * * * * Interface info * * * * *
  320. 016 *Entry: none
  321. 017 *Exit:  none - return to command level
  322. 018 * * * * * Revision history * * * * *
  323. 019 *.0 - 1/29/87 JF3
  324. 020 END
  325.  
  326.     DKSTATUS
  327. 001 SUBROUTINE (STATUS)
  328. 002 *Display Kermit status
  329. 003 *1/29/87 JF3 0.3.0
  330. 004 *]DKCNV
  331. 005 COM P(64);EQU PAR.LIST TO P(12)
  332. 006 p=1;LOOP PARAM=PAR.LIST<2,p> UNTIL PARAM="" DO
  333. 007   index=-PAR.LIST<3,p>;cnv=PAR.LIST<5,p>;IF NUM(cnv) THEN cnv=-cnv
  334. 008   CALL DKCNV(arg,cnv,index);PRINT PARAM:"=":arg
  335. 009 p=p+1;REPEAT;STATUS=1;RETURN
  336. 010 * * * * * Interface info * * * * *
  337. 011 * Entry:
  338. 012 *   PAR.LIST := <2,p> parameter p name
  339. 013 *            := <3,p> COM position
  340. 014 *            := <5,p> conversion type/subr name
  341. 015 * Exit:
  342. 016 *   STATUS   := 1 means finished ok
  343. 017 * * * * * Revision history * * * * *
  344. 018 *.0 - 1/29/87 JF3 Not yet ready for subparams.
  345. 019 END
  346.  
  347.     RDF
  348. 001 *MAIN
  349. 002 *Read distr. files in PROC PIB
  350. 003 *8/10/89 JF3 R83 2.2
  351. 004 PROCREAD PIB ELSE PRINT "Must be run from MAKE-DISTR PROC!";STOP
  352. 005 a=FIELD(PIB," ",1);list=FIELD(PIB," ",2)
  353. 006 OPEN "DICT","M/DICT" ELSE PRINT "NO M/DICT!";STOP
  354. 007 a=a+1;READV line FROM list,a ELSE PRINT "No DISTR-FILES";STOP
  355. 008 PIB=a:" ":line;PROCWRITE PIB
  356. 009 * * * * * Interface info * * * * *
  357. 010 *Entry: none - used only for the MAKE-DISTR  and MAKE-COLUMBIA Procs
  358. 011 * * * * * Revision history * * * * *
  359. 012 *.1 - 8/10/89 JF3 Add Columbia files list
  360. 013 *
  361. 014 *.0 - 1/19/89 JF3
  362. 015 END
  363.  
  364.     DKRF1
  365. 001 SUBROUTINE (status)
  366. 002 *Receive a File name packet -- filetype = 1 -- UNUSED IN 0.3
  367. 003 *6/29/87 JF3 0.3
  368. 004 *]DKCNV
  369. 005 EQU AM TO CHAR(254)
  370. 006 IF item#"" THEN
  371. 007   CALL DKCNV(access,"",-16:AM:9);IF access="S" THEN item="" ELSE
  372. 008     status=0;GO 9
  373. 009   END;IF item<1>#"CC" AND item<1>#"CL" THEN
  374. 010     DK1.3="U3":FID<1,1>;beg.fid=OCONV("",DK1.3)
  375. 011     IF beg.fid THEN
  376. 012       item<12>=beg.fid;item<13>=1
  377. 013     END
  378. 014   END
  379. 015 END;9 RETURN
  380. 016 * * * * * Interface info * * * * *
  381. 017 *Entry: item := existing item body if any
  382. 018 *
  383. 019 *Exit:
  384. 020 END
  385.  
  386.     ANSITAPE
  387. 001 *MAIN
  388. 002 *Read ANSI formatted tape; convert to file item(s). Not usable for 0.3!
  389. 003 *12/30/86 JF3 4.2E
  390. 004 OPEN "DICT","DK" ELSE PRINT "No DICT DK!";STOP
  391. 005 READ ST FROM "ANSITAPE" ELSE
  392. 006   PRINT "No ANSITAPPE in DICT DK!";STOP
  393. 007 END;PRINT "DESTINATION FILE NAME:":;INPUT file.name
  394. 008 OPEN "",file.name ELSE PRINT "No such file!";STOP
  395. 009 EQU Symbol TO RCW;STATE=1;D=0;LOOP
  396. 010   p=1;READT block ELSE p=0
  397. 011   IF p THEN Symbol=block[p,4]
  398. 012   I=ST<3-p,STATE>;BEGIN CASE
  399. 013   CASE I=2;IF Symbol#"VOL1" THEN GO 9
  400. 014   CASE I=3
  401. 015     IF Symbol="HDR1" THEN
  402. 016       file.name=block[5,17];ext=TRIM(FIELD(file.name,".",2))
  403. 017       IF ext[1,2]="DK" THEN
  404. 018         file.name=FIELD(file.name,".",1);a=1;item=""
  405. 019       END
  406. 020     END ELSE I=0
  407. 021   CASE I=4
  408. 022     IF Symbol="VOL1" THEN D=-1 ELSE
  409. 023       LOOP UNTIL RCW="" OR RCW[1,1]="^" DO
  410. 024         item<a>=block[p+4,RCW-4];a=a+1;p=p+RCW;RCW=block[p,4]
  411. 025       REPEAT;p=1;I=0
  412. 026     END
  413. 027   CASE I=5
  414. 028     IF Symbol="EOF1" THEN
  415. 029       WRITE item ON file.name
  416. 030     END ELSE I=0
  417. 031   CASE I=8;D=5
  418. 032   CASE I=9
  419. 033 9   PRINT "FORMAT ERROR!";PRINT "STATE=":STATE;STATE=99
  420. 034     IF p THEN PRINT block
  421. 035   END CASE;IF I THEN STATE=ST<4,STATE>+D;D=0
  422. 036 UNTIL STATE>=9 DO REPEAT
  423. 037 REWIND ELSE PRINT "TAPE NOT READY!"
  424. 038 END
  425.  
  426.     DKQUOT
  427. 001 SUBROUTINE (RX,f,F)
  428. 002 *Reconcile send-init Quote fields
  429. 003 *1/29/87 JF3 0.3.0
  430. 004 *
  431. 005 COM X1(21),QCTL,QBIN,CHKT,REPT,X2(28),SQCTL,SQBIN,SCHKT
  432. 006 BEGIN CASE
  433. 007 CASE f=7
  434. 008   BEGIN CASE
  435. 009   CASE F="N" OR F="" OR F=QCTL;GO 4
  436. 010   CASE F="Y";QBIN=SQBIN;F=QBIN
  437. 011   CASE 1;GOSUB 10;IF X THEN F="Y" ELSE
  438. 012 4     QBIN="";F="N"
  439. 013   END;END CASE
  440. 014 CASE f=8;IF F#SCHKT THEN CHKT=1
  441. 015 CASE f=9
  442. 016   BEGIN CASE
  443. 017   CASE F=" " OR F="" OR F=QCTL OR F=QBIN;GO 6
  444. 018   CASE 1;GOSUB 10;IF X THEN REPT=F ELSE
  445. 019 6     REPT="";F=" "
  446. 020   END;END CASE
  447. 021 END CASE;RETURN
  448. 022 10 X=SEQ(F);X=(33<=X AND X<=62) OR (96<=X AND X<=126);RETURN
  449. 023 * * * * * Interface info * * * * *
  450. 024 *Entry: RX     := 1 if receiver, 0 if sender (Mistakenly not referenced!)
  451. 025 *       f      := Init packet field #
  452. 026 *       F      :=  "     "      "   contents
  453. 027 *Exit:  COM fields setup for transaction
  454. 028 * * * * * Revision history * * * * *
  455. 029 *.0 - 1/29/87 JF3
  456.  
  457.     DKRETR
  458. 001 SUBROUTINE (STATUS)
  459. 002 *RETreive Record to send from system
  460. 003 *7/21/87 JF3 0.3.0
  461. 004 *]DKFTYPE
  462. 005 COM CMD.LINE,X1,ERR,X2,PKT.SEQ,DATA,CHECK,TYPE,X3,DEBUG.MODE
  463. 006 COM X4(6),MAXL,X5(6),CHKT,X6(9),PICK.file.type,p,L,X7(4)
  464. 007 COM ID,ITEM,rec.terminator,F.NAME,FV,filename.type,FID,X8(16),Type
  465. 008 EQU INITIAL.ENTRY TO STATUS,OK TO STATUS,AM TO CHAR(254),DK1 TO p
  466. 009 IF INITIAL.ENTRY THEN
  467. 010   PICK.file.type=filename.type<2>;DK1=FID<1,1>
  468. 011   BEGIN CASE
  469. 012   CASE PICK.file.type<2
  470. 013     READ ITEM FROM FV,ID ELSE DATA="item: ":ID;ID=4;GO 10
  471. 014     IF PICK.file.type=1 THEN
  472. 015       A1=ITEM<1>
  473. 016       * * * * * Ultimate * * * * *
  474. 017       IF A1="CC" OR A1="CL" THEN
  475. 018         STATUS=OCONV(ITEM<2>:",":ITEM<3>,"U3":DK1);IF OK THEN NULL
  476. 019       END ELSE PICK.file.type=0
  477. 020     END
  478. 021   CASE PICK.file.type=3
  479. 022     STATUS=OCONV(ID,"U0":DK1);IF OK THEN DK1="U1":DK1 ELSE
  480. 023       DATA="entry: ":ID;ID=4;GO 10
  481. 024     END
  482. 025   CASE 1
  483. 026 2   DATA="DATAFILE";ID=1;GO 10
  484. 027   END CASE;CALL DKFTYPE;L=INT(8*(MAXL-2-CHKT)/10)
  485. 028   IF NOT(PICK.file.type) THEN p=1
  486. 029 END ELSE
  487. 030   BEGIN CASE
  488. 031   CASE PICK.file.type<2
  489. 032     IF Type="A" THEN
  490. 033       DATA=FIELD(ITEM,AM,p);p=p+1;STATUS=NOT(COL2())
  491. 034       DATA=DATA:rec.terminator
  492. 035     END ELSE DATA=ITEM[p,L];p=p+L;STATUS=(DATA="")
  493. 036   CASE PICK.file.type=3
  494. 037     STATUS=0;DATA=OCONV(L,DK1)
  495. 038     IF DATA=CHAR(0) OR DATA="" THEN STATUS=1
  496. 039   END CASE
  497. 040 END;9 RETURN
  498. 041 10 DATA=INSERT(DATA,1,0,0,"K":ID);STATUS=-1;GO 9
  499. 042 * * * * * Interface info * * * * *
  500. 043 *Entry: STATUS       := 1 means first entry to retrieve data
  501. 044 *                       0 means subsequent entry; return next record
  502. 045 *
  503. 046 *Exit:                  On INITIAL.ENTRY        On subsequent entries
  504. 047 *                       ----------------        ---------------------
  505. 048 *       STATUS       := 1 means data ok          1 means last record
  506. 049 *                                                0 means more to go
  507. 050 *                       -----------------On either-------------------
  508. 051 *                      <0 means K-msg err id VM filler in DATA
  509. 052 *Uses:  NFN          := 1 means Normalized File Names in the
  510. 053 *                         Kermit sense
  511. 054 * * * * * Revision history * * * * *
  512. 055 *.0 - 7/21/87 JF3
  513. 056 END
  514.  
  515.     DKXMTZ
  516. 001 SUBROUTINE (STATUS)
  517. 002 *Transmit a End of File packet
  518. 003 *1/29/87 JF3 0.3.0
  519. 004 *]DKFPKT]DKXPKTS]DKFATAL
  520. 005 COM X1(5),DATA,X2,RCV.PKT.TYPE
  521. 006 EQU XMT.PKT.TYPE TO STATUS,OK TO STATUS
  522. 007 XMT.PKT.TYPE="Z";DATA="";CALL DKFPKT(XMT.PKT.TYPE);IF OK THEN
  523. 008   STATUS=0;CALL DKXPKTS(STATUS)
  524. 009   IF OK<=0 OR RCV.PKT.TYPE="E" THEN CALL DKFATAL(STATUS)
  525. 010 END
  526. 011 9 RETURN
  527. 012 * * * * * Interface info * * * * *
  528. 013 *Entry: none
  529. 014 *Exit:  transaction terminated
  530. 015 * * * * * Revision history * * * * *
  531. 016 *.0 - 1/29/87 JF3
  532. 017 END
  533.  
  534.     DKCOMMENT
  535. 001 SUBROUTINE (STATUS)
  536. 002 *no operation; just a COMMENT for TAKE files
  537. 003 *11/4/88 JF3 0.3.0
  538. 004 *
  539. 005 COM X1,HELP.LIST,X2(3),LINE
  540. 006 STATUS=1;RETURN
  541. 007 * * * * * Interface info * * * * *
  542. 008 *No interface needed
  543. 009 * * * * * Revision history * * * * *
  544. 010 *
  545. 011 *.0 11/4/88 JF3
  546. 012 END
  547.  
  548.     DKXMTD
  549. 001 SUBROUTINE (STATUS)
  550. 002 *Transmit Data packet(s)
  551. 003 *1/29/87 JF3 0.3.0
  552. 004 *]DKFPKT]DKXPKTS]DKFATAL
  553. 005 COM X1(5),DATA,X2,RCV.PKT.TYPE,X3(8),MAXL
  554. 006 EQU XMT.PKT.TYPE TO STATUS,OK TO STATUS,LEN TO STATUS,RECEIVER TO STATUS
  555. 007 ALL.DATA=DATA;LEN.ALL.DATA=LEN(ALL.DATA);PTR=0;LOOP
  556. 008   XMT.PKT.TYPE="D";CALL DKFPKT(XMT.PKT.TYPE)
  557. 009   IF OK>0 THEN
  558. 010     PTR=PTR+LEN;RECEIVER=0;CALL DKXPKTS(RECEIVER)
  559. 011     IF RCV.PKT.TYPE="E" THEN CALL DKFATAL(STATUS)
  560. 012   END ELSE GO 9
  561. 013 UNTIL PTR=LEN.ALL.DATA DO DATA=ALL.DATA[PTR+1,MAXL] REPEAT
  562. 014 9 RETURN
  563. 015 * * * * * Interface info * * * * *
  564. 016 *Entry: DATA := data field of packet to send
  565. 017 *
  566. 018 *Exit:  STATUS := # of chars sent if successful
  567. 019 *              := <= 0 if unsuccessful
  568. 020 * * * * * Revision history * * * * *
  569. 021 *.0 - 1/29/87 JF3
  570. 022 END
  571.  
  572.     DKVERSION
  573. 001 SUBROUTINE (STATUS)
  574. 002 *Display current Kermit version & revision
  575. 003 *1/29/87 JF3 0.3.0
  576. 004 *
  577. 005 COM X1,HELP.LIST
  578. 006 PRINT HELP.LIST<1>[2,999];STATUS=1;RETURN
  579. 007 * * * * * Interface info * * * * *
  580. 008 *Entry: none
  581. 009 *Exit:  none
  582. 010 * * * * * Revision history * * * * *
  583. 011 *.0 - 1/29/87 JF3
  584. 012 END
  585.  
  586.     DKCTL
  587. 001 SUBROUTINE (N)
  588. 002 *Perform Kermit ctl() function
  589. 003 *4/9/87 JF3 0.3.0
  590. 004 *
  591. 005 s=SEQ(N);BEGIN CASE
  592. 006 CASE s<=31 OR s=63;s=s+64
  593. 007 CASE 64<=s AND s<=95 OR s=127;s=s-64
  594. 008 CASE 1;N=" ";GO 9
  595. 009 END CASE;N=CHAR(s)
  596. 010 9 RETURN
  597. 011 * * * * * Interface Info * * * * *
  598. 012 * Entry: N contains a single character in the range:
  599. 013 *          0-31,63-95,127 (decimal)
  600. 014 * Exit:  N contains Kermit ctl(N), i.e. N xor 64.
  601. 015 * * * * * Revision history * * * * *
  602. 016 *.0 - 4/9/87 JF3
  603. 017 END
  604.  
  605.     DKDF
  606. 001 SUBROUTINE (arg,c,index)
  607. 002 *Convert DATAFILE to include file type
  608. 003 *5/6/87 JF3 0.3.0
  609. 004 !]DKOPNFILE
  610. 005 COM X1(45),datafile
  611. 006 datafile=arg;BEGIN CASE
  612. 007 CASE c=1
  613. 008   BEGIN CASE
  614. 009   CASE arg="TERMINAL";type="2"
  615. 010   CASE arg="SPOOLER";type="3"
  616. 011   CASE 1
  617. 012     CALL DKOPNFILE(type);IF type<0 THEN
  618. 013       c="K4";c<2>="file: ":arg;index<1>=0;GO 9
  619. 014     END
  620. 015   END CASE;index<2>=type
  621. 016 CASE c=-1
  622. 017   arg=datafile<1>;type=datafile<2>
  623. 018   IF type#"" THEN arg=arg:" <":type:">"
  624. 019 CASE 1
  625. 020 * INS "K10" BEFORE c<1>;c<2,2>="DKDF";  *ULTIMATE/Microdata
  626. 021   c=INSERT(c,1,0,0,"K10");c<2,2>="DKDF";*PICK
  627. 022 9 arg="!!!";datafile="";GO 10
  628. 023 END CASE;c=0;10 RETURN
  629. 024 * * * * * Interface info * * * * *
  630. 025 * Entry:
  631. 026 *   if c=1 then convert from display to internal formats with file opening
  632. 027 *      arg    := [ {DICT }filename ]
  633. 028 *                [  SPOOLER        ]
  634. 029 *   if  c=-1 then convert from internal to display formats
  635. 030 *      arg<1> := as above plus
  636. 031 *      arg<2> := [ null ] if ordinary data file or
  637. 032 *                [ P    ] if SPOOLER.
  638. 033 * Exit:
  639. 034 *      arg    := opposite form of c=1 to c=-1 above (conv ok)
  640. 035 *             := "!!!" indicates fatal error
  641. 036 *      c=0    := no further conversions (conv ok)
  642. 037 *      c<1>   := fatal error message item-id
  643. 038 *      c<2>   := multivalued parameters for error message
  644. 039 * * * * * Revision history * * * * *
  645. 040 *.0 - 5/6/87 JF3
  646. 041 END
  647.  
  648.     DKSERVER
  649. 001 SUBROUTINE (STATUS)
  650. 002 *go into SERVER mode for command input - NOT USED in 0.3
  651. 003 *6/25/87 JF3
  652. 004 *]DKRCVG]DKXPKTS]DKRCVt]DKACK
  653. 005 COM X1(5),msg,X2(33),remote.control
  654. 006 msg="K20";STATUS="!";CALL DKIO(STATUS)
  655. 007 remote.control=1
  656. 008 STATUS=1;RETURN
  657. 009 * * * * * Interface info * * * * *
  658. 010 *Entry: none
  659. 011 *
  660. 012 *Exit:  remote.control := set to Server mode = "1"
  661. 013 * * * * * Revision history * * * * *
  662. 014 *.0 - 6/25/87 JF3
  663. 015 END
  664.  
  665.     DKATTRS
  666. 001 SUBROUTINE (STATUS)
  667. 002 *Send file ATTRibuteS -- UNUSED IN 0.3
  668. 003 *7/14/87 JF3
  669. 004 *]DKCNV]DKXMTA
  670. 005 COM X1(2),ERR,X2(2),DATA,X3(38),FV,FILE.NAME
  671. 006 CALL DKCNV(ATTRS.ON,0,0);*NEEDS TO BE FIXED
  672. 007 IF ATTRS.ON THEN
  673. 008   A=1;ATTRS=1;LOOP
  674. 009     index=-(32*A-6);CALL DKCNV(OK,"",index);ATTRS=ATTRS*OK
  675. 010   WHILE ATTRS AND A<2 DO A=A+1 REPEAT
  676. 011   IF ATTRS THEN CALL DKXMTA(STATUS) ELSE OK=1
  677. 012 END;RETURN
  678. 013 * * * * * Interface info * * * * *
  679. 014 *Entry:
  680. 015 *
  681. 016 *Exit:
  682. 017 * * * * * Revision history * * * * *
  683. 018 *.0 - 7/14/87 JF3
  684. 019 END
  685.  
  686.     DKTAKE
  687. 001 SUBROUTINE (STATUS)
  688. 002 *Take sequence of commands from file item (begin attr. 2)
  689. 003 *1/29/87 JF3 0.3.1
  690. 004 *]DKOPNFILE]DKPARSE]DKcmd]PERR
  691. 005 COM CMD.LINE,X1,ERR,X2(2),DATA,X3(38),FV,FILE.NAME
  692. 006 EQU LF TO CHAR(10),CR TO CHAR(13),SPACE TO " ",OK TO STATUS
  693. 007 EQU VM TO CHAR(253),AM TO CHAR(254),MSG TO STATUS,ID TO STATUS
  694. 008 CALL DKOPNFILE(STATUS);IF OK THEN
  695. 009   ID=FIELD(CMD.LINE,SPACE,I);IF ID="" THEN ITEM="" ELSE
  696. 010     READ ITEM FROM FV,ID ELSE MSG=ID:VM:FILE.NAME;ID=21;GO 7
  697. 011   END;A=2;LOOP CMD=ITEM<A> UNTIL CMD="" DO
  698. 012     C=CMD;CALL DKPARSE(C)
  699. 013     IF C THEN SUBR="DK":CMD;CALL @SUBR(STATUS) ELSE ID="K1";MSG="";GOSUB 7
  700. 014   A=A+1;REPEAT
  701. 015 END ELSE ID="K0";MSG=""
  702. 016 7 CALL PERR(0,0,ERR,ID,MSG);8 STATUS=0;9 RETURN
  703. 017 * * * * * Interface info * * * * *
  704. 018 *
  705. 019 * * * * * Revision history * * * * *
  706. 020 *.1 11/4/88 JF3 Change to multi-attribute command format
  707. 021 *
  708. 022 *.0 1/29/87 JF3
  709. 023 END
  710.  
  711.     DKDFAULT
  712. 001 SUBROUTINE (STATUS)
  713. 002 *set DEFAULT parameters
  714. 003 *6/25/87 JF3 0.3.0
  715. 004 *]PERR]DKCNV
  716. 005 COM P(64);EQU SVM TO CHAR(252),VM TO CHAR(253)
  717. 006 EQU HELP.LIST TO P(2),ERR TO P(3),MSG TO P(6),PAR.LIST TO P(12)
  718. 007 EQU DK.MD TO P(15),UM.FIDS TO P(47)
  719. 008 id="HELP";READ HELP.LIST FROM DK.MD,id ELSE GO 4
  720. 009 id="PARAMS";READ PAR.LIST FROM DK.MD,id ELSE
  721. 010 4 CALL PERR(0,0,ERR,21,id:VM:"DK-MD");STOP
  722. 011 END;UM.FIDS=PAR.LIST<13>
  723. 012 v=1;LOOP PAR=PAR.LIST<2,v> UNTIL PAR="" DO
  724. 013   index=PAR.LIST<3,v>;cnv=PAR.LIST<5,v>;s=1;arg.list=PAR.LIST<7,v>
  725. 014   IF NOT(NUM(cnv)) THEN cnv<1,2>=1
  726. 015   LOOP arg=FIELD(arg.list,SVM,s) WHILE COL2() DO
  727. 016     IF arg#"" THEN
  728. 017       index<2>=PAR.LIST<9,v,s>;CALL DKCNV(arg,cnv,index)
  729. 018       IF arg="!!!" THEN MSG=cnv;CALL DKIO("!");STATUS=0;GO 9
  730. 019     END
  731. 020   s=s+1;REPEAT;index=index<1>;IF 49<=index AND index<=61 THEN
  732. 021     P(index-32)=P(index)
  733. 022   END;v=v+1
  734. 023 REPEAT;STATUS=1;9 RETURN
  735. 024 * * * * * Interface info * * * * *
  736. 025 *Entry: none (execpt in COM)
  737. 026 *Exit:  STATUS set true
  738. 027 * * * * * Revision history * * * * *
  739. 028 *.0 - 6/25/87 JF3
  740. 029 END
  741.  
  742.     DKXMTF
  743. 001 SUBROUTINE (STATUS)
  744. 002 *Transmit a File Header packet
  745. 003 *1/29/87 JF3 0.3.0
  746. 004 *]DKFPKT]DKXPKTS]DKFATAL
  747. 005 COM X1(7),RCV.PKT.TYPE
  748. 006 EQU XMT.PKT.TYPE TO STATUS,OK TO STATUS
  749. 007 XMT.PKT.TYPE="F";CALL DKFPKT(XMT.PKT.TYPE);IF OK THEN
  750. 008   RECEIVER=0;CALL DKXPKTS(RECEIVER)
  751. 009   IF RCV.PKT.TYPE="E" THEN CALL DKFATAL(STATUS)
  752. 010 END;RETURN
  753. 011 * * * * * Interface info * * * * *
  754. 012 *Entry: none
  755. 013 *Exit:  none
  756. 014 *                 neg. error code if not.
  757. 015 * * * * * Revision history * * * * *
  758. 016 *.0 - 1/29/87 JF3
  759. 017 END
  760.  
  761.     DKERR
  762. 001 SUBROUTINE DKERR
  763. 002 *Format ERRor messages for output
  764. 003 *5/6/87 JF3 0.3.0
  765. 004 *]PERR
  766. 005 COM X1(2),ERR,X2(2),msg;EQU VM TO CHAR(253)
  767. 006 i=msg<1>;READV MSG FROM ERR,i,2 ELSE MSG="No '":i:"' in DK-ERR!"
  768. 007 msg=msg<2>;i=1;j=1;OMSG=""
  769. 008 LOOP X=FIELD(MSG,VM,i) UNTIL COL2()=0 DO
  770. 009   IF X="" THEN X=msg<1,j>;j=j+1
  771. 010   OMSG=OMSG:X;i=i+1
  772. 011 REPEAT;msg=OMSG;RETURN
  773. 012 * * * * * Interface info * * * * *
  774. 013 * Entry:
  775. 014 *   msg<1>   := error msg item-id in ERR file
  776. 015 *      <2>   := filler for msg body (multivalued)
  777. 016 *
  778. 017 * Exit:
  779. 018 *   msg      := formatted msg for output
  780. 019 * * * * * Revision history * * * * *
  781. 020 *.0 - 5/6/87 JF3
  782. 021 END
  783.  
  784.     DKAnn
  785. 001 *DUMMY
  786. 002 *called subroutine list and common interface for received A packets
  787. 003 *7/21/87 JF3 0.3.0
  788. 004 *]DKA01]DKA02]DKA09]DKA15
  789. 005 * * * * * Interface info * * * * *
  790. 006 *Entry: STATUS := DATA portion of subfield of A packet
  791. 007 *
  792. 008 *Exit:
  793. 009 * * * * * Revision history * * * * *
  794. 010 *.0 - 7/21/87 JF3
  795. 011 END
  796.  
  797.     DKINIT
  798. 001 SUBROUTINE (STATUS)
  799. 002 *Initial Send-init parameters
  800. 003 *4/9/87 JF3 0.3.0
  801. 004 *]DKCNV]DKDBUG
  802. 005 COM X1(2),ERR,X2(2),DATA,X3(3),DEBUG.MODE,X4(38)
  803. 006 COM SPAR(16);EQU AM TO CHAR(254),VM TO CHAR(253)
  804. 007 C=1:AM:1:AM:1:AM:AM:-3:AM:AM:AM:AM:AM:"CAPAS":VM:1:AM:1:AM:1:AM:1
  805. 008 DATA="";FOR index=49 TO 61
  806. 009   I=index-48;CALL DKCNV(arg,C<I>,-index)
  807. 010   IF index=52 THEN CALL DKCNV(arg,4,0)
  808. 011   IF index=53 THEN CALL DKCNV(arg,1,0)
  809. 012   DATA=DATA:arg
  810. 013 NEXT index;IF DEBUG.MODE THEN
  811. 014   SAVE=DATA;I=LEN(DATA)+3;CALL DKCNV(I,1,0)
  812. 015   DATA=CHAR(0):I:"  ":DATA:" ";CALL DKDBUG("I");DATA=SAVE
  813. 016 END;STATUS=1;RETURN
  814. 017 * * * * * Interface info * * * * *
  815. 018 *Entry: none
  816. 019 *Exit:  send-init packet setup
  817. 020 * * * * * Revision history * * * * *
  818. 021 *.0 - 4/9/87 JF3
  819. 022 END
  820.  
  821.     DKA15
  822. 001 SUBROUTINE (STATUS)
  823. 002 *check received Attribute 15 (Format) -- UNUSED IN 0.3
  824. 003 *6/11/87 JF3
  825. 004 *]DKCTL]DKCNV
  826. 005 COM X1(42),record.termination,X2(19),p.format
  827. 006 EQU DATA TO STATUS,rec.size.len TO record.termination
  828. 007 p.format=DATA[1,1];record.termination="";ix=43;BEGIN CASE
  829. 008 CASE p.format="A"
  830. 009   i=2;LOOP c=DATA[i,1] UNTIL c="" DO
  831. 010     CALL DKCTL(c);record.termination=record.termination:c
  832. 011   i=i+1;REPEAT;GO 9
  833. 012 CASE p.format="D";l=1
  834. 013 CASE p.format="F";l=4
  835. 014 CASE p.format="M";l=1;ix=0;*NEEDS TO BE FIXED
  836. 015 CASE p.format="R";l=1;ix=0
  837. 016 CASE 1;STATUS=0;GO 9
  838. 017 END CASE;arg=DATA[2,l];IF l=1 THEN
  839. 018   IF NUM(arg) THEN cnv=0 ELSE cnv=-1
  840. 019   CALL DKCNV(arg,cnv,ix)
  841. 020 END;8 STATUS=1;9 RETURN
  842. 021 * * * * * Interface info * * * * *
  843. 022 * * * * * Revision history * * * * *
  844. 023 *.0 - 6/11/87 JF3
  845. 024 END
  846.  
  847.     DKFATAL
  848. 001 *TERM
  849. 002 *Process fatal errors; print diagnostic msg
  850. 003 *1/29/87 JF3 0.3
  851. 004 *
  852. 005 COM X(62),line,prog
  853. 006 *Should call DKIO here !
  854. 007 PRINT "?Fatal error in LINE ":line:" of ":prog
  855. 008 * * * * * Interface info * * * * *
  856. 009 *Entry: line := source line # of problem program
  857. 010 *       prog := problem program name
  858. 011 *Exit: none
  859. 012 * * * * * Revision history * * * * *
  860. 013 *.0 - 1/29/87 JF3
  861. 014 END
  862.  
  863.     DKXMTG
  864. 001 SUBROUTINE (STATUS)
  865. 002 *XMiT a Generic server command -- UNUSED IN 0.3
  866. 003 *8/7/87 JF3
  867. 004 *]DKFPKT]DKXPKTS]DKFATAL
  868. 005 COM X1(4),n,DATA,X2,RCV.PKT.TYPE,X3(8),MAXL
  869. 006 EQU XMT.PKT.TYPE TO STATUS,OK TO STATUS,LEN TO STATUS,RECEIVER TO STATUS
  870. 007 XMT.PKT.TYPE="G";n=0;CALL DKFPKT(XMT.PKT.TYPE);IF OK THEN
  871. 008   RECEIVER=0;CALL DKXPKTS(RECEIVER)
  872. 009   BEGIN CASE
  873. 010   CASE RCV.PKT.TYPE="S"
  874. 011     IF DATAFILE#"" THEN
  875. 012       CALL DKRECON(STATUS)
  876. 013       CALL DKRECEIVE(STATUS)
  877. 014     END
  878. 015   CASE RCV.PKT.TYPE="X"
  879. 016 *   Set up to type on terminal
  880. 017     n=n+1
  881. 018   CASE RCV.PKT.TYPE="Y"
  882. 019     GOSUB 10
  883. 020   CASE RCV.PKT.TYPE="N"
  884. 021   CASE 1
  885. 022   END CASE
  886. 023 END
  887. 024 RETURN
  888. 025 10 CALL DKIO(STATUS);RETURN
  889. 026 * * * * * Interface info * * * * *
  890. 027 *Entry: DATA := single character command. See KPM 8.2.1. Must be
  891. 028 *                 less than MAXL long.
  892. 029 *
  893. 030 *Exit:  STATUS := 0 means DATA too long
  894. 031 *                 1   "   all went ok
  895. 032 * * * * * Revision history * * * * *
  896. 033 *.0 - 8/7/87 JF3
  897. 034 END
  898.  
  899.     KERMIT
  900. 001 *MAIN
  901. 002 *DATA/KERMIT
  902. 003 *6/30/87 JF3 0.3.0
  903. 004 *]OPENFILE]DKDFAULT]GTRMCHR]DKEXEC]DKIO
  904. 005 COM P(64);DIM i(3),Q(29)
  905. 006 EQU ERR TO P(3),MSG TO P(6),PARAMS TO P(12)
  906. 007 EQU DK.MD TO P(15),CMD.PROMPT TO P(33),REMOTE.CTRL TO P(40),c TO i(1)
  907. 008 EQU LF TO CHAR(10),CR TO CHAR(13)
  908. 009 MAT P="";MAT i="";MAT Q=""
  909. 010 CALL OPENFILE("DICT","DK-MD",DK.MD);CALL OPENFILE("","DK-ERR",ERR)
  910. 011 CALL DKDFAULT(status);IF REMOTE.CTRL="" THEN
  911. 012   CALL GTRMCHR(MSG);CLR.SCRN=MSG<1,1>
  912. 013   MSG=CLR.SCRN:PARAMS<1>[2,99];status=0;GOSUB 10
  913. 014   MSG=CR:LF;status=0;GOSUB 10
  914. 015 END;LOOP
  915. 016   CALL DKEXEC(status)
  916. 017 WHILE status DO REPEAT;STOP
  917. 018 10 CALL DKIO(status);RETURN
  918. 019 * * * * * Interface info * * * * *
  919. 020 *Entry: none
  920. 021 *
  921. 022 * * * * * Revision history * * * * *
  922. 023 *.0 - 6/30/87 JF3
  923. 024 END
  924.  
  925.     DKDBUG
  926. 001 SUBROUTINE (STATUS)
  927. 002 *Print KERMIT debug data on printer or pause for input/examine
  928. 003 *7/29/87 JF3 0.3.0
  929. 004 *]DKCNV
  930. 005 COM command,X1(4),DATA,X2(17),CHKT;EQU MX TO "MX",FMT TO "L#6"
  931. 006 IF command<1>="!DBUG" THEN
  932. 007   DATA="D/K DEBUG";STATUS=1;CALL DKIO(STATUS);STATUS=1
  933. 008 END ELSE
  934. 009   PRINTER ON;IF STATUS="H" THEN
  935. 010     PRINT ON 1 "                DATA/KERMIT DEBUG OUTPUT"
  936. 011     PRINT ON 1 ""
  937. 012     PRINT ON 1 "STAT  MARK  LEN   SEQ   TYPE  CHECK  "
  938. 013     PRINT ON 1 "      hex   dec   dec   chr   dec    TIME "
  939. 014     PRINT ON 1 "";PRINT ON 1 "      {DATA...}"
  940. 015   END ELSE
  941. 016     PRINT ON 1 "";PRINT ON 1 STATUS FMT:;FOR F=1 TO 5
  942. 017       IF F<5 THEN D=DATA[F,1] ELSE D=DATA[L+3-CHKT,CHKT]
  943. 018       IF F=1 THEN D=OCONV(D,MX)
  944. 019       IF F=2 OR F=3 THEN CALL DKCNV(D,-1,0)
  945. 020       IF F=2 THEN L=D
  946. 021       IF F=5 THEN
  947. 022         BEGIN CASE
  948. 023         CASE CHKT=1;CALL DKCNV(D,-1,0)
  949. 024 *       CASE CHKT=2
  950. 025 *       CASE CHKT=3
  951. 026         END CASE
  952. 027       END;PRINT ON 1 D FMT:
  953. 028     NEXT F;PRINT ON 1 OCONV(TIME(),"MTHS")
  954. 029     PRINT ON 1 ""FMT:"{":DATA[5,L-2-CHKT]:"}"
  955. 030   END;PRINTER OFF
  956. 031 END;RETURN
  957. 032 * * * * * Interface info * * * * *
  958. 033 *Entry: command := "!DBUG" means pause for input to eximane
  959. 034 *                   variables
  960. 035 *                   else print formatted packet data on logical
  961. 036 *                   printfile #1
  962. 037 * * * * * Revision history * * * * *
  963. 038 *.0 - 7/29/87 JF3
  964. 039 END
  965.  
  966.     DKEXEC
  967. 001 SUBROUTINE (status)
  968. 002 *EXEcute a Command
  969. 003 *10/17/88 JF3 0.3.1
  970. 004 *]DKIO]DKVERC
  971. 005 COM command.line,X1(4),DATA,X2(4),DELAY,X3(3),DK.MD,X4(17),CMD.PROMPT
  972. 006 COM X5(6),REMOTE.MODE;EQU LF TO CHAR(10),CR TO CHAR(13)
  973. 007 a=1;BEGIN CASE
  974. 008 CASE REMOTE.MODE=0
  975. 009 CASE REMOTE.MODE="" OR ABS(REMOTE.MODE)=1
  976. 010   DATA=CR:LF:CMD.PROMPT<3>;status=1;GOSUB 12
  977. 011 CASE REMOTE.MODE=2
  978. 012   DATA="";CALL DKXPKTS(status)
  979. 013 CASE REMOTE.MODE=3
  980. 014   id="COMMANDS";READU command.line FROM DK.MD,id ELSE RELEASE DK.MD,id
  981. 015   IF command.line="" THEN FOR s=1 TO DELAY;RQM 1;NEXT s ELSE
  982. 016     a=command.line<1>[2,9];WRITEV "K":a ON DK.MD,id,1
  983. 017   END
  984. 018 END CASE;IF REMOTE.MODE<2 THEN command.line=DATA;GOSUB 10
  985. 019 status=FIELD(command.line<a>," ",1);IF status="" THEN status=1 ELSE
  986. 020   CALL DKVERC(status);IF status>0 THEN
  987. 021     subroutine=DATA
  988. 022     IF REMOTE.MODE<2 THEN GOSUB 10
  989. 023     CALL @subroutine(status)
  990. 024   END
  991. 025 END;RETURN
  992. 026 10 DATA="";status=-1;12 CALL DKIO(status);RETURN
  993. 027 * * * * * Interface info * * * * *
  994. 028 *Entry: REMOTE.MODE := -1 means phantom for local mode
  995. 029 *                       0   "   local modes
  996. 030 *                       1   "   remote mode operation
  997. 031 *                       2   "   server mode
  998. 032 *                       3   "   remote command mode
  999. 033 *
  1000. 034 *Exit:
  1001. 035 * * * * * Revision history * * * * *
  1002. 036 *
  1003. 037 *.1 10/17/88 JF3 Fix batch capability
  1004. 038 *
  1005. 039 *.0 1/29/87 JF3
  1006. 040 END
  1007.  
  1008.     DKFTYPE
  1009. 001 SUBROUTINE DKFTYPE
  1010. 002 *Set up record delimiter form File attribute TYPE
  1011. 003 *7/14/87 JF3 0.3.0
  1012. 004 *]DKCNV
  1013. 005 COM X1(42),rec.delim,X2(20),Type;EQU AM TO CHAR(254)
  1014. 006 CALL DKCNV(Type,0,-48:AM:2);Opt=Type[2,9];Type=Type[1,1]
  1015. 007 BEGIN CASE
  1016. 008 CASE Type="A"
  1017. 009   IF Opt="" THEN Opt="MJ"
  1018. 010   c=1;rec.delim="";LOOP O=Opt[c,1] UNTIL O="" DO
  1019. 011     CALL DKCNV(O,4,0);rec.delim=rec.delim:O
  1020. 012   c=c+1;REPEAT
  1021. 013 CASE Type="B"
  1022. 014   IF Opt="" THEN Opt=8
  1023. 015   rec.delim=""
  1024. 016 CASE Type="I"
  1025. 017   IF Opt="" THEN Opt=8
  1026. 018   rec.delim=""
  1027. 019 END CASE;RETURN
  1028. 020 * * * * * Interface info * * * * *
  1029. 021 *Entry: F.A    := see DKXMTA
  1030. 022 *
  1031. 023 * * * * * Revision history * * * * *
  1032. 024 *.0 - 7/14/87 JF3
  1033. 025 END
  1034.  
  1035.     DKRCVS
  1036. 001 SUBROUTINE (STATUS)
  1037. 002 *ReCeiVe a Send-init packet to initialize
  1038. 003 *10/21/88 JF3 0.3.0
  1039. 004 *]DKDBUG]DKXPKTS]DKVPKT]DKRECON]DKACK
  1040. 005 COM X1(3),MARK,PKT.SEQ,DATA,CHECK,TYP,LIMIT,DEBUG.MODE,X2(10),EOL
  1041. 006 COM X3(11),CMD.PROMPT,X4(3),RETRY,LINE,X5,REMOTE.CTRL
  1042. 007 *ECHO.OFF=OCONV(0,"U80E0");*Microdata
  1043. 008  ECHO OFF;                 *PICK/Ultimate
  1044. 009 IF DEBUG.MODE THEN CALL DKDBUG("H")
  1045. 010 PKT.SEQ=-1;first.pkt=1;ok=0;PROMPT"";LOOP
  1046. 011   IF first.pkt THEN
  1047. 012 3   STATUS=3;CALL DKIO(STATUS);first.pkt=0;PROMPT EOL
  1048. 013     c=1;LOOP C=DATA[c,1] UNTIL C=MARK OR C="" DO c=c+1 REPEAT
  1049. 014     IF C="" THEN DATA="";GO 3 ELSE DATA=DATA[c,9999]
  1050. 015   END ELSE STATUS=1;CALL DKXPKTS(STATUS)
  1051. 016 * Timeout check goes here
  1052. 017 5 STATUS=1;CALL DKVPKT(STATUS);IF STATUS>0 THEN
  1053. 018     IF TYP="S" THEN
  1054. 019       ok=1;DATA=DATA[5,LEN(DATA)-5];CALL DKRECON(STATUS)
  1055. 020     END ELSE STATUS=-4;ok=STATUS
  1056. 021   END
  1057. 022 UNTIL STATUS=ok DO
  1058. 023   RETRY=RETRY+1;IF RETRY>=LIMIT THEN
  1059. 024 *   ECHO.ON=OCONV(0,"U70E0");*Microdata
  1060. 025     ECHO ON;                 *PICK/Ultimate
  1061. 026     GO 9
  1062. 027   END ELSE CALL DKACK("N")
  1063. 028 REPEAT;9 RETURN
  1064. 029 * * * * * Interface info * * * * *
  1065. 030 *Entry: none
  1066. 031 *
  1067. 032 *Exit:
  1068. 033 *  STATUS := 1 means all ok
  1069. 034 *           -4   "   non-S packet received
  1070. 035 * * * * * Revision history * * * * *
  1071. 036 *.0 - 10/21/88 JF3
  1072. 037 END
  1073.  
  1074.     DKRECEIVE
  1075. 001 SUBROUTINE (STATUS)
  1076. 002 *RECEIVE data transaction
  1077. 003 *7/17/89 JF3 0.3.1
  1078. 004 *]DKRCVS]DKACK]DKXPKTS]DKRCVF]DKRCVA]DKRCVD]DKRCVZ
  1079. 005 COM CMD.LINE,X1,ERR,X2,n,DATA,CHECK,TYPE,X3,DEBUG.MODE
  1080. 006 COM X4(23),PICK.file.type,X5(2),r,X6(6),local.dest.filespec,FV,FN
  1081. 007 EQU OK TO STATUS,LF TO CHAR(10),CR TO CHAR(13)
  1082. 008 OK=1;local.dest.filespec=FIELD(CMD.LINE<1>," ",2);PICK.file.type=FN<2>
  1083. 009 local.dest.filespec=""
  1084. 010 *IF local.dest.filespec#"" AND PICK.file.type>1 THEN STATUS=-1;GO 9
  1085. 011 r=0;CALL DKRCVS(STATUS);IF OK>0 THEN
  1086. 012   STATUS="S";CALL DKACK(STATUS);LOOP
  1087. 013     STATUS=1;CALL DKXPKTS(STATUS)
  1088. 014   UNTIL STATUS<=0 DO
  1089. 015     BEGIN CASE
  1090. 016     CASE TYPE="F";CALL DKRCVF(STATUS)
  1091. 017     CASE TYPE="A";CALL DKRCVA(STATUS)
  1092. 018     CASE TYPE="D";CALL DKRCVD(STATUS)
  1093. 019     CASE TYPE="Z";CALL DKRCVZ(STATUS)
  1094. 020     CASE TYPE="B";CALL DKRCVB(STATUS);GO 8
  1095. 021     END CASE;IF NOT(OK) THEN GO 9
  1096. 022     IF TYPE="A" THEN STATUS="A" ELSE STATUS="Y"
  1097. 023     CALL DKACK(STATUS);IF NOT(OK) THEN GO 9
  1098. 024   REPEAT;IF OK THEN
  1099. 025 8   STATUS="Y";DATA="";CALL DKACK(STATUS);IF OK THEN CALL DKXPKTS(-1)
  1100. 026   END
  1101. 027 END;9 RETURN
  1102. 028 * * * * * Interface info * * * * *
  1103. 029 *Entry: CMD.LINE := receive command in form:
  1104. 030 *                     RECEIVE [item-id]
  1105. 031 *                   where optional "item-id" is id under which to
  1106. 032 *                   store data in set DATAFILE.
  1107. 033 *       FN        := destination file name (<1>) and DATA/KERMIT
  1108. 034 *                    file type (<2>) as defined in DKOPNFILE.
  1109. 035 *
  1110. 036 *Uses:  r         := retry count per Kermit Protocol Manual
  1111. 037 *       n         := packet sequence
  1112. 038 *
  1113. 039 *Exit:  STATUS    := result of operation:
  1114. 040 *                    0 means error occured
  1115. 041 *                    1   "   all went ok
  1116. 042 *
  1117. 043 * * * * * Revision history * * * * *
  1118. 044 *.1 - 7/17/89 JF3 Call to DKRCVB to get ECHO back ON.
  1119. 045 *
  1120. 046 *.0 - 10/22/88 JF3
  1121. 047 END
  1122.  
  1123.     DKFRMAT
  1124. 001 SUBROUTINE DKFRMAT
  1125. 002 *FoRMAT packet data -- UNUSED IN 0.3
  1126. 003 *1/23/89 JF3
  1127. 004 !]DKFNAME]DKFTYPE]DKXMTD
  1128. 005 COM CMD.LINE,X1,ERR,X2,PKT.SEQ,DATA,CHECK,TYPE,X3,DEBUG.MODE
  1129. 006 COM X4(6),MAXL,X5(6),CHKT,X6(9),f.type,p,L,X7(4)
  1130. 007 COM ID,ITEM,rec.delim,F.NAME,FV,filename.type,FID,X8(15),Format,Type
  1131. 008 EQU INITIAL.ENTRY TO STATUS,OK TO STATUS,AM TO CHAR(254),DK1 TO p
  1132. 009 IF INITIAL.ENTRY THEN
  1133. 010   f.type=filename.type<2>;p=1
  1134. 011   BEGIN CASE
  1135. 012   CASE f.type<2
  1136. 013     READ ITEM FROM FV,ID ELSE
  1137. 014       DATA="item: ":ID;ID=4;GO 10
  1138. 015     END
  1139. 016   CASE f.type=3
  1140. 017     DK1=FID<1,1>
  1141. 018     STATUS=OCONV(ID,"U0":DK1);IF OK THEN DK1="U1":DK1 ELSE
  1142. 019       DATA="entry: ":ID;ID=4;GO 10
  1143. 020     END
  1144. 021   CASE 1
  1145. 022 2   DATA="DATAFILE";ID=1;GO 10
  1146. 023   END CASE;IF F.NAME="" THEN CALL DKFNAME
  1147. 024   CALL DKFTYPE;L=INT(8*(MAXL-2-CHKT)/10)
  1148. 025 END ELSE
  1149. 026   BEGIN CASE
  1150. 027   CASE f.type<2
  1151. 028     LOOP
  1152. 029       IF Type="A" THEN DATA=FIELD(ITEM,AM,p);p=p+1 ELSE
  1153. 030         DATA=ITEM[p,L];p=p+L
  1154. 031       END
  1155. 032     UNTIL DATA="" DO p=p+1 REPEAT
  1156. 033   CASE f.type=3
  1157. 034     STATUS=0;DATA=OCONV(L,DK1)
  1158. 035     IF DATA=CHAR(0) OR DATA="" THEN STATUS=1
  1159. 036   END CASE
  1160. 037   DATA=DATA:rec.delim;CALL DKXMTD(STATUS);IF NOT(OK) THEN GOSUB 10;*???
  1161. 038 END;9 RETURN
  1162. 039 10 STATUS=-1
  1163. 040  DATA=INSERT(DATA,1;"K":ID);                *PICK/Ultimate
  1164. 041 *INS ("K":ID) BEFORE DATA<1>;STATUS=-1;     *Microdata
  1165. 042 GO 9
  1166. 043 * * * * * Interface info * * * * *
  1167. 044 *Entry: STATUS       := 1 means first entry to retrieve data
  1168. 045 *                       0 means subsequent entry; return next record
  1169. 046 *
  1170. 047 *Exit:                  On INITIAL.ENTRY        On subsequent entries
  1171. 048 *                       ----------------        ---------------------
  1172. 049 *       STATUS       := 1 means data ok          1 means last record
  1173. 050 *                                                0 means more to go
  1174. 051 *                       -----------------On either-------------------
  1175. 052 *                      <0 means K-msg err id VM filler in DATA
  1176. 053 *Uses:  NFN          := 1 means Normalized File Names in the
  1177. 054 *                         Kermit sense
  1178. 055 * * * * * Revision history * * * * *
  1179. 056 *.0 - 1/23/89 JF3
  1180. 057 END
  1181.  
  1182.     DKOPNFILE
  1183. 001 SUBROUTINE (STATUS)
  1184. 002 *Open a file for processing
  1185. 003 *7/20/87 JF3 0.3.0
  1186. 004 !]OPENFILE
  1187. 005 COM X1(44),Data.FV,Data.file.name;EQU file.type TO STATUS
  1188. 006 *EQU F.REALLOC TO D.CODE;*Microdata
  1189. 007 IF Data.file.name[1,5]="DICT " THEN
  1190. 008   dict="DICT";dictname=Data.file.name[6,99]
  1191. 009 END ELSE dict="";dictname=Data.file.name
  1192. 010 * * * * * Ultimate/PICK * * * * *
  1193. 011  filename=FIELD(dictname,",",2)
  1194. 012  IF filename="" THEN
  1195. 013    filename=dictname
  1196. 014  END ELSE dictname=FIELD(dictname,",",1);dict=dictname
  1197. 015 * * * * * Microdata * * * * *
  1198. 016 *filename=dictname
  1199. 017 * * * * * * * * * * * * * * * *
  1200. 018 D.CODE=OCONV(dictname,"TMD;X;;1");file.type=D.CODE[1,1]
  1201. 019 IF file.type#"D" AND file.type#"Q" THEN STATUS=-1;GO 9
  1202. 020 OPEN dict,filename TO Data.FV ELSE STATUS=-1;GO 9
  1203. 021  D.CODE=OCONV(filename,"TDICT ":dictname:";X;;1");       *PICK/Ultimate
  1204. 022  IF D.CODE="DC" THEN file.type=1 ELSE file.type=0;       *PICK/Ultimate
  1205. 023 *F.REALLOC=OCONV("DL/ID","T*":filename:";X;;13");        *Microdata
  1206. 024 *IF F.REALLOC[1,1]="B" THEN file.type=1 ELSE file.type=0;*Microdata
  1207. 025 9 RETURN
  1208. 026 * * * * * Interface info * * * * *
  1209. 027 *Entry: Data.file.name    := {DICT }filename       ;*any implementation
  1210. 028 *                            {dictname,}filename   ;*Ultimate/PICK only
  1211. 029 *
  1212. 030 *Exit:  STATUS            := -1 means no go;
  1213. 031 *                             0 means ordinary file
  1214. 032 *                             1 means catalog pointer file
  1215. 033 *       Data.FV           := data file variable
  1216. 034 *       Data.file.name    := as in Entry.
  1217. 035 * * * * * Revision history * * * * *
  1218. 036 *.0 - 7/20/87 JF3
  1219. 037 END
  1220.  
  1221.     DKSEND
  1222. 001 SUBROUTINE (STATUS)
  1223. 002 *Send file item(s)
  1224. 003 *8/12/87 JF3 0.3.0
  1225. 004 !]DKRETR]DKFNAME]DKCNV]DKIO]DKXMTt
  1226. 005 COM CMD.LINE,X1,ERR,X2,n,DATA,X3(30),r,X4(3),ID,X5(2),f.name,FV
  1227. 006 EQU LF TO CHAR(10),CR TO CHAR(13),SPACE TO " ",OK TO STATUS
  1228. 007 EQU VM TO CHAR(253),AM TO CHAR(254),DONE TO STATUS
  1229. 008 *ECHO.OFF=OCONV(0,"U80E0");*Microdata
  1230. 009  ECHO OFF;                 *PICK/Ultimate
  1231. 010 SELECTED=0;initial=0;LOOP
  1232. 011   IF initial THEN
  1233. 012     IF SELECTED THEN
  1234. 013 2     READNEXT ID ELSE ID=""
  1235. 014       f.name="";GO 3
  1236. 015     END ELSE ID=""
  1237. 016   END ELSE ID=FIELD(CMD.LINE<1>,SPACE,2);f.name=FIELD(CMD.LINE<1>,SPACE,3)
  1238. 017   IF ID="*" AND NOT(initial) THEN SELECT FV;SELECTED=1;GO 2
  1239. 018 3 UNTIL ID="" DO
  1240. 019   STATUS=1;CALL DKRETR(STATUS);IF NOT(OK) THEN GOSUB 7
  1241. 020   IF NOT(initial) THEN pkt.type="S";n=0;r=0;GOSUB 5;initial=1
  1242. 021   CALL DKFNAME;DATA=f.name
  1243. 022   pkt.type="F";GOSUB 5;ATTRS=0;*CALL DKCNV(ATTRS,0,-26:AM:3)
  1244. 023   IF ATTRS THEN CALL DKXMTA(STATUS) ELSE OK=1
  1245. 024   IF OK THEN
  1246. 025     STATUS=0;LOOP CALL DKRETR(STATUS) UNTIL DONE DO
  1247. 026       CALL DKXMTD(STATUS);GOSUB 6;STATUS=0
  1248. 027     REPEAT;pkt.type="Z";GOSUB 5
  1249. 028   END
  1250. 029 REPEAT;pkt.type="B";GOSUB 5;STATUS=1;GO 9
  1251. 030 5 subr="DKXMT":pkt.type;CALL @subr(STATUS)
  1252. 031 6 IF OK>0 THEN n=MOD(n+1,64);r=0;RETURN
  1253. 032 *Set correct mode here.
  1254. 033 7 DATA="K5":AM:"Send":VM:DATA;RETURN TO 8
  1255. 034 8 CALL DKIO("!");STATUS=-1;9 RETURN
  1256. 035 * * * * * Interface info * * * * *
  1257. 036 * Entry:
  1258. 037 *   CMD.LINE    := SEND [ item-id ] . . .
  1259. 038 *                       [    *    ]
  1260. 039 *                       [ entry#  ]
  1261. 040 *
  1262. 041 * Exit   :
  1263. 042 *   STATUS      := 1 means finished ok
  1264. 043 *               := 0   "   error; transaction terminated
  1265. 044 *   FILE.NAME<1>:= file name as entered
  1266. 045 *            <2>:= file type: nul means regular data file
  1267. 046 *                             "P" means spooler PRINTFILE
  1268. 047 * * * * * Revision history * * * * *
  1269. 048 *.0 - 8/12/87 JF3
  1270. 049 END
  1271.  
  1272.     DKFPKT
  1273. 001 SUBROUTINE (TYPE)
  1274. 002 *Form a PacKeT
  1275. 003 *7/21/87 JF3 0.3.0
  1276. 004 *]DKCNV]DKCTL]DKCHECK
  1277. 005 COM X1(3),MARK,PKT.SEQ,PACKET,CHECK,X2(9)
  1278. 006 COM MAXL,X3(5),QBIN,CHKT,REPT,X4(28),SQCTL;EQU STATUS TO TYPE
  1279. 007 EQU test.len TO r.prefix,max.len TO r.prefix
  1280. 008 p=CHKT+4;l=TYPE[1,1];IF l="Y" THEN l=TYPE[2,1]
  1281. 009 IF l="A" OR l="I" OR l="S" THEN
  1282. 010   data=PACKET;l=LEN(data);p=p+l;TYPE=TYPE[1,1];GO 5
  1283. 011 END;data="";l=0;r=1;LOOP c=PACKET[l+1,1] UNTIL c="" DO
  1284. 012   IF REPT="" THEN r.prefix="" ELSE
  1285. 013     r=l+2;max.len=l+94
  1286. 014     LOOP WHILE PACKET[r,1]=c AND r<max.len DO r=r+1 REPEAT
  1287. 015     r=r-l-1;IF r>3 THEN
  1288. 016       s=r;CALL DKCNV(s,1,0);r.prefix=REPT:s
  1289. 017     END ELSE r.prefix="";r=1
  1290. 018   END;s=SEQ(c);IF s>=128 THEN
  1291. 019     s=s-128;c=CHAR(s);IF QBIN#"" THEN r.prefix=r.prefix:QBIN
  1292. 020   END;IF s<=31 OR s=127 THEN CALL DKCTL(c);c=SQCTL:c ELSE
  1293. 021     IF c=SQCTL THEN c=SQCTL:SQCTL ELSE
  1294. 022       IF QBIN#"" AND c=QBIN THEN c=SQCTL:QBIN
  1295. 023       IF c=REPT THEN c=SQCTL:REPT
  1296. 024   END;END;c=r.prefix:c;lc=LEN(c);test.len=p+lc
  1297. 025   IF test.len>MAXL THEN GO 5 ELSE data=data:c;l=l+r;p=test.len
  1298. 026 REPEAT;IF l=0 THEN l=-1
  1299. 027 5 PACKET=MARK:CHAR(p+30):CHAR(PKT.SEQ+32):TYPE:data
  1300. 028 CHECK=0;CALL DKCHECK(CHECK);STATUS=(CHECK#"")*l;RETURN
  1301. 029 * * * * * Interface info * * * * *
  1302. 030 *Entry: TYPE   := Protocol packet type or Yx where:
  1303. 031 *                   x=S means Send-init ack packet
  1304. 032 *                   x=I   "   server Init ack, or
  1305. 033 *                   x=A   "   file Attribute ack.
  1306. 034 *       PACKET := contains DATA field of packet
  1307. 035 *
  1308. 036 *Exit:  STATUS := >0 means length of packet
  1309. 037 *                  0   "   packet cannot be checksumed
  1310. 038 *                 <0   "   data field is nul
  1311. 039 * * * * * Revision history * * * * *
  1312. 040 *.0 - 7/21/87 JF3
  1313. 041 END
  1314.  
  1315.     DKRCVT
  1316. 001 *DUMMY
  1317. 002 *Subroutine list for DKRCVt type subs
  1318. 003 *4/1/87 JF3 0.3.0
  1319. 004 *]DKRCVS]DKRCVF]DKRCVA]DKRCVD]DKRCVZ]DKRCVB
  1320. 005 END
  1321.  
  1322.     DKDPKT
  1323. 001 SUBROUTINE (STATUS)
  1324. 002 *Decode a packet
  1325. 003 *1/29/87 JF3 0.3.0
  1326. 004 *]DKCNV]DKDBUG
  1327. 005 COM X1(5),DATA,X2(3),DEBUG.MODE,X3(11),QCTL,QBIN,CHKT,REPT
  1328. 006 EQU L TO STATUS
  1329. 007 PACKET=DATA;DATA="";L=0;R=0;BIT8=0;LOOP GOSUB 6 UNTIL C="" DO
  1330. 008   BEGIN CASE
  1331. 009   CASE C=REPT;IF R THEN GO 9 ELSE GOSUB 6;CALL DKCNV(C,-1,0);R=C
  1332. 010   CASE C=QBIN;IF BIT8 THEN GO 9 ELSE BIT8=1
  1333. 011   CASE C=QCTL;GOSUB 6;BEGIN CASE
  1334. 012       CASE C=QCTL;CASE C=QBIN;CASE C=REPT
  1335. 013       CASE 1;C=CHAR(SEQ(C)-64)
  1336. 014     END CASE;GO 4
  1337. 015   CASE 1
  1338. 016 4   IF BIT8 THEN C=CHAR(SEQ(C)+128);BIT8=0;*SM invalid for file data!
  1339. 017     IF R THEN C=STR(C,R);R=0
  1340. 018     DATA=DATA:C
  1341. 019   CASE 0
  1342. 020 6 L=L+1;C=PACKET[L,1];RETURN
  1343. 021   END CASE
  1344. 022 REPEAT;L=L-1;IF L=0 THEN L=-1
  1345. 023 IF DEBUG.MODE THEN
  1346. 024   R=L;STATUS="D";PACKET=DATA;C=LEN(DATA)+2+CHKT;CALL DKCNV(C,1,0)
  1347. 025   DATA=CHAR(0):C:"  ":DATA:STR(" ",CHKT);CALL DKDBUG(STATUS)
  1348. 026 DATA=PACKET;L=R;END;8 RETURN
  1349. 027 9 STATUS=0;GO 8
  1350. 028 * * * * * Interface info * * * * *
  1351. 029 *Entry: DATA contains received packet data field
  1352. 030 *
  1353. 031 *Exit:  DATA contains expanded data
  1354. 032 * * * * * Revision history * * * * *
  1355. 033 *.0 1/29/87 JF3
  1356. 034 END
  1357.  
  1358.     DKcnv
  1359. 001 *DUMMY
  1360. 002 *Subroutine list for custom parameter conversion routines
  1361. 003 *7/14/87 JF3 0.3
  1362. 004 *]DKDF]DKFA
  1363. 005 END
  1364.  
  1365.     DKVERC
  1366. 001 SUBROUTINE (STATUS)
  1367. 002 *VERify a command as valid
  1368. 003 *6/25/87 JF3 0.3.0
  1369. 004 *]DKPARSE]DKIO
  1370. 005 COM X1(5),data,X2(5),PARAMS,X3(52),i(3)
  1371. 006 EQU CMD TO STATUS,ok TO STATUS,c TO i(1)
  1372. 007 IF CMD[1,1]="!" THEN CMD=CMD[2,99];c=1 ELSE
  1373. 008   MAT i=0;CALL DKPARSE(CMD,2)
  1374. 009 END;IF c THEN
  1375. 010   data="DK":CMD;v=1;ok=0;LOOP conv.code=PARAMS<14,v> UNTIL conv.code="" DO
  1376. 011     ok=(PARAMS<15,v>=OCONV(data,conv.code))
  1377. 012     IF ok THEN GO 9 ELSE v=v+1
  1378. 013   REPEAT;data="DKverb: ":data
  1379. 014 END ELSE data="command: ":CMD
  1380. 015 data=INSERT(data,1,0,0,"K1");STATUS="!";CALL DKIO(STATUS);STATUS=-1
  1381. 016 9 RETURN
  1382. 017 * * * * * Interface info * * * * *
  1383. 018 *Entry : CMD   := all caps command token
  1384. 019 *
  1385. 020 *Exit:  STATUS := -1 invalid command
  1386. 021 *                  1 means command ok; DKcommand in data
  1387. 022 * * * * * Revision history * * * * *
  1388. 023 *.0 - 6/25/87 JF3
  1389. 024 END
  1390.  
  1391.     DKRCVA
  1392. 001 SUBROUTINE (STATUS)
  1393. 002 *Receive a file Attribute packet -- NOT USED in 0.3
  1394. 003 *7/14/87 JF3
  1395. 004 *]DKCNV]DKAnn
  1396. 005 COM X1(5),DATA,X2(5),PARAMS;EQU AM TO CHAR(254),OK TO STATUS
  1397. 006 DIM ack.attrs(2);MAT ack.attrs=""
  1398. 007 s=1;LOOP ATTR=DATA[s,1] UNTIL ATTR="" DO
  1399. 008   attr.no=ATTR;CALL DKCNV(attr.no,-1,0)
  1400. 009   sLENGTH=DATA[s+1,1];CALL DKCNV(sLENGTH,-1,0);sDATA=DATA[s+2,sLENGTH]
  1401. 010   p=11;LOOP
  1402. 011 *   LOCATE attr.no IN PARAMS<p>,1 SETTING w ELSE w=-1;*Microdata/Ultimate
  1403. 012     LOCATE(attr.no,PARAMS<p>;w) ELSE w=-1;            *PICK
  1404. 013     IF w>0 THEN
  1405. 014       IF p=11 THEN
  1406. 015         subroutine="DKA":(100+attr.no)[2,2];STATUS=sDATA
  1407. 016         CALL @subroutine(STATUS);IF STATUS>1 THEN w=OK ELSE w=NOT(OK)
  1408. 017       END ELSE w=0
  1409. 018     END ELSE
  1410. 019       IF p=12 THEN w=2
  1411. 020     END
  1412. 021   WHILE w=-1 DO p=p+1 REPEAT
  1413. 022   IF w THEN ack.attrs(w)=ack.attrs(w):ATTR
  1414. 023 s=s+2+sLENGTH;REPEAT;IF ack.attrs(1)="" THEN DATA="Y";w=2 ELSE DATA="N";w=1
  1415. 024 DATA=DATA:ack.attrs(w);STATUS=1;RETURN
  1416. 025 * * * * * Interface info * * * * *
  1417. 026 *Entry: DATA := File Attribute packet per Kermit Protocol Manual
  1418. 027 *               each DATA field containing (optionally) many subfields
  1419. 028 *
  1420. 029 *Exit:  DATA := data field of ack packet
  1421. 030 *
  1422. 031 *Uses:  ack.attrs(1) := N{xxx} list
  1423. 032 *                (2) := Y{xxx} list
  1424. 033 * * * * * Revision history * * * * *
  1425. 034 *.0 - 7/14/87 JF3
  1426. 035 END
  1427.  
  1428.     DKSET
  1429. 001 SUBROUTINE (STATUS)
  1430. 002 *SET kermit parameters
  1431. 003 *7/24/87 JF3 0.3.0
  1432. 004 *]DKCNV]DKPARSE]DKIO]GTRMCHR
  1433. 005 COM P(64),i(3);EQU SPACE TO " ",a TO i(1),v TO i(2),s TO i(3)
  1434. 006 EQU CMD.LINE TO P(1),ERR TO P(3),PAR.LIST TO P(12),DICT.DK TO P(15)
  1435. 007 EQU MSG TO P(6),help.request TO i(2);par=OCONV(CMD.LINE<1>,"G1 1")
  1436. 008 help.request=(par="?");IF help.request THEN
  1437. 009 * Get terminal width below
  1438. 010   CALL GTRMCHR(MSG);s=INT(OCONV(MSG<4>,"G,1")/2);s="L#":s
  1439. 011   v=1;MSG="";LOOP GOSUB 10 UNTIL par="" DO
  1440. 012     GOSUB 10;STATUS=-1;CALL DKIO(STATUS);MSG=""
  1441. 013   REPEAT;STATUS=1
  1442. 014 END ELSE
  1443. 015   a=2;v=0;CALL DKPARSE(par,12);IF v THEN
  1444. 016     IF PAR.LIST<8,v>="" THEN p=2 ELSE
  1445. 017       p=3;a=8;subpar=OCONV(CMD.LINE<1>,"G2 1");CALL DKPARSE(subpar,12)
  1446. 018       IF NOT(s) THEN MSG="subparameter: ":subpar;GO 4
  1447. 019     END;arg=OCONV(CMD.LINE<1>,"G":p:" 99");cnv=PAR.LIST<5,v>
  1448. 020     IF NOT(NUM(cnv)) THEN cnv<1,2>="1"
  1449. 021     idx=PAR.LIST<3,v>;idx<2>=PAR.LIST<9,v,s>
  1450. 022     CALL DKCNV(arg,cnv,idx);IF arg="!!!" THEN
  1451. 023       P(6)=cnv;CALL DKIO("!");STATUS=-1
  1452. 024     END ELSE STATUS=1
  1453. 025   END ELSE
  1454. 026     MSG="parameter: ":par
  1455. 027 4   MSG=INSERT(MSG,1,0,0,"K1");CALL DKIO("!");STATUS=-1
  1456. 028   END
  1457. 029 END;RETURN
  1458. 030 10 par=PAR.LIST<2,v>;MSG=MSG:(par:SPACE:PAR.LIST<6,v>)s
  1459. 031 v=v+1;RETURN
  1460. 032 * * * * * Interface info * * * * *
  1461. 033 * Entry:
  1462. 034 *   CMD.LINE := SET [parameter {subparameter }value]
  1463. 035 *                   [?                             ]
  1464. 036 *
  1465. 037 * Exit:
  1466. 038 *   STATUS   := 1 means finished ok
  1467. 039 * * * * * Revision history * * * * *
  1468. 040 *.0 - 7/14/87 JF3
  1469. 041 END
  1470.  
  1471.     DKRETRY
  1472. 001 SUBROUTINE (status)
  1473. 002 *increment RETRY counter and check against limit
  1474. 003 *7/21/87 JF3 0.3
  1475. 004 *]DKERR]DKFPKT]DKIO
  1476. 005 COM X1(8),LIMIT,X2(27),r;EQU OK TO status,AM TO CHAR(254)
  1477. 006 r=r+1;IF r<LIMIT THEN status=1 ELSE
  1478. 007   DATA="K3":AM:LIMIT;CALL DKERR;status="E";CALL DKFPKT(status)
  1479. 008   IF OK THEN CALL DKIO(-2);status=0
  1480. 009 END;RETURN
  1481. 010 * * * * * Interface info * * * * *
  1482. 011 *Entry: none
  1483. 012 *
  1484. 013 *Exit:  status := 1 means retry counter incremented
  1485. 014 *              := 0   "   error packet sent, transaction terminated
  1486. 015 * * * * * Revision history * * * * *
  1487. 016 *.0 - 7/21/87 JF3
  1488. 017 END
  1489.  
  1490.     DKRCVB
  1491. 001 SUBROUTINE (STATUS)
  1492. 002 *Receive an Break packet
  1493. 003 *7/17/89 JF3 0.3.1
  1494. 004 !
  1495. 005 STATUS=0
  1496. 006 *ECHO.ON=OCONV(0,"U70E0");*Microdata
  1497. 007  ECHO ON;                 *PICK/Ultimate
  1498. 008 RETURN
  1499. 009 * * * * * Interface Info * * * * *
  1500. 010 *
  1501. 011 *Entry:  none
  1502. 012 *
  1503. 013 *Exit:   ECHO set ON; STATUS reset
  1504. 014 * * * * * Revision history * * * * *
  1505. 015 *.1 - 7/17/89 JF3 Set ECHO back on after transaction
  1506. 016 *
  1507. 017 *.0 - 1/29/87 JF3
  1508. 018 END
  1509.  
  1510.     DKRCVZ
  1511. 001 SUBROUTINE (STATUS)
  1512. 002 *Receive an End-of-file packet
  1513. 003 *10/22/88 JF3 0.3.0
  1514. 004 *]DKSTOR
  1515. 005 COM X1(33),F.TYPE,X2,RECORD,X3(4),FILE.NAME,ITEM,X4,LOCAL.FILE.SPEC,FV
  1516. 006 EQU OK TO STATUS
  1517. 007 IF RECORD="" THEN STATUS=1 ELSE CALL DKSTOR(STATUS)
  1518. 008 IF OK THEN
  1519. 009   BEGIN CASE
  1520. 010   CASE F.TYPE<2
  1521. 011     IF LOCAL.FILE.SPEC="" THEN id=FILE.NAME ELSE id=LOCAL.FILE.SPEC
  1522. 012     WRITE ITEM ON FV,id;*EXECUTE "MSG !0 '":id:"'"
  1523. 013     IF F.TYPE=1 THEN NULL;*CLEAN UP POINTER-FILE DATA
  1524. 014   CASE F.TYPE=2
  1525. 015   CASE F.TYPE=3;PRINTER CLOSE
  1526. 016   END CASE
  1527. 017 END;RETURN
  1528. 018 * * * * * Interface info * * * * *
  1529. 019 *Entry: RECORD := any remnant of received file
  1530. 020 * * * * * Revision history * * * * *
  1531. 021 *.0 - 10/22/88 JF3
  1532. 022 END
  1533.  
  1534.     DKA01
  1535. 001 SUBROUTINE (STATUS)
  1536. 002 *check received Attribute 1 (length) -- NOT USED in 0.3
  1537. 003 *7/14/87 JF3
  1538. 004 *
  1539. 005 COM X1(33),DATAFILE.TYPE;EQU Length TO STATUS
  1540. 006 IF DATAFILE.TYPE=0 THEN
  1541. 007   IF (Length+0)>32 THEN STATUS=0
  1542. 008 END ELSE STATUS=1
  1543. 009 RETURN
  1544. 010 * * * * * Interface info * * * * *
  1545. 011 *See DKAnn
  1546. 012 * * * * * Revision history * * * * *
  1547. 013 *.0 - 7/14/87 JF3
  1548. 014 END
  1549.  
  1550.     DKSTOR
  1551. 001 SUBROUTINE (STATUS)
  1552. 002 *STOre received Record into system
  1553. 003 *10/22/88 JF3 0.3.0
  1554. 004 *
  1555. 005 COM X1(29),MAX.REC.LEN,X2(3),PICK.file.type,a,RECORD,X3(5)
  1556. 006 COM ITEM,X4(3),DATAFILE,X5(16),F.FORMAT
  1557. 007 IF MAX.REC.LEN AND LEN(RECORD)>MAX.REC.LEN THEN STATUS=0 ELSE
  1558. 008 * Undefined if DATAFILE is null; should be fixed!
  1559. 009   IF DATAFILE="" THEN
  1560. 010     BEGIN CASE
  1561. 011     CASE DISP="";GO 5
  1562. 012     CASE DISP="O";CASE DISP="S"
  1563. 013     CASE DISP="P";GO 30
  1564. 014     CASE DISP="T";GO 20
  1565. 015     CASE DISP="L";CASE DISP="X"
  1566. 016     CASE DISP="A";GO 10
  1567. 017     END CASE
  1568. 018   END ELSE
  1569. 019     BEGIN CASE
  1570. 020     CASE PICK.file.type=0
  1571. 021 5     IF F.FORMAT="I" THEN ITEM=ITEM:RECORD ELSE ITEM<a>=RECORD
  1572. 022     CASE PICK.file.type=1
  1573. 023 10    *Put RECORD to catalog space
  1574. 024     CASE PICK.file.type=2
  1575. 025 20    *Put RECORD into ABS space
  1576. 026     CASE PICK.file.type=3
  1577. 027 30    PRINTER ON;PRINT RECORD;PRINTER OFF;RETURN
  1578. 028     END CASE
  1579. 029   END;a=a+1;RECORD="";STATUS=1
  1580. 030 END;RETURN
  1581. 031 * * * * * Interface info * * * * *
  1582. 032 * * * * * Revision history * * * * *
  1583. 033 *.0 - 10/22/88 JF3
  1584. 034 END
  1585.  
  1586.     DKA02
  1587. 001 SUBROUTINE (STATUS)
  1588. 002 *check received Attribute 2 (type) -- NOT USED in 0.3
  1589. 003 *7/21/87 JF3
  1590. 004 *
  1591. 005 COM X1(63),Type
  1592. 006 EQU DATA TO STATUS
  1593. 007 type=DATA[1,1];STATUS=1
  1594. 008 BEGIN CASE
  1595. 009 CASE type="A"
  1596. 010 CASE type="B"
  1597. 011 CASE type="D"
  1598. 012 CASE type="F"
  1599. 013 CASE type="I"
  1600. 014 CASE 1;STATUS=0;GO 9
  1601. 015 END CASE;arg=DATA[2,l];IF l=1 THEN
  1602. 016   IF NUM(arg) THEN cnv=0 ELSE cnv=-1
  1603. 017   CALL DKCNV(arg,cnv,ix)
  1604. 018 END;8 STATUS=1;9 RETURN
  1605. 019 * * * * * Interface info * * * * *
  1606. 020 *See DKAnn
  1607. 021 * * * * * Revision history * * * * *
  1608. 022 *.0 - 7/21/87 JF3
  1609. 023 END
  1610.  
  1611.     DKRCVD
  1612. 001 SUBROUTINE (STATUS)
  1613. 002 *ReCeiVe a Data packet
  1614. 003 *10/22/88 JF3 0.3.0
  1615. 004 *]DKDPKT]DKSTOR
  1616. 005 COM X1(5),DATA,X2(23),MAX.REC.LEN,p1,len.REC.TERM,X3(2),a,record
  1617. 006 COM X4(6),REC.TERMINATION,X5(18),l,F.FORMAT,X6;EQU OK TO STATUS
  1618. 007 EQU REC.SIZE.LEN TO REC.TERMINATION,REC.SIZE TO REC.TERMINATION
  1619. 008 IF a=1 THEN
  1620. 009   BEGIN CASE
  1621. 010   CASE F.FORMAT="";GO 1;F.FORMAT="A";REC.TERMINATION="";GO 2
  1622. 011   CASE F.FORMAT="A";GO 2
  1623. 012   CASE F.FORMAT="D";len.REC.TERM=0
  1624. 013   CASE F.FORMAT="F";len.REC.TERM=0;p1=1;l=REC.SIZE
  1625. 014   CASE 1
  1626. 015 1   F.FORMAT="A";REC.TERMINATION=CHAR(13):CHAR(10)
  1627. 016 2   len.REC.TERM=LEN(REC.TERMINATION);p1=1
  1628. 017   END CASE
  1629. 018 END;CALL DKDPKT(STATUS);rec.complete=0
  1630. 019 IF F.FORMAT="A" THEN DATA=record:DATA
  1631. 020 LOOP
  1632. 021   IF F.FORMAT="I" THEN record=DATA;DATA="";rec.complete=1 ELSE
  1633. 022     len.DATA=LEN(DATA);BEGIN CASE
  1634. 023     CASE F.FORMAT="A"
  1635. 024       p2=INDEX(DATA,REC.TERMINATION,1);record=""
  1636. 025       IF p2 THEN rec.complete=1;p2=p2-1 ELSE p2=len.DATA
  1637. 026     CASE F.FORMAT="D"
  1638. 027       IF l THEN p1=1 ELSE
  1639. 028         l=DATA[1,REC.SIZE.LEN]-REC.SIZE.LEN;p1=REC.SIZE.LEN+1
  1640. 029       END;GO 3
  1641. 030     CASE F.FORMAT="F"
  1642. 031 3     rec.complete=(l<=len.DATA);p2=l
  1643. 032     END CASE;record=record:DATA[p1,p2]
  1644. 033     DATA=DATA[p1+p2+len.REC.TERM,9999]
  1645. 034   END
  1646. 035 UNTIL DATA="" DO
  1647. 036   GOSUB 5;IF NOT(OK) THEN GO 9
  1648. 037 REPEAT;IF rec.complete THEN
  1649. 038 5 CALL DKSTOR(STATUS);IF OK THEN
  1650. 039     rec.complete=0;IF F.FORMAT="F" THEN l=REC.SIZE ELSE l=0
  1651. 040   END
  1652. 041 END ELSE l=l-(len.DATA-(p1-1));STATUS=1
  1653. 042 9 RETURN
  1654. 043 * * * * * Interface Info * * * * *
  1655. 044 *Uses:  l         Set to 0 by DKRCVF; generally means # chars
  1656. 045 *                   remaining to complete a record.
  1657. 046 * * * * * Revision history * * * * *
  1658. 047 *.0 - 10/22/88 JF3
  1659. 048 END
  1660.  
  1661.     DKSHOW
  1662. 001 SUBROUTINE (STATUS)
  1663. 002 *SHOW parameters somewhere
  1664. 003 *8/7/87 JF3 0.3.0
  1665. 004 *]DKCNV]DKPARSE]DKIO
  1666. 005 COM P(64),i(3);EQU a TO i(1),p TO i(2),s TO i(3)
  1667. 006 EQU CMD.LINE TO P(1),MSG TO P(6),PAR.LIST TO P(12),REMOTE.CTRL TO P(40)
  1668. 007 EQU cr TO CHAR(13),lf TO CHAR(10);CALL GTRMCHR(MSG);MSG=MSG<4>
  1669. 008 LINES.PAGE=FIELD(MSG,",",2);CHARS.LINE=FIELD(MSG,",",1)+1;P(41)="ALL"
  1670. 009 COLS=INT(CHARS.LINE/26);a=2;s=0
  1671. 010  FMT="L#":INT((CHARS.LINE-1)/COLS);     *Microdata/PICK
  1672. 011 *FMT="L(#":INT((CHARS.LINE-1)/COLS):")";*Ultimate
  1673. 012 I.PARAM=FIELD(CMD.LINE<1>," ",2);STATUS=1;L=1;C=1;p=0;t=999
  1674. 013 CALL DKPARSE(I.PARAM,12);IF p THEN
  1675. 014   SUB.PARAM=FIELD(CMD.LINE<1>," ",3);IF SUB.PARAM#"" THEN
  1676. 015     a=8;CALL DKPARSE(SUB.PARAM,12)
  1677. 016     IF s THEN t=s;GOSUB 11 ELSE MSG="subparameter: ":SUB.PARAM;GO 6
  1678. 017   END ELSE GOSUB 10
  1679. 018 END ELSE
  1680. 019   a=1;p=0;CALL DKPARSE(I.PARAM,41);IF p THEN
  1681. 020     p=0
  1682. 021     LOOP p=p+1;I.PARAM=PAR.LIST<2,p> UNTIL I.PARAM="" DO GOSUB 10 REPEAT
  1683. 022   END ELSE
  1684. 023     MSG="parameter: ":I.PARAM
  1685. 024 6    MSG=INSERT(MSG,1,0,0,"K1");STATUS="!";GO 20
  1686. 025   END
  1687. 026 END;9 MSG="";STATUS=-1;GO 20
  1688. 027 10 s=1;11 index=-PAR.LIST<3,p>;cnv=PAR.LIST<5,p>
  1689. 028 IF NUM(cnv) THEN cnv=-cnv ELSE cnv<1,2>="-1"
  1690. 029 LOOP SUB.PARAM=PAR.LIST<8,p,s> UNTIL (SUB.PARAM="" AND s>1) OR s>t DO
  1691. 030   IF SUB.PARAM#"" THEN index<2>=PAR.LIST<9,p,s>;SUB.PARAM=" ":SUB.PARAM
  1692. 031   SUB.PARAM=SUB.PARAM:"=";CALL DKCNV(arg,cnv,index)
  1693. 032   IF L>LINES.PAGE AND REMOTE.CTRL<3 THEN
  1694. 033     MSG="K8";STATUS="!";GOSUB 20
  1695. 034     IF STATUS THEN L=1;C=1 ELSE STATUS=1;RETURN TO 9
  1696. 035   END;MSG=I.PARAM:SUB.PARAM:arg
  1697. 036   IF C=COLS THEN STATUS=-1;C=1;L=L+1 ELSE
  1698. 037     MSG=MSG FMT;STATUS=-(REMOTE.CTRL=3);C=C+1
  1699. 038   END;GOSUB 20
  1700. 039 s=s+1;REPEAT;RETURN
  1701. 040 20 CALL DKIO(STATUS);RETURN
  1702. 041 * * * * * Interface info * * * * *
  1703. 042 * Entry:
  1704. 043 *   PAR.LIST := <2,p> parameter p name
  1705. 044 *            := <3,p> COM position
  1706. 045 *            := <5,p> conversion type/subr name
  1707. 046 * Exit:
  1708. 047 *   STATUS   := 1 means finished ok
  1709. 048 * * * * * Revision history * * * * *
  1710. 049 *.0 - 8/7/87 JF3
  1711. 050 END
  1712.  
  1713.     DKIO
  1714. 001 SUBROUTINE (STATUS)
  1715. 002 *Input/Output operations
  1716. 003 *11/4/88 JF3 0.3.1
  1717. 004 !]DKERR]DKDBUG]DKINP
  1718. 005 COM P(64);EQU ERR TO P(3),DATA TO P(6),DEBUG.MODE TO P(10),EOL TO P(21)
  1719. 006 EQU CMD.PROMPT TO P(33),LINE TO P(38),REMOTE.CTRL TO P(40)
  1720. 007 IF STATUS="!" THEN CALL DKERR;STATUS=-1
  1721. 008 IF DATA#"" THEN
  1722. 009   BEGIN CASE
  1723. 010   CASE REMOTE.CTRL=3 AND STATUS=-1
  1724. 011     IF LINE#"" THEN EXECUTE "MSG !":LINE:" ":DATA
  1725. 012   CASE STATUS#3
  1726. 013     PRINT DATA:;IF DEBUG.MODE>0 THEN CALL DKDBUG("S")
  1727. 014   END CASE
  1728. 015 END;IF STATUS>0 THEN
  1729. 016   IF STATUS=1 THEN PROMPT CMD.PROMPT<4>
  1730. 017   a=ABS(REMOTE.CTRL);IF REMOTE.CTRL="" OR a=1 OR a=2 THEN
  1731. 018     IF STATUS>1 THEN STATUS=0;*PICK/Ultimate
  1732. 019 *   STATUS=1                  *Microdata
  1733. 020     IF a=1 THEN
  1734. 021 *     ECHO.ON=OCONV("","U70E0");*Microdata
  1735. 022       ECHO ON                  ;*PICK/Ultimate
  1736. 023     END;CALL DKINP(STATUS);STATUS=(DATA#"")
  1737. 024     IF DEBUG.MODE>0 THEN CALL DKDBUG("R")
  1738. 025   END
  1739. 026 END;IF STATUS=0 OR REMOTE.CTRL=3 THEN STATUS=1 ELSE
  1740. 027   IF STATUS=-1 THEN PRINT
  1741. 028   IF STATUS=-2 THEN PRINT EOL:
  1742. 029 END;RETURN
  1743. 030 * * * * * Interface info * * * * *
  1744. 031 *Entry:
  1745. 032 *  STATUS     :=  1 means pause for input & reset prompt char
  1746. 033 *             :=  2   "     "    "    "    but no new prompt
  1747. 034 *             :=  3   "   pause for input & no output at all
  1748. 035 *             :=  0   "   no pause
  1749. 036 *             := -1   "   no pause & cr/lf after output
  1750. 037 *             := -2   "   no pause & terminate w/EOL
  1751. 038 *
  1752. 039 * LINE        := alternate process #; 0 means none.
  1753. 040 *
  1754. 041 * REMOTE.CTRL :=  3 means Batch mode               |
  1755. 042 *                 2   "   Server mode              |  MAIN
  1756. 043 *                 1   "   Remote mode              | PROCESS
  1757. 044 *               nul   "   Local mode - connected   |
  1758. 045 *                 0   "   Local mode - closed      |
  1759. 046 *                         -------------------------------------
  1760. 047 *                -1   "   Remote mode              |
  1761. 048 *                -2   "   Server mode              |   SUB
  1762. 049 *                -3   "   closed connection (idle) | PROCESS
  1763. 050 *
  1764. 051 *Exit:
  1765. 052 *  STATUS     := true means all went ok
  1766. 053 *             := false   "   timeout awaiting input (not implemented)
  1767. 054 END
  1768. 055 * * * * * Revision history * * * * *
  1769. 056 *.1 11/4/88 JF3 Change DKinp to DKINP
  1770. 057 *
  1771. 058 *.0 8/13/87 JF3
  1772.  
  1773.     DKRCVE
  1774. 001 SUBROUTINE (STATUS)
  1775. 002 *Receive a Error packet
  1776. 003 *1/29/87 JF3 0.3.0
  1777. 004 *]DKDPKT
  1778. 005 CALL DKDPKT(STATUS);STATUS=-1;RETURN
  1779. 006 * * * * * Interface info * * * * *
  1780. 007 * * * * * Revision history * * * * *
  1781. 008 *.0 - 1/29/87 JF3
  1782.  
  1783.     DKPRMT
  1784. 001 SUBROUTINE (arg,c,X)
  1785. 002 *Convert prompt string -- NOT USED in 0.3
  1786. 003 *7/21/87 JF3 0.3
  1787. 004 *
  1788. 005 COM X1(32),CMD.PROMPT
  1789. 006 c=c<2>;IF c>0 THEN
  1790. 007   l=LEN(arg);CMD.PROMPT=arg[1,l-1];CMD.PROMPT<2>=arg[l,1]
  1791. 008 END ELSE
  1792. 009   arg=CMD.PROMPT<1>:CMD.PROMPT<2>
  1793. 010 END;c=0;RETURN
  1794. 011 * * * * * Interface info * * * * *
  1795. 012 *Entry: c<2>  := >0 means convert from external (prompt-string prompt-char)
  1796. 013 *                   to internal (CMD.PROMPT dynamic array)
  1797. 014 *                otherwise convert internal to external
  1798. 015 *       arg   := data to convert from or into
  1799. 016 *
  1800. 017 *Exit:
  1801. 018 * * * * * Revision history * * * * *
  1802. 019 *.0 - 7/21/87 JF3
  1803. 020 END
  1804.  
  1805.     DKFINISH
  1806. 001 SUBROUTINE (STATUS)
  1807. 002 *tell remote server to shut down; we are FINISHed -- NOT USED in 0.3
  1808. 003 *8/7/87 JF3
  1809. 004 COM X1(5),DATA
  1810. 005 DATA="F";CALL DKXMTG(STATUS)
  1811. 006 RETURN
  1812. 007 * * * * * Interface info * * * * *
  1813. 008 * * * * * Revision history * * * * *
  1814. 009 *.0 - 8/7/87 JF3
  1815. 010 END
  1816.  
  1817.     DKHELP
  1818. 001 SUBROUTINE (STATUS)
  1819. 002 *Display HELP info
  1820. 003 *4/9/87 JF3 0.3
  1821. 004 *]DKIO
  1822. 005 COM X1,HELP.LIST,X2(3),LINE
  1823. 006 C=2;LOOP LINE=HELP.LIST<C> UNTIL LINE="" DO
  1824. 007   CALL DKIO(-1)
  1825. 008 C=C+1;REPEAT;STATUS=1;RETURN
  1826. 009 * * * * * Interface info * * * * *
  1827. 010 *Entry: none
  1828. 011 *Exit: none
  1829. 012 * * * * * Revision history * * * * *
  1830. 013 *.0 - 4/9/87 JF3
  1831. 014 END
  1832.  
  1833.     DKRCVF
  1834. 001 SUBROUTINE (STATUS)
  1835. 002 *ReCeiVe a File name packet
  1836. 003 *7/21/87 JF3 0.3.0
  1837. 004 *]DKDPKT
  1838. 005 COM X1(5),DATA,X2(27),f.type,A,C,X3(4),filename,item
  1839. 006 COM X4(2),FV,FN,FID,X5(14),l
  1840. 007 EQU OK TO STATUS,b TO " ",FF TO CHAR(12),DK1.3 TO STATUS,beg.fid TO STATUS
  1841. 008 CALL DKDPKT(STATUS);filename=DATA
  1842. 009 BEGIN CASE
  1843. 010 CASE f.type<2
  1844. 011   READ item FROM FV,filename ELSE item=""
  1845. 012   IF f.type=0 THEN item="";*TEMP FOR SMS
  1846. 013   IF f.type=1 THEN
  1847. 014     DK1.3="U3":FID<1,1>;beg.fid=OCONV("",DK1.3)
  1848. 015     IF beg.fid THEN
  1849. 016       item<12>=beg.fid;item<13>=1
  1850. 017     END
  1851. 018   END
  1852. 019 CASE f.type=3
  1853. 020   PRINTER ON
  1854. 021   PRINT 'FOLLOWING JOB RECEIVED AS FILE "':filename:'".':FF:
  1855. 022   PRINTER OFF;DATA="PRINTFILE"
  1856. 023 END CASE
  1857. 024 A=1;C="";l=0
  1858. 025 RETURN
  1859. 026 * * * * * Interface info * * * * *
  1860. 027 *Entry:
  1861. 028 * * * * * Revision history * * * * *
  1862. 029 *.0 - 7/21/87 JF3
  1863. 030 END
  1864.  
  1865.     DKFA
  1866. 001 SUBROUTINE (arg,c,index)
  1867. 002 *Convert file attributes -- NOT USED in 0.3
  1868. 003 *7/14/87 JF3
  1869. 004 !
  1870. 005 COM X1(47),F.ATTRS
  1871. 006 s=index<2>
  1872. 007 *LOCATE s IN F.ATTRS<2> SETTING v ELSE arg="";GO 4;*Microdata/Ultimate
  1873. 008  LOCATE(s,F.ATTRS,2;v) ELSE arg="";GO 4;           *PICK
  1874. 009 arg=F.ATTRS<1,v>
  1875. 010 4 c=0;RETURN
  1876. 011 * * * * * Interface info * * * * *
  1877. 012 * Entry:
  1878. 013 *
  1879. 014 * Exit:
  1880. 015 * * * * * Revision history * * * * *
  1881. 016 *.0 - 7/14/87 JF3
  1882. 017 END
  1883.  
  1884.     DKEXIT
  1885. 001 SUBROUTINE (STATUS)
  1886. 002 *Exit command
  1887. 003 *6/30/87 JF3 0.3.0
  1888. 004 !
  1889. 005 COM X1(39),REMOTE.CTRL
  1890. 006 IF REMOTE.CTRL=3 THEN
  1891. 007 * ECHO.ON=OCONV("","U80E0");*Microdata
  1892. 008   ECHO ON;                  *PICK/Ultimate
  1893. 009 END;STATUS=0;RETURN
  1894. 010 * * * * * Interface info * * * * *
  1895. 011 *Entry: none
  1896. 012 *Exit:  return to TCL
  1897. 013 * * * * * Revision history * * * * *
  1898. 014 *.0 - 6/30/87 JF3
  1899. 015 END
  1900.  
  1901.     DKINP
  1902. 001 SUBROUTINE (STATUS)
  1903. 002 *INPut data (with timeout on NON Reality/Royale versions)
  1904. 003 *11/4/88 JF3 0.3.2
  1905. 004 !
  1906. 005 COM V(96);EQU DATA TO V(6),TIMEOUT TO V(18),EOL TO V(21)
  1907. 006 *EQU S TO 11;*Ultimate
  1908. 007  EQU S TO 14;*PICK
  1909. 008 DATA="";IF STATUS THEN
  1910. 009   INPUT DATA:
  1911. 010 * * * * * PICK/Ultimate * * * * *
  1912. 011  END ELSE
  1913. 012    GOSUB 8;PROMPT"";PRINT EOL:;LOOP
  1914. 013      LOOP N=SYSTEM(S) WHILE N DO
  1915. 014        INPUT c,1:;IF c="" THEN c=EOL
  1916. 015        DATA=DATA:c;IF c=EOL THEN STATUS=1;GO 9
  1917. 016        IF N=1 THEN GOSUB 8
  1918. 017      REPEAT
  1919. 018    UNTIL TIME()>=t AND still.early DO
  1920. 019      IF NOT(still.early) THEN GOSUB 8
  1921. 020    REPEAT;STATUS=0
  1922. 021 * * * * * * * * * * * * * * *
  1923. 022 END;8 t=TIME();still.early=(t<86385);t=t+TIMEOUT
  1924. 023 9 RETURN
  1925. 024 * * * * * Interface info * * * * *
  1926. 025 *Entry: STATUS := false means check timeout
  1927. 026 *                 true    "   ordinary input
  1928. 027 *       PROMPT must be set by caller
  1929. 028 *
  1930. 029 *Exit:  STATUS := false means timeout occured
  1931. 030 *                 true    "   all ok
  1932. 031 *       DATA   := any input including EOL char
  1933. 032 * * * * * Revision history * * * * *
  1934. 033 *.2 - 11/4/88 JF3 Fix midnight timeout problem.
  1935. 034 *
  1936. 035 *.1 - 12/29/87 JF3 Make SYSTEM(x) EQUatable.
  1937. 036 *
  1938. 037 *.0 - 1/29/87 JF3
  1939. 038 END
  1940.  
  1941.     DKXMTS
  1942. 001 SUBROUTINE (STATUS)
  1943. 002 *XMiT a Send-init packet
  1944. 003 *7/24/87 JF3 0.3.0
  1945. 004 !]DKINIT]DKDBUG]DKXPKTS]DKRECON]DKRETRY
  1946. 005 COM X1(3),MARK,n,DATA,X2,TYPE,X3,DEBUG.MODE,DELAY
  1947. 006 *EQU TYPE TO STATUS,RECEIVER TO STATUS,OK TO STATUS;*ULTIMATE/Microdata
  1948. 007  EQU RECEIVER TO STATUS,OK TO STATUS;*PICK
  1949. 008 CALL DKINIT(OK);IF OK THEN
  1950. 009   TYPE="S";CALL DKFPKT(TYPE);IF OK THEN
  1951. 010     IF DEBUG.MODE THEN CALL DKDBUG("H")
  1952. 011 *   SLEEP=OCONV(DELAY,"U407A");*Microdata/Ultimate
  1953. 012     SLEEP DELAY;               *PICK
  1954. 013     LOOP
  1955. 014       RECEIVER=0;CALL DKXPKTS(RECEIVER);IF OK>0 THEN
  1956. 015         BEGIN CASE
  1957. 016         CASE TYPE="Y"
  1958. 017           RECEIVER=0;CALL DKRECON(RECEIVER)
  1959. 018         CASE TYPE="N";CALL DKRETRY;OK=0
  1960. 019         END CASE
  1961. 020       END ELSE CALL DKDBUG(STATUS);STOP
  1962. 021     UNTIL OK DO REPEAT
  1963. 022   END ELSE STATUS=0
  1964. 023 END;RETURN
  1965. 024 * * * * * Interface info * * * * *
  1966. 025 *Entry: none
  1967. 026 *
  1968. 027 *Exit: STATUS := true means both sides configured
  1969. 028 *                false means error occured somewhere.
  1970. 029 * * * * * Revision history * * * * *
  1971. 030 *.0 - 7/24/87 JF3
  1972. 031 END
  1973.  
  1974.     DKFNAME
  1975. 001 SUBROUTINE DKFNAME
  1976. 002 *setup File NAMEs (in Kermit sense)
  1977. 003 *7/8/87 JF3 0.3.0
  1978. 004 *]DKCNV]DKNFN
  1979. 005 COM X1(16),MAXL,X2(6),CHKT,X3(16),ID,X4(2)
  1980. 006 COM F.NAME,X5,filename.type;DIM N(3)
  1981. 007 EQU name TO N(1),type TO N(2),sep TO N(3),AM TO CHAR(254)
  1982. 008 name=filename.type<1>;type=filename.type<2>;sep=""
  1983. 009 CALL DKCNV(NFN,0,-48:AM:105);NFN=(NFN[1,6]="NORMAL")
  1984. 010 IF F.NAME="" THEN
  1985. 011   BEGIN CASE
  1986. 012   CASE type<2
  1987. 013     IF NFN THEN type=name ELSE type=""
  1988. 014     name=ID
  1989. 015 * CASE type=2;type="";sep=".";*Not used.
  1990. 016   CASE type=3;type=(1000+ID)[2,3]
  1991. 017   CASE 1;F.NAME="";GO 9
  1992. 018   END CASE
  1993. 019 END ELSE
  1994. 020   type=INDEX(F.NAME,".",1);IF type THEN
  1995. 021     name=F.NAME[1,type-1];type=F.NAME[type+1,9999];sep="."
  1996. 022   END ELSE name=F.NAME;type=""
  1997. 023 END;IF NFN THEN CALL DKNFN(MAT N)
  1998. 024 F.NAME=(name:sep:type)[1,MAXL-2-CHKT]
  1999. 025 9 RETURN
  2000. 026 * * * * * Interface info * * * * *
  2001. 027 *Entry: filename.type <1> := file name SET by command
  2002. 028 *                     <2> := file type # SET by command
  2003. 029 *Uses:  NFN   := Normalized File Names
  2004. 030 *       sep   := file name seperator
  2005. 031 *Exit:  F.NAME := filename to be used in transaction
  2006. 032 * * * * * Revision history * * * * *
  2007. 033 *.0 - 7/8/87 JF3
  2008. 034 END
  2009.  
  2010.     DKRECON
  2011. 001 SUBROUTINE (STATUS)
  2012. 002 *Reconcile initial packet parameters
  2013. 003 *10/24/88 JF3 0.3.1
  2014. 004 *]DKQUOT]DKCNV
  2015. 005 COM X1(5),DATA,X2(16),QBIN;EQU RX TO STATUS
  2016. 006 AckPkt="";f=1;c=1;LOOP F=DATA[c,1] UNTIL F="" OR f=10 DO
  2017. 007   p=(16+f);EOL=(f=5);CAPAS=(f=10);ix=p*(EOL OR CAPAS)
  2018. 008   BEGIN CASE;CASE f=4;cnv=4
  2019. 009     CASE CAPAS;S=F;LOOP WHILE MOD(SEQ(S),2) DO
  2020. 010       c=c+1;S=DATA[c,1];F=F:S;REPEAT;cnv="CAPAS";cnv<1,2>=-1
  2021. 011     CASE 5<f AND f<10;cnv=0;CALL DKQUOT(RX,f,F)
  2022. 012   CASE 1;cnv=1;END CASE;IF NUM(cnv) THEN icnv=-cnv ELSE icnv=cnv
  2023. 013   CALL DKCNV(F,icnv,ix);IF EOL THEN CALL DKCNV(F,3,p)
  2024. 014   IF RX THEN
  2025. 015     IF EOL THEN cnv=-3
  2026. 016     IF CAPAS THEN cnv<1,2>=1
  2027. 017     IF f=7 THEN
  2028. 018       IF NOT(F="N" OR F=QBIN) THEN F="Y"
  2029. 019     END ELSE
  2030. 020       IF f=4 THEN cnv=3
  2031. 021       CALL DKCNV(F,cnv,-(48+f))
  2032. 022       IF f=4 THEN cnv=4;GO 7
  2033. 023       IF EOL THEN
  2034. 024         cnv=1;7 CALL DKCNV(F,cnv,0)
  2035. 025     END;END;AckPkt=AckPkt:F
  2036. 026   END;f=f+1;c=c+1
  2037. 027 REPEAT;IF RX THEN DATA=AckPkt
  2038. 028 STATUS=1;RETURN
  2039. 029 * * * * * Interface info * * * * *
  2040. 030 * Entry:
  2041. 031 *   STATUS   := 1 means Receive mode
  2042. 032 *   DATA     := DATA field of received init (S or Y) packet
  2043. 033 * Exit:
  2044. 034 *   If Receive mode then DATA contains DATA field of Ack packet
  2045. 035 * * * * * Revision history * * * * *
  2046. 036 *.1 - 10/24/88 JF3
  2047. 037 *
  2048. 038 *.0 - 1/29/87 JF3
  2049. 039 END
  2050.  
  2051.     DKBATCH
  2052. 001 SUBROUTINE (STATUS)
  2053. 002 *go into BATCH mode
  2054. 003 *8/7/87 JF3 0.3.0
  2055. 004 *]DKRCVG]DKXPKTS]DKRCVt
  2056. 005 COM command.line,X1(4),msg,X2(31),process,X3,remote.control
  2057. 006 *IF remote.control THEN
  2058. 007 *END ELSE
  2059. 008   process=FIELD(command.line<1>," ",2);IF NUM(process) THEN
  2060. 009     *check for logged on process here
  2061. 010     msg="K21";STATUS="!";CALL DKIO(STATUS);remote.control=3
  2062. 011     command.line=""
  2063. 012 *   ECHO.OFF=OCONV("","U80E0");*Microdata
  2064. 013     ECHO OFF;                  *PICK/Ulitmate
  2065. 014   END ELSE msg="K1";msg<2>="process#";STATUS="!";CALL DKIO(STATUS)
  2066. 015 *END
  2067. 016 STATUS=1;RETURN
  2068. 017 * * * * * Interface info * * * * *
  2069. 018 *Entry: none
  2070. 019 *
  2071. 020 *Exit:  remote.control := set to remote command mode = "3"
  2072. 021 * * * * * Revision history * * * * *
  2073. 022 *.0 - 8/7/87 JF3
  2074. 023 END
  2075.  
  2076.     DKCAPAS
  2077. 001 SUBROUTINE (arg,c,X)
  2078. 002 *Convert CAPAS bit fields -- NOT USED in 0.3
  2079. 003 *2/6/87 JF3
  2080. 004 *]DKCNV
  2081. 005 DIM C(9);MAT C=0;I=0
  2082. 006 BEGIN CASE
  2083. 007 CASE c=1
  2084. 008   v=1;LOOP P=arg<1,v> UNTIL P="" DO
  2085. 009     IF P THEN
  2086. 010       P=arg<2,v>-1;i=INT(P/5)+1;P=5*i-P
  2087. 011       C(i)=C(i)+PWR(2,P);IF i>I THEN I=i
  2088. 012     END;v=v+1
  2089. 013   REPEAT;arg="";FOR i=1 TO I
  2090. 014     C(i)=C(i)+(I>i);CALL DKCNV(C(i),1,0);arg=arg:C(i)
  2091. 015   NEXT i
  2092. 016 CASE c=-1
  2093. 017   I=LEN(arg);int.arg="";FOR i=1 TO I
  2094. 018     P=arg[i,1];CALL DKCNV(P,-1,0);FOR p=5 TO 1 STEP -1
  2095. 019       v=PWR(2,p);bit=(P>=v);IF bit THEN P=P-v
  2096. 020       v=5*i-p+1;int.arg<2,v>=v;int.arg<1,v>=bit
  2097. 021     NEXT p
  2098. 022   NEXT i;arg=int.arg
  2099. 023 END CASE;c=0;RETURN
  2100. 024 * * * * * Interface info * * * * *
  2101. 025 * Entry:
  2102. 026 *   if  c=1 then convert from internal to packet formats
  2103. 027 *     arg<1>:= multivalued bit fields
  2104. 028 *        <2>:= associated field #s
  2105. 029 *   if c=-1 then convert from packet to internal formats
  2106. 030 *     arg   := char string from packet CAPAS field
  2107. 031 * Exit:
  2108. 032 *   if c=1 on entry then
  2109. 033 *      arg    := char() encoded string
  2110. 034 *   if c=-1 on entry then
  2111. 035 *      arg<1> :=} as above
  2112. 036 *      arg<2> :=}
  2113. 037 *   c         := 0
  2114. 038 * * * * * Revision history * * * * *
  2115. 039 *.0 - 2/6/87 JF3
  2116. 040 END
  2117.  
  2118.     DKXMTT
  2119. 001 *DUMMY
  2120. 002 *Subroutine list for DKXMTt subroutine names
  2121. 003 *4/3/87 JF3 0.3
  2122. 004 *]DKXMTS]DKXMTF]DKXMTA]DKXMTD]DKXMTZ]DKXMTB
  2123. 005 END
  2124.  
  2125.     DKCHECK
  2126. 001 SUBROUTINE (check)
  2127. 002 *Checksum a packet
  2128. 003 *4/9/87 JF3 0.3.0
  2129. 004 *]DKCNV
  2130. 005 COM X1(5),DATA,X2(10),MAXL,X3(6),CHKT,X4(24),SMAXL
  2131. 006 EQU STATUS TO check;RX=check;STATUS="";IF RX THEN
  2132. 007   L=DATA[2,1];CALL DKCNV(L,-1,0)
  2133. 008   IF 0<=L AND L<=SMAXL THEN L=L+2-CHKT ELSE GO 9
  2134. 009 END ELSE L=LEN(DATA)
  2135. 010 s=0;FOR c=2 TO L
  2136. 011   CHR=DATA[c,1];IF CHR="" THEN GO 9
  2137. 012   s=s+SEQ(CHR)
  2138. 013 NEXT c;BEGIN CASE
  2139. 014 CASE CHKT=1;check=CHAR(32+MOD(INT(MOD(s,256)/64)+s,64))
  2140. 015 CASE CHKT=2
  2141. 016 * Bug of some kind here; can't get it to work!
  2142. 017   L=1;LOOP
  2143. 018     c=MOD(s,64);CALL DKCNV(c,1,0);check=c:check
  2144. 019   UNTIL L=2 DO s=INT(s/64);L=L+1 REPEAT
  2145. 020 CASE CHKT=3;*Insert assembly call here
  2146. 021 END CASE
  2147. 022 9 RETURN
  2148. 023 * * * * * Interface info * * * * *
  2149. 024 *Entry: check := true if we are receiving
  2150. 025 *Exit:  check contains check code for packet
  2151. 026 * * * * * Revision history * * * * *
  2152. 027 *.0 - 4/9/87 JF3
  2153. 028 END
  2154.  
  2155.