mirror of
https://github.com/PDP-10/its.git
synced 2026-01-28 21:01:16 +00:00
329 lines
11 KiB
Plaintext
Executable File
329 lines
11 KiB
Plaintext
Executable File
;-*-MIDAS-*-
|
||
|
||
TITLE LISP CHAOS NETWORK SUPPORT PACKAGE
|
||
|
||
;;; This is the low-level chaos-net handling package for LISP.
|
||
;;; All functions in this file are prefixed with %CHAOS-
|
||
;;; A CHAOS net connection data structure is a cons containing
|
||
;;; an input file array and an output file array open on the CHAOS device.
|
||
|
||
;;; Note: packet buffers are allocated specially as GC protected arrays
|
||
;;; to allow interrupts while in a PKTIOT call.
|
||
|
||
;;; TODO: Make %CHAOS-ALLOCATE-BUFFER more clever for subsequent allocations
|
||
;;; Fix up OPEN and CLOSE routines
|
||
|
||
;;; Insert CHAOS network definitions and FASL defs.
|
||
|
||
IF1, .INSRT SYSTEM;CHSDEF >
|
||
IF1, .INSRT LISP;.FASL DEFS
|
||
.FASL
|
||
|
||
VERPRT LCHNSP
|
||
|
||
; note: this form of syscal does not allow LH stuff in last arg, e.g. indirect bit, etc.
|
||
DEFINE SYSCAL NAME,ARGS
|
||
.CALL [SETZ ? SIXBIT/NAME/ ? ARGS ((SETZ))]
|
||
.LOSE 1000
|
||
TERMIN
|
||
|
||
;;; (%CHAOS-OPEN-CHANNELS <receive-window-size>)
|
||
;;; Creates the a pair of file arrays, returns a cons of them, and
|
||
;;; a CHAOS connection is created in the ITS NCP by a call to CHAOSO.
|
||
;;; <receive-window-size> is optional and defaults to the value of
|
||
;;; CHAOS-DEFAULT-RECEIVE-WINDOW.
|
||
;;; Note: this cons must be saved to protect the file arrays from GC.
|
||
|
||
;.SXEVAL (SETQ CHAOS-DEFAULT-RECEIVE-WINDOW 5.)
|
||
|
||
.ENTRY %CHAOS-OPEN-CHANNELS LSUBR 001002 ;lsubr 0 or 1 arg
|
||
SKIPE T ;if no args, use the default
|
||
SKIPA TT,@(P) ;pick up arg 1
|
||
MOVE TT,@.SPECIAL CHAOS-DEFAULT-RECEIVE-WINDOW
|
||
ADD P,T ;clean up the pdl
|
||
PUSH FXP,TT ;save window size on the fxpdl
|
||
MOVE TT,[SIXBIT /CHAOS/] ;get a file array on the CHAOS device
|
||
PUSHJ P,ALFILE ;allocate a channel
|
||
JRST OPNLOS ;couldn't get it
|
||
PUSH P,A ;save this file array
|
||
MOVE TT,[SIXBIT /CHAOS/] ;get another file array on the CHAOS device
|
||
PUSHJ P,ALFILE ;allocate again
|
||
JRST OPNLO1 ;couldn't
|
||
HLLZ TT,TTSAR(A) ;pick up the LH of the TTSAR
|
||
TLO TT,TTS.IO ;set the output bit
|
||
HLLM TT,TTSAR(A) ;store it
|
||
MOVE B,A ;save the output array in B
|
||
POP P,A ;get back the input array into A
|
||
POP FXP,R ;get the receive window size in R
|
||
MOVEI TT,F.CHAN ;index into the file array channel number slot
|
||
SYSCAL CHAOSO,[ @TTSAR(A) ? @TTSAR(B) ? R] ; in, out, rcv window
|
||
JCALL 2,.FUNCTION CONS ;return a cons of the file arrays
|
||
|
||
OPNLO1: POP P,A
|
||
OPNLOS: POP FXP,TT
|
||
SETZ A,
|
||
POPJ P,
|
||
|
||
;;; (%CHAOS-CLOSE-CHANNELS <connection>)
|
||
;;; Takes a cons which is a connection as returned by %CHAOS-OPEN-CHANNELS.
|
||
;;; Forces output and closes the channels, but does not send a CLS packet
|
||
;;; (do this first if the connection should be closed cleanly).
|
||
;;; Note: this routine has to be fixed up to allow LISP I/O to work.
|
||
|
||
.ENTRY %CHAOS-CLOSE-CHANNELS SUBR 0002 ;subr 1 arg
|
||
MOVEI TT,F.CHAN ;index into the file array channel slot
|
||
HRRZ B,(A) ;B gets the CDR (output file array)
|
||
HLRZ A,(A) ;A gets the CAR (input file array)
|
||
.CALL [ SETZ ? 'FINISH ? SETZ @TTSAR(B) ] ;force out any queued packets
|
||
JFCL ;no-op if this fails (connection was closed)
|
||
.CALL [ SETZ ? SIXBIT/CLOSE/ ? SETZ @TTSAR(A) ]
|
||
JFCL
|
||
.CALL [ SETZ ? SIXBIT/CLOSE/ ? SETZ @TTSAR(B) ]
|
||
JFCL
|
||
; should we bother to turn on the close bit in the file arrays? so channels get reused
|
||
POPJ P,
|
||
|
||
;;; (%CHAOS-EOF <connection>)
|
||
;;; Sends a %COEOF packet.
|
||
|
||
.ENTRY %CHAOS-EOF SUBR 0002 ;subr of 1 arg
|
||
MOVE TT,.SPECIAL CHAOS-INTERNAL-PKT-BUFFER ;pointer to pk buffer ttsar
|
||
HRRZ TT,TTSAR(TT) ;pointer to actual data area (array is GC protected).
|
||
MOVEI T,%COEOF ;set the packet opcode to RFC
|
||
DPB T,[$CPKOP (TT)]
|
||
SETZ T, ;0 byte count
|
||
DPB T,[$CPKNB (TT)]
|
||
HRRZ A,(A) ;get output file array
|
||
MOVE B,-2(TT) ;get pointer to the asar of the packet array
|
||
JCALL 2,.FUNCTION %CHAOS-PKTIOT ;send the packet
|
||
|
||
;;; (%CHAOS-PKTIOT <file array> <packet array>)
|
||
;;; <file array> is a file array open on the CHAOS device.
|
||
;;; <packet array> is an array pointer to a GC protected array.
|
||
;;; Thus it is usually passed one of the buffers created by %CHAOS-ALLOCATE-BUFFER.
|
||
;;; If an IOC error occurs, a THROW will be done to CHAOS-PKTIOT-ERROR.
|
||
|
||
.ENTRY %CHAOS-PKTIOT SUBR 0003 ;subr 2 args
|
||
PUSH FXP,D ;don't clobber D
|
||
MOVEI D,IOTLOS
|
||
JSP T,SPECBIND ;bind the IOCINS location
|
||
D_5,,IOCINS
|
||
POP FXP,D
|
||
MOVEI TT,F.CHAN
|
||
PKIOTC: SYSCAL PKTIOT,[@TTSAR(A) ? TTSAR(B)]
|
||
JRST UNBIND ;unbind IOCINS
|
||
|
||
;;; Ioc error interrupt routine for the PKTIOT
|
||
|
||
IOTLOS: HRRI R,PKTLS1 ;process the error here
|
||
HRLI R,PKTERR
|
||
TLO R,400000
|
||
AOS (FLP)
|
||
POPJ FLP, ;YES, its FLP!!!! (super crock...)
|
||
PKTERR: 0
|
||
|
||
;;; This is called at non interrupt level. Error code in CHAOS-PKTIOT-ERROR-CODE
|
||
|
||
PKTLS1: UNLOCKI
|
||
MOVE TT,PKTERR ;pick up the error code
|
||
JSP T,FXCONS ;make a fixnum (guaranteed to be an inum, so no GC)
|
||
MOVEM A,.SPECIAL CHAOS-PKTIOT-ERROR-CODE
|
||
MOVEI A,.ATOM CHAOS-PKTIOT-ERROR
|
||
SETZ B,
|
||
JCALL 2,.FUNCTION *THROW
|
||
|
||
;;; Allocate a GC protected, immoveable packet-buffer array
|
||
;;; (gag, using a whole page for this poor little buffer - should
|
||
;;; hack something more efficient one of these days...)
|
||
|
||
.ENTRY %CHAOS-ALLOCATE-BUFFER SUBR 0001 ;subr 0 args
|
||
JSP T,SACONS ;allocate an array header
|
||
MOVEI TT,1 ;get a page of core
|
||
PUSHJ P,GETCOR
|
||
SKIPN TT
|
||
JRST [ SETZ A ? POPJ P,]
|
||
HRR T,TT ;stuff in array prefix info
|
||
HRLI T,AHEAD
|
||
BLT T,4(TT)
|
||
HRLI T,TTS<1D>+TT ;1D array, indexed by TT
|
||
HRLI TT,AS.FX ;fixnum type array
|
||
MOVEM T,TTSAR(A)
|
||
MOVEM TT,ASAR(A)
|
||
MOVEM A,-2(T) ;backward pointer in the array prefix
|
||
HRRM T,(TT) ;and pointer to data area.
|
||
POPJ P,
|
||
|
||
AHEAD: -200,,0
|
||
PUSHJ P,CFIX1
|
||
JSP T,1DIMF
|
||
0
|
||
200
|
||
|
||
;;; might as well do this at load time...
|
||
.SXEVAL (SETQ CHAOS-INTERNAL-PKT-BUFFER (%CHAOS-ALLOCATE-BUFFER))
|
||
|
||
|
||
;;; (%CHAOS-REQUEST-CONNECTION <connection> <destination host> <contact-name>
|
||
;;; <request-or-listen-flag> <netblk-time>)
|
||
;;; Open the chaos net channel. Arguments are:
|
||
;;; <connection> is a cons as returned byt %CHAOS-OPEN-CHANNELS.
|
||
;;; <destination host> is a fixnum 16 bit host address
|
||
;;; (host number + subnet number).
|
||
;;; <contact-name> is a symbol or a list of fixnums which is considered to be
|
||
;;; the contact name optionally followed by a space and JCL.
|
||
;;; <request-or-listen-flag> is T if this is a RFC or NIL if a LSN.
|
||
;;; <netblk-time> is the amount of time to wait for a response.
|
||
;;; Uses CHAOS-INTERNAL-PKT-BUFFER for the buffer.
|
||
;;; Returns a connection state as a fixnum.
|
||
|
||
.ENTRY %CHAOS-REQUEST-CONNECTION SUBR 0006 ;subr 5 args
|
||
PUSH P,[FIX1] ;make it NCALLable
|
||
PUSH P,AR1 ;save request/listen flag
|
||
PUSH P,AR2A ;save netblk time
|
||
MOVE TT,.SPECIAL CHAOS-INTERNAL-PKT-BUFFER ;pointer to pk buffer ttsar
|
||
HRRZ TT,TTSAR(TT) ;pointer to actual data area (array is GC protected).
|
||
MOVEI T,%CORFC ;set the packet opcode to RFC
|
||
SKIPN AR1
|
||
MOVEI T,%COLSN
|
||
DPB T,[$CPKOP (TT)]
|
||
MOVE T,(B) ;get destination host number arg
|
||
DPB T,[$CPKDA (TT)] ;deposit it
|
||
SETZ T, ;zero destination index
|
||
DPB T,[$CPKDI (TT)] ;depost it
|
||
MOVEI T,(C) ;check TYPEP of contact name = SYMBOL
|
||
LSH T,-11 ;standard hack (don't bother checking for NIL)
|
||
MOVE T,ST(T) ;look it up in the segment table
|
||
TLNE T,ST.SY ;SYMBOL?
|
||
PUSHJ P,EXPSYM ;yes, go exploden it
|
||
|
||
SETZ T, ;loop for copying contact name, jcl. T is byte cnt.
|
||
MOVE D,[441000,,%CPKDT(TT)] ;8-bit bytes, place to put data bytes
|
||
CNAMLP: HLR B,(C) ;get the car of the list (a fixnum)
|
||
MOVE F,(B) ;turn into a machine number
|
||
IDPB F,D ;deposit it into the packet
|
||
HRR C,(C) ;CDR the list
|
||
AOS T ;increment the byte count
|
||
JUMPN C,CNAMLP ;loop if we didn't CDR off the end of the list
|
||
|
||
DPB T,[$CPKNB (TT)] ;deposit the byte count into the packet
|
||
PUSH P,A ;save A (the connection)
|
||
HRRZ A,(A) ;get output file array
|
||
MOVE B,-2(TT) ;get pointer to the asar of the packet array
|
||
CALL 2,.FUNCTION %CHAOS-PKTIOT ;send the packet
|
||
POP P,A ;get A back
|
||
MOVEI TT,F.CHAN
|
||
HLRZ A,(A) ;CAR is the input file array
|
||
POP P,B ;get the netblk time-out time off the stack
|
||
POP P,C ;get request/listen flag back
|
||
MOVEI R,%CSRFS ;assume RFC
|
||
SKIPN C ;if T, then it was
|
||
MOVEI R, %CSLSN ;otherwise listening
|
||
MOVE T,(B) ;time-out time
|
||
SYSCAL NETBLK,[ MOVE @TTSAR(A) ;CHAOS input channel
|
||
MOVE R ;current state
|
||
MOVE T ;time-out time
|
||
MOVEM TT] ;new state returned here
|
||
POPJ P, ;TT gets converted at FIX1 if needed
|
||
|
||
;;; explode a symbol pointed to by C
|
||
EXPSYM: PUSH P,A ;save A, TT, AR1
|
||
PUSH P,TT
|
||
PUSH P,AR1
|
||
MOVEI A,(C)
|
||
CALL 1,.FUNCTION EXPLODEN
|
||
MOVEI C,(A) ;back into C
|
||
POP P,AR1
|
||
POP P,TT
|
||
POP P,A
|
||
POPJ P,
|
||
|
||
;;; (%CHAOS-OPEN-CONNECTION <connection>)
|
||
;;; Sends an OPN packet (pretty useless since easy to do with %CHAOS-PKTIOT)
|
||
|
||
.ENTRY %CHAOS-OPEN-CONNECTION SUBR 0002 ;subr 1 arg
|
||
MOVE TT,.SPECIAL CHAOS-INTERNAL-PKT-BUFFER
|
||
HRRZ TT,TTSAR(TT) ;get pointer to array data
|
||
MOVEI T,%COOPN ;OPN opcode
|
||
DPB T,[ $CPKOP (TT)] ;deposit it in the opcode field
|
||
HRRZ A,(A) ;CDR is the output file array
|
||
MOVE B,-2(TT) ;pointer to asar
|
||
JCALL 2,.FUNCTION %CHAOS-PKTIOT ;send the packet
|
||
|
||
;;; MISC utility functions
|
||
|
||
;;; (%CHAOS-SET-PKT-OPCODE <array> <opcode>)
|
||
;;; Sets the opcode field in a packet buffer array pointed to by <array>.
|
||
;;; <opcode> is a fixnum.
|
||
|
||
.ENTRY %CHAOS-SET-PKT-OPCODE SUBR 0003 ;subr 2 args
|
||
HRRZ TT,TTSAR(A) ;get pointer to array data
|
||
MOVE T,(B) ;get the number
|
||
DPB T,[$CPKOP (TT)] ;deposit it in the opcode field
|
||
MOVEI A,.ATOM T
|
||
POPJ P,
|
||
|
||
;;; (%CHAOS-GET-PKT-OPCODE <array>)
|
||
;;; Gets the opcode field in a packet buffer array pointed to by <array>.
|
||
|
||
.ENTRY %CHAOS-GET-PKT-OPCODE SUBR 0002 ;subr 1 arg
|
||
HRRZ TT,TTSAR(A) ;get pointer to array data
|
||
LDB TT,[$CPKOP (TT)] ;load from the opcode field
|
||
JSP T,FXCONS ;convert number in TT to a fixnum
|
||
POPJ P,
|
||
|
||
;;; (%CHAOS-SET-PKT-LENGTH <array> <length>)
|
||
;;; Sets the byte count for a packet.
|
||
|
||
.ENTRY %CHAOS-SET-PKT-LENGTH SUBR 0003 ;subr 2 args
|
||
HRRZ TT,TTSAR(A) ;get pointer to array data
|
||
MOVE T,(B) ;get the fixnum count
|
||
DPB T,[$CPKNB (TT)] ;deposit it in the byte count field
|
||
MOVEI A,.ATOM T
|
||
POPJ P,
|
||
|
||
;;; (%CHAOS-GET-PKT-LENGTH <array>)
|
||
;;; Gets the byte count for a packet.
|
||
|
||
.ENTRY %CHAOS-GET-PKT-LENGTH SUBR 0002 ;subr 1 arg
|
||
HRRZ TT,TTSAR(A) ;get pointer to array data
|
||
LDB TT,[$CPKNB (TT)] ;load from the byte count field
|
||
JSP T,FXCONS ;convert number in TT into a FIXNUM
|
||
POPJ P,
|
||
|
||
;;; (%CHAOS-GET-BYTE <array> <index>)
|
||
;;; Gets data byte specified by <index> from packet in <array>.
|
||
.ENTRY %CHAOS-GET-BYTE SUBR 0003 ;subr 2 args
|
||
HRRZ TT,TTSAR(A) ;get pointer to array data
|
||
MOVE R,(B) ;get fixnum index
|
||
IDIVI R,4 ;compute word offset and remainder
|
||
ADD TT,R
|
||
IMULI F,8 ;compute byte position
|
||
MOVEI T,28.
|
||
SUB T,F
|
||
LSH T,30. ;and position it
|
||
IOR T,[001000,,%CPKDT(TT)]
|
||
LDB TT,T
|
||
JSP T,FXCONS
|
||
POPJ P,
|
||
|
||
;;; (%CHAOS-PUT-BYTE <array> <byte>)
|
||
;;; Puts <byte> at the end of the packet and updates the packet length.
|
||
.ENTRY %CHAOS-PUT-BYTE SUBR 0003 ;subr 2 args
|
||
HRRZ TT,TTSAR(A) ;get pointer to array data
|
||
LDB R,[$CPKNB(TT)] ;get the number of bytes
|
||
MOVEI T,1(R)
|
||
DPB T,[$CPKNB(TT)] ;increment and redeposit
|
||
IDIVI R,4 ;compute word offset and remainder
|
||
ADD TT,R
|
||
IMULI F,8 ;compute byte position
|
||
MOVEI T,28.
|
||
SUB T,F
|
||
LSH T,30. ;and position it
|
||
IOR T,[001000,,%CPKDT(TT)]
|
||
MOVE R,(B)
|
||
DPB R,T
|
||
MOVEI A,.ATOM T
|
||
POPJ P,
|
||
|
||
FASEND
|