home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
pick.zip
/
picpr.bas
< prev
next >
Wrap
BASIC Source File
|
1987-01-22
|
74KB
|
2,155 lines
DKPARSE
001 SUBROUTINE (token,COM.index)
002 *PARSE a symbol table for a minimally unique (U/L case) token match
003 *6/25/87 JF3 0.3.0
004 *
005 COM P(64),index(3);EQU a TO index(1),v TO index(2),s TO index(3)
006 s=0;i=1;LOOP WHILE index(i) DO i=i+1 REPEAT
007 t.len=LEN(token);check.unique=0;3 LOOP
008 index(i)=index(i)+1
009 SYM=FIELD(P(COM.index)<a,v,s>," ",1)
010 UNTIL SYM="" DO
011 c=1;LOOP T=token[c,1] UNTIL T="" DO
012 S=SEQ(T);IF 97<=S AND S<=122 THEN T=CHAR(S-32)
013 IF T=SYM[c,1] THEN c=c+1 ELSE
014 IF check.unique THEN GO 7 ELSE GO 6
015 END
016 REPEAT;IF check.unique THEN GO 8 ELSE SYM1=SYM;ix=index(i);check.unique=1
017 6 REPEAT;IF check.unique THEN
018 7 token=SYM1;index(i)=ix
019 END ELSE
020 8 index(i)=0
021 END;9 RETURN
022 * * * * * Interface info * * * * *
023 *Entry: token := char. string for search.
024 * c := index of COM variable containing dynamic array
025 * of symbol data. Each element must begin
026 * with a symbol in all caps terminated
027 * by a space; additional data may follow.
028 * a := attr# wherein to restrict match search.
029 * Zero means search by attributes.
030 * v := value# as above but values.
031 * s := Set to zero.
032 *
033 *Exit: token := Symbol that matched; unchanged otherwise.
034 * c := unchanged
035 * a := attr# where token match found; zero if not found.
036 * v := value# where found.
037 * s := subvalue# where found.
038 *
039 *Use: check.unique := true means check next symbol for match
040 * to determine if token is unique.
041 * * * * * Revision history * * * * *
042 *.0 - 6/25/87 JF3
043 END
DKTC
001 SUBROUTINE (STATUS)
002 *Test Conversion routines
003 *6/29/87 JF3 0.3
004 *
005 COM P(64)
006 PRINT "idx":;INPUT idx
007 LOOP PRINT "cnv":;INPUT cnv UNTIL cnv="END" DO
008 LOOP
009 DEBUG
010 PRINT "arg":;INPUT arg
011 UNTIL arg="END" DO
012 CALL DKCNV(arg,cnv,idx)
013 PRINT "arg(hex)=":OCONV(arg,"MX"):" ":arg;PRINT
014 REPEAT
015 REPEAT;STATUS=1;RETURN;END
DKNFN
001 SUBROUTINE (MAT N)
002 *Normalize File Names (in Kermit sense)
003 *7/8/87 JF3 0.3.0
004 *
005 DIM N(3)
006 EQU name TO N(1),type TO N(2),sep TO N(3)
007 FOR p=1 TO 2
008 string="";c=1;LOOP C=N(p)[c,1] UNTIL C="" DO
009 s=SEQ(C);BEGIN CASE
010 CASE s<=47;C="X"
011 CASE 58<=s AND s<=64;C="X"
012 CASE 91<=s AND s<=96;C="X"
013 CASE 97<=s AND s<=122;C=CHAR(s-32)
014 CASE (123<=s);C="X"
015 END CASE;string=string:C;c=c+1
016 REPEAT;N(p)=string
017 NEXT p;IF type="" THEN sep="" ELSE sep="."
018 RETURN
019 * * * * * Interface info * * * * *
020 *Entry: name := file name in Kermit sense
021 * type := " type " " "
022 * sep := seperator character
023 *
024 *Exit: as above but normalized per Kermit Protocol Manual
025 * * * * * Revision history * * * * *
026 *.0 - 7/8/87 JF3
027 END
DKA09
001 SUBROUTINE (status)
002 *check received Attribute 9 (access)
003 *6/29/87 JF3 0.3.0
004 *
005 COM X1(41),item
006 EQU Access TO status
007 BEGIN CASE
008 CASE Access="N"
009 CASE Access="S"
010 CASE Access="A"
011 CASE 1;status=0
012 END CASE
013 RETURN
014 * * * * * Interface info * * * * *
015 *Entry: status := file access character
016 *
017 *Exit: status := 1 if ok; 0 otherwise
018 * * * * * Revision history * * * * *
019 *.0 - 6/29/87 JF3
020 END
DKCNV
001 SUBROUTINE (arg,cnv,index)
002 *Convert parameters to COM format
003 *5/8/87 JF3 0.3.0
004 !]DKcnv]DKCTL
005 COM P(64);I=index<1>;RETREIVE=(I<0);I=ABS(I)
006 IF RETREIVE THEN
007 GOSUB 10;IF a THEN arg=P(I)<a,v> ELSE arg=P(I)
008 END;IF NUM(cnv) THEN c=ABS(cnv) ELSE
009 IF cnv="" THEN c=0 ELSE
010 SUBR="DK":cnv<1,1>;c=cnv<1,2>;CALL @SUBR(arg,c,index)
011 END
012 END;BEGIN CASE
013 CASE c=1;IF cnv>0 THEN arg=CHAR(arg+32) ELSE arg=SEQ(arg)-32
014 CASE c=2;IF cnv>0 THEN
015 IF arg="ON" THEN arg=1 ELSE arg=0
016 END ELSE
017 IF arg=1 THEN arg="ON" ELSE arg="OFF"
018 END
019 CASE c=3;IF cnv>0 THEN arg=CHAR(arg) ELSE arg=SEQ(arg)
020 CASE c=4;*[0<=arg<=31 or arg=127] or OCONV[]
021 * DK1.2="U2":P(47)<1,1>;*Microdata/Ultimate
022 * arg=OCONV(arg,DK1.2); *Microdata/Ultimate
023 CALL DKCTL(arg); *PICK
024 CASE 1;cnv=c
025 END CASE;IF index<1>>0 THEN
026 GOSUB 10;IF arg="x" THEN arg=""
027 IF a THEN
028 P(I)<a,v>=arg;IF s#"" THEN P(I)<2,v>=s
029 END ELSE P(I)=arg
030 END;RETURN
031 10 s=index<2>;IF s="" THEN a=0;v=0 ELSE
032 IF s<99 THEN
033 a=1
034 * LOCATE s IN P(I)<2> SETTING v ELSE NULL;*Microdata/Ultimate
035 LOCATE(s,P(I),2;v) ELSE NULL; *PICK
036 END ELSE a=s-100;v=1;s=""
037 END;RETURN
038 * * * * * Interface info * * * * *
039 * Entry:
040 * arg := contains data to be operated upon or
041 * is destination of data retrieved.
042 * cnv := DK conversion code:
043 * null or 0 means no conversion
044 * numeric means convert here:
045 * >0 : convert to internal/packet
046 * <0 : convert to external
047 * non-numeric means call external subroutine
048 * index <1>:= COM position: Neg. means retreive data; pos. means
049 * store data, 0 means ignore COM data.
050 * <2>:= <=99 means code associated with subparameter
051 * else 100+attr# within COM variable of data
052 * Null means single valued data.
053 * Exit:
054 * arg := data as converted
055 * cnv := }modified only on
056 * index := } error detection.
057 * * * * * Revision history * * * * *
058 *.0 - 5/8/87 JF3
059 END
DKXPKTS
001 SUBROUTINE (STATUS)
002 *eXchange PacKeTS (send or receive)
003 *10/22/88 JF3 0.3.1
004 *]DKIO]DKVPKT]DKRETRY]DKACK]DKERR]DKFPKT
005 COM X1(4),n,DATA,CHECK,TYPE,LIMIT,X2(11),EOL,X3(2),CHKT,X4(12),r
006 EQU LEN TO STATUS,ok TO STATUS,AM TO CHAR(254)
007 xmt.pkt=DATA:CHECK;function=STATUS;ok=0;r=0;LOOP
008 DATA=xmt.pkt;PROMPT EOL;IF function>=0 THEN
009 STATUS=2;CALL DKIO(STATUS);STATUS=function;CALL DKVPKT(STATUS)
010 IF STATUS>0 THEN
011 IF TYPE="E" THEN
012 * If local mode then print msg on screen
013 DATA="";CALL DKACK("Y");CALL DKIO(-2);STATUS=0;ok=0
014 END ELSE ok=STATUS;DATA=DATA[5,LEN-2-CHKT]
015 END
016 END ELSE CALL DKIO(-2);STATUS=1;ok=STATUS
017 UNTIL STATUS=ok DO
018 CALL DKRETRY(STATUS);IF NOT(ok) THEN GO 9
019 REPEAT;9 RETURN
020 * * * * * Interface info * * * * *
021 *Entry: DATA := DATA field of packet to send
022 * CHECK := check code the packet
023 * STATUS := function indicator:
024 * >=0 means input a response packet after sending a packet
025 * -1 " do not wait for answer; just terminate packet
026 *
027 *Exit: DATA := disassembled received packet data
028 * STATUS := 0 means retry limit exceeded
029 * 1 " received packet ok
030 * -1 " E packet received
031 * * * * * Revision history * * * * *
032 *.1 - 10/22/88 JF3
033 *
034 *.0 - 10/21/88 JF3
035 END
DKVPKT
001 SUBROUTINE (STATUS)
002 *Verify a received packet
003 *3/27/89 JF3 0.3.1
004 *]DKCHECK]CKCNV
005 COM X1(3),MARK,CTRL.SEQ,PACKET,CHECK,TYPE,X2,DEBUG.MODE,X3(13),CHKT
006 EQU LEN TO STATUS;RECEIVER=STATUS;TYPE=""
007 STATUS=INDEX(PACKET,MARK,1);IF STATUS THEN
008 IF STATUS>1 THEN PACKET=PACKET[STATUS,99999]
009 CHECK=1;CALL DKCHECK(CHECK);IF CHECK="" THEN STATUS=-6 ELSE
010 LEN=PACKET[2,1];CALL DKCNV(LEN,-1,0)
011 IF CHECK=PACKET[LEN+3-CHKT,CHKT] THEN
012 TYPE=PACKET[4,1];BEGIN CASE
013 CASE TYPE="D";CASE TYPE="Y";CASE TYPE="N";CASE TYPE="S"
014 CASE TYPE="B";CASE TYPE="F";CASE TYPE="Z";CASE TYPE="E"
015 CASE TYPE="A"
016 CASE 1;STATUS=-4;GO 9;END CASE
017 PACKET.SEQ=PACKET[3,1];CALL DKCNV(PACKET.SEQ,-1,0)
018 IF PACKET.SEQ#MOD(CTRL.SEQ+RECEIVER,64) THEN STATUS=-3
019 END ELSE STATUS=-2
020 END
021 END ELSE STATUS=-1
022 9 IF DEBUG.MODE THEN
023 PRINTER ON;PRINT ON 1;PRINT ON 1 "DKVPKT: ":STATUS
024 PRINT ON 1 OCONV(PACKET,"MX");PRINT ON 1;PRINTER OFF
025 END;RETURN
026 * * * * * Interface info * * * * *
027 *Entry: STATUS := false means send mode; true means receive mode
028 * PACKET := packet data as received from the line and
029 * as described in the Protocol Manual chapter 6.
030 *
031 *Exit: STATUS := LEN field (dec.) of packet if packet all ok;
032 * neg. error code if not.
033 END
034 * * * * * Revision history * * * * *
035 *.1 - 3/27/89 JF3 - Scan for MARK
036 *
037 *.0 - 10/21/88 JF3
DKXMTA
001 SUBROUTINE (STATUS)
002 *XMiT file Attribute packet(s)
003 *7/29/87 JF3 0.3.0
004 *]DKFPKT]DKXPKTS]DKFATAL
005 COM X1(5),PACKET,X2,RCV.PKT.TYPE,X3(8),MAXL,X4(6),CHKT,X5(23),F.A
006 EQU XMT.PKT.TYPE TO STATUS,OK TO STATUS
007 max.len=MAXL-2-CHKT;pkt.len=0;PACKET="";v=0;LOOP
008 IF v THEN attribute=F.A<2,v> ELSE attribute=14
009 UNTIL attribute="" DO
010 IF v THEN DATA=F.A<1,v> ELSE DATA=PAR.LIST<10>
011 length=LEN(DATA)
012 pkt.len=pkt.len+length+2;IF pkt.len>max.len THEN GOSUB 5;PACKET=""
013 CALL DKCNV(attribute,1,0);CALL DKCNV(length,1,0)
014 PACKET=PACKET:attribute:length:DATA
015 v=v+1;REPEAT
016 5 XMT.PKT.TYPE="A";CALL DKFPKT(XMT.PKT.TYPE);IF OK THEN
017 RECEIVER=0;CALL DKXPKTS(RECEIVER)
018 IF RCV.PKT.TYPE="E" THEN CALL DKFATAL(STATUS)
019 END
020 RETURN
021 * * * * * Interface info * * * * *
022 *Entry: F.A := dynamic array of settable File Attribute data
023 * <1> := multivalued list of attribute data
024 * <2> := assoc. m.v. list of attr. codes
025 * * * * * Revision history * * * * *
026 *.0 - 7/29/87 JF3
027 END
DKACK
001 SUBROUTINE (STATUS)
002 *set up an ACKnowledge packet
003 *10/21/88 JF3 0.3.0
004 *]DKFPKT
005 COM X1(4),n,DATA,X2(30),r
006 BEGIN CASE
007 CASE STATUS="Y"
008 CASE STATUS="E"
009 CASE STATUS="N";DATA="";GO 9
010 CASE 1;STATUS="Y":STATUS
011 END CASE;n=MOD(n+1,64);r=0;9 CALL DKFPKT(STATUS);RETURN
012 * * * * * Interface info * * * * *
013 *Entry: STATUS := "E" if error msg for acknowledgement
014 * "Y" for plain ack.
015 * otherwise carry packet type thru to FormPacKeT
016 *
017 *Exit: STATUS See DKFPKT.
018 * r := retry counter set to 0
019 * * * * * Revision history * * * * *
020 *.0 - 10/21/88 JF3
021 END
DKXMTB
001 SUBROUTINE (STATUS)
002 *Transmit a Break Transmission pkt.
003 *1/29/87 JF3 0.3.0
004 *]DKFPKT]DKXPKTS]DKFATAL
005 COM X1(5),DATA,X2,RCV.PKT.TYPE
006 EQU XMT.PKT.TYPE TO STATUS,OK TO STATUS
007 XMT.PKT.TYPE="B";DATA="";CALL DKFPKT(XMT.PKT.TYPE);IF OK THEN
008 STATUS=0;CALL DKXPKTS(STATUS)
009 IF OK<=0 OR RCV.PKT.TYPE="E" THEN CALL DKFATAL(STATUS) ELSE
010 PROMPT">"
011 * ECHO.ON=OCONV(0,"U70E0");*Microdata
012 ECHO ON; *PICK/Ultimate
013 END
014 END;RETURN
015 * * * * * Interface info * * * * *
016 *Entry: none
017 *Exit: none - return to command level
018 * * * * * Revision history * * * * *
019 *.0 - 1/29/87 JF3
020 END
DKSTATUS
001 SUBROUTINE (STATUS)
002 *Display Kermit status
003 *1/29/87 JF3 0.3.0
004 *]DKCNV
005 COM P(64);EQU PAR.LIST TO P(12)
006 p=1;LOOP PARAM=PAR.LIST<2,p> UNTIL PARAM="" DO
007 index=-PAR.LIST<3,p>;cnv=PAR.LIST<5,p>;IF NUM(cnv) THEN cnv=-cnv
008 CALL DKCNV(arg,cnv,index);PRINT PARAM:"=":arg
009 p=p+1;REPEAT;STATUS=1;RETURN
010 * * * * * Interface info * * * * *
011 * Entry:
012 * PAR.LIST := <2,p> parameter p name
013 * := <3,p> COM position
014 * := <5,p> conversion type/subr name
015 * Exit:
016 * STATUS := 1 means finished ok
017 * * * * * Revision history * * * * *
018 *.0 - 1/29/87 JF3 Not yet ready for subparams.
019 END
RDF
001 *MAIN
002 *Read distr. files in PROC PIB
003 *8/10/89 JF3 R83 2.2
004 PROCREAD PIB ELSE PRINT "Must be run from MAKE-DISTR PROC!";STOP
005 a=FIELD(PIB," ",1);list=FIELD(PIB," ",2)
006 OPEN "DICT","M/DICT" ELSE PRINT "NO M/DICT!";STOP
007 a=a+1;READV line FROM list,a ELSE PRINT "No DISTR-FILES";STOP
008 PIB=a:" ":line;PROCWRITE PIB
009 * * * * * Interface info * * * * *
010 *Entry: none - used only for the MAKE-DISTR and MAKE-COLUMBIA Procs
011 * * * * * Revision history * * * * *
012 *.1 - 8/10/89 JF3 Add Columbia files list
013 *
014 *.0 - 1/19/89 JF3
015 END
DKRF1
001 SUBROUTINE (status)
002 *Receive a File name packet -- filetype = 1 -- UNUSED IN 0.3
003 *6/29/87 JF3 0.3
004 *]DKCNV
005 EQU AM TO CHAR(254)
006 IF item#"" THEN
007 CALL DKCNV(access,"",-16:AM:9);IF access="S" THEN item="" ELSE
008 status=0;GO 9
009 END;IF item<1>#"CC" AND item<1>#"CL" THEN
010 DK1.3="U3":FID<1,1>;beg.fid=OCONV("",DK1.3)
011 IF beg.fid THEN
012 item<12>=beg.fid;item<13>=1
013 END
014 END
015 END;9 RETURN
016 * * * * * Interface info * * * * *
017 *Entry: item := existing item body if any
018 *
019 *Exit:
020 END
ANSITAPE
001 *MAIN
002 *Read ANSI formatted tape; convert to file item(s). Not usable for 0.3!
003 *12/30/86 JF3 4.2E
004 OPEN "DICT","DK" ELSE PRINT "No DICT DK!";STOP
005 READ ST FROM "ANSITAPE" ELSE
006 PRINT "No ANSITAPPE in DICT DK!";STOP
007 END;PRINT "DESTINATION FILE NAME:":;INPUT file.name
008 OPEN "",file.name ELSE PRINT "No such file!";STOP
009 EQU Symbol TO RCW;STATE=1;D=0;LOOP
010 p=1;READT block ELSE p=0
011 IF p THEN Symbol=block[p,4]
012 I=ST<3-p,STATE>;BEGIN CASE
013 CASE I=2;IF Symbol#"VOL1" THEN GO 9
014 CASE I=3
015 IF Symbol="HDR1" THEN
016 file.name=block[5,17];ext=TRIM(FIELD(file.name,".",2))
017 IF ext[1,2]="DK" THEN
018 file.name=FIELD(file.name,".",1);a=1;item=""
019 END
020 END ELSE I=0
021 CASE I=4
022 IF Symbol="VOL1" THEN D=-1 ELSE
023 LOOP UNTIL RCW="" OR RCW[1,1]="^" DO
024 item<a>=block[p+4,RCW-4];a=a+1;p=p+RCW;RCW=block[p,4]
025 REPEAT;p=1;I=0
026 END
027 CASE I=5
028 IF Symbol="EOF1" THEN
029 WRITE item ON file.name
030 END ELSE I=0
031 CASE I=8;D=5
032 CASE I=9
033 9 PRINT "FORMAT ERROR!";PRINT "STATE=":STATE;STATE=99
034 IF p THEN PRINT block
035 END CASE;IF I THEN STATE=ST<4,STATE>+D;D=0
036 UNTIL STATE>=9 DO REPEAT
037 REWIND ELSE PRINT "TAPE NOT READY!"
038 END
DKQUOT
001 SUBROUTINE (RX,f,F)
002 *Reconcile send-init Quote fields
003 *1/29/87 JF3 0.3.0
004 *
005 COM X1(21),QCTL,QBIN,CHKT,REPT,X2(28),SQCTL,SQBIN,SCHKT
006 BEGIN CASE
007 CASE f=7
008 BEGIN CASE
009 CASE F="N" OR F="" OR F=QCTL;GO 4
010 CASE F="Y";QBIN=SQBIN;F=QBIN
011 CASE 1;GOSUB 10;IF X THEN F="Y" ELSE
012 4 QBIN="";F="N"
013 END;END CASE
014 CASE f=8;IF F#SCHKT THEN CHKT=1
015 CASE f=9
016 BEGIN CASE
017 CASE F=" " OR F="" OR F=QCTL OR F=QBIN;GO 6
018 CASE 1;GOSUB 10;IF X THEN REPT=F ELSE
019 6 REPT="";F=" "
020 END;END CASE
021 END CASE;RETURN
022 10 X=SEQ(F);X=(33<=X AND X<=62) OR (96<=X AND X<=126);RETURN
023 * * * * * Interface info * * * * *
024 *Entry: RX := 1 if receiver, 0 if sender (Mistakenly not referenced!)
025 * f := Init packet field #
026 * F := " " " contents
027 *Exit: COM fields setup for transaction
028 * * * * * Revision history * * * * *
029 *.0 - 1/29/87 JF3
DKRETR
001 SUBROUTINE (STATUS)
002 *RETreive Record to send from system
003 *7/21/87 JF3 0.3.0
004 *]DKFTYPE
005 COM CMD.LINE,X1,ERR,X2,PKT.SEQ,DATA,CHECK,TYPE,X3,DEBUG.MODE
006 COM X4(6),MAXL,X5(6),CHKT,X6(9),PICK.file.type,p,L,X7(4)
007 COM ID,ITEM,rec.terminator,F.NAME,FV,filename.type,FID,X8(16),Type
008 EQU INITIAL.ENTRY TO STATUS,OK TO STATUS,AM TO CHAR(254),DK1 TO p
009 IF INITIAL.ENTRY THEN
010 PICK.file.type=filename.type<2>;DK1=FID<1,1>
011 BEGIN CASE
012 CASE PICK.file.type<2
013 READ ITEM FROM FV,ID ELSE DATA="item: ":ID;ID=4;GO 10
014 IF PICK.file.type=1 THEN
015 A1=ITEM<1>
016 * * * * * Ultimate * * * * *
017 IF A1="CC" OR A1="CL" THEN
018 STATUS=OCONV(ITEM<2>:",":ITEM<3>,"U3":DK1);IF OK THEN NULL
019 END ELSE PICK.file.type=0
020 END
021 CASE PICK.file.type=3
022 STATUS=OCONV(ID,"U0":DK1);IF OK THEN DK1="U1":DK1 ELSE
023 DATA="entry: ":ID;ID=4;GO 10
024 END
025 CASE 1
026 2 DATA="DATAFILE";ID=1;GO 10
027 END CASE;CALL DKFTYPE;L=INT(8*(MAXL-2-CHKT)/10)
028 IF NOT(PICK.file.type) THEN p=1
029 END ELSE
030 BEGIN CASE
031 CASE PICK.file.type<2
032 IF Type="A" THEN
033 DATA=FIELD(ITEM,AM,p);p=p+1;STATUS=NOT(COL2())
034 DATA=DATA:rec.terminator
035 END ELSE DATA=ITEM[p,L];p=p+L;STATUS=(DATA="")
036 CASE PICK.file.type=3
037 STATUS=0;DATA=OCONV(L,DK1)
038 IF DATA=CHAR(0) OR DATA="" THEN STATUS=1
039 END CASE
040 END;9 RETURN
041 10 DATA=INSERT(DATA,1,0,0,"K":ID);STATUS=-1;GO 9
042 * * * * * Interface info * * * * *
043 *Entry: STATUS := 1 means first entry to retrieve data
044 * 0 means subsequent entry; return next record
045 *
046 *Exit: On INITIAL.ENTRY On subsequent entries
047 * ---------------- ---------------------
048 * STATUS := 1 means data ok 1 means last record
049 * 0 means more to go
050 * -----------------On either-------------------
051 * <0 means K-msg err id VM filler in DATA
052 *Uses: NFN := 1 means Normalized File Names in the
053 * Kermit sense
054 * * * * * Revision history * * * * *
055 *.0 - 7/21/87 JF3
056 END
DKXMTZ
001 SUBROUTINE (STATUS)
002 *Transmit a End of File packet
003 *1/29/87 JF3 0.3.0
004 *]DKFPKT]DKXPKTS]DKFATAL
005 COM X1(5),DATA,X2,RCV.PKT.TYPE
006 EQU XMT.PKT.TYPE TO STATUS,OK TO STATUS
007 XMT.PKT.TYPE="Z";DATA="";CALL DKFPKT(XMT.PKT.TYPE);IF OK THEN
008 STATUS=0;CALL DKXPKTS(STATUS)
009 IF OK<=0 OR RCV.PKT.TYPE="E" THEN CALL DKFATAL(STATUS)
010 END
011 9 RETURN
012 * * * * * Interface info * * * * *
013 *Entry: none
014 *Exit: transaction terminated
015 * * * * * Revision history * * * * *
016 *.0 - 1/29/87 JF3
017 END
DKCOMMENT
001 SUBROUTINE (STATUS)
002 *no operation; just a COMMENT for TAKE files
003 *11/4/88 JF3 0.3.0
004 *
005 COM X1,HELP.LIST,X2(3),LINE
006 STATUS=1;RETURN
007 * * * * * Interface info * * * * *
008 *No interface needed
009 * * * * * Revision history * * * * *
010 *
011 *.0 11/4/88 JF3
012 END
DKXMTD
001 SUBROUTINE (STATUS)
002 *Transmit Data packet(s)
003 *1/29/87 JF3 0.3.0
004 *]DKFPKT]DKXPKTS]DKFATAL
005 COM X1(5),DATA,X2,RCV.PKT.TYPE,X3(8),MAXL
006 EQU XMT.PKT.TYPE TO STATUS,OK TO STATUS,LEN TO STATUS,RECEIVER TO STATUS
007 ALL.DATA=DATA;LEN.ALL.DATA=LEN(ALL.DATA);PTR=0;LOOP
008 XMT.PKT.TYPE="D";CALL DKFPKT(XMT.PKT.TYPE)
009 IF OK>0 THEN
010 PTR=PTR+LEN;RECEIVER=0;CALL DKXPKTS(RECEIVER)
011 IF RCV.PKT.TYPE="E" THEN CALL DKFATAL(STATUS)
012 END ELSE GO 9
013 UNTIL PTR=LEN.ALL.DATA DO DATA=ALL.DATA[PTR+1,MAXL] REPEAT
014 9 RETURN
015 * * * * * Interface info * * * * *
016 *Entry: DATA := data field of packet to send
017 *
018 *Exit: STATUS := # of chars sent if successful
019 * := <= 0 if unsuccessful
020 * * * * * Revision history * * * * *
021 *.0 - 1/29/87 JF3
022 END
DKVERSION
001 SUBROUTINE (STATUS)
002 *Display current Kermit version & revision
003 *1/29/87 JF3 0.3.0
004 *
005 COM X1,HELP.LIST
006 PRINT HELP.LIST<1>[2,999];STATUS=1;RETURN
007 * * * * * Interface info * * * * *
008 *Entry: none
009 *Exit: none
010 * * * * * Revision history * * * * *
011 *.0 - 1/29/87 JF3
012 END
DKCTL
001 SUBROUTINE (N)
002 *Perform Kermit ctl() function
003 *4/9/87 JF3 0.3.0
004 *
005 s=SEQ(N);BEGIN CASE
006 CASE s<=31 OR s=63;s=s+64
007 CASE 64<=s AND s<=95 OR s=127;s=s-64
008 CASE 1;N=" ";GO 9
009 END CASE;N=CHAR(s)
010 9 RETURN
011 * * * * * Interface Info * * * * *
012 * Entry: N contains a single character in the range:
013 * 0-31,63-95,127 (decimal)
014 * Exit: N contains Kermit ctl(N), i.e. N xor 64.
015 * * * * * Revision history * * * * *
016 *.0 - 4/9/87 JF3
017 END
DKDF
001 SUBROUTINE (arg,c,index)
002 *Convert DATAFILE to include file type
003 *5/6/87 JF3 0.3.0
004 !]DKOPNFILE
005 COM X1(45),datafile
006 datafile=arg;BEGIN CASE
007 CASE c=1
008 BEGIN CASE
009 CASE arg="TERMINAL";type="2"
010 CASE arg="SPOOLER";type="3"
011 CASE 1
012 CALL DKOPNFILE(type);IF type<0 THEN
013 c="K4";c<2>="file: ":arg;index<1>=0;GO 9
014 END
015 END CASE;index<2>=type
016 CASE c=-1
017 arg=datafile<1>;type=datafile<2>
018 IF type#"" THEN arg=arg:" <":type:">"
019 CASE 1
020 * INS "K10" BEFORE c<1>;c<2,2>="DKDF"; *ULTIMATE/Microdata
021 c=INSERT(c,1,0,0,"K10");c<2,2>="DKDF";*PICK
022 9 arg="!!!";datafile="";GO 10
023 END CASE;c=0;10 RETURN
024 * * * * * Interface info * * * * *
025 * Entry:
026 * if c=1 then convert from display to internal formats with file opening
027 * arg := [ {DICT }filename ]
028 * [ SPOOLER ]
029 * if c=-1 then convert from internal to display formats
030 * arg<1> := as above plus
031 * arg<2> := [ null ] if ordinary data file or
032 * [ P ] if SPOOLER.
033 * Exit:
034 * arg := opposite form of c=1 to c=-1 above (conv ok)
035 * := "!!!" indicates fatal error
036 * c=0 := no further conversions (conv ok)
037 * c<1> := fatal error message item-id
038 * c<2> := multivalued parameters for error message
039 * * * * * Revision history * * * * *
040 *.0 - 5/6/87 JF3
041 END
DKSERVER
001 SUBROUTINE (STATUS)
002 *go into SERVER mode for command input - NOT USED in 0.3
003 *6/25/87 JF3
004 *]DKRCVG]DKXPKTS]DKRCVt]DKACK
005 COM X1(5),msg,X2(33),remote.control
006 msg="K20";STATUS="!";CALL DKIO(STATUS)
007 remote.control=1
008 STATUS=1;RETURN
009 * * * * * Interface info * * * * *
010 *Entry: none
011 *
012 *Exit: remote.control := set to Server mode = "1"
013 * * * * * Revision history * * * * *
014 *.0 - 6/25/87 JF3
015 END
DKATTRS
001 SUBROUTINE (STATUS)
002 *Send file ATTRibuteS -- UNUSED IN 0.3
003 *7/14/87 JF3
004 *]DKCNV]DKXMTA
005 COM X1(2),ERR,X2(2),DATA,X3(38),FV,FILE.NAME
006 CALL DKCNV(ATTRS.ON,0,0);*NEEDS TO BE FIXED
007 IF ATTRS.ON THEN
008 A=1;ATTRS=1;LOOP
009 index=-(32*A-6);CALL DKCNV(OK,"",index);ATTRS=ATTRS*OK
010 WHILE ATTRS AND A<2 DO A=A+1 REPEAT
011 IF ATTRS THEN CALL DKXMTA(STATUS) ELSE OK=1
012 END;RETURN
013 * * * * * Interface info * * * * *
014 *Entry:
015 *
016 *Exit:
017 * * * * * Revision history * * * * *
018 *.0 - 7/14/87 JF3
019 END
DKTAKE
001 SUBROUTINE (STATUS)
002 *Take sequence of commands from file item (begin attr. 2)
003 *1/29/87 JF3 0.3.1
004 *]DKOPNFILE]DKPARSE]DKcmd]PERR
005 COM CMD.LINE,X1,ERR,X2(2),DATA,X3(38),FV,FILE.NAME
006 EQU LF TO CHAR(10),CR TO CHAR(13),SPACE TO " ",OK TO STATUS
007 EQU VM TO CHAR(253),AM TO CHAR(254),MSG TO STATUS,ID TO STATUS
008 CALL DKOPNFILE(STATUS);IF OK THEN
009 ID=FIELD(CMD.LINE,SPACE,I);IF ID="" THEN ITEM="" ELSE
010 READ ITEM FROM FV,ID ELSE MSG=ID:VM:FILE.NAME;ID=21;GO 7
011 END;A=2;LOOP CMD=ITEM<A> UNTIL CMD="" DO
012 C=CMD;CALL DKPARSE(C)
013 IF C THEN SUBR="DK":CMD;CALL @SUBR(STATUS) ELSE ID="K1";MSG="";GOSUB 7
014 A=A+1;REPEAT
015 END ELSE ID="K0";MSG=""
016 7 CALL PERR(0,0,ERR,ID,MSG);8 STATUS=0;9 RETURN
017 * * * * * Interface info * * * * *
018 *
019 * * * * * Revision history * * * * *
020 *.1 11/4/88 JF3 Change to multi-attribute command format
021 *
022 *.0 1/29/87 JF3
023 END
DKDFAULT
001 SUBROUTINE (STATUS)
002 *set DEFAULT parameters
003 *6/25/87 JF3 0.3.0
004 *]PERR]DKCNV
005 COM P(64);EQU SVM TO CHAR(252),VM TO CHAR(253)
006 EQU HELP.LIST TO P(2),ERR TO P(3),MSG TO P(6),PAR.LIST TO P(12)
007 EQU DK.MD TO P(15),UM.FIDS TO P(47)
008 id="HELP";READ HELP.LIST FROM DK.MD,id ELSE GO 4
009 id="PARAMS";READ PAR.LIST FROM DK.MD,id ELSE
010 4 CALL PERR(0,0,ERR,21,id:VM:"DK-MD");STOP
011 END;UM.FIDS=PAR.LIST<13>
012 v=1;LOOP PAR=PAR.LIST<2,v> UNTIL PAR="" DO
013 index=PAR.LIST<3,v>;cnv=PAR.LIST<5,v>;s=1;arg.list=PAR.LIST<7,v>
014 IF NOT(NUM(cnv)) THEN cnv<1,2>=1
015 LOOP arg=FIELD(arg.list,SVM,s) WHILE COL2() DO
016 IF arg#"" THEN
017 index<2>=PAR.LIST<9,v,s>;CALL DKCNV(arg,cnv,index)
018 IF arg="!!!" THEN MSG=cnv;CALL DKIO("!");STATUS=0;GO 9
019 END
020 s=s+1;REPEAT;index=index<1>;IF 49<=index AND index<=61 THEN
021 P(index-32)=P(index)
022 END;v=v+1
023 REPEAT;STATUS=1;9 RETURN
024 * * * * * Interface info * * * * *
025 *Entry: none (execpt in COM)
026 *Exit: STATUS set true
027 * * * * * Revision history * * * * *
028 *.0 - 6/25/87 JF3
029 END
DKXMTF
001 SUBROUTINE (STATUS)
002 *Transmit a File Header packet
003 *1/29/87 JF3 0.3.0
004 *]DKFPKT]DKXPKTS]DKFATAL
005 COM X1(7),RCV.PKT.TYPE
006 EQU XMT.PKT.TYPE TO STATUS,OK TO STATUS
007 XMT.PKT.TYPE="F";CALL DKFPKT(XMT.PKT.TYPE);IF OK THEN
008 RECEIVER=0;CALL DKXPKTS(RECEIVER)
009 IF RCV.PKT.TYPE="E" THEN CALL DKFATAL(STATUS)
010 END;RETURN
011 * * * * * Interface info * * * * *
012 *Entry: none
013 *Exit: none
014 * neg. error code if not.
015 * * * * * Revision history * * * * *
016 *.0 - 1/29/87 JF3
017 END
DKERR
001 SUBROUTINE DKERR
002 *Format ERRor messages for output
003 *5/6/87 JF3 0.3.0
004 *]PERR
005 COM X1(2),ERR,X2(2),msg;EQU VM TO CHAR(253)
006 i=msg<1>;READV MSG FROM ERR,i,2 ELSE MSG="No '":i:"' in DK-ERR!"
007 msg=msg<2>;i=1;j=1;OMSG=""
008 LOOP X=FIELD(MSG,VM,i) UNTIL COL2()=0 DO
009 IF X="" THEN X=msg<1,j>;j=j+1
010 OMSG=OMSG:X;i=i+1
011 REPEAT;msg=OMSG;RETURN
012 * * * * * Interface info * * * * *
013 * Entry:
014 * msg<1> := error msg item-id in ERR file
015 * <2> := filler for msg body (multivalued)
016 *
017 * Exit:
018 * msg := formatted msg for output
019 * * * * * Revision history * * * * *
020 *.0 - 5/6/87 JF3
021 END
DKAnn
001 *DUMMY
002 *called subroutine list and common interface for received A packets
003 *7/21/87 JF3 0.3.0
004 *]DKA01]DKA02]DKA09]DKA15
005 * * * * * Interface info * * * * *
006 *Entry: STATUS := DATA portion of subfield of A packet
007 *
008 *Exit:
009 * * * * * Revision history * * * * *
010 *.0 - 7/21/87 JF3
011 END
DKINIT
001 SUBROUTINE (STATUS)
002 *Initial Send-init parameters
003 *4/9/87 JF3 0.3.0
004 *]DKCNV]DKDBUG
005 COM X1(2),ERR,X2(2),DATA,X3(3),DEBUG.MODE,X4(38)
006 COM SPAR(16);EQU AM TO CHAR(254),VM TO CHAR(253)
007 C=1:AM:1:AM:1:AM:AM:-3:AM:AM:AM:AM:AM:"CAPAS":VM:1:AM:1:AM:1:AM:1
008 DATA="";FOR index=49 TO 61
009 I=index-48;CALL DKCNV(arg,C<I>,-index)
010 IF index=52 THEN CALL DKCNV(arg,4,0)
011 IF index=53 THEN CALL DKCNV(arg,1,0)
012 DATA=DATA:arg
013 NEXT index;IF DEBUG.MODE THEN
014 SAVE=DATA;I=LEN(DATA)+3;CALL DKCNV(I,1,0)
015 DATA=CHAR(0):I:" ":DATA:" ";CALL DKDBUG("I");DATA=SAVE
016 END;STATUS=1;RETURN
017 * * * * * Interface info * * * * *
018 *Entry: none
019 *Exit: send-init packet setup
020 * * * * * Revision history * * * * *
021 *.0 - 4/9/87 JF3
022 END
DKA15
001 SUBROUTINE (STATUS)
002 *check received Attribute 15 (Format) -- UNUSED IN 0.3
003 *6/11/87 JF3
004 *]DKCTL]DKCNV
005 COM X1(42),record.termination,X2(19),p.format
006 EQU DATA TO STATUS,rec.size.len TO record.termination
007 p.format=DATA[1,1];record.termination="";ix=43;BEGIN CASE
008 CASE p.format="A"
009 i=2;LOOP c=DATA[i,1] UNTIL c="" DO
010 CALL DKCTL(c);record.termination=record.termination:c
011 i=i+1;REPEAT;GO 9
012 CASE p.format="D";l=1
013 CASE p.format="F";l=4
014 CASE p.format="M";l=1;ix=0;*NEEDS TO BE FIXED
015 CASE p.format="R";l=1;ix=0
016 CASE 1;STATUS=0;GO 9
017 END CASE;arg=DATA[2,l];IF l=1 THEN
018 IF NUM(arg) THEN cnv=0 ELSE cnv=-1
019 CALL DKCNV(arg,cnv,ix)
020 END;8 STATUS=1;9 RETURN
021 * * * * * Interface info * * * * *
022 * * * * * Revision history * * * * *
023 *.0 - 6/11/87 JF3
024 END
DKFATAL
001 *TERM
002 *Process fatal errors; print diagnostic msg
003 *1/29/87 JF3 0.3
004 *
005 COM X(62),line,prog
006 *Should call DKIO here !
007 PRINT "?Fatal error in LINE ":line:" of ":prog
008 * * * * * Interface info * * * * *
009 *Entry: line := source line # of problem program
010 * prog := problem program name
011 *Exit: none
012 * * * * * Revision history * * * * *
013 *.0 - 1/29/87 JF3
014 END
DKXMTG
001 SUBROUTINE (STATUS)
002 *XMiT a Generic server command -- UNUSED IN 0.3
003 *8/7/87 JF3
004 *]DKFPKT]DKXPKTS]DKFATAL
005 COM X1(4),n,DATA,X2,RCV.PKT.TYPE,X3(8),MAXL
006 EQU XMT.PKT.TYPE TO STATUS,OK TO STATUS,LEN TO STATUS,RECEIVER TO STATUS
007 XMT.PKT.TYPE="G";n=0;CALL DKFPKT(XMT.PKT.TYPE);IF OK THEN
008 RECEIVER=0;CALL DKXPKTS(RECEIVER)
009 BEGIN CASE
010 CASE RCV.PKT.TYPE="S"
011 IF DATAFILE#"" THEN
012 CALL DKRECON(STATUS)
013 CALL DKRECEIVE(STATUS)
014 END
015 CASE RCV.PKT.TYPE="X"
016 * Set up to type on terminal
017 n=n+1
018 CASE RCV.PKT.TYPE="Y"
019 GOSUB 10
020 CASE RCV.PKT.TYPE="N"
021 CASE 1
022 END CASE
023 END
024 RETURN
025 10 CALL DKIO(STATUS);RETURN
026 * * * * * Interface info * * * * *
027 *Entry: DATA := single character command. See KPM 8.2.1. Must be
028 * less than MAXL long.
029 *
030 *Exit: STATUS := 0 means DATA too long
031 * 1 " all went ok
032 * * * * * Revision history * * * * *
033 *.0 - 8/7/87 JF3
034 END
KERMIT
001 *MAIN
002 *DATA/KERMIT
003 *6/30/87 JF3 0.3.0
004 *]OPENFILE]DKDFAULT]GTRMCHR]DKEXEC]DKIO
005 COM P(64);DIM i(3),Q(29)
006 EQU ERR TO P(3),MSG TO P(6),PARAMS TO P(12)
007 EQU DK.MD TO P(15),CMD.PROMPT TO P(33),REMOTE.CTRL TO P(40),c TO i(1)
008 EQU LF TO CHAR(10),CR TO CHAR(13)
009 MAT P="";MAT i="";MAT Q=""
010 CALL OPENFILE("DICT","DK-MD",DK.MD);CALL OPENFILE("","DK-ERR",ERR)
011 CALL DKDFAULT(status);IF REMOTE.CTRL="" THEN
012 CALL GTRMCHR(MSG);CLR.SCRN=MSG<1,1>
013 MSG=CLR.SCRN:PARAMS<1>[2,99];status=0;GOSUB 10
014 MSG=CR:LF;status=0;GOSUB 10
015 END;LOOP
016 CALL DKEXEC(status)
017 WHILE status DO REPEAT;STOP
018 10 CALL DKIO(status);RETURN
019 * * * * * Interface info * * * * *
020 *Entry: none
021 *
022 * * * * * Revision history * * * * *
023 *.0 - 6/30/87 JF3
024 END
DKDBUG
001 SUBROUTINE (STATUS)
002 *Print KERMIT debug data on printer or pause for input/examine
003 *7/29/87 JF3 0.3.0
004 *]DKCNV
005 COM command,X1(4),DATA,X2(17),CHKT;EQU MX TO "MX",FMT TO "L#6"
006 IF command<1>="!DBUG" THEN
007 DATA="D/K DEBUG";STATUS=1;CALL DKIO(STATUS);STATUS=1
008 END ELSE
009 PRINTER ON;IF STATUS="H" THEN
010 PRINT ON 1 " DATA/KERMIT DEBUG OUTPUT"
011 PRINT ON 1 ""
012 PRINT ON 1 "STAT MARK LEN SEQ TYPE CHECK "
013 PRINT ON 1 " hex dec dec chr dec TIME "
014 PRINT ON 1 "";PRINT ON 1 " {DATA...}"
015 END ELSE
016 PRINT ON 1 "";PRINT ON 1 STATUS FMT:;FOR F=1 TO 5
017 IF F<5 THEN D=DATA[F,1] ELSE D=DATA[L+3-CHKT,CHKT]
018 IF F=1 THEN D=OCONV(D,MX)
019 IF F=2 OR F=3 THEN CALL DKCNV(D,-1,0)
020 IF F=2 THEN L=D
021 IF F=5 THEN
022 BEGIN CASE
023 CASE CHKT=1;CALL DKCNV(D,-1,0)
024 * CASE CHKT=2
025 * CASE CHKT=3
026 END CASE
027 END;PRINT ON 1 D FMT:
028 NEXT F;PRINT ON 1 OCONV(TIME(),"MTHS")
029 PRINT ON 1 ""FMT:"{":DATA[5,L-2-CHKT]:"}"
030 END;PRINTER OFF
031 END;RETURN
032 * * * * * Interface info * * * * *
033 *Entry: command := "!DBUG" means pause for input to eximane
034 * variables
035 * else print formatted packet data on logical
036 * printfile #1
037 * * * * * Revision history * * * * *
038 *.0 - 7/29/87 JF3
039 END
DKEXEC
001 SUBROUTINE (status)
002 *EXEcute a Command
003 *10/17/88 JF3 0.3.1
004 *]DKIO]DKVERC
005 COM command.line,X1(4),DATA,X2(4),DELAY,X3(3),DK.MD,X4(17),CMD.PROMPT
006 COM X5(6),REMOTE.MODE;EQU LF TO CHAR(10),CR TO CHAR(13)
007 a=1;BEGIN CASE
008 CASE REMOTE.MODE=0
009 CASE REMOTE.MODE="" OR ABS(REMOTE.MODE)=1
010 DATA=CR:LF:CMD.PROMPT<3>;status=1;GOSUB 12
011 CASE REMOTE.MODE=2
012 DATA="";CALL DKXPKTS(status)
013 CASE REMOTE.MODE=3
014 id="COMMANDS";READU command.line FROM DK.MD,id ELSE RELEASE DK.MD,id
015 IF command.line="" THEN FOR s=1 TO DELAY;RQM 1;NEXT s ELSE
016 a=command.line<1>[2,9];WRITEV "K":a ON DK.MD,id,1
017 END
018 END CASE;IF REMOTE.MODE<2 THEN command.line=DATA;GOSUB 10
019 status=FIELD(command.line<a>," ",1);IF status="" THEN status=1 ELSE
020 CALL DKVERC(status);IF status>0 THEN
021 subroutine=DATA
022 IF REMOTE.MODE<2 THEN GOSUB 10
023 CALL @subroutine(status)
024 END
025 END;RETURN
026 10 DATA="";status=-1;12 CALL DKIO(status);RETURN
027 * * * * * Interface info * * * * *
028 *Entry: REMOTE.MODE := -1 means phantom for local mode
029 * 0 " local modes
030 * 1 " remote mode operation
031 * 2 " server mode
032 * 3 " remote command mode
033 *
034 *Exit:
035 * * * * * Revision history * * * * *
036 *
037 *.1 10/17/88 JF3 Fix batch capability
038 *
039 *.0 1/29/87 JF3
040 END
DKFTYPE
001 SUBROUTINE DKFTYPE
002 *Set up record delimiter form File attribute TYPE
003 *7/14/87 JF3 0.3.0
004 *]DKCNV
005 COM X1(42),rec.delim,X2(20),Type;EQU AM TO CHAR(254)
006 CALL DKCNV(Type,0,-48:AM:2);Opt=Type[2,9];Type=Type[1,1]
007 BEGIN CASE
008 CASE Type="A"
009 IF Opt="" THEN Opt="MJ"
010 c=1;rec.delim="";LOOP O=Opt[c,1] UNTIL O="" DO
011 CALL DKCNV(O,4,0);rec.delim=rec.delim:O
012 c=c+1;REPEAT
013 CASE Type="B"
014 IF Opt="" THEN Opt=8
015 rec.delim=""
016 CASE Type="I"
017 IF Opt="" THEN Opt=8
018 rec.delim=""
019 END CASE;RETURN
020 * * * * * Interface info * * * * *
021 *Entry: F.A := see DKXMTA
022 *
023 * * * * * Revision history * * * * *
024 *.0 - 7/14/87 JF3
025 END
DKRCVS
001 SUBROUTINE (STATUS)
002 *ReCeiVe a Send-init packet to initialize
003 *10/21/88 JF3 0.3.0
004 *]DKDBUG]DKXPKTS]DKVPKT]DKRECON]DKACK
005 COM X1(3),MARK,PKT.SEQ,DATA,CHECK,TYP,LIMIT,DEBUG.MODE,X2(10),EOL
006 COM X3(11),CMD.PROMPT,X4(3),RETRY,LINE,X5,REMOTE.CTRL
007 *ECHO.OFF=OCONV(0,"U80E0");*Microdata
008 ECHO OFF; *PICK/Ultimate
009 IF DEBUG.MODE THEN CALL DKDBUG("H")
010 PKT.SEQ=-1;first.pkt=1;ok=0;PROMPT"";LOOP
011 IF first.pkt THEN
012 3 STATUS=3;CALL DKIO(STATUS);first.pkt=0;PROMPT EOL
013 c=1;LOOP C=DATA[c,1] UNTIL C=MARK OR C="" DO c=c+1 REPEAT
014 IF C="" THEN DATA="";GO 3 ELSE DATA=DATA[c,9999]
015 END ELSE STATUS=1;CALL DKXPKTS(STATUS)
016 * Timeout check goes here
017 5 STATUS=1;CALL DKVPKT(STATUS);IF STATUS>0 THEN
018 IF TYP="S" THEN
019 ok=1;DATA=DATA[5,LEN(DATA)-5];CALL DKRECON(STATUS)
020 END ELSE STATUS=-4;ok=STATUS
021 END
022 UNTIL STATUS=ok DO
023 RETRY=RETRY+1;IF RETRY>=LIMIT THEN
024 * ECHO.ON=OCONV(0,"U70E0");*Microdata
025 ECHO ON; *PICK/Ultimate
026 GO 9
027 END ELSE CALL DKACK("N")
028 REPEAT;9 RETURN
029 * * * * * Interface info * * * * *
030 *Entry: none
031 *
032 *Exit:
033 * STATUS := 1 means all ok
034 * -4 " non-S packet received
035 * * * * * Revision history * * * * *
036 *.0 - 10/21/88 JF3
037 END
DKRECEIVE
001 SUBROUTINE (STATUS)
002 *RECEIVE data transaction
003 *7/17/89 JF3 0.3.1
004 *]DKRCVS]DKACK]DKXPKTS]DKRCVF]DKRCVA]DKRCVD]DKRCVZ
005 COM CMD.LINE,X1,ERR,X2,n,DATA,CHECK,TYPE,X3,DEBUG.MODE
006 COM X4(23),PICK.file.type,X5(2),r,X6(6),local.dest.filespec,FV,FN
007 EQU OK TO STATUS,LF TO CHAR(10),CR TO CHAR(13)
008 OK=1;local.dest.filespec=FIELD(CMD.LINE<1>," ",2);PICK.file.type=FN<2>
009 local.dest.filespec=""
010 *IF local.dest.filespec#"" AND PICK.file.type>1 THEN STATUS=-1;GO 9
011 r=0;CALL DKRCVS(STATUS);IF OK>0 THEN
012 STATUS="S";CALL DKACK(STATUS);LOOP
013 STATUS=1;CALL DKXPKTS(STATUS)
014 UNTIL STATUS<=0 DO
015 BEGIN CASE
016 CASE TYPE="F";CALL DKRCVF(STATUS)
017 CASE TYPE="A";CALL DKRCVA(STATUS)
018 CASE TYPE="D";CALL DKRCVD(STATUS)
019 CASE TYPE="Z";CALL DKRCVZ(STATUS)
020 CASE TYPE="B";CALL DKRCVB(STATUS);GO 8
021 END CASE;IF NOT(OK) THEN GO 9
022 IF TYPE="A" THEN STATUS="A" ELSE STATUS="Y"
023 CALL DKACK(STATUS);IF NOT(OK) THEN GO 9
024 REPEAT;IF OK THEN
025 8 STATUS="Y";DATA="";CALL DKACK(STATUS);IF OK THEN CALL DKXPKTS(-1)
026 END
027 END;9 RETURN
028 * * * * * Interface info * * * * *
029 *Entry: CMD.LINE := receive command in form:
030 * RECEIVE [item-id]
031 * where optional "item-id" is id under which to
032 * store data in set DATAFILE.
033 * FN := destination file name (<1>) and DATA/KERMIT
034 * file type (<2>) as defined in DKOPNFILE.
035 *
036 *Uses: r := retry count per Kermit Protocol Manual
037 * n := packet sequence
038 *
039 *Exit: STATUS := result of operation:
040 * 0 means error occured
041 * 1 " all went ok
042 *
043 * * * * * Revision history * * * * *
044 *.1 - 7/17/89 JF3 Call to DKRCVB to get ECHO back ON.
045 *
046 *.0 - 10/22/88 JF3
047 END
DKFRMAT
001 SUBROUTINE DKFRMAT
002 *FoRMAT packet data -- UNUSED IN 0.3
003 *1/23/89 JF3
004 !]DKFNAME]DKFTYPE]DKXMTD
005 COM CMD.LINE,X1,ERR,X2,PKT.SEQ,DATA,CHECK,TYPE,X3,DEBUG.MODE
006 COM X4(6),MAXL,X5(6),CHKT,X6(9),f.type,p,L,X7(4)
007 COM ID,ITEM,rec.delim,F.NAME,FV,filename.type,FID,X8(15),Format,Type
008 EQU INITIAL.ENTRY TO STATUS,OK TO STATUS,AM TO CHAR(254),DK1 TO p
009 IF INITIAL.ENTRY THEN
010 f.type=filename.type<2>;p=1
011 BEGIN CASE
012 CASE f.type<2
013 READ ITEM FROM FV,ID ELSE
014 DATA="item: ":ID;ID=4;GO 10
015 END
016 CASE f.type=3
017 DK1=FID<1,1>
018 STATUS=OCONV(ID,"U0":DK1);IF OK THEN DK1="U1":DK1 ELSE
019 DATA="entry: ":ID;ID=4;GO 10
020 END
021 CASE 1
022 2 DATA="DATAFILE";ID=1;GO 10
023 END CASE;IF F.NAME="" THEN CALL DKFNAME
024 CALL DKFTYPE;L=INT(8*(MAXL-2-CHKT)/10)
025 END ELSE
026 BEGIN CASE
027 CASE f.type<2
028 LOOP
029 IF Type="A" THEN DATA=FIELD(ITEM,AM,p);p=p+1 ELSE
030 DATA=ITEM[p,L];p=p+L
031 END
032 UNTIL DATA="" DO p=p+1 REPEAT
033 CASE f.type=3
034 STATUS=0;DATA=OCONV(L,DK1)
035 IF DATA=CHAR(0) OR DATA="" THEN STATUS=1
036 END CASE
037 DATA=DATA:rec.delim;CALL DKXMTD(STATUS);IF NOT(OK) THEN GOSUB 10;*???
038 END;9 RETURN
039 10 STATUS=-1
040 DATA=INSERT(DATA,1;"K":ID); *PICK/Ultimate
041 *INS ("K":ID) BEFORE DATA<1>;STATUS=-1; *Microdata
042 GO 9
043 * * * * * Interface info * * * * *
044 *Entry: STATUS := 1 means first entry to retrieve data
045 * 0 means subsequent entry; return next record
046 *
047 *Exit: On INITIAL.ENTRY On subsequent entries
048 * ---------------- ---------------------
049 * STATUS := 1 means data ok 1 means last record
050 * 0 means more to go
051 * -----------------On either-------------------
052 * <0 means K-msg err id VM filler in DATA
053 *Uses: NFN := 1 means Normalized File Names in the
054 * Kermit sense
055 * * * * * Revision history * * * * *
056 *.0 - 1/23/89 JF3
057 END
DKOPNFILE
001 SUBROUTINE (STATUS)
002 *Open a file for processing
003 *7/20/87 JF3 0.3.0
004 !]OPENFILE
005 COM X1(44),Data.FV,Data.file.name;EQU file.type TO STATUS
006 *EQU F.REALLOC TO D.CODE;*Microdata
007 IF Data.file.name[1,5]="DICT " THEN
008 dict="DICT";dictname=Data.file.name[6,99]
009 END ELSE dict="";dictname=Data.file.name
010 * * * * * Ultimate/PICK * * * * *
011 filename=FIELD(dictname,",",2)
012 IF filename="" THEN
013 filename=dictname
014 END ELSE dictname=FIELD(dictname,",",1);dict=dictname
015 * * * * * Microdata * * * * *
016 *filename=dictname
017 * * * * * * * * * * * * * * * *
018 D.CODE=OCONV(dictname,"TMD;X;;1");file.type=D.CODE[1,1]
019 IF file.type#"D" AND file.type#"Q" THEN STATUS=-1;GO 9
020 OPEN dict,filename TO Data.FV ELSE STATUS=-1;GO 9
021 D.CODE=OCONV(filename,"TDICT ":dictname:";X;;1"); *PICK/Ultimate
022 IF D.CODE="DC" THEN file.type=1 ELSE file.type=0; *PICK/Ultimate
023 *F.REALLOC=OCONV("DL/ID","T*":filename:";X;;13"); *Microdata
024 *IF F.REALLOC[1,1]="B" THEN file.type=1 ELSE file.type=0;*Microdata
025 9 RETURN
026 * * * * * Interface info * * * * *
027 *Entry: Data.file.name := {DICT }filename ;*any implementation
028 * {dictname,}filename ;*Ultimate/PICK only
029 *
030 *Exit: STATUS := -1 means no go;
031 * 0 means ordinary file
032 * 1 means catalog pointer file
033 * Data.FV := data file variable
034 * Data.file.name := as in Entry.
035 * * * * * Revision history * * * * *
036 *.0 - 7/20/87 JF3
037 END
DKSEND
001 SUBROUTINE (STATUS)
002 *Send file item(s)
003 *8/12/87 JF3 0.3.0
004 !]DKRETR]DKFNAME]DKCNV]DKIO]DKXMTt
005 COM CMD.LINE,X1,ERR,X2,n,DATA,X3(30),r,X4(3),ID,X5(2),f.name,FV
006 EQU LF TO CHAR(10),CR TO CHAR(13),SPACE TO " ",OK TO STATUS
007 EQU VM TO CHAR(253),AM TO CHAR(254),DONE TO STATUS
008 *ECHO.OFF=OCONV(0,"U80E0");*Microdata
009 ECHO OFF; *PICK/Ultimate
010 SELECTED=0;initial=0;LOOP
011 IF initial THEN
012 IF SELECTED THEN
013 2 READNEXT ID ELSE ID=""
014 f.name="";GO 3
015 END ELSE ID=""
016 END ELSE ID=FIELD(CMD.LINE<1>,SPACE,2);f.name=FIELD(CMD.LINE<1>,SPACE,3)
017 IF ID="*" AND NOT(initial) THEN SELECT FV;SELECTED=1;GO 2
018 3 UNTIL ID="" DO
019 STATUS=1;CALL DKRETR(STATUS);IF NOT(OK) THEN GOSUB 7
020 IF NOT(initial) THEN pkt.type="S";n=0;r=0;GOSUB 5;initial=1
021 CALL DKFNAME;DATA=f.name
022 pkt.type="F";GOSUB 5;ATTRS=0;*CALL DKCNV(ATTRS,0,-26:AM:3)
023 IF ATTRS THEN CALL DKXMTA(STATUS) ELSE OK=1
024 IF OK THEN
025 STATUS=0;LOOP CALL DKRETR(STATUS) UNTIL DONE DO
026 CALL DKXMTD(STATUS);GOSUB 6;STATUS=0
027 REPEAT;pkt.type="Z";GOSUB 5
028 END
029 REPEAT;pkt.type="B";GOSUB 5;STATUS=1;GO 9
030 5 subr="DKXMT":pkt.type;CALL @subr(STATUS)
031 6 IF OK>0 THEN n=MOD(n+1,64);r=0;RETURN
032 *Set correct mode here.
033 7 DATA="K5":AM:"Send":VM:DATA;RETURN TO 8
034 8 CALL DKIO("!");STATUS=-1;9 RETURN
035 * * * * * Interface info * * * * *
036 * Entry:
037 * CMD.LINE := SEND [ item-id ] . . .
038 * [ * ]
039 * [ entry# ]
040 *
041 * Exit :
042 * STATUS := 1 means finished ok
043 * := 0 " error; transaction terminated
044 * FILE.NAME<1>:= file name as entered
045 * <2>:= file type: nul means regular data file
046 * "P" means spooler PRINTFILE
047 * * * * * Revision history * * * * *
048 *.0 - 8/12/87 JF3
049 END
DKFPKT
001 SUBROUTINE (TYPE)
002 *Form a PacKeT
003 *7/21/87 JF3 0.3.0
004 *]DKCNV]DKCTL]DKCHECK
005 COM X1(3),MARK,PKT.SEQ,PACKET,CHECK,X2(9)
006 COM MAXL,X3(5),QBIN,CHKT,REPT,X4(28),SQCTL;EQU STATUS TO TYPE
007 EQU test.len TO r.prefix,max.len TO r.prefix
008 p=CHKT+4;l=TYPE[1,1];IF l="Y" THEN l=TYPE[2,1]
009 IF l="A" OR l="I" OR l="S" THEN
010 data=PACKET;l=LEN(data);p=p+l;TYPE=TYPE[1,1];GO 5
011 END;data="";l=0;r=1;LOOP c=PACKET[l+1,1] UNTIL c="" DO
012 IF REPT="" THEN r.prefix="" ELSE
013 r=l+2;max.len=l+94
014 LOOP WHILE PACKET[r,1]=c AND r<max.len DO r=r+1 REPEAT
015 r=r-l-1;IF r>3 THEN
016 s=r;CALL DKCNV(s,1,0);r.prefix=REPT:s
017 END ELSE r.prefix="";r=1
018 END;s=SEQ(c);IF s>=128 THEN
019 s=s-128;c=CHAR(s);IF QBIN#"" THEN r.prefix=r.prefix:QBIN
020 END;IF s<=31 OR s=127 THEN CALL DKCTL(c);c=SQCTL:c ELSE
021 IF c=SQCTL THEN c=SQCTL:SQCTL ELSE
022 IF QBIN#"" AND c=QBIN THEN c=SQCTL:QBIN
023 IF c=REPT THEN c=SQCTL:REPT
024 END;END;c=r.prefix:c;lc=LEN(c);test.len=p+lc
025 IF test.len>MAXL THEN GO 5 ELSE data=data:c;l=l+r;p=test.len
026 REPEAT;IF l=0 THEN l=-1
027 5 PACKET=MARK:CHAR(p+30):CHAR(PKT.SEQ+32):TYPE:data
028 CHECK=0;CALL DKCHECK(CHECK);STATUS=(CHECK#"")*l;RETURN
029 * * * * * Interface info * * * * *
030 *Entry: TYPE := Protocol packet type or Yx where:
031 * x=S means Send-init ack packet
032 * x=I " server Init ack, or
033 * x=A " file Attribute ack.
034 * PACKET := contains DATA field of packet
035 *
036 *Exit: STATUS := >0 means length of packet
037 * 0 " packet cannot be checksumed
038 * <0 " data field is nul
039 * * * * * Revision history * * * * *
040 *.0 - 7/21/87 JF3
041 END
DKRCVT
001 *DUMMY
002 *Subroutine list for DKRCVt type subs
003 *4/1/87 JF3 0.3.0
004 *]DKRCVS]DKRCVF]DKRCVA]DKRCVD]DKRCVZ]DKRCVB
005 END
DKDPKT
001 SUBROUTINE (STATUS)
002 *Decode a packet
003 *1/29/87 JF3 0.3.0
004 *]DKCNV]DKDBUG
005 COM X1(5),DATA,X2(3),DEBUG.MODE,X3(11),QCTL,QBIN,CHKT,REPT
006 EQU L TO STATUS
007 PACKET=DATA;DATA="";L=0;R=0;BIT8=0;LOOP GOSUB 6 UNTIL C="" DO
008 BEGIN CASE
009 CASE C=REPT;IF R THEN GO 9 ELSE GOSUB 6;CALL DKCNV(C,-1,0);R=C
010 CASE C=QBIN;IF BIT8 THEN GO 9 ELSE BIT8=1
011 CASE C=QCTL;GOSUB 6;BEGIN CASE
012 CASE C=QCTL;CASE C=QBIN;CASE C=REPT
013 CASE 1;C=CHAR(SEQ(C)-64)
014 END CASE;GO 4
015 CASE 1
016 4 IF BIT8 THEN C=CHAR(SEQ(C)+128);BIT8=0;*SM invalid for file data!
017 IF R THEN C=STR(C,R);R=0
018 DATA=DATA:C
019 CASE 0
020 6 L=L+1;C=PACKET[L,1];RETURN
021 END CASE
022 REPEAT;L=L-1;IF L=0 THEN L=-1
023 IF DEBUG.MODE THEN
024 R=L;STATUS="D";PACKET=DATA;C=LEN(DATA)+2+CHKT;CALL DKCNV(C,1,0)
025 DATA=CHAR(0):C:" ":DATA:STR(" ",CHKT);CALL DKDBUG(STATUS)
026 DATA=PACKET;L=R;END;8 RETURN
027 9 STATUS=0;GO 8
028 * * * * * Interface info * * * * *
029 *Entry: DATA contains received packet data field
030 *
031 *Exit: DATA contains expanded data
032 * * * * * Revision history * * * * *
033 *.0 1/29/87 JF3
034 END
DKcnv
001 *DUMMY
002 *Subroutine list for custom parameter conversion routines
003 *7/14/87 JF3 0.3
004 *]DKDF]DKFA
005 END
DKVERC
001 SUBROUTINE (STATUS)
002 *VERify a command as valid
003 *6/25/87 JF3 0.3.0
004 *]DKPARSE]DKIO
005 COM X1(5),data,X2(5),PARAMS,X3(52),i(3)
006 EQU CMD TO STATUS,ok TO STATUS,c TO i(1)
007 IF CMD[1,1]="!" THEN CMD=CMD[2,99];c=1 ELSE
008 MAT i=0;CALL DKPARSE(CMD,2)
009 END;IF c THEN
010 data="DK":CMD;v=1;ok=0;LOOP conv.code=PARAMS<14,v> UNTIL conv.code="" DO
011 ok=(PARAMS<15,v>=OCONV(data,conv.code))
012 IF ok THEN GO 9 ELSE v=v+1
013 REPEAT;data="DKverb: ":data
014 END ELSE data="command: ":CMD
015 data=INSERT(data,1,0,0,"K1");STATUS="!";CALL DKIO(STATUS);STATUS=-1
016 9 RETURN
017 * * * * * Interface info * * * * *
018 *Entry : CMD := all caps command token
019 *
020 *Exit: STATUS := -1 invalid command
021 * 1 means command ok; DKcommand in data
022 * * * * * Revision history * * * * *
023 *.0 - 6/25/87 JF3
024 END
DKRCVA
001 SUBROUTINE (STATUS)
002 *Receive a file Attribute packet -- NOT USED in 0.3
003 *7/14/87 JF3
004 *]DKCNV]DKAnn
005 COM X1(5),DATA,X2(5),PARAMS;EQU AM TO CHAR(254),OK TO STATUS
006 DIM ack.attrs(2);MAT ack.attrs=""
007 s=1;LOOP ATTR=DATA[s,1] UNTIL ATTR="" DO
008 attr.no=ATTR;CALL DKCNV(attr.no,-1,0)
009 sLENGTH=DATA[s+1,1];CALL DKCNV(sLENGTH,-1,0);sDATA=DATA[s+2,sLENGTH]
010 p=11;LOOP
011 * LOCATE attr.no IN PARAMS<p>,1 SETTING w ELSE w=-1;*Microdata/Ultimate
012 LOCATE(attr.no,PARAMS<p>;w) ELSE w=-1; *PICK
013 IF w>0 THEN
014 IF p=11 THEN
015 subroutine="DKA":(100+attr.no)[2,2];STATUS=sDATA
016 CALL @subroutine(STATUS);IF STATUS>1 THEN w=OK ELSE w=NOT(OK)
017 END ELSE w=0
018 END ELSE
019 IF p=12 THEN w=2
020 END
021 WHILE w=-1 DO p=p+1 REPEAT
022 IF w THEN ack.attrs(w)=ack.attrs(w):ATTR
023 s=s+2+sLENGTH;REPEAT;IF ack.attrs(1)="" THEN DATA="Y";w=2 ELSE DATA="N";w=1
024 DATA=DATA:ack.attrs(w);STATUS=1;RETURN
025 * * * * * Interface info * * * * *
026 *Entry: DATA := File Attribute packet per Kermit Protocol Manual
027 * each DATA field containing (optionally) many subfields
028 *
029 *Exit: DATA := data field of ack packet
030 *
031 *Uses: ack.attrs(1) := N{xxx} list
032 * (2) := Y{xxx} list
033 * * * * * Revision history * * * * *
034 *.0 - 7/14/87 JF3
035 END
DKSET
001 SUBROUTINE (STATUS)
002 *SET kermit parameters
003 *7/24/87 JF3 0.3.0
004 *]DKCNV]DKPARSE]DKIO]GTRMCHR
005 COM P(64),i(3);EQU SPACE TO " ",a TO i(1),v TO i(2),s TO i(3)
006 EQU CMD.LINE TO P(1),ERR TO P(3),PAR.LIST TO P(12),DICT.DK TO P(15)
007 EQU MSG TO P(6),help.request TO i(2);par=OCONV(CMD.LINE<1>,"G1 1")
008 help.request=(par="?");IF help.request THEN
009 * Get terminal width below
010 CALL GTRMCHR(MSG);s=INT(OCONV(MSG<4>,"G,1")/2);s="L#":s
011 v=1;MSG="";LOOP GOSUB 10 UNTIL par="" DO
012 GOSUB 10;STATUS=-1;CALL DKIO(STATUS);MSG=""
013 REPEAT;STATUS=1
014 END ELSE
015 a=2;v=0;CALL DKPARSE(par,12);IF v THEN
016 IF PAR.LIST<8,v>="" THEN p=2 ELSE
017 p=3;a=8;subpar=OCONV(CMD.LINE<1>,"G2 1");CALL DKPARSE(subpar,12)
018 IF NOT(s) THEN MSG="subparameter: ":subpar;GO 4
019 END;arg=OCONV(CMD.LINE<1>,"G":p:" 99");cnv=PAR.LIST<5,v>
020 IF NOT(NUM(cnv)) THEN cnv<1,2>="1"
021 idx=PAR.LIST<3,v>;idx<2>=PAR.LIST<9,v,s>
022 CALL DKCNV(arg,cnv,idx);IF arg="!!!" THEN
023 P(6)=cnv;CALL DKIO("!");STATUS=-1
024 END ELSE STATUS=1
025 END ELSE
026 MSG="parameter: ":par
027 4 MSG=INSERT(MSG,1,0,0,"K1");CALL DKIO("!");STATUS=-1
028 END
029 END;RETURN
030 10 par=PAR.LIST<2,v>;MSG=MSG:(par:SPACE:PAR.LIST<6,v>)s
031 v=v+1;RETURN
032 * * * * * Interface info * * * * *
033 * Entry:
034 * CMD.LINE := SET [parameter {subparameter }value]
035 * [? ]
036 *
037 * Exit:
038 * STATUS := 1 means finished ok
039 * * * * * Revision history * * * * *
040 *.0 - 7/14/87 JF3
041 END
DKRETRY
001 SUBROUTINE (status)
002 *increment RETRY counter and check against limit
003 *7/21/87 JF3 0.3
004 *]DKERR]DKFPKT]DKIO
005 COM X1(8),LIMIT,X2(27),r;EQU OK TO status,AM TO CHAR(254)
006 r=r+1;IF r<LIMIT THEN status=1 ELSE
007 DATA="K3":AM:LIMIT;CALL DKERR;status="E";CALL DKFPKT(status)
008 IF OK THEN CALL DKIO(-2);status=0
009 END;RETURN
010 * * * * * Interface info * * * * *
011 *Entry: none
012 *
013 *Exit: status := 1 means retry counter incremented
014 * := 0 " error packet sent, transaction terminated
015 * * * * * Revision history * * * * *
016 *.0 - 7/21/87 JF3
017 END
DKRCVB
001 SUBROUTINE (STATUS)
002 *Receive an Break packet
003 *7/17/89 JF3 0.3.1
004 !
005 STATUS=0
006 *ECHO.ON=OCONV(0,"U70E0");*Microdata
007 ECHO ON; *PICK/Ultimate
008 RETURN
009 * * * * * Interface Info * * * * *
010 *
011 *Entry: none
012 *
013 *Exit: ECHO set ON; STATUS reset
014 * * * * * Revision history * * * * *
015 *.1 - 7/17/89 JF3 Set ECHO back on after transaction
016 *
017 *.0 - 1/29/87 JF3
018 END
DKRCVZ
001 SUBROUTINE (STATUS)
002 *Receive an End-of-file packet
003 *10/22/88 JF3 0.3.0
004 *]DKSTOR
005 COM X1(33),F.TYPE,X2,RECORD,X3(4),FILE.NAME,ITEM,X4,LOCAL.FILE.SPEC,FV
006 EQU OK TO STATUS
007 IF RECORD="" THEN STATUS=1 ELSE CALL DKSTOR(STATUS)
008 IF OK THEN
009 BEGIN CASE
010 CASE F.TYPE<2
011 IF LOCAL.FILE.SPEC="" THEN id=FILE.NAME ELSE id=LOCAL.FILE.SPEC
012 WRITE ITEM ON FV,id;*EXECUTE "MSG !0 '":id:"'"
013 IF F.TYPE=1 THEN NULL;*CLEAN UP POINTER-FILE DATA
014 CASE F.TYPE=2
015 CASE F.TYPE=3;PRINTER CLOSE
016 END CASE
017 END;RETURN
018 * * * * * Interface info * * * * *
019 *Entry: RECORD := any remnant of received file
020 * * * * * Revision history * * * * *
021 *.0 - 10/22/88 JF3
022 END
DKA01
001 SUBROUTINE (STATUS)
002 *check received Attribute 1 (length) -- NOT USED in 0.3
003 *7/14/87 JF3
004 *
005 COM X1(33),DATAFILE.TYPE;EQU Length TO STATUS
006 IF DATAFILE.TYPE=0 THEN
007 IF (Length+0)>32 THEN STATUS=0
008 END ELSE STATUS=1
009 RETURN
010 * * * * * Interface info * * * * *
011 *See DKAnn
012 * * * * * Revision history * * * * *
013 *.0 - 7/14/87 JF3
014 END
DKSTOR
001 SUBROUTINE (STATUS)
002 *STOre received Record into system
003 *10/22/88 JF3 0.3.0
004 *
005 COM X1(29),MAX.REC.LEN,X2(3),PICK.file.type,a,RECORD,X3(5)
006 COM ITEM,X4(3),DATAFILE,X5(16),F.FORMAT
007 IF MAX.REC.LEN AND LEN(RECORD)>MAX.REC.LEN THEN STATUS=0 ELSE
008 * Undefined if DATAFILE is null; should be fixed!
009 IF DATAFILE="" THEN
010 BEGIN CASE
011 CASE DISP="";GO 5
012 CASE DISP="O";CASE DISP="S"
013 CASE DISP="P";GO 30
014 CASE DISP="T";GO 20
015 CASE DISP="L";CASE DISP="X"
016 CASE DISP="A";GO 10
017 END CASE
018 END ELSE
019 BEGIN CASE
020 CASE PICK.file.type=0
021 5 IF F.FORMAT="I" THEN ITEM=ITEM:RECORD ELSE ITEM<a>=RECORD
022 CASE PICK.file.type=1
023 10 *Put RECORD to catalog space
024 CASE PICK.file.type=2
025 20 *Put RECORD into ABS space
026 CASE PICK.file.type=3
027 30 PRINTER ON;PRINT RECORD;PRINTER OFF;RETURN
028 END CASE
029 END;a=a+1;RECORD="";STATUS=1
030 END;RETURN
031 * * * * * Interface info * * * * *
032 * * * * * Revision history * * * * *
033 *.0 - 10/22/88 JF3
034 END
DKA02
001 SUBROUTINE (STATUS)
002 *check received Attribute 2 (type) -- NOT USED in 0.3
003 *7/21/87 JF3
004 *
005 COM X1(63),Type
006 EQU DATA TO STATUS
007 type=DATA[1,1];STATUS=1
008 BEGIN CASE
009 CASE type="A"
010 CASE type="B"
011 CASE type="D"
012 CASE type="F"
013 CASE type="I"
014 CASE 1;STATUS=0;GO 9
015 END CASE;arg=DATA[2,l];IF l=1 THEN
016 IF NUM(arg) THEN cnv=0 ELSE cnv=-1
017 CALL DKCNV(arg,cnv,ix)
018 END;8 STATUS=1;9 RETURN
019 * * * * * Interface info * * * * *
020 *See DKAnn
021 * * * * * Revision history * * * * *
022 *.0 - 7/21/87 JF3
023 END
DKRCVD
001 SUBROUTINE (STATUS)
002 *ReCeiVe a Data packet
003 *10/22/88 JF3 0.3.0
004 *]DKDPKT]DKSTOR
005 COM X1(5),DATA,X2(23),MAX.REC.LEN,p1,len.REC.TERM,X3(2),a,record
006 COM X4(6),REC.TERMINATION,X5(18),l,F.FORMAT,X6;EQU OK TO STATUS
007 EQU REC.SIZE.LEN TO REC.TERMINATION,REC.SIZE TO REC.TERMINATION
008 IF a=1 THEN
009 BEGIN CASE
010 CASE F.FORMAT="";GO 1;F.FORMAT="A";REC.TERMINATION="";GO 2
011 CASE F.FORMAT="A";GO 2
012 CASE F.FORMAT="D";len.REC.TERM=0
013 CASE F.FORMAT="F";len.REC.TERM=0;p1=1;l=REC.SIZE
014 CASE 1
015 1 F.FORMAT="A";REC.TERMINATION=CHAR(13):CHAR(10)
016 2 len.REC.TERM=LEN(REC.TERMINATION);p1=1
017 END CASE
018 END;CALL DKDPKT(STATUS);rec.complete=0
019 IF F.FORMAT="A" THEN DATA=record:DATA
020 LOOP
021 IF F.FORMAT="I" THEN record=DATA;DATA="";rec.complete=1 ELSE
022 len.DATA=LEN(DATA);BEGIN CASE
023 CASE F.FORMAT="A"
024 p2=INDEX(DATA,REC.TERMINATION,1);record=""
025 IF p2 THEN rec.complete=1;p2=p2-1 ELSE p2=len.DATA
026 CASE F.FORMAT="D"
027 IF l THEN p1=1 ELSE
028 l=DATA[1,REC.SIZE.LEN]-REC.SIZE.LEN;p1=REC.SIZE.LEN+1
029 END;GO 3
030 CASE F.FORMAT="F"
031 3 rec.complete=(l<=len.DATA);p2=l
032 END CASE;record=record:DATA[p1,p2]
033 DATA=DATA[p1+p2+len.REC.TERM,9999]
034 END
035 UNTIL DATA="" DO
036 GOSUB 5;IF NOT(OK) THEN GO 9
037 REPEAT;IF rec.complete THEN
038 5 CALL DKSTOR(STATUS);IF OK THEN
039 rec.complete=0;IF F.FORMAT="F" THEN l=REC.SIZE ELSE l=0
040 END
041 END ELSE l=l-(len.DATA-(p1-1));STATUS=1
042 9 RETURN
043 * * * * * Interface Info * * * * *
044 *Uses: l Set to 0 by DKRCVF; generally means # chars
045 * remaining to complete a record.
046 * * * * * Revision history * * * * *
047 *.0 - 10/22/88 JF3
048 END
DKSHOW
001 SUBROUTINE (STATUS)
002 *SHOW parameters somewhere
003 *8/7/87 JF3 0.3.0
004 *]DKCNV]DKPARSE]DKIO
005 COM P(64),i(3);EQU a TO i(1),p TO i(2),s TO i(3)
006 EQU CMD.LINE TO P(1),MSG TO P(6),PAR.LIST TO P(12),REMOTE.CTRL TO P(40)
007 EQU cr TO CHAR(13),lf TO CHAR(10);CALL GTRMCHR(MSG);MSG=MSG<4>
008 LINES.PAGE=FIELD(MSG,",",2);CHARS.LINE=FIELD(MSG,",",1)+1;P(41)="ALL"
009 COLS=INT(CHARS.LINE/26);a=2;s=0
010 FMT="L#":INT((CHARS.LINE-1)/COLS); *Microdata/PICK
011 *FMT="L(#":INT((CHARS.LINE-1)/COLS):")";*Ultimate
012 I.PARAM=FIELD(CMD.LINE<1>," ",2);STATUS=1;L=1;C=1;p=0;t=999
013 CALL DKPARSE(I.PARAM,12);IF p THEN
014 SUB.PARAM=FIELD(CMD.LINE<1>," ",3);IF SUB.PARAM#"" THEN
015 a=8;CALL DKPARSE(SUB.PARAM,12)
016 IF s THEN t=s;GOSUB 11 ELSE MSG="subparameter: ":SUB.PARAM;GO 6
017 END ELSE GOSUB 10
018 END ELSE
019 a=1;p=0;CALL DKPARSE(I.PARAM,41);IF p THEN
020 p=0
021 LOOP p=p+1;I.PARAM=PAR.LIST<2,p> UNTIL I.PARAM="" DO GOSUB 10 REPEAT
022 END ELSE
023 MSG="parameter: ":I.PARAM
024 6 MSG=INSERT(MSG,1,0,0,"K1");STATUS="!";GO 20
025 END
026 END;9 MSG="";STATUS=-1;GO 20
027 10 s=1;11 index=-PAR.LIST<3,p>;cnv=PAR.LIST<5,p>
028 IF NUM(cnv) THEN cnv=-cnv ELSE cnv<1,2>="-1"
029 LOOP SUB.PARAM=PAR.LIST<8,p,s> UNTIL (SUB.PARAM="" AND s>1) OR s>t DO
030 IF SUB.PARAM#"" THEN index<2>=PAR.LIST<9,p,s>;SUB.PARAM=" ":SUB.PARAM
031 SUB.PARAM=SUB.PARAM:"=";CALL DKCNV(arg,cnv,index)
032 IF L>LINES.PAGE AND REMOTE.CTRL<3 THEN
033 MSG="K8";STATUS="!";GOSUB 20
034 IF STATUS THEN L=1;C=1 ELSE STATUS=1;RETURN TO 9
035 END;MSG=I.PARAM:SUB.PARAM:arg
036 IF C=COLS THEN STATUS=-1;C=1;L=L+1 ELSE
037 MSG=MSG FMT;STATUS=-(REMOTE.CTRL=3);C=C+1
038 END;GOSUB 20
039 s=s+1;REPEAT;RETURN
040 20 CALL DKIO(STATUS);RETURN
041 * * * * * Interface info * * * * *
042 * Entry:
043 * PAR.LIST := <2,p> parameter p name
044 * := <3,p> COM position
045 * := <5,p> conversion type/subr name
046 * Exit:
047 * STATUS := 1 means finished ok
048 * * * * * Revision history * * * * *
049 *.0 - 8/7/87 JF3
050 END
DKIO
001 SUBROUTINE (STATUS)
002 *Input/Output operations
003 *11/4/88 JF3 0.3.1
004 !]DKERR]DKDBUG]DKINP
005 COM P(64);EQU ERR TO P(3),DATA TO P(6),DEBUG.MODE TO P(10),EOL TO P(21)
006 EQU CMD.PROMPT TO P(33),LINE TO P(38),REMOTE.CTRL TO P(40)
007 IF STATUS="!" THEN CALL DKERR;STATUS=-1
008 IF DATA#"" THEN
009 BEGIN CASE
010 CASE REMOTE.CTRL=3 AND STATUS=-1
011 IF LINE#"" THEN EXECUTE "MSG !":LINE:" ":DATA
012 CASE STATUS#3
013 PRINT DATA:;IF DEBUG.MODE>0 THEN CALL DKDBUG("S")
014 END CASE
015 END;IF STATUS>0 THEN
016 IF STATUS=1 THEN PROMPT CMD.PROMPT<4>
017 a=ABS(REMOTE.CTRL);IF REMOTE.CTRL="" OR a=1 OR a=2 THEN
018 IF STATUS>1 THEN STATUS=0;*PICK/Ultimate
019 * STATUS=1 *Microdata
020 IF a=1 THEN
021 * ECHO.ON=OCONV("","U70E0");*Microdata
022 ECHO ON ;*PICK/Ultimate
023 END;CALL DKINP(STATUS);STATUS=(DATA#"")
024 IF DEBUG.MODE>0 THEN CALL DKDBUG("R")
025 END
026 END;IF STATUS=0 OR REMOTE.CTRL=3 THEN STATUS=1 ELSE
027 IF STATUS=-1 THEN PRINT
028 IF STATUS=-2 THEN PRINT EOL:
029 END;RETURN
030 * * * * * Interface info * * * * *
031 *Entry:
032 * STATUS := 1 means pause for input & reset prompt char
033 * := 2 " " " " but no new prompt
034 * := 3 " pause for input & no output at all
035 * := 0 " no pause
036 * := -1 " no pause & cr/lf after output
037 * := -2 " no pause & terminate w/EOL
038 *
039 * LINE := alternate process #; 0 means none.
040 *
041 * REMOTE.CTRL := 3 means Batch mode |
042 * 2 " Server mode | MAIN
043 * 1 " Remote mode | PROCESS
044 * nul " Local mode - connected |
045 * 0 " Local mode - closed |
046 * -------------------------------------
047 * -1 " Remote mode |
048 * -2 " Server mode | SUB
049 * -3 " closed connection (idle) | PROCESS
050 *
051 *Exit:
052 * STATUS := true means all went ok
053 * := false " timeout awaiting input (not implemented)
054 END
055 * * * * * Revision history * * * * *
056 *.1 11/4/88 JF3 Change DKinp to DKINP
057 *
058 *.0 8/13/87 JF3
DKRCVE
001 SUBROUTINE (STATUS)
002 *Receive a Error packet
003 *1/29/87 JF3 0.3.0
004 *]DKDPKT
005 CALL DKDPKT(STATUS);STATUS=-1;RETURN
006 * * * * * Interface info * * * * *
007 * * * * * Revision history * * * * *
008 *.0 - 1/29/87 JF3
DKPRMT
001 SUBROUTINE (arg,c,X)
002 *Convert prompt string -- NOT USED in 0.3
003 *7/21/87 JF3 0.3
004 *
005 COM X1(32),CMD.PROMPT
006 c=c<2>;IF c>0 THEN
007 l=LEN(arg);CMD.PROMPT=arg[1,l-1];CMD.PROMPT<2>=arg[l,1]
008 END ELSE
009 arg=CMD.PROMPT<1>:CMD.PROMPT<2>
010 END;c=0;RETURN
011 * * * * * Interface info * * * * *
012 *Entry: c<2> := >0 means convert from external (prompt-string prompt-char)
013 * to internal (CMD.PROMPT dynamic array)
014 * otherwise convert internal to external
015 * arg := data to convert from or into
016 *
017 *Exit:
018 * * * * * Revision history * * * * *
019 *.0 - 7/21/87 JF3
020 END
DKFINISH
001 SUBROUTINE (STATUS)
002 *tell remote server to shut down; we are FINISHed -- NOT USED in 0.3
003 *8/7/87 JF3
004 COM X1(5),DATA
005 DATA="F";CALL DKXMTG(STATUS)
006 RETURN
007 * * * * * Interface info * * * * *
008 * * * * * Revision history * * * * *
009 *.0 - 8/7/87 JF3
010 END
DKHELP
001 SUBROUTINE (STATUS)
002 *Display HELP info
003 *4/9/87 JF3 0.3
004 *]DKIO
005 COM X1,HELP.LIST,X2(3),LINE
006 C=2;LOOP LINE=HELP.LIST<C> UNTIL LINE="" DO
007 CALL DKIO(-1)
008 C=C+1;REPEAT;STATUS=1;RETURN
009 * * * * * Interface info * * * * *
010 *Entry: none
011 *Exit: none
012 * * * * * Revision history * * * * *
013 *.0 - 4/9/87 JF3
014 END
DKRCVF
001 SUBROUTINE (STATUS)
002 *ReCeiVe a File name packet
003 *7/21/87 JF3 0.3.0
004 *]DKDPKT
005 COM X1(5),DATA,X2(27),f.type,A,C,X3(4),filename,item
006 COM X4(2),FV,FN,FID,X5(14),l
007 EQU OK TO STATUS,b TO " ",FF TO CHAR(12),DK1.3 TO STATUS,beg.fid TO STATUS
008 CALL DKDPKT(STATUS);filename=DATA
009 BEGIN CASE
010 CASE f.type<2
011 READ item FROM FV,filename ELSE item=""
012 IF f.type=0 THEN item="";*TEMP FOR SMS
013 IF f.type=1 THEN
014 DK1.3="U3":FID<1,1>;beg.fid=OCONV("",DK1.3)
015 IF beg.fid THEN
016 item<12>=beg.fid;item<13>=1
017 END
018 END
019 CASE f.type=3
020 PRINTER ON
021 PRINT 'FOLLOWING JOB RECEIVED AS FILE "':filename:'".':FF:
022 PRINTER OFF;DATA="PRINTFILE"
023 END CASE
024 A=1;C="";l=0
025 RETURN
026 * * * * * Interface info * * * * *
027 *Entry:
028 * * * * * Revision history * * * * *
029 *.0 - 7/21/87 JF3
030 END
DKFA
001 SUBROUTINE (arg,c,index)
002 *Convert file attributes -- NOT USED in 0.3
003 *7/14/87 JF3
004 !
005 COM X1(47),F.ATTRS
006 s=index<2>
007 *LOCATE s IN F.ATTRS<2> SETTING v ELSE arg="";GO 4;*Microdata/Ultimate
008 LOCATE(s,F.ATTRS,2;v) ELSE arg="";GO 4; *PICK
009 arg=F.ATTRS<1,v>
010 4 c=0;RETURN
011 * * * * * Interface info * * * * *
012 * Entry:
013 *
014 * Exit:
015 * * * * * Revision history * * * * *
016 *.0 - 7/14/87 JF3
017 END
DKEXIT
001 SUBROUTINE (STATUS)
002 *Exit command
003 *6/30/87 JF3 0.3.0
004 !
005 COM X1(39),REMOTE.CTRL
006 IF REMOTE.CTRL=3 THEN
007 * ECHO.ON=OCONV("","U80E0");*Microdata
008 ECHO ON; *PICK/Ultimate
009 END;STATUS=0;RETURN
010 * * * * * Interface info * * * * *
011 *Entry: none
012 *Exit: return to TCL
013 * * * * * Revision history * * * * *
014 *.0 - 6/30/87 JF3
015 END
DKINP
001 SUBROUTINE (STATUS)
002 *INPut data (with timeout on NON Reality/Royale versions)
003 *11/4/88 JF3 0.3.2
004 !
005 COM V(96);EQU DATA TO V(6),TIMEOUT TO V(18),EOL TO V(21)
006 *EQU S TO 11;*Ultimate
007 EQU S TO 14;*PICK
008 DATA="";IF STATUS THEN
009 INPUT DATA:
010 * * * * * PICK/Ultimate * * * * *
011 END ELSE
012 GOSUB 8;PROMPT"";PRINT EOL:;LOOP
013 LOOP N=SYSTEM(S) WHILE N DO
014 INPUT c,1:;IF c="" THEN c=EOL
015 DATA=DATA:c;IF c=EOL THEN STATUS=1;GO 9
016 IF N=1 THEN GOSUB 8
017 REPEAT
018 UNTIL TIME()>=t AND still.early DO
019 IF NOT(still.early) THEN GOSUB 8
020 REPEAT;STATUS=0
021 * * * * * * * * * * * * * * *
022 END;8 t=TIME();still.early=(t<86385);t=t+TIMEOUT
023 9 RETURN
024 * * * * * Interface info * * * * *
025 *Entry: STATUS := false means check timeout
026 * true " ordinary input
027 * PROMPT must be set by caller
028 *
029 *Exit: STATUS := false means timeout occured
030 * true " all ok
031 * DATA := any input including EOL char
032 * * * * * Revision history * * * * *
033 *.2 - 11/4/88 JF3 Fix midnight timeout problem.
034 *
035 *.1 - 12/29/87 JF3 Make SYSTEM(x) EQUatable.
036 *
037 *.0 - 1/29/87 JF3
038 END
DKXMTS
001 SUBROUTINE (STATUS)
002 *XMiT a Send-init packet
003 *7/24/87 JF3 0.3.0
004 !]DKINIT]DKDBUG]DKXPKTS]DKRECON]DKRETRY
005 COM X1(3),MARK,n,DATA,X2,TYPE,X3,DEBUG.MODE,DELAY
006 *EQU TYPE TO STATUS,RECEIVER TO STATUS,OK TO STATUS;*ULTIMATE/Microdata
007 EQU RECEIVER TO STATUS,OK TO STATUS;*PICK
008 CALL DKINIT(OK);IF OK THEN
009 TYPE="S";CALL DKFPKT(TYPE);IF OK THEN
010 IF DEBUG.MODE THEN CALL DKDBUG("H")
011 * SLEEP=OCONV(DELAY,"U407A");*Microdata/Ultimate
012 SLEEP DELAY; *PICK
013 LOOP
014 RECEIVER=0;CALL DKXPKTS(RECEIVER);IF OK>0 THEN
015 BEGIN CASE
016 CASE TYPE="Y"
017 RECEIVER=0;CALL DKRECON(RECEIVER)
018 CASE TYPE="N";CALL DKRETRY;OK=0
019 END CASE
020 END ELSE CALL DKDBUG(STATUS);STOP
021 UNTIL OK DO REPEAT
022 END ELSE STATUS=0
023 END;RETURN
024 * * * * * Interface info * * * * *
025 *Entry: none
026 *
027 *Exit: STATUS := true means both sides configured
028 * false means error occured somewhere.
029 * * * * * Revision history * * * * *
030 *.0 - 7/24/87 JF3
031 END
DKFNAME
001 SUBROUTINE DKFNAME
002 *setup File NAMEs (in Kermit sense)
003 *7/8/87 JF3 0.3.0
004 *]DKCNV]DKNFN
005 COM X1(16),MAXL,X2(6),CHKT,X3(16),ID,X4(2)
006 COM F.NAME,X5,filename.type;DIM N(3)
007 EQU name TO N(1),type TO N(2),sep TO N(3),AM TO CHAR(254)
008 name=filename.type<1>;type=filename.type<2>;sep=""
009 CALL DKCNV(NFN,0,-48:AM:105);NFN=(NFN[1,6]="NORMAL")
010 IF F.NAME="" THEN
011 BEGIN CASE
012 CASE type<2
013 IF NFN THEN type=name ELSE type=""
014 name=ID
015 * CASE type=2;type="";sep=".";*Not used.
016 CASE type=3;type=(1000+ID)[2,3]
017 CASE 1;F.NAME="";GO 9
018 END CASE
019 END ELSE
020 type=INDEX(F.NAME,".",1);IF type THEN
021 name=F.NAME[1,type-1];type=F.NAME[type+1,9999];sep="."
022 END ELSE name=F.NAME;type=""
023 END;IF NFN THEN CALL DKNFN(MAT N)
024 F.NAME=(name:sep:type)[1,MAXL-2-CHKT]
025 9 RETURN
026 * * * * * Interface info * * * * *
027 *Entry: filename.type <1> := file name SET by command
028 * <2> := file type # SET by command
029 *Uses: NFN := Normalized File Names
030 * sep := file name seperator
031 *Exit: F.NAME := filename to be used in transaction
032 * * * * * Revision history * * * * *
033 *.0 - 7/8/87 JF3
034 END
DKRECON
001 SUBROUTINE (STATUS)
002 *Reconcile initial packet parameters
003 *10/24/88 JF3 0.3.1
004 *]DKQUOT]DKCNV
005 COM X1(5),DATA,X2(16),QBIN;EQU RX TO STATUS
006 AckPkt="";f=1;c=1;LOOP F=DATA[c,1] UNTIL F="" OR f=10 DO
007 p=(16+f);EOL=(f=5);CAPAS=(f=10);ix=p*(EOL OR CAPAS)
008 BEGIN CASE;CASE f=4;cnv=4
009 CASE CAPAS;S=F;LOOP WHILE MOD(SEQ(S),2) DO
010 c=c+1;S=DATA[c,1];F=F:S;REPEAT;cnv="CAPAS";cnv<1,2>=-1
011 CASE 5<f AND f<10;cnv=0;CALL DKQUOT(RX,f,F)
012 CASE 1;cnv=1;END CASE;IF NUM(cnv) THEN icnv=-cnv ELSE icnv=cnv
013 CALL DKCNV(F,icnv,ix);IF EOL THEN CALL DKCNV(F,3,p)
014 IF RX THEN
015 IF EOL THEN cnv=-3
016 IF CAPAS THEN cnv<1,2>=1
017 IF f=7 THEN
018 IF NOT(F="N" OR F=QBIN) THEN F="Y"
019 END ELSE
020 IF f=4 THEN cnv=3
021 CALL DKCNV(F,cnv,-(48+f))
022 IF f=4 THEN cnv=4;GO 7
023 IF EOL THEN
024 cnv=1;7 CALL DKCNV(F,cnv,0)
025 END;END;AckPkt=AckPkt:F
026 END;f=f+1;c=c+1
027 REPEAT;IF RX THEN DATA=AckPkt
028 STATUS=1;RETURN
029 * * * * * Interface info * * * * *
030 * Entry:
031 * STATUS := 1 means Receive mode
032 * DATA := DATA field of received init (S or Y) packet
033 * Exit:
034 * If Receive mode then DATA contains DATA field of Ack packet
035 * * * * * Revision history * * * * *
036 *.1 - 10/24/88 JF3
037 *
038 *.0 - 1/29/87 JF3
039 END
DKBATCH
001 SUBROUTINE (STATUS)
002 *go into BATCH mode
003 *8/7/87 JF3 0.3.0
004 *]DKRCVG]DKXPKTS]DKRCVt
005 COM command.line,X1(4),msg,X2(31),process,X3,remote.control
006 *IF remote.control THEN
007 *END ELSE
008 process=FIELD(command.line<1>," ",2);IF NUM(process) THEN
009 *check for logged on process here
010 msg="K21";STATUS="!";CALL DKIO(STATUS);remote.control=3
011 command.line=""
012 * ECHO.OFF=OCONV("","U80E0");*Microdata
013 ECHO OFF; *PICK/Ulitmate
014 END ELSE msg="K1";msg<2>="process#";STATUS="!";CALL DKIO(STATUS)
015 *END
016 STATUS=1;RETURN
017 * * * * * Interface info * * * * *
018 *Entry: none
019 *
020 *Exit: remote.control := set to remote command mode = "3"
021 * * * * * Revision history * * * * *
022 *.0 - 8/7/87 JF3
023 END
DKCAPAS
001 SUBROUTINE (arg,c,X)
002 *Convert CAPAS bit fields -- NOT USED in 0.3
003 *2/6/87 JF3
004 *]DKCNV
005 DIM C(9);MAT C=0;I=0
006 BEGIN CASE
007 CASE c=1
008 v=1;LOOP P=arg<1,v> UNTIL P="" DO
009 IF P THEN
010 P=arg<2,v>-1;i=INT(P/5)+1;P=5*i-P
011 C(i)=C(i)+PWR(2,P);IF i>I THEN I=i
012 END;v=v+1
013 REPEAT;arg="";FOR i=1 TO I
014 C(i)=C(i)+(I>i);CALL DKCNV(C(i),1,0);arg=arg:C(i)
015 NEXT i
016 CASE c=-1
017 I=LEN(arg);int.arg="";FOR i=1 TO I
018 P=arg[i,1];CALL DKCNV(P,-1,0);FOR p=5 TO 1 STEP -1
019 v=PWR(2,p);bit=(P>=v);IF bit THEN P=P-v
020 v=5*i-p+1;int.arg<2,v>=v;int.arg<1,v>=bit
021 NEXT p
022 NEXT i;arg=int.arg
023 END CASE;c=0;RETURN
024 * * * * * Interface info * * * * *
025 * Entry:
026 * if c=1 then convert from internal to packet formats
027 * arg<1>:= multivalued bit fields
028 * <2>:= associated field #s
029 * if c=-1 then convert from packet to internal formats
030 * arg := char string from packet CAPAS field
031 * Exit:
032 * if c=1 on entry then
033 * arg := char() encoded string
034 * if c=-1 on entry then
035 * arg<1> :=} as above
036 * arg<2> :=}
037 * c := 0
038 * * * * * Revision history * * * * *
039 *.0 - 2/6/87 JF3
040 END
DKXMTT
001 *DUMMY
002 *Subroutine list for DKXMTt subroutine names
003 *4/3/87 JF3 0.3
004 *]DKXMTS]DKXMTF]DKXMTA]DKXMTD]DKXMTZ]DKXMTB
005 END
DKCHECK
001 SUBROUTINE (check)
002 *Checksum a packet
003 *4/9/87 JF3 0.3.0
004 *]DKCNV
005 COM X1(5),DATA,X2(10),MAXL,X3(6),CHKT,X4(24),SMAXL
006 EQU STATUS TO check;RX=check;STATUS="";IF RX THEN
007 L=DATA[2,1];CALL DKCNV(L,-1,0)
008 IF 0<=L AND L<=SMAXL THEN L=L+2-CHKT ELSE GO 9
009 END ELSE L=LEN(DATA)
010 s=0;FOR c=2 TO L
011 CHR=DATA[c,1];IF CHR="" THEN GO 9
012 s=s+SEQ(CHR)
013 NEXT c;BEGIN CASE
014 CASE CHKT=1;check=CHAR(32+MOD(INT(MOD(s,256)/64)+s,64))
015 CASE CHKT=2
016 * Bug of some kind here; can't get it to work!
017 L=1;LOOP
018 c=MOD(s,64);CALL DKCNV(c,1,0);check=c:check
019 UNTIL L=2 DO s=INT(s/64);L=L+1 REPEAT
020 CASE CHKT=3;*Insert assembly call here
021 END CASE
022 9 RETURN
023 * * * * * Interface info * * * * *
024 *Entry: check := true if we are receiving
025 *Exit: check contains check code for packet
026 * * * * * Revision history * * * * *
027 *.0 - 4/9/87 JF3
028 END