-
Notifications
You must be signed in to change notification settings - Fork 0
/
k11pak.mac
2050 lines (1655 loc) · 58 KB
/
k11pak.mac
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
.title k11pak packet driver for kermit-11
.ident /8.0.01/
.enabl gbl
; Brian Nelson 30-Nov-83 10:20:09
; Last edit: 02-Jul-85 14:44:32
;
; Change Software, Toledo, Ohio
; University of Toledo, Toledo, Ohio
;
.enabl lc
; define macros and things we want for KERMIT-11
;
; K11MAC.MAC defines all macros and a number of symbols
.include /IN:K11DEF.MAC/
.if ndf, K11INC
.ift
.include /IN:K11MAC.MAC/
.endc
.iif ndf, k11inc, .error ; INCLUDE for IN:K11MAC.MAC failed
.include /IN:K11DEF.MAC/
maxpak == 94. ; maximum packet size-maxsize(checksum)
mx$try == 10 ; number of times to retry packet
myquote == '# ; quoting
mypad == 0 ; no padding
mypchar == 0 ; thus no pad character
myeol == cr ; end-of-line
mytime == 12 ; time me out after this
myqbin == '& ; 8 bit quoting
defchk == '1
mychkt == defchk ; normal checksumming
myrept == 176 ; tilde for repeat things
mycapa == capa.a+capa.l ; /42/ Attributes + long packets
maxtim == 60 ; maximum timeout
mintim == 2 ; minimum timeout
badchk == 377 ; psuedo packet type for checksum
timout == 'T&137 ; psuedo packet type for timeout
defdly == 6 ; delay for SENDING to start up
.sbttl notes on RMS-11
; RSTS and RSX note:
;
; Note that we really don't need distinct luns for input, output
; and directory lookup as we would normally never have more than
; one of them active at any given time. The space used to do this
; only adds about 1 KW of size to the task so I am not going to
; worry about it. There could always come a time when the above
; assumption will not hold. Most of KERMIT-11 is sharable anyway
; due to the linking to RMSRES. The code, all being in PSECT $CODE
; can always be task built with the /MU switch to make more of it
; sharable (RSTS and RSX11M Plus only).
; The one thing to note is that LUN.LO must ALWAYS be reserved as
; logging and debugging to disk can be running concurrently with
; anything else. Also, when the TAKE command is put in another lun
; will be required for it.
lun.kb == 0 ; assume if channel 0 --> terminal
lun.in == 1 ; channel for input files
lun.ou == 2 ; channel for output files
lun.lo == 3 ; channel for packet and file logging
lun.tr == 3 ; same as lun.log
lun.ta == 4 ; for the TAKE command
lun.tt == 5 ; for RSX, the normal TI: channel
lun.sr == 6 ; channel for $search for RMSv2.0
lun.ti == 7 ; channel number for connected terminal
lun.xk == 7 ; Ditto, for clarity
lun.co == 10 ; used as is lin.ti for remote connect
lun.as == 11 ; used to attach to remote link device
; to fake a device assignment
.psect $pdata
null: .byte 0,0 ; a null packet to send
.psect $code
.sbttl KERMIT packet format
; PACKET FORMAT
;
;The KERMIT protocol is built around exchange of packets of the following for-
;mat:
;
; +------+-----------+-----------+------+------------+-------+
; ] MARK ] char(LEN) ] char(SEQ) ] TYPE ] DATA ] CHECK ]
; +------+-----------+-----------+------+------------+-------+
;
;where all fields consist of ASCII characters. The fields are:
;
;MARK The synchronization character that marks the beginning of the packet.
; This should normally be CTRL-A, but may be redefined.
;
;LEN The number of ASCII characters within the packet that follow this
; field, in other words the packet length minus two. Since this number
; is transformed to a single character via the char() function, packet
; character counts of 0 to 94 (decimal) are permitted, and 96 (decimal)
; is the maximum total packet length. The length does not include end-
; of-line or padding characters, which are outside the packet and are
; strictly for the benefit of the operating system, but it does include
; the block check characters.
;
;SEQ The packet sequence number, modulo 64, ranging from 0 to 63. Sequence
; numbers "wrap around" to 0 after each group of 64 packets.
;
;
;TYPE The packet type, a single ASCII character. The following packet types
; are required:
;
; D Data packet
; Y Acknowledge (ACK)
; N Negative acknowledge (NAK)
; S Send initiate (exchange parameters)
; B Break transmission (EOT)
; F File header
; Z End of file (EOF)
; E Error
;
;
;DATA The "contents" of the packet, if any contents are required in the given
; type of packet, interpreted according to the packet type. Control
; characters are preceded by a special prefix character, normally "#",
; and "uncontrollified" via ctl(). A prefixed sequence may not be broken
; across packets. Logical records in printable files are delimited with
; CRLFs, suitably prefixed (e.g. "#M#J"). Any prefix characters are in-
; cluded in the count. Optional encoding for 8-bit data and repeated
; characters is described later.
;
;
;CHECK A block check on the characters in the packet between, but not includ-
; ing, the mark and the block check itself. The check for each packet is
; computed by both hosts, and must agree if a packet is to be accepted.
; A single-character arithmetic checksum is the normal and required block
; check. Only six bits of the arithmetic sum are included. In order
; that all the bits of each data character contribute to this quantity,
; bits 6 and 7 of the final value are added to the quantity formed by
; bits 0-5. Thus if s is the arithmetic sum of the ASCII characters,
; then
;
; check = char((s + ((s AND 192)/64)) AND 63)
;
; This is the default block check, and all Kermits must be capable of
; performing it. Other optional block check types are described later.
; The block check is based on the ASCII values of the characters in the
; packet. Non-ASCII systems must translate to ASCII before performing
; the block check calculation.
;
;
;
; 13-Oct-84 14:01:32 BDN moved SENDSW and RECSW out
.sbttl GETCR0 decide where to get the next character from
; 06-Nov-85 11:22:14 BDN Added Edit 38
;
; Passed: r0 LUN
; Return: r0 Error code (generally 0 or ER$EOF)
; r1 Character just read
;
;
; GETCR0 is the lowest level entry point called in Kermit to
; obtain the next character for a SEND function (even GETC
; calls it), where that it may be a normal file transfer, or
; a SERVER extended response. The main idea in altering it is
; so that a server dispatch routine can change the the
; default (get from a file) to, say, get from an .ASCIZ
; string in memory or switch to some other kind of
; GET_NEXT_CHARACTER routine. This requires that the service
; routine insert its GET_NEXT_CHAR routine address into the
; global 'GETCROUTINE' and also to reset it to 'FGETCR0' when
; the action is complete. Currenty, REMOTE HELP and REMOTE
; DIR use this facility.
getcr0::tst getcroutine ; /38/is there any routine address set
bne 10$ ; /38/yes
call fgetcr0 ; /38/no, default to file reading
br 100$ ; /38/exit
10$: call @getcroutine ; /38/call currently defined routine
100$: return
tgetcr::tst tgetaddr ; /38/Have we ever been inited ?
beq 90$ ; /38/no, return ER$EOF
movb @tgetaddr,r1 ; /38/yes, get next character please
beq 90$ ; /38/nothing is left to do
inc tgetaddr ; /38/text_address++
clr r0 ; /38/return(no_errors)
br 100$ ; /38/exit
90$: mov #ER$EOF ,r0 ; /38/return(end_of_file)
mov #fgetcr0,getcroutine ; /38/reset to file reading please
100$: return ; /38/exit
global <getcroutine,fgetcr0,tgetcr0,tgetaddr,ER$EOF>
.sbttl spack send packet
; S P A C K $
;
; spack$(%val type,%val num,%val len, %loc data)
;
; input: @r5 type of packet
; 2(r5) packet number
; 4(r5) length of the packet
; 6(r5) location of the data to send
; output: r0 error status
$ALLSIZ = <MAXLNG+<MAXLNG/10>>&177776
spack$::save <r1,r2,r3,r4> ; Save registers that we may use
call spakwa
call spakin
sub #$ALLSIZ,sp ; /42/ Allocate a LONG buffer
mov sp ,r4 ; Point to the buffer
clr -(sp) ; Count the total length
tst prexon ; /53/ Should we prefix all packets
beq 5$ ; /53/ with an XON? If eq, NO
movb #'Q&37 ,(r4)+ ; /53/ Yes, insert one
inc @sp ; /53/ Write_length++
5$: setpar sensop ,(r4)+ ; Start all packets with control A
mov r4 ,r2 ; Get address for checksum compute
inc @sp ; Packetlength := succ(packetlength)
mov 4(r5) ,r0 ; The length of the packet
cmp r0 ,#MAXPAK ; Packet too large ?
blos 15$ ; No
bitb #CAPA.L,conpar+p.capas ; /43/ Check to see if both sides
beq 10$ ; /43/ REALLY understand long packets
bitb #CAPA.L,senpar+p.capas ; /43/ We would normally but it is
beq 10$ ; /43/ possible to SET NOLONG
tst senlng ; /42/ Receiver said it can do long
beq 10$ ; /42/ packets? If eq, then no
; /42/ Otherwise, build ext header.
mov r2 ,-(sp) ; /42/ Save this
mov #40 ,-(sp) ; /42/ Accumulate header checksum
setpar #40 ,(r4)+ ; /42/ Length is a space, of course.
tochar 2(r5) ,r1 ; /42/ Packet sequence please
add r1 ,(sp) ; /42/ Add into header checksum now.
setpar r1 ,(r4)+ ; /42/ Insert it
movb (r5) ,r1 ; /42/ The packet type is next.
bicb #40 ,r1 ; /42/ Insure always upper case.
add r1 ,(sp) ; /42/ Add in the checksum
setpar r1 ,(r4)+ ; /42/ And insert that also
mov r0 ,r3 ; /42/ Insert the total packet size
clr r2 ; /42/ First byte is size/95.
add chksiz ,r3 ; /42/ Must include checksum size.
div #95. ,r2 ; /42/ Second byte is size mod 95
tochar r2 ,r2 ; /42/ Convert to character rep
tochar r3 ,r3 ; /42/ Convert to character rep
setpar r2 ,(r4)+ ; /42/ Insert high bits into packet
add r2 ,(sp) ; /42/ Add into checksum
setpar r3 ,(r4)+ ; /42/ Insert low bits into packet
add r3 ,(sp) ; /42/ Add into checksum
mov (sp)+ ,r0 ; /42/ Pop the checksum please
mov r0 ,r2 ; /42/ Save it
bic #^C300 ,r2 ; /42/ Compute it as in:
ash #-6 ,r2 ; /42/ Chk=char((s+((s&0300)/0100))&77)
add r0 ,r2 ; /42/ ...
bic #^C77 ,r2 ; /42/ Got it now
tochar r2 ,r2 ; /42/ Convert checksum to character
setpar r2 ,(r4)+ ; /42/ and insert into packet.
mov (sp)+ ,r2 ; /42/ Where to start checksum for rest
mov #7 ,(sp) ; /42/ We now have seven characters.
br 20$ ; /42/ Add off we go
10$: mov #MAXPAK-3,r0 ; Yes, reset packet size please
15$: add #2 ,r0 ; + two for number and type
add chksiz ,r0 ; + the length of the checksum please
clr r1 ; Accumulated checksum
tochar r0 ,r1 ; Start the checksum out right
setpar r1 ,(r4)+ ; And stuff length into the packet
inc @sp ; Packetlength := succ(packetlength)
tochar 2(r5) ,r0 ; Convert the packet number now
setpar r0 ,(r4)+ ; And stuff it into the packet
inc @sp ; Packetlength := succ(packetlength)
movb @r5 ,r0 ; Get the packet type now
bicb #40 ,r0 ; Insure UPPER CASE packet type
setpar r0 ,(r4)+ ; Insert the packet type into buffer
inc @sp ; Packetlength := succ(packetlength)
20$: mov 4(r5) ,r1 ; Get the data length
beq 40$ ; Nothing to do
mov 6(r5) ,r3 ; Address of the data to send
30$: clr r0 ; Get the next character
bisb (r3)+ ,r0 ; Next char
setpar r0 ,(r4)+ ; Now move the data byte into the buffer
inc @sp ; Packetlength := succ(packetlength)
sob r1 ,30$ ; Next please
40$: clrb @r4 ; Set .asciz for call to checks
mov r2 ,-(sp) ; Starting address for checksum field
call checks ; Simple
mov (sp)+ ,r2 ; Get the computed checksum now
call spakck ; Stuff checksum into buffer now
add r0 ,@sp ; And the length of the checksum
setpar conpar+p.eol,(r4)+ ; End of line needed ?
inc @sp ; Packetlength := succ(packetlength)
mov (sp)+ ,r1 ; Packet length
mov sp ,r4 ; Address(buffer)
calls pakwri ,<r4,r1,#lun.ti>; And dump the buffer out now
call spakfi ; Handle ibm stuff if possible
add #$ALLSIZ,sp ; Pop the buffer
unsave <r4,r3,r2,r1> ; Pop registers that we used
return
GLOBAL <CHKSIZ,CONPAR,DEBUG,SENSOP,RECSOP,SENLNG>
GLOBAL <PREXON> ; /53/
.sbttl spack routines
.enabl lsb
spakin::bit #log$pa ,trace ; tracing today ?
beq 5$ ; no
calls dskdmp ,<#200$,4(r5),@r5,2(r5),6(r5)>
5$: tst pauset ; wait a moment ?
beq 6$ ; no
calls suspend ,<pauset> ; yes
6$: mov #conpar+p.padc,r2 ; address of the pad character ?
clr r1
bisb conpar+p.npad,r1 ; send some pad characters ?
tst r1
beq 20$ ; no padding
10$: calls pakwri ,<r2,#1,#lun.ti>; send some padding
sob r1 ,10$ ; next please
20$: movb @r5 ,r1 ; the packet type next
cmpb r1 ,#'A&137 ; a legitimate packet type ?
blo 30$ ; no
cmpb r1 ,#'Z&137 ; must be in the range A..Z
bhi 30$ ; no good
sub #100 ,r1 ; convert into range 1..26
asl r1 ; and count the packet type
asl r1 ; /43/ 32 bits
add #1 ,pcnt.s+2(r1) ; /43/ 32 bits, paccnt(type)++
adc pcnt.s+0(r1) ; /43/ 32 bits, the high part
add #1 ,pcnt.s+2 ; /43/ 32 bits now
adc pcnt.s+0 ; /43/ The high order part
30$: return
.save
.psect $PDATA ,D
200$: .asciz /SPACK - /
.even
.restore
.dsabl lsb
spakck: clr r0 ; checksum.len := 0
cmpb chktyp ,#defchk ; if checklength > 6 bits
blos 20$ ; then begin
cmpb chktyp ,#'3 ; if checktype = CRC16
bne 10$ ; then begin
mov r2 ,r1 ; checkchar1:=tochar(check[12..15])
ash #-14 ,r1 ; shift over 12 bits
bic #^C17 ,r1 ; mask off the high 12 bits
tochar r1 ,@r4
setpar @r4 ,(r4)+
inc r0 ; packetlength := succ(packetlength)
; end
10$: mov r2 ,r1 ; checkchar1 := tochar(check[6..11])
ash #-6 ,r1 ; shift over 6 bits
bic #^C77 ,r1 ; mask off the higher order bits
tochar r1 ,@r4
setpar @r4 ,(r4)+
inc r0 ; packetlength := succ(packetlength)
bic #^C77 ,r2 ; now drop the high bits from checks
20$:
tochar r2 ,@r4
tst ranerr ; insert random checksum errors?
beq 40$ ; no, please don't
mov r0 ,-(sp) ;+ test mode
call irand ;+ test mode
tst r0 ;+ test mode
bne 30$ ;+ test mode
incb @r4 ;+ test mode
30$: mov (sp)+ ,r0 ;+ test mode
40$: setpar @r4 ,(r4)+
inc r0 ; packetlength := succ(packetlength)
return
global <chktyp ,pauset ,pcnt.s ,ranerr>
.sbttl try to handle half duplex handshake garbage ala IBM (barf)
spakfi: save <r2> ; don't do this forever please
call 200$ ; dump raw i/o first please
unsave <r2>
return
200$: bit #log$io ,trace ; dumping all i/o out ?
beq 230$ ; no
save <r0,r1,r2,r4> ; save these please
mov r1 ,r2 ; anything to do ?
beq 220$ ; no
210$: clr r0 ; yes, dump ch by ch please
bisb (r4)+ ,r0 ; get the next ch to dump
mov #lun.lo ,r1 ; the lun to write to
call putcr0 ; simple
sob r2 ,210$ ; next please
220$: unsave <r4,r2,r1,r0> ; pop and exit
230$: return ; bye
global <handch>
.enabl lsb
spakwa: save <r2>
tstb handch ; any paritcular handshake char today?
beq 100$ ; no, just exit please
scan @r5 ,#200$
tst r0
bne 100$
mov #200 ,r2 ; a limit on looping please
10$: calls binrea ,<#lun.ti,#4> ; wait for XON, max 4 seconds please
tst r0 ; did the read timeout. if so, exit.
bne 90$ ; exit and try to xon the link
bicb #200 ,r1 ; insure no parity is set
cmpb r1 ,handch ; is this the handshake character
beq 100$ ; no, try again please
sob r2 ,10$ ; not forever, please
br 100$ ; bye
90$: save <r0> ; save error flags
calls ttxon ,<#ttname,#lun.ti>; get the line turned on again please
unsave <r0> ; pop error
100$: unsave <r2> ; pop loop index
return
.save
.psect $PDATA ,D
200$: .byte msg$snd
.byte msg$ser
.byte msg$rcv
.byte msg$command
.byte msg$generic
.byte 0
.even
.restore
.dsabl lsb
global <ttname>
.sbttl rpack$ read incoming packet
; R P A C K $
;
; rpack$(%loc data)
;
; input: @r5 buffer address
; 2(r5) data structure of 3 words to contain the
; returned length, number and type
;
; output: r0 error code if < 0, packet type if > 0
; 255 for checksum error
;
o$len = 0 ; offset for retruned packet length
o$num = 2 ; offset for returned packet number
o$type = 4 ; offset for returned packet type
;
; word 2 packet type
; word 1 packet number
; as in: 2(r5) ------> word 0 packet length
;
;
;
; local data offsets from r4 (allocated on the stack
;
.done = 0 ; if <> 0 then we have the packet
.type = 2 ; current type of packet
.ccheck = 4 ; computed checksum
.rcheck = 6 ; received checksum
.len = 10 ; received pakcet length
.timeo = 12 ; current timeout
.num = 14 ; packet number, received
.size = 16 ; current size of data portion
.paksi = 20 ; for loop control for data portion
.cbuff = 22 ; /42/ Mark checksum buffer address
.hdtype = 24 ; /42/
.lsize = 26 ; total size of local data
; internal register usage:
;
; r0 error return
; r1 current character just read from remote
; r3 pointer to temp buffer containing the packet less the SOH
; and the checksum, used for computing checksum after the
; packet has been read.
; r4 pointer to local r/w data
; r5 pointer to argument list
.sbttl rpack continued
.iif ndf,$ALLSIZ, $ALLSIZ = <MAXLNG+<MAXLNG/10>>&177776
rpack$::save <r1,r2,r3,r4>
clr recbit ; /43/ Clear bit sum out
sub #.lsize ,sp ; allocate space for local data
mov sp ,r4 ; and point to it please
sub #$ALLSIZ,sp ; /42/ Allocate huge buffer
clr .num(r4) ; /41/ No fubar numbers on SOH tmo
clr .size(r4) ; /41/ No fubar sizes on SOH timeout
call waitsoh ; wait for a packet to start
tst r0 ; did it work or did we timeout
beq 5$ ; yes
jmp 95$ ; we must have timed out then
5$: mov sp ,r3 ; the packet less SOH and checksum
mov sp ,.cbuff(r4) ; /42/ Save start address
clr .hdtype(r4) ; /42/
call rpakin ; initialize things
10$: tst .done(r4) ; while ( !done ) {
bne 90$ ;
;
call rpakrd ; Read the next character from
bcs 95$ ; packet reader's buffer
bisb r1 ,recbit ; /43/ So we can determine parity set
bic #^C177 ,r1 ; Insure parity is cleared out
cmpb r1 ,recsop ; If the character is senders SOH
beq 80$ ; then we have to restart this else
movb r1 ,(r3)+ ; *checkpacket++ = ch ;
unchar r1 ,r0 ; Get the length packet next please
mov r0 ,.hdtype(r4) ; /42/ Save header type
cmp r0 ,#2 ; /42/ If the length is 0,1 or 2 then
ble 15$ ; /42/ an extended header instead
14$: sub #2 ,r0 ; This is NOT an extended header so we
sub chksiz ,r0 ; will check to see if the packet can
bge 15$ ; hold at least SEQ+TYPE+CHECK
clr r0 ; /44/
;- add chksiz ,r0 ; Can't, thus we somehow lost the check
;- dec r0 ; sum type, so punt and reset it to a
;- movb #defchk ,chktyp ; type one checksum
;- mov #1 ,chksiz ; Fix the Checksum length also
15$: mov r0 ,.len(r4) ; Stuff the packet length
call rpakrd ; As before, ask for the next character
bcs 95$ ; and take an error exit if need be
bisb r1 ,recbit ; /43/ So we can determine parity set
bic #^C177 ,r1 ; Insure parity is cleared out
cmpb r1 ,recsop ; If this is the sender's START_OF_PAK
beq 80$ ; then it's time to restart the loop.
movb r1 ,(r3)+ ; Insert the sequence number into the
unchar r1 ,.num(r4) ; checksum packet and save the SEQ
call rpakrd ; Read the TYPE field next, exiting
bcs 95$ ; on a read error, of course.
bisb r1 ,recbit ; /43/ So we can determine parity set
bic #^C177 ,r1 ; Insure parity is cleared out
cmpb r1 ,recsop ; As always, if we find the sender's
beq 80$ ; START_OF_PACKET, the restart.
movb r1 ,(r3)+ ; Save the TYPE field into the checksum
mov r1 ,.type(r4) ; and also into the field for return.
tst .hdtype(r4) ; /42/ NOW check for extended header.
bne 19$ ; /42/ Not extended header.
call rdexhd ; /42/ ReaD EXtended HeaDer
tst r0 ; /42/ Did this work ok ?
bgt 80$ ; /42/ No, got a RESYNCH
bmi 96$ ; /42/ No, got a timeout or checksum
19$: mov .len(r4),.paksi(r4) ; loop for the data, if any
mov @r5 ,r2 ; point to the buffer now
20$: tst .paksi(r4) ; for i := 1 to len do
beq 30$ ; begin
call rpakrd ; read(input,ch)
bcs 95$ ; exit if error
clrpar r1 ; ch := ch and chr(177B)
cmpb r1 ,recsop ; if ch = SOH then resynch
beq 80$ ;
cmp .size(r4),#MAXLNG ; if currentsize < MAXPAKSIZE
bhis 25$ ; then
movb r1 ,(r2)+ ; data[i] := ch
movb r1 ,(r3)+ ; checkpacket++ := ch
; end
25$: inc .size(r4) ; currentsize:=succ(currentsize)
dec .paksi(r4) ; nchar_left := nchar_left - 1
br 20$ ; end
30$: clrb @r2 ; data[len] := NULL
clrb @r3 ; checkpacket++ := null
mov sp ,r3 ; reset base address of checkpacket
call rpakck ; read the checksum now
bcs 95$ ; exit on line error (like timeout)
mov sp ,.done(r4) ; flag that we are done
br 10$ ; check to see if we are done
80$: br 5$ ; synch error, restart the packet
90$: call rpakfi ; finish checksum and return the
br 100$
95$: mov 2(r5) ,r1 ; timeout error, flag no packet
clr r0 ; nonfatal error for timout
mov #timout ,o$type(r1) ; return as psuedo packet type
mov #timout ,.type(r4) ; return as psuedo packet type
96$: call rpakst ; do stats and disk dumping now
100$: add #.lsize+$ALLSIZ,sp ; /42/ Pop local buffers
unsave <r4,r3,r2,r1>
return
global <chktyp>
.sbttl Read extended header type 0 for long packets
; Added edit /42/ 08-Jan-86 16:32:59 Brian Nelson
rdexhd: mov r5 ,-(sp) ; /42/ Need an ODD register for MUL
mov r2 ,-(sp) ; /42/ Save R2 please
call rpakrd ; /42/ Extended header, read the LENX1
bcs 90$ ; /42/ field, exiting on read errors.
bic #^C177 ,r1 ; /42/ Insure parity is cleared out
cmpb r1 ,recsop ; /42/ Exit if we find the SENDERS
beq 80$ ; /42/ START_OF_HEADER please
movb r1 ,(r3)+ ; /42/ Save into Checksum buffer
unchar r1 ,r5 ; /42/ Get the high order of length
mul #95. ,r5 ; /42/ Shift over please
call rpakrd ; /42/ Extended header, read the LENX2
bcs 90$ ; /42/ field, exiting on read errors.
bic #^C177 ,r1 ; /42/ Insure parity is cleared out
cmpb r1 ,recsop ; /42/ Exit if we find the SENDERS
beq 80$ ; /42/ START_OF_HEADER please
movb r1 ,(r3)+ ; /42/ Save into Checksum buffer
unchar r1 ,r1 ; /42/ Get the next one
add r1 ,r5 ; /42/ Now we have the EXTENDED length
sub chksiz ,r5 ; /42/ Drop it by checksum size
mov r5 ,.len(r4) ; /42/ Save it here, of course
mov .cbuff(r4),r5 ; /42/ Now, at LAST, get the extended
mov #5 ,r1 ; /42/ header CHECKSUM data
clr -(sp) ; /42/ Accum in stack
10$: clr r0 ; /42/ Use the normal SAFE way to add
bisb (r5)+ ,r0 ; /42/ bytes even though we know for
add r0 ,(sp) ; /42/ that no sign extends will happen
sob r1 ,10$ ; /42/ Next please
mov (sp)+ ,r0 ; /42/ Pop the checksum please
mov r0 ,r2 ; /42/ Save it
bic #^C300 ,r2 ; /42/ Compute it as in:
ash #-6 ,r2 ; /42/ Chk=char((s+((s&0300)/0100))&77)
add r0 ,r2 ; /42/ ...
bic #^C77 ,r2 ; /42/ Got it now
call rpakrd ; /42/ Extended header, read the HCHECK
bcs 90$ ; /42/ field, exiting on read errors.
bic #^C177 ,r1 ; /42/ Insure parity is cleared out
cmpb r1 ,recsop ; /42/ Exit if we find the SENDERS
beq 80$ ; /42/ START_OF_HEADER please
movb r1 ,(r3)+ ; /42/ Save into Checksum buffer
unchar r1 ,r1 ; /42/ Convert to actual checksum now
cmpb r1 ,r2 ; /42/ Do the CHECKSUMS match ?
bne 85$ ; /42/ No, exit with such set please
clr r0 ; /42/ It worked, exit normally
br 100$ ; /42/ bye...
80$: mov #1 ,r0 ; /42/ Resynch time
br 100$ ; /42/ Exit
85$: mov #badchk ,r0 ; /42/ Header Checksum error
br 95$ ; /42/ Stuff the error
90$: mov #timout ,r0 ; /42/ Return timeout error
95$: mov 2(sp) ,r5 ; /42/ Return timeout error
mov 2(r5) ,r1 ; /42/ Get address of result block
clr o$len(r1) ; /42/ Clear this also
mov r0 ,o$type(r1) ; /42/ Return the error
mov r0 ,.type(r4) ; /42/ Here also please
mov #-1 ,r0 ; /42/ Fatal error
100$: mov (sp)+ ,r2 ; /42/ Pop r2 and
mov (sp)+ ,r5 ; /42/ Restore R5
return
.sbttl subroutines for RPACK only
.enabl lsb
rpakrd: calls binrea ,<#lun.ti,.timeo(r4)>; read(input,ch)
tst r0 ; did it work
bne 110$ ; no
call rawio ; perhaps raw i/o logging
bit #log$rp ,trace ; dump to a local terminal ?
beq 20$ ; no
cmpb r1 ,recsop ; start of a packet ?
beq 10$ ; yes
movb r1 ,-(sp) ; yes, stuff the ch onto the stack
mov sp ,r1 ; point to it
print r1 ,#1 ; dump it
clr r1 ; restore what we read and exit
bisb (sp)+ ,r1 ; restore it and exit
br 20$ ; bye
10$: print #200$ ; start of a packet
20$: clr r0 ; no errors
clc ; it worked
return ; bye
110$: save <r0> ; save the error code
calls ttxon ,<#ttname,#lun.ti>; get the line turned on again please
unsave <r0> ; restore the error code
sec ; flag the error
return ; bye
.save
.psect $PDATA ,D
200$: .asciz <cr><lf>/<SOH>/
.even
.restore
.dsabl lsb
rpakin: clr .done(r4) ; done := false
clr .type(r4) ; packettype := 0
clr .ccheck(r4) ; checksum := 0
clr .rcheck(r4) ; received_checksum := 0
clr .len(r4) ; current length := 0
clr .num(r4) ; packet_number := 0
clr .timeo(r4) ; timeout := 0
clr .size(r4) ; current size of data part of packet
clr .paksi(r4) ; loop control for data of packet
mov @r5 ,r0 ; initialize the buffer to null
mov #40 ,r1
10$: clrb (r0)+ ; simple
clrb (r0)+ ; simple
sob r1 ,10$
mov 2(r5) ,r0 ; return parameters
clr (r0)+ ; packet.length := 0
clr (r0)+ ; packet.number := 0
clr (r0)+ ; packet.type := 0
call settmo
mov r0 ,.timeo(r4)
return
settmo: mov sertim ,r0 ; if waiting for server command
bne 20$ ; then use that timeout
clr r0 ;
bisb conpar+p.time,r0 ; get the remotes timeout
bne 10$ ; ok
mov #mytime ,r0 ; no good, setup a timeout
10$: cmpb r0,setrec+p.time ; use SET TIMEOUT value if >
bhis 20$ ; no, use the timeout as in
clr r0 ; ok, use the value the user said
bisb setrec+p.time,r0 ; in the SET TIMEOUT command
bne 20$ ; must be > 0 by now
mov #mytime ,r0 ; no ??
20$: return
global <conpar ,setrec ,sertim>
.sbttl finish up rpack
rpakfi: mov r3 ,-(sp) ; compute correct checksum type
call checks ; simple
mov (sp)+ ,.ccheck(r4) ; and stuff it in please
cmpb .ccheck(r4),.rcheck(r4) ; compare computed checksum with the
beq 100$ ; actual checksum
mov #badchk ,.type(r4) ; flag checksum error
100$: mov 2(r5) ,r1 ; where to return some things
mov .len(r4),o$len(r1) ; return the packet length
mov .type(r4),o$type(r1) ; and the packet type
mov .num(r4),o$num(r1) ; and at last, the packet number
call rpakst ; do stats and logging now
call rpaklo ; possibly log checksum errors?
return
.enabl lsb
rpakst: cmpb .type(r4),#'A&137 ; count the packet types for stats
blo 110$ ; bad packet type
cmpb .type(r4),#'Z&137 ; must in the range A..Z
bhi 110$ ; definiately a bad packet
movb .type(r4),r1 ; packet is ok, add it to the stats
sub #100 ,r1 ; convert to 1..26
asl r1 ; to word offsets
asl r1 ; /43/ Double word offsets
add #1 ,pcnt.r+2(r1) ; /43/ 32 bit addition today
adc pcnt.r+0(r1) ; /43/ The high order part of it
add #1 ,pcnt.r+2 ; /43/ Add it in here also
adc pcnt.r+0 ; /43/ High order part
110$: bit #log$pa ,trace ; tracing today ?
beq 120$ ; no
calls dskdmp ,<#200$,.len(r4),.type(r4),.num(r4),@r5>
120$: return
.save
.psect $PDATA ,D
200$: .asciz /RPACK - /
.even
.restore
.dsabl lsb
.enabl lsb
rpaklo: save <r0>
cmp .rcheck(r4),.ccheck(r4) ; checksums match ?
beq 100$ ; yes, do nothing then
bit #log$io ,trace ; not if in raw i/o mode
bne 100$ ; forget it
sub #60 ,sp ; dump bad checksums out to disk
mov sp ,r1 ; point to the buffer
copyz #200$ ,r1 ; a header
strlen r1 ; length so far
add r0 ,r1 ; point to the end of it
deccvt .rcheck(r4),r1 ; convert to decimal
add #6 ,r1 ; move along please
deccvt .ccheck(r4),r1 ; the calculated checksum
add #6 ,r1 ; make it .asciz
clrb @r1 ; simple
mov sp ,r1 ; point back to the buffer
strlen r1 ; get the length
calls putrec ,<r1,r0,#lun.lo>; dump buffer to disk
add #60 ,sp ; pop buffer and exit
100$: unsave <r0> ; pop r0 and exit
return
.save
.psect $PDATA ,D
200$: .asciz /?Bad Checksum: rcv,calc are /
.even
.restore
.dsabl lsb
global <pcnt.r ,sertim ,trace>
.sbttl read and convert the checksum for RPACK
rpakck: save <r3> ; use r3 for accumulating check
clr r3 ; assume zero for now
call rpakrd ; read(input,ch)
bcs 110$ ; exit if error
bisb r1 ,recbit ; recbit |= ch ;
bic #^c177 ,r1 ; ch := ch and 177B
unchar r1 ,r3 ; received_check := ch
cmpb chktyp ,#defchk ; if len(checksum) > 8bits
blos 10$ ; then begin
ash #6 ,r3 ; check := check * 64
call rpakrd ; read(input,ch)
bcs 110$ ; exit if error
bic #^c177 ,r1 ; ch := ch and 177B
unchar r1 ,r1 ; ch := unchar(ch)
bisb r1 ,r3 ; rcheck := rcheck + ch
cmpb chktyp ,#'3 ; if checktype = CRC16
bne 10$ ; then
ash #6 ,r3 ; begin
call rpakrd ; check := check * 64
bcs 110$ ; check := check + ch
bic #^c177 ,r1 ; ch := ch and 177B
unchar r1 ,r1 ;
bisb r1 ,r3 ; end ;
10$: clc
br 120$
110$: sec
120$: mov r3 ,.rcheck(r4) ; return the checksum
unsave <r3>
return
.sbttl parity routines
; C L R P A R
;
; input: 2(sp) the character to clear parity for
; output: 2(sp) the result
;
; caller by CLRPAR macro
;
; If parity is set to anything but NONE then always
; clear the parity out else clear it if and only if
; filetype is not image mode.
clrpar::tstb parity ; handle nothing please (no parity)
beq 10$ ; yes
cmpb parity ,#par$no ; set parity none used ?
bne 20$ ; no, must be some other type
10$: tst image ; no parity, image mode today ?
bne 100$ ; yes, leave things alone please
20$: bic #^C177 ,2(sp) ; no, clear bits 7-15 please
100$: return ; bye
global <parity>
.sbttl compute proper checksum please
; C H E C K S
;
; input: 2(sp) address of .asciz string to compute checksum for
; output: @sp the computed checksum
checks::save <r0,r1,r2,r3> ; save registers we may use
mov 12(sp) ,r2 ; point to the string to do it for
clr 12(sp) ; assume a zero checksum ?
cmpb chktyp ,#'3 ; CRC-CCITT type today ?
bne 5$ ; no
strlen r2 ; yes, get the .asciz string length
calls crcclc ,<r2,r0> ; compute the CRC16-CCITT
mov r0 ,r2 ; stuff the result into r2 for later
br 90$ ; and exit
5$: clr r1 ; init the checksum accumulator
10$: clr r3 ; get the next ch please
bisb (r2)+ ,r3 ; got the next ch now
beq 20$ ; hit the end of the string
cmpb parity ,#par$no ; did the packet contain parity?
beq 15$ ; no, leave bit 7 alone
bic #^C177 ,r3 ; yes, please clear bit seven
15$: bic #170000 ,r1 ; /42/ Insure long packet not overflow
add r3 ,r1 ; check := check + ch
br 10$
20$: mov r1 ,r2 ; checksum := (((checksum and 300B)/64)
cmpb chktyp ,#'2 ; 12 bit sum type checksum ?
beq 30$ ; yes, just exit
bic #^C300 ,r2 ; +checksum) and 77B)
ash #-6 ,r2 ;
add r1 ,r2 ;
bic #^C77 ,r2
br 90$
30$: bic #170000 ,r2 ; type 2 checksum
90$: mov r2 ,12(sp) ; return the checksum
100$: unsave <r3,r2,r1,r0> ; exit
return
.sbttl crc calculation
; This routine will calculate the CRC for a string, using the