-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathBSP
2694 lines (2406 loc) · 148 KB
/
BSP
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
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "19-Jan-93 10:23:19" {DSK}<python>lde>lispcore>sources>BSP.;3 149048
changes to%: (RECORDS BSPSOC ACKPUP BSPSTREAM)
previous date%: " 4-Jan-93 17:24:25" {DSK}<python>lde>lispcore>sources>BSP.;2)
(* ; "
Copyright (c) 1982, 1983, 1900, 1984, 1985, 1986, 1987, 1990, 1993 by Venue & Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT BSPCOMS)
(RPAQQ BSPCOMS
((DECLARE%: EVAL@COMPILE DONTCOPY (* ;
"This socket record has both RTP and BSP state info")
(RECORDS BSPSOC ACKPUP BSPSTREAM)
(CONSTANTS * RTPSTATES)
(CONSTANTS * RTPEVENTS)
(CONSTANTS (WORDSPERPORT 3))
(MACROS RTP.OTHERFN BSP.OTHERFN BSP.INPUT.ERROR BSP.OUTPUT.ERROR \BSPINCFILEPTR))
(COMS (* ;
"User-level RTP socket manipulation")
(FNS OPENRTPSOCKET CLOSERTPSOCKET \INIT.RTPPROCESS))
(COMS (* ; "RTP process")
(FNS \RTP.SOCKET.PROCESS \RTP.HANDLE.INPUT \RTP.HANDLE.PUP \RTP.HANDLE.RFC \RTP.CLEANUP
\RTP.ACTION \RTP.ERROR \RTP.SHOW.FAILURE \RTP.FILTER \SEND.ABORT
\SEND.ANSWERING.RFC \SEND.END \SEND.ENDREPLY \SEND.RFC \FILLRTPPUP \SETRTPPORTS)
(FNS \BSPINIT \BSPEVENTFN \BSP.CLOSE.OPEN.SOCKETS))
(COMS (* ; "Creating BSP stream")
(FNS OPENBSPSTREAM \SMASHBSPSTREAM BSPOUTPUTSTREAM BSPINPUTSTREAM BSPFRNADDRESS
CLOSEBSPSTREAM \BSP.FLUSHINPUT BSPOPENP GETBSPUSERINFO SETBSPUSERINFO)
(FNS CREATEBSPSTREAM ENDBSPSTREAM))
(COMS (* ; "BSP stream functions")
(FNS BSPBIN \BSP.GETNEXTBUFFER BSPPEEKBIN BSPREADP BSPEOFP \BSPBACKFILEPTR
\BSP.PREPARE.INPUT \BSP.GETFILEPTR \BSP.DECLARE.FILEPTR \BSP.SETFILEPTR
\BSP.SKIPBYTES \BSP.CLEANUP.INPUT BSPBOUT \BSP.OTHERBOUT \BSPWRITEBLOCK
BSPFORCEOUTPUT \BSP.SENDBUFFER \BSP.PREPARE.OUTPUT BSPGETMARK BSPPUTMARK
BSP.PUTINTERRUPT))
(COMS (* ; "BSP pup handler")
(FNS \BSP.HANDLE.INPUT \BSP.HANDLE.ACK \BSP.HANDLE.DATA \BSP.HANDLE.ERROR
\BSP.HANDLE.INTERRUPT \BSP.HANDLE.INTERRUPTREPLY \SEND.ACK \SEARCH.OUTPUTQ
\SETBSPTIMEOUT \TRANSMIT.STRATEGY))
(COMS (* ; "BSP utilities")
(FNS \BSP.DEFAULT.ERROR.HANDLER \BSP.TIMERFN \BSP.FLUSH.SOCKET.QUEUES \FILLBSPPUP
BSPHELP))
[COMS (* ; "debugging")
(FNS PPSOC PPSOC.CURRENT PRINTTIMER PRINTPUPQUEUE BSPPRINTPUP \RTP.INFO.HOOK)
(DECLARE%: DONTCOPY (ALISTS (PUPPRINTMACROS 8 9 16 17 18 20]
(INITRECORDS BSPSOC)
(SYSRECORDS BSPSOC)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\BSPINIT)))
(COMS (* ;
"Some of these may want to be constants")
(INITVARS (\BSPSOCKETS)
(\RFC.TIMEOUT 2000)
(\RTP.DALLY.TIMEOUT 5000)
(\RTP.DEFAULTTIMEOUT 30000)
(\BSP.MAXPUPS 12)
(\BSP.IDLETIMEOUT 15000)
(\BSP.OUTSTANDINGDATATIMEOUT 250)
(\BSP.MAXPUPALLOC 200)
(\BSP.ALLOCHYSTERESIS 50)
(\BSP.OVERLAP.DATA.WITH.ACK)
(\BSP.INITIAL.MAXPUPALLOC 5)
(\BSP.INITIAL.ADATATIMEOUT 1000)
(\BSP.MIN.ADATA.TIMEOUT 500)
(\BSP.MAX.ADATA.TIMEOUT 10000)
(\BSP.INACTIVITY.TIMEOUT 120000)
(\BSP.NO.INACTIVITY.TIMEOUT T))
(GLOBALVARS \BSPSOCKETS \RFC.TIMEOUT \RTP.DALLY.TIMEOUT \RTP.DEFAULTTIMEOUT
\BSP.MAXPUPS \BSP.IDLETIMEOUT \BSP.OUTSTANDINGDATATIMEOUT \BSP.MAXPUPALLOC
\BSP.ALLOCHYSTERESIS \BSP.OVERLAP.DATA.WITH.ACK \BSP.INITIAL.MAXPUPALLOC
\BSP.INITIAL.ADATATIMEOUT \BSP.MIN.ADATA.TIMEOUT \BSP.MAX.ADATA.TIMEOUT
\BSP.INACTIVITY.TIMEOUT \BSP.NO.INACTIVITY.TIMEOUT))))
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
(DATATYPE BSPSOC ((FRNPORT WORD)
(FRNSOCKET FIXP) (* ; "Net,host,socket of partner")
(LCLPORT WORD)
(LCLSOCKET FIXP) (* ; "Net,host,socket of us")
(RTPSTATE BYTE) (* ;
"The current state of the RTP connection, see RTPSTATES")
(RTPPROCESS POINTER) (* ; "Process handle for RTP demon")
(RTPEVENT POINTER) (* ; "Notified when RTPSTATE changes")
(PUPSOC POINTER) (* ;
"The packet-level socket used by us")
(CONNID POINTER) (* ;
"A large integer, the connection ID")
(RTPTIMER POINTER) (* ;
"Timer used for timing out some RTP steps")
(RTPTIMEOUT WORD) (* ;
"Timeout for current RTP op, or zero if none")
(BSPINPUTHANDLER POINTER) (* ;
"Function that is the top-level loop of the watcher process")
(* ;; "The rest of this structure is dedicated to handling the BSP")
(BSPINPUTSTREAM POINTER) (* ; "Pointer back to STREAM object")
(BSPTIMER POINTER) (* ; "Timer for BSP use")
(BSPTIMEOUT WORD)
(BSPFAILUREREASON POINTER) (* ;
"Why connection was broken or not opened")
(BSPOTHERPUPFN POINTER) (* ;
"Called on error, interrupt and non-bsp pups")
(BSPERRORHANDLER POINTER) (* ; "Called for bsp errors")
(BSPIOTIMEOUT POINTER) (* ;
"if non-zero will cause prepare.output and prepare.input to timeout")
(RCVBYTEID POINTER) (* ; "ID of as far as we have acked")
(RCVINTERRUPTID POINTER) (* ; "ID of next incoming interrupt")
(BSPINPUTQ POINTER) (* ;
"Queue of all pups we have received")
(%#UNREADPUPS WORD) (* ;
"How many pups do we have before first hole in input")
(XMITBYTEID POINTER) (* ; "Id of next outgoing pup")
(XMITINTERRUPTID POINTER) (* ; "id of next outgoing interrupt")
(LASTACKID POINTER) (* ;
"Id of last ack, i.e. how far our partner has read us")
(%#UNACKEDPUPS WORD)
(%#UNACKEDBYTES WORD) (* ;
"how many pups/bytes have we sent that haven't been acked")
(BSPOUTPUTQ POINTER) (* ;
"Queue of sent but not acked pups")
(BYTESPERPUP WORD) (* ;
"Maximum size we are allowed to grow pups")
(PUPALLOC WORD) (* ;
"Remaining outgoing pup allocation, i.e. partner's allocation less #UNACKEDPUPS")
(BYTEALLOC WORD) (* ;
"Remaining outgoing byte allocation")
(MAXPUPALLOC WORD)
(PUPALLOCCOUNT WORD)
(ADATACOUNT WORD) (* ; "incremented once per AData sent")
(LASTADATATIME POINTER) (* ; "Time last ADATA was sent")
(ADATATIMEOUT WORD) (* ;
"Timeout currently in use for AData")
(INACTIVITYTIMER POINTER) (* ;
"Time of last incoming pup on this connection")
(LISTENING FLAG) (* ;
"if socket was opened as a server rather than user")
(INTERRUPTOUT FLAG) (* ;
"an unacked interrupt is outstanding")
(INTERRUPTIN FLAG) (* ; "an interrupt has been received")
(ACKPENDING FLAG) (* ;
"Adata was received, we need to ack")
(ACKREQUESTED FLAG) (* ;
"We have sent an Adata, are waiting for ack")
(SENTZEROALLOC FLAG) (* ; "Need to send gratuitous ack")
(BSPNOACTIVITY FLAG) (* ;
"True if BSPINACTIVITYTIMEOUT has passed with no sign of life from other side")
(BSPUSERSTATE POINTER) (* ;
"For applications use to do as it pleases")
(NIL WORD) (* ; "No longer used")
(IOTIMEOUTFN POINTER) (* ;
"function to be called when prepare.* timeout")
(BSPWHENCLOSEDFN POINTER) (* ;
"Called when connection is closed")
(BSPINPUTEVENT POINTER)
(BSPLOCK POINTER)
(BSPINITTIMER POINTER)
(BSPFAILURESTRING POINTER)
(BSPINACTIVITYTIMEOUT POINTER))
(BLOCKRECORD BSPSOC ((FRNNET BYTE)
(FRNHOST BYTE)
(FRNSOCKETHI WORD)
(FRNSOCKETLO WORD)
(LCLNET BYTE)
(LCLHOST BYTE)
(LCLSOCKETHI WORD)
(LCLSOCKETLO WORD)))
[ACCESSFNS BSPSOC ((FRNPUPADDRESS (CONS (fetch FRNPORT of DATUM)
(fetch FRNSOCKET of DATUM)))
(LCLPUPADDRESS (CONS (fetch LCLPORT of DATUM)
(fetch LCLSOCKET of DATUM]
(* ;; "Note: I assume record pkg does not break up the first six words (the two ports). I hope I don't have to force it")
RTPTIMER _ (CREATECELL \FIXP)
BSPTIMER _ (CREATECELL \FIXP)
INACTIVITYTIMER _ (CREATECELL \FIXP)
LASTADATATIME _ (CREATECELL \FIXP)
BSPINPUTQ _ (NCREATE 'SYSQUEUE)
BSPOUTPUTQ _ (NCREATE 'SYSQUEUE))
(BLOCKRECORD ACKPUP ((ACKBYTESPERPUP WORD)
(ACKPUPS WORD)
(ACKBYTES WORD)) (* ;
"body of ACK pup, giving partner's allocation")
)
(ACCESSFNS BSPSTREAM [(BSPSOC (fetch F1 of DATUM)
(replace F1 of DATUM with NEWVALUE))
(* ; "BSPSOC object")
(BSPOUTPUTSTREAM (fetch F2 of DATUM)
(replace F2 of DATUM with NEWVALUE))
(* ;
"If this stream is the input side, gives output side")
(BSPCURRENTPUP (fetch F3 of DATUM)
(replace F3 of DATUM with NEWVALUE))
(* ;
"PUP whose body is the current buffer. Could be redundant")
(MARKPENDING (fetch F4 of DATUM)
(replace F4 of DATUM with NEWVALUE))
(* ;
"On input, true if next byte is a mark")
(BSPFILEPTRHI (fetch FW6 of DATUM)
(replace FW6 of DATUM with NEWVALUE))
(BSPFILEPTRLO (fetch FW7 of DATUM)
(replace FW7 of DATUM with NEWVALUE))
(BSPFILEPTR (\MAKENUMBER (fetch BSPFILEPTRHI of DATUM)
(fetch BSPFILEPTRLO of DATUM))
(PROGN (replace BSPFILEPTRHI of DATUM
with (LRSH NEWVALUE BITSPERWORD))
(replace BSPFILEPTRLO of DATUM
with (LOGAND NEWVALUE MAX.SMALL.INTEGER])
)
(/DECLAREDATATYPE 'BSPSOC
'(WORD FIXP WORD FIXP BYTE POINTER POINTER POINTER POINTER POINTER WORD POINTER POINTER
POINTER WORD POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD POINTER
POINTER POINTER WORD WORD POINTER WORD WORD WORD WORD WORD WORD POINTER WORD POINTER
FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER WORD POINTER POINTER POINTER POINTER POINTER
POINTER POINTER)
'((BSPSOC 0 (BITS . 15))
(BSPSOC 1 FIXP)
(BSPSOC 3 (BITS . 15))
(BSPSOC 4 FIXP)
(BSPSOC 6 (BITS . 7))
(BSPSOC 8 POINTER)
(BSPSOC 10 POINTER)
(BSPSOC 12 POINTER)
(BSPSOC 14 POINTER)
(BSPSOC 16 POINTER)
(BSPSOC 7 (BITS . 15))
(BSPSOC 18 POINTER)
(BSPSOC 20 POINTER)
(BSPSOC 22 POINTER)
(BSPSOC 24 (BITS . 15))
(BSPSOC 26 POINTER)
(BSPSOC 28 POINTER)
(BSPSOC 30 POINTER)
(BSPSOC 32 POINTER)
(BSPSOC 34 POINTER)
(BSPSOC 36 POINTER)
(BSPSOC 38 POINTER)
(BSPSOC 25 (BITS . 15))
(BSPSOC 40 POINTER)
(BSPSOC 42 POINTER)
(BSPSOC 44 POINTER)
(BSPSOC 46 (BITS . 15))
(BSPSOC 47 (BITS . 15))
(BSPSOC 48 POINTER)
(BSPSOC 50 (BITS . 15))
(BSPSOC 51 (BITS . 15))
(BSPSOC 52 (BITS . 15))
(BSPSOC 53 (BITS . 15))
(BSPSOC 54 (BITS . 15))
(BSPSOC 55 (BITS . 15))
(BSPSOC 56 POINTER)
(BSPSOC 58 (BITS . 15))
(BSPSOC 60 POINTER)
(BSPSOC 60 (FLAGBITS . 0))
(BSPSOC 60 (FLAGBITS . 16))
(BSPSOC 60 (FLAGBITS . 32))
(BSPSOC 60 (FLAGBITS . 48))
(BSPSOC 59 (FLAGBITS . 0))
(BSPSOC 59 (FLAGBITS . 16))
(BSPSOC 59 (FLAGBITS . 32))
(BSPSOC 62 POINTER)
(BSPSOC 64 (BITS . 15))
(BSPSOC 66 POINTER)
(BSPSOC 68 POINTER)
(BSPSOC 70 POINTER)
(BSPSOC 72 POINTER)
(BSPSOC 74 POINTER)
(BSPSOC 76 POINTER)
(BSPSOC 78 POINTER))
'80)
(RPAQQ RTPSTATES ((\STATE.CLOSED 0)
(\STATE.SENTRFC 1)
(\STATE.LISTENING 2)
(\STATE.OPEN 3)
(\STATE.ENDRECEIVED 4)
(\STATE.ENDSENT 5)
(\STATE.DALLYING 6)
(\STATE.ABORTED 7)))
(DECLARE%: EVAL@COMPILE
(RPAQQ \STATE.CLOSED 0)
(RPAQQ \STATE.SENTRFC 1)
(RPAQQ \STATE.LISTENING 2)
(RPAQQ \STATE.OPEN 3)
(RPAQQ \STATE.ENDRECEIVED 4)
(RPAQQ \STATE.ENDSENT 5)
(RPAQQ \STATE.DALLYING 6)
(RPAQQ \STATE.ABORTED 7)
(CONSTANTS (\STATE.CLOSED 0)
(\STATE.SENTRFC 1)
(\STATE.LISTENING 2)
(\STATE.OPEN 3)
(\STATE.ENDRECEIVED 4)
(\STATE.ENDSENT 5)
(\STATE.DALLYING 6)
(\STATE.ABORTED 7))
)
(RPAQQ RTPEVENTS ((\EVENT.OPEN 0)
(\EVENT.OPENLISTENING 1)
(\EVENT.OPENIMMEDIATE 2)
(\EVENT.CLOSE 3)
(\EVENT.FORCECLOSE 4)
(\EVENT.RFC 5)
(\EVENT.ABORT 6)
(\EVENT.END 7)
(\EVENT.ENDREPLY 8)
(\EVENT.TIMEOUT 9)))
(DECLARE%: EVAL@COMPILE
(RPAQQ \EVENT.OPEN 0)
(RPAQQ \EVENT.OPENLISTENING 1)
(RPAQQ \EVENT.OPENIMMEDIATE 2)
(RPAQQ \EVENT.CLOSE 3)
(RPAQQ \EVENT.FORCECLOSE 4)
(RPAQQ \EVENT.RFC 5)
(RPAQQ \EVENT.ABORT 6)
(RPAQQ \EVENT.END 7)
(RPAQQ \EVENT.ENDREPLY 8)
(RPAQQ \EVENT.TIMEOUT 9)
(CONSTANTS (\EVENT.OPEN 0)
(\EVENT.OPENLISTENING 1)
(\EVENT.OPENIMMEDIATE 2)
(\EVENT.CLOSE 3)
(\EVENT.FORCECLOSE 4)
(\EVENT.RFC 5)
(\EVENT.ABORT 6)
(\EVENT.END 7)
(\EVENT.ENDREPLY 8)
(\EVENT.TIMEOUT 9))
)
(DECLARE%: EVAL@COMPILE
(RPAQQ WORDSPERPORT 3)
(CONSTANTS (WORDSPERPORT 3))
)
(DECLARE%: EVAL@COMPILE
[PUTPROPS RTP.OTHERFN MACRO ((PUP SOCKET)
(SELECTQ (fetch OTHERPUPFN of SOCKET)
(RELEASE.PUP (RELEASE.PUP PUP))
(\BSP.PUPHANDLER
(\BSP.PUPHANDLER PUP SOCKET))
(APPLY* (fetch OTHERPUPFN of SOCKET)
PUP SOCKET]
[PUTPROPS BSP.OTHERFN MACRO ((PUP SOCKET)
(SELECTQ (fetch BSPOTHERPUPFN of SOCKET)
(RELEASE.PUP (RELEASE.PUP PUP))
(APPLY* (fetch BSPOTHERPUPFN of SOCKET)
PUP
(fetch BSPINPUTSTREAM of SOCKET]
(PUTPROPS BSP.INPUT.ERROR MACRO (OPENLAMBDA (STREAM ERRCODE)
(APPLY* (fetch BSPERRORHANDLER
of (fetch BSPSOC of STREAM))
STREAM ERRCODE)))
(PUTPROPS BSP.OUTPUT.ERROR MACRO (OPENLAMBDA (STREAM ERRCODE)
(APPLY* (fetch BSPERRORHANDLER
of (fetch BSPSOC of STREAM))
STREAM ERRCODE)))
[PUTPROPS \BSPINCFILEPTR MACRO ((STREAM N)
(PROG (NEWLO)
(replace BSPFILEPTRLO of STREAM
with (COND
((IGREATERP (SETQ NEWLO
(IPLUS (fetch BSPFILEPTRLO
of STREAM)
N))
MAX.SMALL.INTEGER)
(add (fetch BSPFILEPTRHI of STREAM)
1)
(SUB1 (IDIFFERENCE NEWLO MAX.SMALL.INTEGER)))
(T NEWLO]
)
)
(* ; "User-level RTP socket manipulation")
(DEFINEQ
(OPENRTPSOCKET
[LAMBDA (FRNPORT MODE PUPSOC CONNID TIMEOUT FAILURESTRING)
(* bvm%: " 6-Oct-86 11:42")
(* ;;; "Open an RTP socket in given MODE, talking to FRNPORT. If mode is or contains USER, we set up a user RTP, sending an RFC to FRNPORT, with initial connection id CONNID (default is chosen at random). If mode is or contains SERVER, we merely listen for an RFC from somewhere, and FRNPORT and CONNID are ignored. If MODE is or contains RETURN, we don't wait around, but return immediately; caller is assumed to be monitoring the state of the connection. In the case where we wait, TIMEOUT is how long we will wait (msecs) before giving up and returning NIL. On success, we return a new BSPSOC. PUPSOC is a packet-level socket opened for the connection by the caller; if omitted, one is created. If MODE is NIL, we open a USER connection and wait for it to succeed.")
(RESETLST
[PROG (SOCKET INITSTATE SOCKET#)
[COND
(FRNPORT (SETQ FRNPORT (ETHERPORT FRNPORT T]
[COND
[(NULL PUPSOC)
(SETQ SOCKET# (PUPSOCKETNUMBER (SETQ PUPSOC (OPENPUPSOCKET]
[(FIXP PUPSOC)
(SETQ PUPSOC (OPENPUPSOCKET (SETQ SOCKET# PUPSOC]
(T (SETQ SOCKET# (PUPSOCKETNUMBER (\DTEST PUPSOC 'PUPSOCKET]
(SETQ SOCKET (create BSPSOC
RTPSTATE _ \STATE.CLOSED
CONNID _ (OR CONNID (RAND 0 16384))
BSPINPUTHANDLER _ (FUNCTION \RTP.HANDLE.INPUT)
BSPOTHERPUPFN _ (FUNCTION RELEASE.PUP)
PUPSOC _ PUPSOC
LCLPORT _ (\LOCALPUPADDRESS)
LCLSOCKET _ SOCKET#
BSPFAILURESTRING _ FAILURESTRING))
(\INIT.RTPPROCESS SOCKET) (* ;
"set up a process to monitor this socket")
(push \BSPSOCKETS SOCKET)
[COND
(FRNPORT (replace FRNPORT of SOCKET with (CAR FRNPORT))
(replace FRNSOCKET of SOCKET with (CDR FRNPORT]
(COND
((NOT MODE)
(SETQQ MODE USER)))
(OBTAIN.MONITORLOCK (fetch BSPLOCK of SOCKET)
NIL T)
[RESETSAVE (PROGN SOCKET)
'(AND RESETSTATE (CLOSERTPSOCKET OLDVALUE 0]
(COND
[(EQMEMB 'USER MODE)
(COND
((NOT FRNPORT)
(ERROR "No foreign port specified")))
(\RTP.ACTION SOCKET \EVENT.OPEN) (* ; "Open the connection (send RFC)")
(COND
((EQMEMB 'RETURN MODE)
(RETURN SOCKET]
[(EQMEMB 'SERVER MODE)
(replace LISTENING of SOCKET with T)
(\RTP.ACTION SOCKET \EVENT.OPENLISTENING)
(COND
((EQMEMB 'RETURN MODE)
(RETURN SOCKET]
((EQ MODE 'RETURN) (* ;
"Caller just wants to create this thing, putting it immediately open")
(\RTP.ACTION SOCKET \EVENT.OPENIMMEDIATE)
(RETURN SOCKET))
(T (\ILLEGAL.ARG MODE)))
(SETQ INITSTATE (fetch RTPSTATE of SOCKET))
[COND
((NEQ TIMEOUT T)
(replace BSPINITTIMER of SOCKET with (SETUPTIMER (OR TIMEOUT
\RTP.DEFAULTTIMEOUT
]
(until (NEQ (fetch RTPSTATE of SOCKET)
INITSTATE) do (MONITOR.AWAIT.EVENT (fetch BSPLOCK of SOCKET
)
(fetch RTPEVENT of SOCKET)))
(* ; "Wait for transaction to happen")
(RETURN (COND
((OR (EQ (fetch RTPSTATE of SOCKET)
\STATE.OPEN)
(EQ (fetch RTPSTATE of SOCKET)
\STATE.ENDRECEIVED)) (* ; "Socket has been opened ok")
SOCKET)
(T (* ; "Give up, flush everything")
(CLOSERTPSOCKET SOCKET 0)
(COND
(FAILURESTRING (\RTP.SHOW.FAILURE SOCKET NIL "No Response")))
(AND (EQ FAILURESTRING 'RETURN)
(fetch BSPFAILUREREASON of SOCKET])])
(CLOSERTPSOCKET
[LAMBDA (SOCKET TIMEOUT DONTSEND) (* bvm%: "29-Mar-85 21:23")
(* ;;; "Close given RTP socket. This sends the normal end sequence if appropriate. TIMEOUT is how long we will wait for the end to complete normally. Value returned is true if the socket was closed normally, NIL if aborted. In either case, SOCKET goes away")
(PROG (SUCCESS)
(WITH.MONITOR (fetch BSPLOCK of SOCKET)
(COND
((NEQ TIMEOUT 0) (* ;
"Is zero to force a bad connection closed immediately")
(replace BSPINITTIMER of SOCKET with (SETUPTIMER (OR TIMEOUT
\RTP.DEFAULTTIMEOUT
)))
(\RTP.ACTION SOCKET \EVENT.CLOSE)
(until (COND
((SETQ SUCCESS (EQ (fetch RTPSTATE of SOCKET)
\STATE.CLOSED))
T)
((EQ (fetch RTPSTATE of SOCKET)
\STATE.ABORTED)
(\RTP.ACTION SOCKET \EVENT.FORCECLOSE)
T)) do (* ; "wait for end handshake")
(MONITOR.AWAIT.EVENT (fetch BSPLOCK of SOCKET)
(fetch RTPEVENT of SOCKET)
\RTP.DEFAULTTIMEOUT)))
(T (\RTP.ACTION SOCKET \EVENT.FORCECLOSE))))
(DEL.PROCESS (PROG1 (fetch RTPPROCESS of SOCKET)
(replace RTPPROCESS of SOCKET with NIL)))
(* ;
"Deleting the process performs any other cleanup needed, such as flushing the PUPSOCKET underneath")
(RETURN SUCCESS])
(\INIT.RTPPROCESS
[LAMBDA (SOCKET) (* bvm%: "29-Mar-85 21:42")
(* ;;; "Creates a process to handle RTP connection on this socket")
(PROG ((PROC (ADD.PROCESS (LIST (FUNCTION \RTP.SOCKET.PROCESS)
(KWOTE SOCKET))
'NAME
'RTP
'RESTARTABLE
'NO))
NAME)
(replace RTPPROCESS of SOCKET with PROC)
[replace RTPEVENT of SOCKET with (CREATE.EVENT (SETQ NAME (PROCESS.NAME PROC]
(replace BSPLOCK of SOCKET with (CREATE.MONITORLOCK NAME])
)
(* ; "RTP process")
(DEFINEQ
(\RTP.SOCKET.PROCESS
[LAMBDA (BSPSOCKET) (* bvm%: "29-Mar-85 21:43")
(DECLARE (SPECVARS BSPSOCKET)) (* ;
"BSPSOCKET is for use by PPSOC in our INFO hook")
(* ;;; "This is the process that monitors the state of the RTP connection on BSPSOCKET. This better get run periodically")
(PROG NIL
(OBTAIN.MONITORLOCK (fetch BSPLOCK of BSPSOCKET)
NIL T)
(RESETSAVE NIL (LIST (FUNCTION \RTP.CLEANUP)
BSPSOCKET))
(PROCESSPROP (THIS.PROCESS)
'INFOHOOK
(FUNCTION \RTP.INFO.HOOK))
LP (SPREADAPPLY* (fetch BSPINPUTHANDLER of BSPSOCKET)
BSPSOCKET)
(GO LP])
(\RTP.HANDLE.INPUT
[LAMBDA (BSPSOCKET) (* bvm%: "29-Mar-85 14:19")
(* ;;; "Top-level of RTP process while connection is being opened")
(LET ((PUPSOC (fetch PUPSOC of BSPSOCKET))
PUP TIMER)
(COND
((SETQ PUP (GETPUP PUPSOC)) (* ; "play with incoming pup")
(\RTP.HANDLE.PUP PUP BSPSOCKET)
(BLOCK))
(T (MONITOR.AWAIT.EVENT (fetch BSPLOCK of BSPSOCKET)
(PUPSOCKETEVENT PUPSOC)
[SETQ TIMER (COND
((NEQ (fetch RTPTIMEOUT of BSPSOCKET)
0)
(fetch RTPTIMER of BSPSOCKET]
(AND TIMER T))
(COND
((AND TIMER (TIMEREXPIRED? TIMER))
(\RTP.ACTION BSPSOCKET \EVENT.TIMEOUT])
(\RTP.HANDLE.PUP
[LAMBDA (PUP BSPSOCKET) (* bvm%: "29-Mar-85 21:31")
(* ;;; "Handles incoming PUP on an RTP connection")
(SELECTC (fetch PUPTYPE of PUP)
(\PT.RFC (\RTP.HANDLE.RFC BSPSOCKET PUP)
(SETQ PUP NIL))
(\PT.END (COND
((\RTP.FILTER BSPSOCKET PUP T T)
(\RTP.ACTION BSPSOCKET \EVENT.END PUP))))
(\PT.ENDREPLY (COND
((\RTP.FILTER BSPSOCKET PUP T T)
(\RTP.ACTION BSPSOCKET \EVENT.ENDREPLY PUP))))
(\PT.ABORT [COND
((\RTP.FILTER BSPSOCKET PUP T T)
(\RTP.ACTION BSPSOCKET \EVENT.ABORT PUP)
(\RTP.SHOW.FAILURE BSPSOCKET PUP (CONCAT "[Abort] " (GETPUPSTRING PUP
BYTESPERWORD])
(\PT.ERROR (COND
((AND (EQ (fetch ERRORPUPCODE of PUP)
\PUPE.NOSOCKET)
(\RTP.FILTER BSPSOCKET PUP T NIL))
(* ; "Treat type 2 errors as abort")
(\RTP.ACTION BSPSOCKET \EVENT.ABORT PUP)
(\RTP.SHOW.FAILURE BSPSOCKET PUP "No Such Socket"))))
(PROGN (BSP.OTHERFN PUP BSPSOCKET)
(SETQ PUP NIL)))
(AND PUP (RELEASE.PUP PUP])
(\RTP.HANDLE.RFC
[LAMBDA (BSPSOCKET PUP) (* bvm%: "29-Mar-85 12:52")
(* ;; "RFC received. This may be either an initiating RFC (if we are listening) or an answering RFC (if we have sent out an initiating RFC of our own)")
(LET ((DATA (fetch PUPCONTENTS of PUP)))
[COND
((EQ (fetch (PORT NET) of DATA)
0) (* ;
"Sender didn't know its own net number, but we know it now")
(replace (PORT NET) of DATA with (fetch PUPSOURCENET of PUP]
(COND
((SELECTC (fetch RTPSTATE of BSPSOCKET)
(\STATE.LISTENING (* ; "Accept all but broadcast pups")
(NEQ (fetch PUPDESTHOST of PUP)
0))
(\STATE.SENTRFC (* ; "Must match the RFC we sent out")
(\RTP.FILTER BSPSOCKET PUP T T))
((LIST \STATE.OPEN \STATE.ENDSENT) (* ;
"probably a duplicate. Make sure it matches the connection we think we have open")
(AND (\RTP.FILTER BSPSOCKET PUP NIL T)
(EQ (fetch (PORT NETHOST) of DATA)
(fetch FRNPORT of BSPSOCKET))
(EQ (fetch (PORT SOCKETHI) of DATA)
(fetch FRNSOCKETHI of BSPSOCKET))
(EQ (fetch (PORT SOCKETLO) of DATA)
(fetch FRNSOCKETLO of BSPSOCKET))))
NIL)
(\RTP.ACTION BSPSOCKET \EVENT.RFC PUP))
(T (* ;
"Bad RFC. Send an Abort in reply")
(SWAPPUPPORTS PUP)
(replace PUPLENGTH of PUP with (IPLUS \PUPOVLEN BYTESPERWORD))
(\PUTBASE DATA 0 0)
(PUTPUPSTRING PUP "RFC refused") (* ; "explanatory string")
(replace TYPEWORD of PUP with \PT.ABORT)
(replace EPREQUEUE of PUP with 'FREE)
(SENDPUP (fetch PUPSOC of BSPSOCKET)
PUP])
(\RTP.CLEANUP
[LAMBDA (SOCKET) (* bvm%: "14-JUN-83 14:48")
(* ;; "Cleanup called when the RTP process on this socket is deleted. CLOSERTPSOCKET may or may not have been called yet, so send an abort if socket isn't closed yet")
(SETQ \BSPSOCKETS (DREMOVE SOCKET \BSPSOCKETS))
(\RTP.ACTION SOCKET \EVENT.FORCECLOSE)
(* ;; "May have been flushed already if the socket was aborted and then timed out, so call CLOSEPUPSOCKET with NOERRORFLG T")
(CLOSEPUPSOCKET (fetch PUPSOC of SOCKET)
T)
[PROG ((FN (fetch BSPWHENCLOSEDFN of SOCKET)))
(AND FN (APPLY* FN (OR (fetch BSPINPUTSTREAM of SOCKET)
SOCKET]
(\BSP.FLUSH.SOCKET.QUEUES SOCKET)
(replace BSPUSERSTATE of SOCKET with NIL) (* ;
"Explicitly delete to avoid problem of circular structures not being collected")
(replace BSPINPUTSTREAM of SOCKET with NIL])
(\RTP.ACTION
[LAMBDA (SOCKET EVENT PUP) (* bvm%: " 8-Mar-84 17:52")
(* ;;; "Runs the RTP 'finite state machine' according to EVENT, one of several things one might want to do to an RTP socket, either intentionally or because of an arrived pup. In the latter case, PUP is also supplied. Performs the indicated event, changing state if appropriate and setting timeouts if appropriate")
(PROG ((STATE (fetch RTPSTATE of SOCKET))
NEWSTATE TIMEOUT STREAM)
(SELECTC EVENT
(\EVENT.OPEN (* ;
"Normal opening of a user connection. Send RFC")
(COND
((NEQ STATE \STATE.CLOSED)
(\RTP.ERROR SOCKET EVENT))
(T (\SEND.RFC SOCKET)
(SETQ NEWSTATE \STATE.SENTRFC))))
(\EVENT.OPENLISTENING (* ;
"Nothing to do, just prepare to listen for an RFC")
(COND
((NEQ STATE \STATE.CLOSED)
(\RTP.ERROR SOCKET EVENT))
(T (SETQ NEWSTATE \STATE.LISTENING))))
(\EVENT.OPENIMMEDIATE (* ;
"Assume RFC done, just put in open state")
(COND
((NEQ STATE \STATE.CLOSED)
(\RTP.ERROR SOCKET EVENT))
(T (SETQ NEWSTATE \STATE.OPEN))))
(\EVENT.CLOSE (* ;
"Try to close connection. Several cases")
(SETQ NEWSTATE (SELECTC STATE
(\STATE.SENTRFC
(* ;
"Tried to open the connection, now giving up")
(\SEND.ABORT SOCKET)
\STATE.ABORTED)
(\STATE.OPEN (* ; "Normal case, send an END")
(\SEND.END SOCKET)
\STATE.ENDSENT)
(\STATE.ENDRECEIVED
(* ;
"Other guy decided to END, too, so forget what we were trying to do and just reply to this END")
(\SEND.ENDREPLY SOCKET)
\STATE.DALLYING)
STATE)))
(\EVENT.FORCECLOSE (* ; "If open, abort")
(SELECTC STATE
((LIST \STATE.SENTRFC \STATE.OPEN \STATE.ENDRECEIVED \STATE.ENDSENT)
(\SEND.ABORT SOCKET))
NIL)
(SETQ NEWSTATE \STATE.ABORTED))
(\EVENT.RFC (* ; "Received an RFC")
(SELECTC STATE
(\STATE.SENTRFC (* ;
"This is the answering RFC. Its body contains the port we should talk to after this")
(\BLT (LOCF (fetch FRNPORT of SOCKET))
(fetch PUPCONTENTS of PUP)
WORDSPERPORT)
(SETQ NEWSTATE \STATE.OPEN))
((LIST \STATE.LISTENING \STATE.OPEN \STATE.ENDSENT)
(* ;
"we were listening for someone, and this is their opening RFC, or possibly a duplicate")
[COND
((fetch LISTENING of SOCKET)
(\SEND.ANSWERING.RFC SOCKET PUP)
(COND
((EQ STATE \STATE.LISTENING)
(SETQ NEWSTATE \STATE.OPEN])
(\RTP.ERROR SOCKET EVENT PUP)))
(\EVENT.ABORT (* ; "Received an ABORT pup")
(SELECTC STATE
((LIST \STATE.CLOSED \STATE.LISTENING)
(* ; "Shouldn't happen")
(\RTP.ERROR SOCKET EVENT PUP))
NIL)
(SETQ NEWSTATE \STATE.ABORTED))
(\EVENT.END (* ; "Received END")
(SELECTC STATE
((LIST \STATE.OPEN \STATE.ENDRECEIVED)
(* ;
"Note that we have received the end, but don't do anything until our user decides to accept the END")
(SETQ STREAM (fetch BSPINPUTSTREAM of SOCKET))
(SETQ NEWSTATE (COND
([OR (AND (fetch BSPCURRENTPUP of STREAM
)
(ILESSP (fetch COFFSET
of STREAM)
(fetch CBUFSIZE
of STREAM)))
(IGREATERP (fetch %#UNREADPUPS
of SOCKET)
(COND
((fetch BSPCURRENTPUP
of STREAM)
1)
(T 0]
(* ;
"There is still input waiting to be read, so can't end just yet")
\STATE.ENDRECEIVED)
(T (* ; "Okay, we're ready to end")
(\SEND.ENDREPLY SOCKET)
\STATE.DALLYING))))
((LIST \STATE.ENDSENT \STATE.DALLYING)
(* ;
"We've already sent an END, but other guy wants to end. Obey.")
(\SEND.ENDREPLY SOCKET)
(SETQ NEWSTATE \STATE.DALLYING))
(\RTP.ERROR SOCKET EVENT PUP)))
(\EVENT.ENDREPLY (* ; "Received ENDREPLY")
(SELECTC STATE
(\STATE.ENDSENT (* ;
"This is the reply to our END. Echo ENDREPLY so partner can stop dallying")
(\SEND.ENDREPLY SOCKET)
(SETQ NEWSTATE \STATE.CLOSED))
(\STATE.DALLYING (* ;
"We send ENDREPLY to partner's END. This is the echoing ENDREPLY, so everything is cool")
(SETQ NEWSTATE \STATE.CLOSED))
(\RTP.ERROR SOCKET EVENT PUP)))
(\EVENT.TIMEOUT (* ;
"RTPTIMER expired, probably want to retransmit something")
(* ;
"Might be nice, perhaps, if we kept copies of these pups that we might want to retransmit")
(COND
((EQ STATE \STATE.DALLYING)
(SETQ NEWSTATE \STATE.CLOSED))
((AND (fetch BSPINITTIMER of SOCKET)
(TIMEREXPIRED? (fetch BSPINITTIMER of SOCKET)))
(\SEND.ABORT SOCKET)
(SETQ NEWSTATE \STATE.CLOSED)
(replace BSPINITTIMER of SOCKET with NIL))
(T (SELECTC STATE
(\STATE.SENTRFC
(\SEND.RFC SOCKET))
(\STATE.ENDSENT
(\SEND.END SOCKET))
NIL))))
(ERROR "Unknown RTP event" EVENT))
[COND
(NEWSTATE (replace RTPSTATE of SOCKET with (SETQ STATE NEWSTATE))
(NOTIFY.EVENT (fetch RTPEVENT of SOCKET))
(AND (fetch BSPINPUTEVENT of SOCKET)
(NOTIFY.EVENT (fetch BSPINPUTEVENT of SOCKET]
(SELECTC STATE
((LIST \STATE.SENTRFC \STATE.ENDSENT \STATE.DALLYING)
(SETUPTIMER (SETQ TIMEOUT (COND
((EQ STATE \STATE.DALLYING)
\RTP.DALLY.TIMEOUT)
(T \RFC.TIMEOUT)))
(fetch RTPTIMER of SOCKET))
(replace RTPTIMEOUT of SOCKET with TIMEOUT))
(replace RTPTIMEOUT of SOCKET with 0])
(\RTP.ERROR
[LAMBDA (SOCKET EVENT FOREIGNPUP) (* bvm%: " 8-Mar-84 17:52")
(COND
(PUPTRACEFLG (PRIN1 "[Unexpected RTP event " PUPTRACEFILE)
(PRINTCONSTANT EVENT RTPEVENTS PUPTRACEFILE "\EVENT.")
(PRIN1 " when in state " PUPTRACEFILE)
(PRINTCONSTANT (fetch RTPSTATE of SOCKET)
RTPSTATES PUPTRACEFILE "\STATE.")
(PRIN1 "]
" PUPTRACEFILE])
(\RTP.SHOW.FAILURE
[LAMBDA (SOCKET PUP REASON) (* bvm%: "29-Mar-85 21:38")
(LET ((FAILURESTRING (fetch BSPFAILURESTRING of SOCKET)))
(COND
((NEQ FAILURESTRING T) (* ;
"Only if we haven't done this already")
(COND
((NEQ FAILURESTRING 'RETURN) (* ;
"RETURN means caller wants to see it, not user")
[COND
(PUP (printout PROMPTWINDOW T "From " (ETHERHOSTNAME (fetch PUPSOURCE
of PUP)
T)))
(T (printout PROMPTWINDOW T (ETHERHOSTNAME (fetch FRNPORT of SOCKET)
T]
(PRIN1 ": " PROMPTWINDOW)
(COND
(FAILURESTRING (printout PROMPTWINDOW FAILURESTRING " because: ")))
(PRIN1 REASON PROMPTWINDOW)))
(replace BSPFAILURESTRING of SOCKET with T)
(* ; "Don't do this again")
(replace BSPFAILUREREASON of SOCKET with REASON])
(\RTP.FILTER
[LAMBDA (SOCKET PUP CHECKFRNPORT CHECKID) (* bvm%: "29-Mar-85 21:25")
(* ;; "True if PUP is a valid RTP pup for this socket, checking frnport and/or id as indicated")
(AND (NEQ (fetch PUPDESTHOST of PUP)
0)
[OR (NOT CHECKFRNPORT)
(PROGN [COND
((EQ (fetch (BSPSOC FRNNET) of SOCKET)
0) (* ;
"We didn't know the local net when we opened the socket; perhaps we do now")
(replace (BSPSOC FRNNET) of SOCKET with (fetch PUPDESTNET
of PUP]
(AND (EQ (fetch PUPSOURCE of PUP)
(fetch (BSPSOC FRNPORT) of SOCKET))
(EQ (fetch PUPSOURCESOCKETHI of PUP)
(fetch (BSPSOC FRNSOCKETHI) of SOCKET))
(EQ (fetch PUPSOURCESOCKETLO of PUP)
(fetch (BSPSOC FRNSOCKETLO) of SOCKET]
(OR (NOT CHECKID)
(AND (EQ (fetch PUPIDHI of PUP)
(\HINUM (fetch CONNID of SOCKET)))
(EQ (fetch PUPIDLO of PUP)
(\LONUM (fetch CONNID of SOCKET])
(\SEND.ABORT
[LAMBDA (SOCKET) (* bvm%: " 8-Mar-84 17:52")
(PROG ((PUP (ALLOCATE.PUP)))
(\FILLRTPPUP SOCKET PUP \PT.ABORT (IPLUS BYTESPERWORD \PUPOVLEN))
(* ;
"Length counts the abort code word")
(\PUTBASE (fetch PUPCONTENTS of PUP)
0 0) (* ; "Abort code")
(PUTPUPSTRING PUP (COND
((EQ (fetch RTPSTATE of SOCKET)
\STATE.SENTRFC)
"Connection attempt aborted")
(T "Connection aborted"))) (* ; "Explanatory string")
(SENDPUP (fetch PUPSOC of SOCKET)
PUP])
(\SEND.ANSWERING.RFC
[LAMBDA (SOCKET IPUP) (* bvm%: " 8-Mar-84 17:52")
(* ;;; "sends an RFC in response to the RFC in IPUP. The connection port we send is self, since we can only support one connection in this model")
(PROG ((OPUP (ALLOCATE.PUP)))
(COND
((EQ (fetch RTPSTATE of SOCKET)
\STATE.LISTENING)
(* ;; "We were waiting for this. If not, this is a duplicate RFC and we just throw it away after retransmitting the answering RFC")
(replace CONNID of SOCKET with (fetch PUPID of IPUP))
(\BLT (LOCF (fetch FRNPORT of SOCKET))
(fetch PUPCONTENTS of IPUP)
WORDSPERPORT) (* ;
"Set foreign connection port for this connection. Our LCLPORT should already be correct")
))
(\FILLRTPPUP SOCKET OPUP \PT.RFC (IPLUS (UNFOLD WORDSPERPORT BYTESPERWORD)
\PUPOVLEN))
(\BLT (LOCF (fetch DEST of OPUP))
(LOCF (fetch SOURCE of IPUP))
WORDSPERPORT) (* ;
"Send this pup to the port by which IPUP arrived, not by the RTP connection port")
(\BLT (fetch PUPCONTENTS of OPUP)
(LOCF (fetch LCLPORT of SOCKET))
WORDSPERPORT) (* ; "Our connection port is self")
(replace EPREQUEUE of OPUP with 'FREE)
(SENDPUP (fetch PUPSOC of SOCKET)
OPUP])
(\SEND.END
[LAMBDA (SOCKET) (* bvm%: " 8-FEB-83 18:22")
(SENDPUP (fetch PUPSOC of SOCKET)
(\FILLRTPPUP SOCKET NIL \PT.END \PUPOVLEN])
(\SEND.ENDREPLY
[LAMBDA (SOCKET) (* bvm%: " 8-FEB-83 18:23")
(SENDPUP (fetch PUPSOC of SOCKET)
(\FILLRTPPUP SOCKET NIL \PT.ENDREPLY \PUPOVLEN])
(\SEND.RFC
[LAMBDA (SOCKET) (* bvm%: "25-Aug-84 23:08")
(* ;;; "Sends an initiating RFC on SOCKET")
(PROG ((PUP (ALLOCATE.PUP)))
(replace PUPLENGTH of PUP with (OR (IPLUS (UNFOLD WORDSPERPORT BYTESPERWORD)
\PUPOVLEN)
\PUPOVLEN))
(replace PUPTYPE of PUP with \PT.RFC)
(replace PUPID of PUP with (fetch CONNID of SOCKET))
(\BLT (LOCF (fetch PUPDEST of PUP))
(LOCF (fetch FRNPORT of SOCKET))
(TIMES 2 WORDSPERPORT))
(replace PUPSOURCE of PUP with 0)
(if (\ROUTE.PUP PUP)
then (* ;
"Find out what net it will send on, then make that our local port")
(replace LCLPORT of SOCKET with (fetch PUPSOURCE of PUP)))
(\BLT (fetch PUPCONTENTS of PUP)
(LOCF (fetch LCLPORT of SOCKET))
WORDSPERPORT) (* ; "Connection port = self")
(SENDPUP (fetch PUPSOC of SOCKET)
PUP])
(\FILLRTPPUP
[LAMBDA (SOCKET PUP TYPE LENGTH) (* bvm%: " 8-FEB-83 18:21")
(* ;;; "Fills in an RTP pup for SOCKET. TYPE is the pup type, LENGTH its length. We fill in also the ID (connection ID) and local and foreign ports (from socket)")
(OR PUP (SETQ PUP (ALLOCATE.PUP)))
(replace PUPLENGTH of PUP with (OR LENGTH \PUPOVLEN))
(replace TYPEWORD of PUP with TYPE) (* ;
"Clears TCONTROL while setting TYPE")
(replace PUPID of PUP with (fetch CONNID of SOCKET))
(\SETRTPPORTS SOCKET PUP)
PUP])
(\SETRTPPORTS
[LAMBDA (SOCKET PUP) (* bvm%: " 2-NOV-83 14:33")
(* ;
"Fill in both Frn and lcl ports in one move")
(\BLT (LOCF (fetch DEST of PUP))