system/ncp.9

   1 ;;; Copyright (c) 1999 Massachusetts Institute of Technology
   2 ;;;
   3 ;;; This program is free software; you can redistribute it and/or
   4 ;;; modify it under the terms of the GNU General Public License as
   5 ;;; published by the Free Software Foundation; either version 3 of the
   6 ;;; License, or (at your option) any later version.
   7 ;;;
   8 ;;; This program is distributed in the hope that it will be useful,
   9 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11 ;;; General Public License for more details.
  12 ;;;
  13 ;;; You should have received a copy of the GNU General Public License
  14 ;;; along with this program; if not, write to the Free Software
  15 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16
  17 SUBTTL  ARPANET NCP variables and tables
  18
  19 EBLK
  20 IMPMQS==13.     ;MESSAGE QUEUE SIZE (LENGTH WORD, 6-WORD LEADER, 6-WORD TEXT)
  21 ;MAIN PROGRAM CONTROL MESSAGE VARIABLES
  22 IMPMPU: -1      ;-1 => FREE
  23         0       ;SWTL THREAD
  24 IMPMPL: -1      ;LINK WORD FOR CONTROL LINK QUEUE
  25 IMPMPC: BLOCK IMPMQS    ;FIRST WORD HAS IMPHTB INDEX,,LENGTH OF TEXT
  26
  27 ;PI CONTROL MESSAGE VARIABLES
  28 IMNPIC==NNETCH+3        ;NUMBER OF BLOCKS IN PI CONTROL QUEUE
  29 ;HOPEFULLY THIS IS ENOUGH.  THE CODE RESPONDS VERY UNGRACEFULLY TO THIS
  30 ;QUEUE FILLING UP.  IN PARTICULAR, WHEN IT HOLDS UP INPUT IT CAN CAUSE
  31 ;A DEADLOCK BY PREVENTING ITSELF FROM SEEING A CONTROL-LINK RFNM IT
  32 ;NEEDS IN ORDER TO SEND SOMETHING THAT'S IN THE QUEUE AND FREE UP SOME
  33 ;SPACE.  FURTHERMORE THE IMP IS UNGRACEFUL AND WILL SOMETIMES REFUSE TO
  34 ;READ INPUT FROM US (EVEN IN THE MIDDLE OF A MESSAGE) UNTIL WE READ
  35 ;INPUT FROM IT.  BUT WE DO THE SAME THING WHEN THIS QUEUE FILLS UP.
  36 ;FURTHERMORE SOMETIMES THE CORE JOB WILL WAIT FOR A NETWORK
  37 ;TRANSMISSION TO COMPLETE SO IT CAN MOVE A NETWORK BUFFER, HANGING THE
  38 ;ENTIRE SYSTEM.  THE CORE-JOB WILL UNHANG AFTER THE IMP TIMES OUT AND
  39 ;FLASHES ITS READY LINE (SEE IMPBER).
  40 ;** BUT SOMETIMES THE IMP NEVER TIMES OUT AND SO THE SYSTEM IS HUNG **
  41
  42 IMPCQ:  REPEAT IMNPIC-1,[
  43         .+IMPMQS+1      ;POINTER TO NEXT FREE OR NEXT IN QUEUE
  44         BLOCK IMPMQS    ;FIRST WORD HAS IMPHTB INDEX,,LENGTH OF TEXT
  45 ]
  46         -1
  47         BLOCK IMPMQS
  48 IMPNCQ: -1      ;NEXT ENTRY TO BE SENT.  -1 IF NONE
  49 IMPLCQ: -1      ;POINTER TO LAST ENTRY IN CONTROL QUEUE
  50 IMFFCQ: IMPCQ   ;POINTER TO FIRST FREE.  -1 IF NONE
  51 IMFCQL: IMNPIC  ;NUMBER FREE CONTROL QUEUE ENTRIES LEFT
  52
  53 ;PENDING RFC QUEUE
  54 IMNPQ==20       ;NUMBER OF PENDING QUEUE ENTRIES
  55 ;(0)    POINTER TO NEXT IN CHAIN OR NEXT FREE.  -1 IF NONE
  56 ;(1)    LOCAL SOCKET NUMBER
  57 ;(2)    FOREIGN SOCKET NUMBER
  58 ;(3)    4.9 = 1 => RTS  = 0 => STR
  59 ;       1.1-1.8 = LINK NUMBER OR BYTE SIZE
  60 ;       1.9-2.7 = FOREIGN HOST NUMBER
  61 ;       3.1-3.9 = TIME RFC RECEIVED, IN SECONDS MOD 512.
  62         IMPPQ           ;IMPBPQ-1 IS BEGINNING OF GETSYS BLOCK, THIS WORD FOR UNRELOCATION
  63 IMPBPQ: -1      ;BEGINNING OF PENDING QUEUE.  -1 IF EMPTY
  64 IMPPQ:  REPEAT IMNPQ-1,[
  65         .+4
  66         BLOCK 3
  67 ]
  68         -1
  69         BLOCK 3
  70 IMPEPQ: -1      ;END OF PENDING QUEUE.  -1 IF EMPTY (IMPEPQ IS END FOR GETSYS BLOCK)
  71 IMFFPQ: IMPPQ   ;FIRST FREE PENDING QUEUE ENTRY.  -1 IF NONE
  72 \f
  73 ;SOCKET TABLE
  74
  75 IMSOKB: IMPSTL          ;BEGIN OF GETSYS BLOCK, LENGTH STORED HERE
  76
  77 IMSOC1: REPEAT IMPSTL,0         ;0 => FREE
  78                                 ;>0 MEANS ALLOCATED, NOT SET UP YET
  79                                 ;4.9 = 1 => SOCKET IN USE
  80                                 ;4.8 = 1 => CHNL TRYING TO BE CLOSED
  81                                 ;3.1-4.7 = MASK FOR CHANNEL SOCKET IS OPEN ON.
  82                                 ;RH = USER INDEX
  83
  84 IMSOC2: BLOCK IMPSTL            ;1.1-4.5 = LOCAL SOCKET NUMBER
  85                                 ;4.6-4.9  0 (MAKES COMPARISONS EASIER)
  86 IMSOC3: BLOCK IMPSTL            ;1.1-4.5 = FOREIGN SOCKET NUMBER
  87                                 ;4.6-4.9 = 0
  88 IMSOC4: BLOCK IMPSTL            ;3.1-3.8 = LINK NUMBER
  89                                 ;3.9-4.7 = FOREIGN HOST NUMBER (IMPHTB INDEX)
  90                                 ;          377 MEANS NOT USING ANY HOST
  91                                 ;4.8 = SET BY RCV CLS - MAKES MATCH USING IMSCHD FAIL
  92                                 ;4.9 = SEND THIS BUFFER NOW
  93         .SEE %NS                ;RH = SOCKET STATE
  94 IMSOC5: BLOCK IMPSTL            ;1.1 - 1.9 => TTY # OF STY, IF CONNECTED TO ONE.
  95                                 ;2.1-2.9 = CLOSE-REASON
  96                                 ;3.1-3.8 = CONNECTION BYTE SIZE
  97                                 ;3.9 => ASCII MODE - 7 BIT
  98                                 ;4.1 => ASCII MODE - 8 BIT
  99                                 ;4.2 => 1 BIT BYTES
 100                                 ;4.3 => NET INT (INR\INS) RECEIVED
 101                                 ;4.4 => HAVE BEGUN COUNTING THE CLOSE TIME-OUT.
 102                                 ;4.5 => CLOSED WHILE IN RFNM WAIT, EXPECT ANOTHER RFNM
 103                                 ;4.6 => CONNECTED DIRECTLY TO A STY.
 104                                 ;4.7 => DON'T BUFFER MORE OUTPUT THAN ALLOCATION
 105                                 ;4.8 => STY WANTS WAKEUP AT 1/2 SEC CLK
 106                                 ;4.9 => TRANSFER IN 32 BIT MODE
 107 IMSOC6: BLOCK IMPSTL            ;RH => BUFFER ADDRESS
 108                                 ;4.9 => LOCKED BY CORE JOB
 109                                 ;4.8 => ACTIVE AT PI LEVEL
 110                                 ;4.7 => INPUT OCCURRED WHILE BUFFER LOCKED
 111                                 ;3.1-3.8 => IOBFT INDEX (377 IF USING BIG BUFFER)
 112 IMSOC7: BLOCK IMPSTL            ;BIT ALLOCATION
 113 IMSOC8: BLOCK IMPSTL            ;MESSAGE ALLOCATION
 114 IMSC7I: BLOCK IMPSTL            ;AMT TO INCREASE BIT ALLOCATION BY IN NEXT ALLOC MSG (INPUT)
 115                                 ;FOR OUTPUT, HAS NUMBER OF BITS IN BUFFER
 116 IMSC8I: BLOCK IMPSTL            ;AMT TO INCREASE MESSAGE ALLOCATION BY NEXT ALLOC MSG (INPUT)
 117 IMSOCT: BLOCK IMPSTL            ;TIME WHEN FIRST MESS PUT INTO BUF
 118                                 ;(DURING INPUT HAS NUMBER OF DATA BYTES LEFT IN CUR MSG)
 119                                 ;(DURING CLOSE HAS TIME TIME-OUT STARTED)
 120 IMSMPP: BLOCK IMPSTL            ;MAIN PROGRAM POINTER, ILDB OR IDPB FOR NEXT BYTE
 121 IMSMPC: BLOCK IMPSTL            ;MAIN PROGRAM COUNTER, FOR OUTPUT HAS NUMBER OF DATA
 122                                 ; BYTES OF ROOM LEFT IN BUFFER.  FOR INPUT HAS TOTAL
 123                                 ; NUMBER OF DATA BYTES IN BUFFER.
 124 IMSPIP: BLOCK IMPSTL            ;INTERRUPT LEVEL POINTER, FOR OUTPUT ILDB TO GET NEXT
 125                                 ; BYTE OUT AT P.I. LEVEL.  FOR INPUT POINTS TO WHERE
 126                                 ; HEADER WORD OF NEXT MESSAGE IN WILL BE STORED.
 127 IMSBFE: BLOCK IMPSTL            ;BYTE POINTER TO LAST BYTE IN BUFFER
 128                                 ;USE CAILE X,@IMSBFE(I) TO CHECK A WORD ADDRESS
 129 IMSOKE==.-1             ;END OF BLOCK FOR GETSYS CALL
 130
 131 BBLK
 132
 133 IMSCLN: 221000,,IMSOC4(I)       ;LINK NUMBER
 134 IMSCBS: 221000,,IMSOC5(I)       ;BYTE SIZE
 135 IMSCLS: 111100,,IMSOC5(I)       ;CLOSE REASON
 136 IMSCFH: 321000,,IMSOC4(I)       ;FOREIGN HOST
 137 IMSCHD: 222100,,IMSOC4(I)       ;FOREIGN HOST AND LINK NUMBER
 138                                 ; EXTRA BIT, SET WHEN RCV CLS
 139 IMSCHL: 222000,,IMSOC4(I)       ;FOREIGN HOST AND LINK WITHOUT EXTRA BIT
 140 \f
 141 NTRFCL: SIXBIT /NETRFC/         ;FOR ICP ON ANY SOCKET < 1000
 142 EBLK
 143         0
 144
 145 NETSRS==1000    ;SMALLEST USER RECEIVE SOCKET NUMBER
 146 NRSOC:  NETSRS  ;NUMBER OF NEXT RECEIVE SOCKET TO BE GENERATED
 147 NETOSW: -1      ;SWITCH LOCKED AT NET OPEN
 148         0
 149 NETHSW: -1      ;SWITCH LOCKED IF HACKING HOST TABLE (IMPHTB)
 150         0
 151 NETLST: 0       ;LIST OF USERS IN NETWORK OPEN CODE
 152
 153 ;INPUT BUFFER FORMAT:
 154 ;THE BUFFER IS CIRCULAR, AND EITHER 200 OR 2000 WORDS LONG.
 155 ;MAY CONTAIN SEVERAL MESSAGES.  EACH CONSISTS OF A HEADER WORD CONTAINING
 156 ; THE NUMBER OF BYTES IN THE MESSAGE, FOLLOWED BY THE BYTES, FOLLOWED BY
 157 ; UNUSED BITS UP TO THE NEXT WORD BOUNDARY.  THIS WEIRD FORMAT IS USED
 158 ; TO AVOID HAVING TO DO BYTE OPERATIONS AT P.I. LEVEL.
 159 ;A HEADER WORD OF -1 MEANS THAT THAT MESSAGE HAS NOT YET BEEN STORED.
 160 ;IMSPIP(I) ALWAYS CONTAINS THE ADDRESS OF A HEADER WORD OF -1.
 161 ;IMSMPP(I) HAS A BYTE POINTER TO THE NEXT DATA BYTE TO BE READ.
 162 ;P.I. LEVEL CAN STORE A MESSAGE INTO THE PART OF THE BUFFER FROM
 163 ;@IMSPIP TO @IMSMPP-1.
 164 ;IMSOCT(I) HAS THE NUMBER OF BYTES THAT MAIN PROGRAM LEVEL CAN
 165 ; READ BEFORE IT GETS TO THE END OF THE CURRENT MESSAGE AND HAS
 166 ; TO CHECK THE NEXT HEADER.
 167 ;IMSMPC(I) HAS THE TOTAL NUMBER OF DATA BYTES IN ALL THE MESSAGES
 168 ; IN THE BUFFER.
 169
 170 ;OUTPUT BUFFER FORMAT:
 171 ;THE BUFFER IS CIRCULAR, AND EITHER 200 OR 2000 WORDS LONG.
 172 ;IT SIMPLY CONTAINS A STRING OF BYTES.
 173 ;IMSMPP(I) HAS A BYTE POINTER TO WHERE THE NEXT BYTE TO BE OUTPUT WILL BE DEPOSITED.
 174 ;IMSPIP(I) HAS A BYTE POINTER TO WHERE THE NEXT BYTE TO BE SENT OUT AT P.I.
 175 ; LEVEL WILL COME FROM.  P.I. LEVEL TRIES TO KEEP EVERYTHING ALIGNED ON
 176 ; WORD BOUNDARIES SO THAT IT DOESN'T HAVE TO DO BYTE OPERATIONS.
 177 ;IMSMPC(I) HAS THE NUMBER OF BYTES THAT MP LEVEL MAY STORE BEFORE RUNNING
 178 ; INTO OLD BYTES THAT HAVEN'T YET BEEN TRANSMITTED.
 179 ;IMSOCT(I) IS SET TO THE TIME THE FIRST BYTE IS PUT INTO THE BUFFER.
 180 ; IT IS CLEARED WHENEVER THE BUFFER GETS EMPTIED.
 181
 182 BBLK
 183 \f
 184 SUBTTL  ARPANET NCP Main Prog system call routines
 185
 186 ;NET .CALL RCHST/RFNAME
 187 NETRCH: MOVEI W,8               ;WE RETURN 8 VALUES.
 188         HRRE I,A
 189         JUMPL I,NETRC3          ;NET WENT DOWN AFTER THIS CHANNEL WAS OPENED.
 190         MOVE B,IMSOC2(I)        ;LOCAL SOCKET NUMBER
 191         MOVE C,IMSOC3(I)        ;FOREIGN SOCKET NUMBER
 192         LDB TT,IMSCFH           ;FOREIGN HOST FOR 4TH WORD.
 193         CAIN TT,377
 194          TDZA D,D               ; 377 MEANS NOT USING ANY HOST
 195 IFN 1,[
 196           JRST [MOVE D,A
 197                 MOVE A,IMPHTN(TT)       ; Get host addr
 198                 TLO A,(NW%ARP)          ; Make full HOSTS3 format
 199                 CALL CVH2NA             ; Convert to HOSTS2 for compatibility
 200                 EXCH A,D
 201                 JRST .+1]
 202 ] ;IFN 1
 203 IFN 0,[
 204          TDZA Q,Q
 205           MOVE Q,IMPHTN(TT)
 206         LDB D,[112000,,Q]       ;TRANSLATE NEW HOST NUMBER TO OLD
 207         ANDI Q,377              ;IF IT WILL FIT IN OLD NOTATION
 208         CAIGE D,100
 209          CAIL Q,4
 210           SKIPA D,IMPHTN(TT)
 211            DPB Q,[060200,,D]
 212 ] ;IFN 0
 213
 214         LDB Q,IMSCBS            ;GET BYTE SIZE FOR HERE AND BELOW
 215 ;FOLLOWING LINE HAS BEEN PUNTED, AN INCOMPATIBLE CHANGE
 216 ;       DPB Q,[111100,,D]       ;INTO 2.9-2.1 OF 4TH WORD
 217         MOVE A,IMSOC5(I)        ;RANDOM WORD
 218         TLNE A,4000             ;SKIP IF 4.3 BIT OFF (NETWRK INT)
 219          TLO D,400000           ;SET FOR USER
 220         PUSHJ P,NETRC1          ;GET TIME IMP GOING DOWN,
 221         HRR TT,IMSOC4(I)        ;MERGE IN SOCKET STATE.
 222         IMUL Q,IMSMPC(I)        ;MULTIPLY BYTE SIZE BY BYTES AVAIL TO GET BITS AVAIL
 223         LDB I,IMSCLS            ;CLS REASON
 224         POPJ P,
 225
 226 NETRC3: MOVEI I,%NCNCP          ;GIVE CLOSE REASON THAT OUR NCP WENT DOWN.
 227 NETRC1: SKIPG TT,IMPDWN+1       ;SYS TIME AT WHICH IMP IS GOING DOWN
 228          JRST NETRC2
 229         SUB TT,TIME             ;(TIME TIL IMP DOWN -1=NOT. 0=DOWN, +=GOING DOWN, N/30. SEC)
 230         SKIPG TT
 231          MOVEI TT,1             ;IF SET TO GO DOWN, AND TIME "PASSED", SAY SOON IF NOT ALREADY DOWN
 232 NETRC2: HRLZS TT
 233         POPJ P,
 234
 235 ;NET .CALL STATUS - SOCKET STATE IN BITS 2.4-2.9
 236 STANET: TRNN A,400000           ;SKIP IF NET WENT DOWN ON THIS LOSER
 237          SKIPA E,IMSOC4(A)      ;GET STATE
 238           MOVEI E,0             ;IF NCP WENT DOWN, STATE IS "CLOSED"
 239         DPB E,[140600,,D]
 240         POPJ P,
 241
 242 ;NET .CALL RESET - ONLY RESETS "INT FM NETWORK" BIT (INR/INS)
 243 NETRS:  HLRZ A,(R)              ;GET LH IOCHNM
 244         MOVSI B,4000            ;4.3 BIT
 245         TRNN A,400000           ;SKIP IF SET TO -1 (NET WENT DOWN ON THIS CHAN)
 246          ANDCAM B,IMSOC5(A)     ;CLEAR BIT
 247         POPJ P,
 248
 249 ;NET .CALL IOPUSH/IOPOP - ALTER THE CHANNEL-OPEN MASK IN IMSOC1.
 250 NETIOP: HRRZ T,UUAC(U)
 251         IMUL I,CHNBIT(T)        ;PUSHING => 0; ELSE BIT FOR CHANNEL BEING POPPED.
 252         HLRZ T,(R)              ;GET SOCKET TABLE IDX
 253         TRNN T,400000           ;SKIP IF NET WENT DOWN ON THIS LOSER
 254          DPB I,[222000,,IMSOC1(T)] ;STORE MASK AWAY.
 255         POPJ P,
 256
 257 ;NET .CALL WHYINT
 258 ;RESULTS ARE %WYNET, SOCKET STATE, BYTES AVAIL, CLS REASON
 259 NETWHY: HRRE I,A                ;GET IMSOC INDEX
 260         MOVEI A,%WYNET          ;FIRST RESULT IS DEVICE CODE
 261         SETZB B,C               ;SET UP RESULTS 2-4 IN CASE NCP WENT DOWN
 262         MOVEI D,%NCNCP
 263         JUMPL I,POPJ1           ;RETURN IF NCP WENT DOWN ON THIS LOSER
 264         HRRZ B,IMSOC4(I)        ;SECOND RESULT IS SOCKET STATE
 265         MOVE Q,IMSOC5(I)
 266         TLNE Q,4000
 267          TLO B,400000           ;SIGN OF SECOND RESULT SET IF NETWRK INT
 268         TLNE Q,40000            ;DIRECT CONNECTED?
 269          TDZA C,C               ;YES, NO BYTES AVAILABLE FOR INPUT
 270           MOVE C,IMSMPC(I)      ;THIRD RESULT IS BYTES AVAILABLE
 271         LDB D,IMSCLS            ;FOURTH RESULT IS CLOSE REASON
 272         JRST POPJ1
 273 \f
 274 ;AIDS TO NETWORK OPEN AND NETHST CALLS
 275
 276 ;SET THINGS UP AND ALLOCATE AN IMSOC INDEX.
 277 ;SKIP RETURNS WITH NETLST AND IMSOC1(I) LOCKED.
 278 ;OR, RETURNS NO-SKIP WITH NOTHING LOCKED AND AN ERROR SIGNALLED.
 279 NETO00: PUSHJ P,LSTSET  ;ADD THIS JOB TO LIST OF NET OPENERS
 280             NETLST
 281         PUSHJ P,SWTL    ;GET AN IMSOC ENTRY TO GC-PROTECT OUR IMPHTB ENTRY
 282             NETOSW
 283         MOVSI I,-IMPSTL
 284         SKIPE IMSOC1(I)
 285          AOBJN I,.-1
 286         JUMPG I,OPNL6   ;DEVICE FULL
 287         MOVEI H,377     ;NO HOST YET
 288         DPB H,IMSCFH
 289         HRRZM U,IMSOC1(I) ;IMSOC1 POSITIVE MEANS ALLOCATED BUT NOT INITED YET
 290         PUSHJ P,LSWPOP  ;NETOSW
 291         PUSHJ P,LOSSET  ;RETURN IMSOC ENTRY IF PCLSR
 292             NETIRT
 293         JRST POPJ1
 294
 295 ;LOSSET ROUTINE TO RETURN IMSOC ENTRY
 296 NETIRT: MOVE T,AC0S+I(U)
 297         HRRZ A,U
 298         CAME A,IMSOC1(T)
 299          JRST 4,.
 300         SETZM IMSOC1(T)
 301         POPJ P,
 302
 303 ;SUBROUTINE TO OPEN UP COMMUNICATIONS WITH THE DESIRED HOST.
 304 ;ENTER WITH HOST NUMBER IN SRN3(U), SKIP-RETURN WITH HOST
 305 ;UP AND IMPHTB INDEX IN H AND IMSCFH.  OR NON-SKIP RETURN WITH ERROR SIGNALLED.
 306 NETOR:  MOVE T,SRN3(U)  ;USER-SPECIFIED HOST NUMBER
 307         JSP J,STDHST    ;STANDARDIZE, OPNL25 IF IT IS NO GOOD
 308         CONO PI,NETOFF
 309         PUSHJ P,FNDHST  ;H GETS HOST TABLE INDEX
 310          JRST OPNL6     ;DEVICE FULL (HOST TABLE FULL)
 311         DPB H,IMSCFH    ;PROTECT IN IMSOC4
 312         CONO PI,NETON
 313         PUSHJ P,SWTL    ;POSSIBLY SEND RST TO HOST OPENING CONNECTION TO
 314             NETHSW
 315         LDB J,IMHSBT    ;GET STATUS
 316         SOJG J,NETORS   ;-1 => DOWN, 0 => RST SENT, 1 => UP
 317         JUMPE J,NETOR1  ;WAIT FOR REPLY
 318         PUSHJ P,NETOW   ;WAIT FOR IMPMPC TO BE FREE
 319         LDB W,[051100,,TIME]
 320         DPB W,[221100,,IMPHTB(H)]
 321         MOVEI J,1
 322         DPB J,IMHSBT    ;MARK AS SENT
 323         AOS IMRFCT
 324         PUSHJ P,STHSTM  ;STORE HOST#, LINK 0 , MESSAGE TYPE 0
 325         MOVE W,[8_24.+1_8]      ;BYTE SIZE = 8, BYTE COUNT = 1
 326         MOVEM W,IMPMPC+6
 327         MOVE W,[12._28.]        ;RST
 328         MOVEM W,IMPMPC+7
 329         MOVEI W,1
 330         HRRM W,IMPMPC   ;MESSAGE LENGTH
 331         PUSHJ P,IMPMPQ  ;SEND IT OUT
 332 NETOR1: PUSHJ P,LSWPOP  ;NETHSW
 333         PCLT
 334         MOVSI T,1000
 335         TDNE T,IMPHTB(H) ;RRP -> 2000,  DOWN -> 0000
 336          PUSHJ P,UFLS
 337         LDB J,IMHSBT    ;GET STATUS
 338         SOJL J,OPNL41   ;HOST DOWN
 339         JUMPE J,NETOR   ;TRY ALL THIS AGAIN
 340         JRST POPJ1      ;HOST UP
 341
 342 NETORS: PUSHJ P,LSWPOP  ;NETHSW
 343         JRST POPJ1      ;HOST IS UP
 344 \f
 345 ;NETWORK OPEN
 346
 347 ;       .OPEN CH,BLK
 348 ;       ERROR RETURN
 349 ;       NORMAL RETURN
 350
 351 ;BLK:   MODE BITS,,(SIXBIT /NET/)
 352 ;       LOCAL SOCKET NUMBER (1.1-4.5)
 353 ;       FOREIGN SOCKET NUMBER (1.1-4.5)
 354 ;       FOREIGN HOST NUMBER
 355
 356 ;BLK:   3.1-3.3 => STANDARD ASCII/IMAGE, UNIT/BLOCK, INPUT/OUTPUT
 357 ;       3.4 = 1 => GENERATE UNIQUE LOCAL RECEIVE (SEND) SOCKET NUMBER
 358 ;       3.4 = 0 => USE LOCAL SOCKET NUMBER SPECIFIED IN BLK+1
 359 ;       3.5 => OPEN SOCKET IN LISTEN MODE
 360 ;       3.6 => IF IMAGE MODE, USE BYTE SIZE IN 4.1-4.6
 361 ;              IF ASCII MODE, USE 8 BIT BYTES RATHER THAN 7
 362 ;       3.7 => USE BIG BUFFER (2000 WORDS INSTEAD OF 200)
 363 ;       3.8 => DON'T BUFFER MORE OUTPUT THAN ALLOCATION
 364 ;       4.1-4.6 = BYTE SIZE IN IMAGE MODE
 365
 366
 367 ;OPEN CODE
 368 NETO:   SKIPN IMPUP
 369          JRST NETOUP
 370         SKIPL IMPUP
 371          JRST OPNL7     ;DEVICE NOT READY
 372         CONO PI,NETOFF
 373         SKIPN IMPTCU
 374          AOS IMPTCU
 375         CONO PI,NETON
 376         MOVSI I,SCLIMP
 377         IORM I,SUPCOR   ;HAVE SYS JOB BRING UP THE NETWORK
 378         PCLT
 379         SKIPE IMPTCU    ;WAIT WHILE IT TRIES TO COME UP
 380          PUSHJ P,UFLS
 381         SKIPE IMPUP
 382          JRST OPNL7     ;LOSE IF NOT UP BY NOW
 383 NETOUP: TLZ A,740000    ;IGNORE EXTRA BITS IN SOCKET NUMBERS
 384         TLZ B,740000
 385         PUSHJ P,NETO00  ;INITIALIZE THINGS
 386          POPJ P,        ;NETWORK NOT UP OR FULL
 387         TLNE C,20       ;SKIP IF NOT LISTEN
 388          JRST NETO10
 389         PUSHJ P,NETOR   ;DO RESET STUFF, OPEN COMMUNICATIONS WITH HOST
 390          POPJ P,        ;HOST DOWN OR ILLEGAL
 391         MOVE J,B        ;CHECK GENDER OF FOREIGN SOCKET
 392         ROT J,-1
 393         XOR J,D
 394         JUMPGE J,OPNL2  ;WRONG DIRECTION
 395 ;DROPS THROUGH
 396 \f;DROPS IN
 397 NETO10: PUSHJ P,SWTL    ;ONLY ONE PROCESS AT A TIME COMPARING SOCKET NUMBERS
 398             NETOSW
 399         TLNN C,20       ;SKIP IF LISTEN
 400          PUSHJ P,NETOW  ;GOBBLE MP CONTROL LINK BLOCK (FOR NETOS)
 401         TLNN C,10
 402          JRST NETO1     ;USE SOCKET NUMBER GIVEN IN WORD 2
 403         MOVEI A,10      ;ADVANCE SYSTEM UNIQUE SOCKET NUMBER
 404         ADDB A,NRSOC
 405         SUBI A,10       ;UNIQUE RECEIVE SOCKET NUMBER
 406         SKIPGE D        ;SKIP IF OPEN IS FOR READ (RECEIVE)
 407          IORI A,1       ;MAKE INTO SEND SOCKET
 408         JRST NETO6
 409
 410 NETO1:  MOVE J,A        ;USER SPECIFIED SOCKET NUMBER
 411         ROT J,-1        ;J 4.9: 0 => RECEIVE  1 => SEND
 412         EQV J,D         ;D 4.9: 0 => READ  1 => WRITE
 413         JUMPGE J,OPNL2  ;WRONG DIRECTION
 414         MOVE J,A
 415         CAIL A,NETSRS   ;SKIP IF SPECIAL SOCKET
 416          TRZA J,7       ;J HAS BASE OF SOCKET GROUP
 417           MOVNI J,1     ; OR -1 IF NOT IN A GROUP
 418         MOVSI Q,-IMPSTL
 419         MOVEI E,0
 420 NETO2:  SKIPL W,IMSOC1(Q)
 421          JRST NETO3     ;NOT HOOKED UP
 422         CAMN A,IMSOC2(Q)
 423          JRST NETO2A    ;DUPLICATE LOCAL SOC #
 424         MOVE T,IMSOC2(Q)
 425         TRZ T,7
 426         CAMN J,T
 427          JRST NETO4     ;JUMP IF PART OF SOCKET GROUP
 428 NETO3:  AOBJN Q,NETO2
 429         SKIPL J         ;SKIP IF NOT PART OF A SOCKET GROUP
 430          JUMPE E,OPNL23 ;FOUND NO EVIDENCE THAT THIS GUY OWNS THIS GROUP
 431         JRST NETO6      ;WINNING
 432
 433 NETO2A: TLNN W,200000   ;SKIP IF BEING CLOSED
 434          JRST OPNL13    ;NO, GIVE ERROR
 435         TLNN C,20
 436          PUSHJ P,LSWPOP ;POP MP CONTROL LINK BLOCK
 437         PUSHJ P,LSWPOP  ;NETOSW
 438         MOVSI T,200000
 439         PCLT
 440         TDNE T,IMSOC1(Q)
 441          PUSHJ P,UFLS   ;WAIT TILL CLOSED
 442         JRST NETO10     ;TRY AGAIN
 443
 444 NETO4:  CAIE U,(W)
 445          JRST OPNL23    ;SOMEONE ELSE HAS IT
 446         MOVNI E,1       ;OK IF NO OTHER CONFLICTS
 447         JRST NETO3
 448 \f
 449 ;HERE WITH SUITABLE LOCAL SOCKET IN A
 450 NETO6:  TLNN C,4        ;SKIP IF IMAGE MODE
 451          JRST NETOC     ;ASCII MODE
 452         MOVEI TT,36.
 453         TLNN C,40       ;SKIP IF BYTE SIZE SUPPLIED
 454          JRST NETOB
 455         LDB E,[330600,,C]       ;USE USER SUPPLIED BYTE SIZE
 456         IDIVI E,36.     ;TT GETS BYTE SIZE MOD 36.
 457         JUMPN TT,NETOB
 458         MOVEI TT,36.    ;36 BITS ANYWAY
 459 NETOB:  PUSH P,TT
 460         MOVEI E,36.
 461         IDIV E,TT       ;36/BS
 462         JUMPE TT,NETOB1 ;EXACT
 463         MOVEI E,32.
 464         IDIV E,(P)      ;32/BS
 465         JUMPE TT,[MOVEI TT,400000       ;32BIT MODE FLAG
 466                  JRST NETOB1]
 467         MOVEI TT,2000           ;FUNNY BYTESIZE FLAG
 468 NETOB1: POP P,E         ;BS
 469         ADD TT,E        ;FLAGS+BS
 470         JRST NETOA
 471
 472 NETOC:  MOVEI TT,400410         ;7 BIT
 473         TLNE C,40
 474          MOVEI TT,401010        ;8 BIT
 475 NETOA:  TLNE C,200
 476          TRO TT,100000          ;DON'T BUFFER MORE OUTPUT THAN ALLOCATION
 477         HRLZM TT,IMSOC5(I)      ;STORE FLAGS AND BC, CLEAR CLOSE REASON
 478         MOVEM A,IMSOC2(I)       ;LOCAL SOCKET NUMBER
 479         MOVEM B,IMSOC3(I)       ;FOREIGN SOCKET NUMBER
 480         SETZM IMSOCT(I)         ;IF INPUT, NOT IN MIDDLE OF A MESSAGE
 481         MOVEI W,%NSRFS
 482         TLNE C,20               ;3.5 LISTEN
 483          MOVEI W,%NSLSN
 484         DPB H,[321000,,W]       ;DON'T CHANGE HOST NUMBER FIELD OF IMSOC4
 485         MOVEM W,IMSOC4(I)       ;SET INITIAL STATE, CLEAR FLAGS
 486         SKIPE IMSOC6(I)         ;SKIP IF HAVEN'T ASSIGNED BUFFER YET
 487          JRST 4,.
 488         PUSH P,A
 489         PUSH P,B
 490         PUSH P,D
 491 NETOE1: TLNN C,100              ;LAST PLACE TO PCLSR (REALLY NETMW)
 492          JRST NETOE7
 493         PUSHJ P,TCALL           ;GET FULL-PAGE BUFFER
 494             JRST IOMQ
 495          JRST NETMW
 496         MOVEI W,MUNET
 497         DPB W,[MUR,,MEMBLT(A)]
 498         DPB I,[MNUMB,,MEMBLT(A)]
 499         LSH A,10.
 500         MOVE W,A                ;BUFFER START ADDRESS
 501         HRLI W,377              ;NOT AN IOBFT-TYPE BUFFER
 502         MOVEI A,1777(A)         ;BUFFER END ADDRESS
 503         JRST NETOE4
 504
 505 NETOE7: MOVEI D,NFNETC(I)
 506         PUSHJ P,TCALL
 507             JRST IUTCO1         ;GET 200-WD BUFFER
 508          JRST NETMW             ;NO MEM AVAIL
 509         LDB W,[IOSA,,IOBFT(A)]
 510         LSH W,6                 ;STARTING ADDRESS
 511         HRL W,A                 ;IOBFT INDEX
 512         MOVEI A,177(W)          ;BUFFER END ADDRESS
 513 NETOE4: MOVEM A,IMSBFE(I)       ;(LH WILL BE STORED LATER)
 514         MOVEM W,IMSOC6(I)
 515 ;CLEAR THE BUFFER FOR EASE IN DEBUGGING.  COMMENT USED TO CLAIM
 516 ;THAT CLEARING IT WAS NECESSARY IN ORDER TO OUTPUT CORRECT HEADERS,
 517 ;BUT THAT WAS FRAUDULENT SINCE HEADERS NEVER COME FROM THE BUFFER.
 518         MOVEI D,1(W)
 519         HRLI D,(W)
 520         SETZM (W)
 521         BLT D,(A)
 522         POP P,D
 523         POP P,B
 524         POP P,A
 525 ;DROPS THROUGH
 526 \f;DROPS IN
 527
 528         MOVSI Q,000100          ;SET UP THE VARIOUS BYTE POINTERS
 529         LDB TT,IMSCBS           ;TO POINT TO END OF BUFFER
 530         MOVE E,IMSOC5(I)        ;SO ILDB WILL GET FIRST BYTE IN BUFFER
 531         TLNN E,2000             ;SKIP IF ONE BIT BYTES
 532          DPB TT,[300600,,Q]     ;OTHERWISE USE USER BYTE SIZE
 533         SKIPGE E
 534          TLO Q,040000           ;32 BIT WORD ENDS 4 BITS OVER
 535         HRR Q,IMSBFE(I)
 536         MOVEM Q,IMSMPP(I)
 537         MOVEM Q,IMSPIP(I)
 538         MOVEM Q,IMSBFE(I)
 539         MOVE T,C                ;GET 3.5 BIT OF C INTO
 540         LSH T,13.               ;4.9 OF T
 541         JUMPL D,NETOE5          ;JUMP IF SENDER
 542         SETOM (W)               ;NULL FIRST HEADER WORD
 543         TLO Q,440000            ;-> LEFT END OF WORD
 544         HRR Q,W
 545         MOVEM Q,IMSPIP(I)       ;SET PI PNTR TO POINT TO FIRST MESSAGE HEADER
 546         SETZM IMSMPC(I)         ;NO INPUT BYTES AVAILABLE YET
 547         MOVEI TT,20.            ;MESSAGE ALLOCATION ALWAYS 20
 548         MOVEM TT,IMSOC8(I)
 549         HRRZ TT,IMSBFE(I)       ;COMPUTE BIT ALLOCATION
 550         SUBI TT,2*20.(W)        ;TT := # WORDS IN BUFFER, -1 FOR LUCK, -2 FOR EACH MSG
 551         SKIPGE IMSOC5(I)        ; (-1 FOR HEADER WORD, AND -1 FOR BREAKAGE)
 552          IMULI TT,32.           ;CONVERT TO # BITS
 553         SKIPL IMSOC5(I)
 554          IMULI TT,36.
 555         LDB Q,IMSCBS            ;BREAKAGE WAS OVER-ESTIMATED BY 1 BYTE PER MSG
 556         IMULI Q,20.
 557         ADD TT,Q
 558         MOVEM TT,IMSOC7(I)      ;STORE CORRECT BIT ALLOCATION
 559         SETZM IMSC8I(I)
 560         SETZM IMSC7I(I)
 561         MOVEI Q,2(I)            ;LINK #
 562         DPB Q,IMSCLN            ;STORE IN LINK # FIELD
 563         JRST NETOE6
 564
 565 NETOE5: SETZM IMSOC7(I)         ;INITIALIZE SENDER'S ALLOCATIONS
 566         SETZM IMSC7I(I)
 567         SETZM IMSOC8(I)
 568         HRRZ TT,IMSBFE(I)
 569         SUBI TT,(W)             ;# BUFFER WORDS, -1 FOR LUCK
 570         SKIPGE IMSOC5(I)        ;SKIP IF 36BIT
 571          IMULI TT,32.           ;ALLOW 32 BITS PER WORD
 572         SKIPL IMSOC5(I)
 573          IMULI TT,36.           ;OR 36 BITS PER WORD
 574         LDB E,IMSCBS
 575         IDIVM TT,E              ;CONVERT TO NUMBER OF BYTES
 576         MOVEM E,IMSMPC(I)       ;THAT MANY ARE FREE AT FIRST
 577 NETOE6: PUSHJ P,IMPSPQ          ;SEARCH PENDING QUEUE (LEAVES UTCOFF)
 578          JRST NETOG             ;NOTHING THERE
 579         JUMPGE T,NETOH          ;JUMP IF NOT LISTENING STATE
 580         MOVE W,2(Q)             ;FOREIGN SOCKET NUMBER
 581         MOVEM W,IMSOC3(I)
 582         LDB H,[101000,,3(Q)]    ;FOREIGN HOST IMPHTB INDEX
 583         DPB H,IMSCFH
 584         SKIPA W,[%NSRFC]
 585 NETOH:   MOVEI W,%NSOPN
 586         HRRM W,IMSOC4(I)
 587         JUMPGE D,NETOD1         ;JUMP IF RECEIVER
 588         SKIPL W,3(Q)            ;SKIP IF RTS, GET LINK #
 589          JRST 4,.               ;HE SENT STR
 590         DPB W,IMSCLN            ;STORE LINK NUMBER
 591 NETOD:  HRRZ Q,UUAC(U)          ;CHANNEL OPEN ON
 592         MOVE Q,CHNBIT(Q)
 593         PUSHJ P,IMPUIM          ;INTERRUPT SELF
 594         JRST NETOG              ;GO FINISH THE OPEN
 595
 596 NETOD1: SKIPGE W,3(Q)           ;SKIP IF STR, GET BYTE SIZE
 597          JRST 4,.               ;HE SENT RTS
 598         ANDI W,377
 599         LDB Q,IMSCBS
 600         CAMN W,Q
 601          JRST NETOD             ;BYTE SIZES DIFFER, LOSE
 602         PUSHJ P,IMPBRT          ;RETURN THE BUFFER
 603         JRST OPNL22             ;SELF-CONTRADICTORY OPEN?
 604 \f
 605 NETOG:  HRRZ W,UUAC(U)
 606         MOVS W,CHNBIT(W)
 607         TLO W,400000            ;IN USE
 608         HRR W,U                 ;SETZ+<<INT MASK>,,<USER WHO HAS SOCKET>>
 609         MOVEM W,IMSOC1(I)       ;WE ARE NOW FULLY SET UP TO THIS SOCKET
 610         CONO PI,NETON
 611         TLNN C,20               ;SKIP IF LISTENING TYPE SOCKET
 612          PUSHJ P,NETOS          ;SEND RFC (CAN'T HANG, ALREADY GOT NETOW)
 613         PUSHJ P,LSWPOP          ;UNLOCK NETOSW, NOW THAT IMSOC1 4.9 IS SET
 614         PUSHJ P,LSWDEL          ;UNLOCK IMSOC1(I)
 615         PUSHJ P,LSWPOP          ;REMOVE FROM LIST OF NETWORK OPENS IN PROGRESS
 616         HRLZ A,I                ;LEFT HALF OF IOCHNM GETS SOCKET INDEX
 617         HLRZS C
 618         JSP Q,OPSLC7
 619             NETDUI,,NETDUO
 620             NETDBI,,NETDBO
 621             NETDUI,,NETDUO
 622             NETDBI,,NETDBO
 623 \f
 624 ;GOBBLE MAIN PROGRAM CONTROL LINK BLOCK
 625
 626 NETOW:  JUMPL U,NETOW1          ;FROM STYNET CLOCK LEVEL
 627         PCLT
 628         SKIPGE IMPHTB(H)        ;SKIP IF NOT RFNM WAIT ON LINK 0
 629          PUSHJ P,UFLS
 630         PUSHJ P,SWTL            ;GRAB CONTROL LINK BLOCK
 631             IMPMPU
 632         SKIPL IMPHTB(H)         ;DID CTL LINK TO THIS HOST GET BACK INTO RFNM WAIT?
 633          POPJ P,                ;NO, OK
 634         PUSHJ P,LSWPOP          ;YES, RELEASE RESOURCE WHILE AWAITING RFNM
 635         JRST NETOW
 636
 637 ;FROM NETIDC (AT CLOCK INTERRUPT LEVEL)
 638 NETOW1: SKIPL IMPHTB(H)
 639          AOSE IMPMPU
 640           CAIA          ;INPUT CAN'T BE READ YET.
 641            POPJ P,
 642         CONO PI,NETOFF
 643         PUSHJ P,IMPUIN  ;REACTIVATE SO WILL CHECK AGAIN
 644         SUB P,[2,,2]    ;THROW THROUGH NETI6, NETID
 645         JRST NETOJ1     ;TAKE NO-INPUT-AVAILABLE EXIT
 646
 647 ;WAIT FOR MEMORY SO CAN ALLOCATE BUFFER
 648
 649 NETMW:  PCLT
 650         MOVEI T,3
 651         CAMG T,LMEMFR
 652          JRST [ PUSHJ P,UDELAY  ;MAYBE MEMORY FROZEN, GIVE CORE JOB
 653                 JRST NETOE1 ]   ;A CHANCE TO PCLSR US, THEN TRY AGAIN
 654         CAMLE T,LMEMFR  ;SKIP WHEN MORE THAN 3K FREE
 655          PUSHJ P,UFLS
 656         JRST NETOE1
 657
 658 ;SEND RFC AND MAYBE ALLOCATE.  IMSOC INDEX IN I, HOST INDEX IN H.
 659
 660 NETOS:  PUSHJ P,STHSTM          ;STORE HOST ADDRESS IN IMPMPC+n, ALSO MESSAGE TYPE
 661         MOVE J,[8_24.+13._8]    ;BYTE SIZE = 8, BYTE COUNT = 13.
 662         MOVEM J,IMPMPC+6
 663         MOVEI J,1_4             ;3 NOPS + RTS
 664         SKIPGE D                ;SKIP IF INPUT
 665          MOVEI J,2_4            ;3 NOPS + STR
 666         MOVEM J,IMPMPC+7
 667         LSH A,4                 ;LOCAL SOCKET NUMBER
 668         MOVEM A,IMPMPC+10
 669         LSH B,4                 ;FOREIGN SOCKET NUMBER
 670         MOVEM B,IMPMPC+11
 671         MOVEI TT,2(I)           ;LINK NUMBER FOR RECEIVE SOCKET
 672         SKIPGE D
 673          LDB TT,IMSCBS          ;BYTE SIZE FOR SEND SOCKET
 674         LSH TT,28.
 675         HRRZ J,IMSOC4(I)
 676         CAIE J,%NSRFC
 677          CAIN J,%NSOPN          ;SKIP IF CONNECTION NOT YET OPEN
 678           JUMPGE D,NETOS2       ;JUMP IF CONNECTION OPEN AND READ
 679         MOVEM TT,IMPMPC+12
 680         MOVEI TT,4              ;TEXT LENGTH
 681 NETOS3: HRRM TT,IMPMPC
 682         JRST IMPMPQ
 683
 684 NETOS2: MOVEI J,<4_8>+2(I)      ;NOP + ALL + LINK #
 685         LSH J,4
 686         IOR TT,J
 687         MOVEM TT,IMPMPC+12
 688         MOVE TT,IMSOC8(I)       ;SEND MESSAGE ALLOC
 689         LSH TT,16.+4
 690         MOVEM TT,IMPMPC+13
 691         MOVE TT,IMSOC7(I)       ;SEND BIT ALLOC
 692         LSH TT,16.+4
 693         MOVEM TT,IMPMPC+14
 694         MOVE TT,[8_24.+22._8]   ;BYTE COUNT = 22.
 695         MOVEM TT,IMPMPC+6
 696         MOVEI TT,6              ;MESSAGE LENGTH
 697         JRST NETOS3
 698 \f
 699 ;.NETAC CH,     ;ACCEPT CONNECTION
 700 ;ERROR RETURN
 701 ;NORMAL RETURN
 702
 703 ANETAC: JSP T,NETCHK
 704         HRRZ T,IMSOC4(I)        ;SOCKET STATE
 705         CAIE T,%NSRFC
 706          JRST OPNL41            ;NOT IN RFC RECEIVED STATE
 707         LDB H,IMSCFH
 708         PUSHJ P,NETOW           ;GET IMPMPC
 709         MOVE A,IMSOC2(I)        ;LOCAL SOCKET NUMBER
 710         MOVE B,IMSOC3(I)        ;FOREIGN SOCKET NUMBER
 711         MOVE D,A
 712         ROT D,-1
 713         PUSHJ P,NETOS           ;SEND RFC (AND MAYBE ALL)
 714         CONO PI,NETOFF
 715         HRRZ T,IMSOC4(I)
 716         MOVEI TT,%NSOPN
 717         CAIN T,%NSRFC
 718          HRRM TT,IMSOC4(I)      ;CONNECTION OPEN
 719         JRST NETOJ1
 720
 721 NETCHK: HRRZ A,(R)
 722         CAIL A,NETDUI
 723         CAILE A,NETDBO
 724          JRST OPNL34    ;NOT A NETWORK CHANNEL
 725         HLRE I,(R)      ;SOCKET TABLE INDEX
 726         JUMPGE I,(T)
 727         JRST OPNL41     ;OTHER END OF PIPELINE GONE (NET WENT DOWN)
 728
 729 ;.NETS CH,      ;SEND BUFFER NOW
 730 ;RETURN
 731
 732 NETFRC: JSP T,NETCHK    ;ENTRY FROM .CALL FORCE
 733         MOVE T,IMSOC2(I)
 734         TRNN T,1
 735          JRST OPNL2     ;NOT SEND SOCKET
 736         CONO PI,NETOFF
 737         MOVE T,IMSMPP(I)
 738         CAMN T,IMSPIP(I)
 739          JRST NETOJ1    ;BUF EMPTY
 740         MOVSI TT,400000 ;TURN ON SEND BUFFER BIT
 741         IORM TT,IMSOC4(I)
 742         PUSHJ P,IMPOST  ;TURNS NETON
 743         JRST POPJ1
 744
 745 NETFIN: HRRZ TT,IMSBFE(I)       ;ENTRY FROM .CALL FINISH (NETFRC HAS BEEN CALLED)
 746         SUB TT,IMSOC6(I)        .SEE NETOE5 ;FOR COMMENTS FOR THIS CODE
 747         HRRZS TT
 748         SKIPGE IMSOC5(I)
 749          IMULI TT,32.
 750         SKIPL IMSOC5(I)
 751          IMULI TT,36.
 752         LDB T,IMSCBS
 753         IDIVM TT,T              ;T NOW HAS SIZE OF OUTPUT BUFFER IN BYTES
 754         CAME T,IMSMPC(I)        ;WAIT FOR BUFFER TO EMPTY OUT
 755          PUSHJ P,UFLS
 756         MOVEI T,%NSRFN          ;WAIT FOR RFNM
 757         HLL T,IMSOC4(I)         ;4.9 IS KNOWN TO BE OFF NOW!
 758         CAMN T,IMSOC4(I)
 759          PUSHJ P,UFLS
 760         JRST POPJ1
 761 \f
 762 ;.NETINT CH,    ;SEND NETWORK INTERRUPT "INR" OR "INS"
 763         ;INR FROM RECEIVER TO SENDER (LOCAL SOCKET EVEN, FOREIGN ODD)
 764         ;INS FROM SND TO RCV ( -", -")
 765 ;ALSO .CALL NETINT, ARG 1 IS CH
 766
 767 NNETINT:JSP T,NETCHK
 768         AOSA (P)        ;GOING TO WIN, SKIP RETURN
 769 ANETINT: JSP T,NETCHK   ;I<- SOCKET TABLE INDEX
 770         LDB H,IMSCFH    ;HOST INDEX FOR NETOW
 771         PUSHJ P,NETOW   ;WAIT FOR IMPMPU
 772         MOVEI A,1       ;SET COUNT
 773         MOVEM A,IMPMPC
 774         PUSHJ P,STHSTM  ;STORE HOST ADDRESS
 775         MOVE A,[8_24.+2_8]      ;BYTE SIZE 8, COUNT 2
 776         MOVEM A,IMPMPC+6
 777         MOVE A,IMSOC2(I)        ;LCL SOCK #
 778         MOVSI B,7_10.   ;INR
 779         TRNE A,1        ;SKIP IF RCV
 780          MOVSI B,8_10.  ;INS
 781         LDB A,IMSCLN    ;LINK #
 782         DPB A,[241000,,B]
 783         MOVEM B,IMPMPC+7
 784         JRST IMPMPQ     ;QUE IT, START OUTPUT (IMPOST)
 785
 786 ;STORE HOST ADDRESS FROM H INTO LEADER IN IMPMPC.  BASHES W, Q.
 787 STHSTM: MOVEI Q,IMPMPL
 788         HRLM H,IMPMPC           ;ALSO SAVE HOST INDEX FOR PI LEVEL
 789 ;STORE HOST ADDRESS FROM H INTO LEADER IN (Q), BASHES W.
 790 STHSTP: MOVE W,IMPHTN(H)        ;FOREIGN HOST NUMBER
 791 IFN 1,  DPB W,[103000,,3(Q)]    ; Store host address
 792 IFN 0,[ DPB W,[301000,,3(Q)]    ;STORE HOST NUMBER
 793         LSH W,-9
 794         DPB W,[102000,,3(Q)]    ;STORE IMP NUMBER
 795 ] ;IFN 0
 796         MOVSI W,17_10.          ;NEW-FORMAT FLAG
 797         MOVEM W,2(Q)            ;MESSAGE TYPE 0 (LINK, ETC. ARE ALWAYS ZERO)
 798         POPJ P,
 799
 800 ;.CALL NETBLK           ;WAIT FOR STATE TO CHANGE OR TIME OUT
 801 ; ARG 1 - CHANNEL
 802 ; ARG 2 - STATE
 803 ; ARG 3 - TIME, AS IN .SLEEP (OPTIONAL) (WRITTEN BACK)
 804 ; VAL 1 - NEW STATE
 805 ; VAL 2 - TIME LEFT
 806
 807 ANETBLK:JSP T,NETCHK
 808         MOVE T,I        ;SAVE INDEX IN T
 809         HRL T,B         ;STATE ALSO
 810         CAIGE W,3       ;SKIP IF 3 ARGS (TIME GIVEN)
 811          JRST ANETB3    ;USE DEFAULT TIME
 812         TLNE C,1000     ;SKIP IF POINTER, RATHER THAN IMMEDIATE
 813          JRST ANETB5
 814         XCTR XRW,[MOVES B,(C)]  ;GET TIME FROM USER (CHECK WRITE ALSO)
 815         JUMPL B,ANETB1  ;NEG MEANS ALREADY ABS TIME
 816         MOVNS B         ;MAKE NEG
 817         SUB B,TIME      ;-TIME TO GO TO
 818 ANETB1: UMOVEM B,(C)    ;STORE NEG TIME FOR PCLSR
 819         MOVNS B         ;MAKE +
 820 ANETB4: MOVEM B,EPDL(U) ;ALSO USED IN B LATER
 821         PUSHJ P,ANETB2  ;SKIP IF STATE CHANGE OR TIMEOUT
 822          PUSHJ P,UFLS
 823         SUB B,TIME      ;HOW MUCH USED?
 824         HRRZ A,IMSOC4(I)        ;RETURN STATE
 825         JRST POPJ1
 826
 827 ANETB2: HLR A,T         ;DESIRED STATE
 828         XOR A,IMSOC4(T) ;CURRENT STATE
 829         TRNE A,-1       ;SKIP IF STILL MATCH
 830          JRST POPJ1
 831         MOVE A,EPDL(U)  ;SAVED TIME HERE
 832         CAMG A,TIME
 833          AOS (P)        ;TIME OUT!
 834         POPJ P,
 835
 836 ANETB3: HRLOI B,377777  ;NO TIME SUPPLIED, USE INFINITY
 837         JRST ANETB4
 838
 839 ANETB5: HRRZ B,C        ;IMMEDIATE TIME SUPPLIED
 840         ADD B,TIME      ;(TIMEOUT WILL RESTART ON EACH PCLSR, TOO BAD)
 841         JRST ANETB4
 842 \f
 843 IFE INETP,[
 844 ;.CALL STYNET
 845 ;ARG 1 - STY CHANNEL
 846 ;ARG 2 - NET INPUT CHANNEL TO CONNECT STY OUTPUT TO, OR -1 TO DISCONNECT
 847 ;ARG 3 - NET OUTPUT CHANNEL TO CONNECT STY INPUT TO
 848 ;ARG 4 - CHARS TO SEND WHEN OUTPUT .RESET HAPPENS ON STY'S TTY
 849 ;          UP TO 3 8-BIT CHARACTERS, LEFT JUSTIFIED.
 850
 851 NSTYNT: TLNN R,%CLSST
 852          JRST OPNL34            ;1ST ARG NOT A STY CHANNEL.
 853         HLRZ I,(R)              ;GET TTY # OF STY
 854         HRRES B                 ;ALLOW IMMEDIATE -1
 855         JUMPGE B,NSTYN2         ;JUMP IF CONNECTING.
 856         PUSHJ P,NSTYN0          ;DISCONNECT
 857          JRST OPNL41            ;WASN'T CONNECTED
 858         JRST POPJ1
 859
 860 ;VARIOUS ROUTINES CALL HERE WITH THE TTY# OF A STY IN I, TO DISCONNECT THE
 861 ; STY FROM THE NETWORK.  NOTE THIS ROUTINE MUST NOT CHANGE U AND MUST NOT
 862 ; LSWCLR, SINCE IT COULD BE CALLED FROM IODCL VIA STYCLS OR NETCLS.
 863
 864 NSTYN0: MOVSI B,%SSNET          ;DISCONNECTING BOTH SIDES.
 865         CONO PI,NETOFF
 866         TDNN B,STYSTS-NFSTTY(I)
 867          POPJ P,                        ;THIS STY NOT CONNECTED?
 868         ANDCAB B,STYSTS-NFSTTY(I)       ;MARK AS NO LONGER CONNECTED
 869         MOVE C,STYNTL-NFSTTY(I)         ;REMOVE THIS STY FROM ACTIVATION LIST
 870         MOVEI D,STYNTA-STYNTL+NFSTTY
 871 NSTYN1: CAMN I,STYNTL-NFSTTY(D)         ;FIND THE STY THAT POINTS TO THIS ONE,
 872          MOVEM C,STYNTL-NFSTTY(D)       ;AND PATCH US OUT OF THE LIST.
 873         SKIPE D,STYNTL-NFSTTY(D)        ;SEARCH WHOLE LIST TILL FIND WHO POINTS TO US.
 874          JRST NSTYN1
 875         SETOB C,STYNTL-NFSTTY(I)
 876         EXCH C,STYNTI-NFSTTY(I) ;MARK THIS STY AS HAVING NO CONNECTION, GET SOCKET INDICES
 877 IFN CHAOSP,[
 878         TLNE B,%SSCHA
 879          JRST [ MOVSI B,%SSCHA  ;DISCONNECT FROM CHAOS NET
 880                 ANDCAM B,STYSTS-NFSTTY(I)
 881                 MOVSI B,%CFSTY
 882                 TDNN B,CHSSTA(C)
 883                  JRST 4,.       ;CHAOS DOESN'T THINK IT WAS CONNECTED?
 884                 ANDCAM B,CHSSTA(C)
 885                 JRST NETOJ1 ]
 886 ];CHAOSP
 887         MOVE B,[40000,,777]
 888         TDNN B,IMSOC5(C)
 889          JRST 4,.               ;SOCKET DOESN'T THINK IT WAS CONNECTED?
 890         ANDCAM B,IMSOC5(C)      ;AND MARK SOCKETS WE WERE CONNECTED TO AS DISCONNECTED
 891         MOVSS C
 892         TDNN B,IMSOC5(C)
 893          JRST 4,.               ;SOCKET DOESN'T THINK IT WAS CONNECTED?
 894         ANDCAM B,IMSOC5(C)
 895         JRST NETOJ1
 896
 897 NSTYN2: MOVE Q,I                ;SAVE TTY # OF STY
 898         MOVEI E,1
 899         MOVE A,B                ;DECODE THE NETWORK INPUT CHANNEL
 900         JSP T,CHNDCD
 901 IFN CHAOSP,[
 902         HRRZ A,(R)
 903         CAIE A,CHAIDN
 904          CAIN A,CHAODN
 905           JRST [ HLRZ I,(R)     ;CONNECT TO CHAOS NET
 906                  CONO PI,NETOFF
 907                  MOVSI B,%CFSTY
 908                  TDNE B,CHSSTA(I)
 909                   JRST OPNL23   ;ALREADY CONNECTED, FILE LOCKED
 910                  MOVSI C,%SSNET+%SSCHA
 911                  TDNE C,STYSTS-NFSTTY(Q)
 912                   JRST OPNL23   ;ALREADY CONNECTED, FILE LOCKED
 913                  IORM B,CHSSTA(I)       ;OK, HOOK UP
 914                  DPB Q,[$CFTTN,,CHSSTA(I)]
 915                  JRST NSTYN3 ]
 916 ];CHAOSP
 917         JSP T,NETCHK    ;TEST LEGALITY;  OPNL IF LOSES
 918         TDNE E,IMSOC2(I)
 919          JRST OPNL2             ;WRONG DIRECTION IF IT'S AN OUTPUT CHANNEL
 920         MOVE B,I                ;SAVE INPUT IMSOC INDEX
 921         MOVE A,C                ;DECODE OUTPUT CHANNEL
 922         JSP T,CHNDCD
 923         JSP T,NETCHK
 924         TDNN E,IMSOC2(I)
 925          JRST OPNL2             ;WRONG DIRECTION IF INPUT SOCKET
 926         CONO PI,NETOFF
 927         MOVE E,[40000,,777]
 928         TDNN E,IMSOC5(B)        ;ERROR IF EITHER CHANNEL ALREADY CONNECTED
 929          TDNE E,IMSOC5(I)
 930           JRST OPNL23           ;"FILE LOCKED"
 931         MOVSI C,%SSNET
 932         TDNE C,STYSTS-NFSTTY(Q)
 933          JRST OPNL23            ;SIMILAR ERROR IF STY ALREADY CONNECTED
 934         HRR E,Q                 ;GET 40000,,TTY #
 935         IORM E,IMSOC5(I)
 936         IORM E,IMSOC5(B)        ;MARK SOCKETS AS CONNECTED
 937 NSTYN3: SKIPGE STYNTL-NFSTTY(Q) ;HALT IF STY'S VARS ARE NOT CORRECT FOR A
 938          SKIPL STYNTI-NFSTTY(Q) ;NON-CONNECTED STY.
 939           JRST 4,.
 940         IORM C,STYSTS-NFSTTY(Q) ;ALL ERROR CAUGHT, SO MARK STY CONNECTED.
 941         HRL B,I                 ;PUT INPUT IMSOC IDX,, OUTPUT IMSOC IDX
 942         MOVSM B,STYNTI-NFSTTY(Q) ;INTO THE STY
 943         TRZ D,7777              ;STORE THE OUTPUT RESET CHARACTERS - AT MOST 3
 944         MOVEM D,STYORC-NFSTTY(Q)
 945 IFN CHAOSP,[                    ;ACTIVATE IN CASE HAS UNREAD INPUT
 946         TLNN C,%SSCHA
 947          PUSHJ P,IMPUIN
 948         TLNE C,%SSCHA
 949          PUSHJ P,CHINTI
 950 ];CHAOSP
 951 .ELSE   PUSHJ P,IMPUIN
 952         JRST NETOJ1
 953 ] ;IFE INETP
 954 \f
 955 SUBTTL  ARPANET MP I/O ROUTINES
 956
 957 IFE INETP,[
 958 ;CALL STYNTC AT CLOCK LEVEL TO PROCESS ALL NECESSARY TRANSFERS OF DATA
 959 ;BETWEEN CONNECTED STYS AND NET SOCKETS
 960
 961 STYNTC: CONO PI,NETOFF
 962         SKIPN I,STYNTA          ;GET HEAD OF ACTIVATE LIST
 963          JRST NETONJ            ;EMPTY
 964         SETZM STYNTA            ;COPY LIST IN CASE A STY IS PUT BACK ON
 965         CONO PI,NETON
 966 STYNT7: MOVE A,STYNTL-NFSTTY(I) ;GET NEXT ON LIST
 967         MOVEM A,STYNTB          ;SAVE FOR NEXT TIME AROUND LOOP
 968         SETOM STYNTL-NFSTTY(I)  ;THIS ONE IS NO LONGER ON ACTIVATE LIST
 969         MOVE A,STYSTS-NFSTTY(I)
 970         TLNN A,%SSNET
 971          JRST 4,.               ;STY CLAIMS NOT TO BE CONNECTED??
 972         MOVE R,I                ;SAVE TTY #
 973 IFN CHAOSP,[
 974         TLNE A,%SSCHA
 975          JRST STYCHA            ;CONNECTED TO CHAOS NET
 976 ];CHAOSP
 977 ] ;IFE INETP
 978 IFN INETP,STYNCP:
 979
 980         SKIPGE TTYOAC(I)
 981          JRST STYNT1            ;NO OUTPUT, CHECK FOR INPUT
 982 ;HANDLE OUTPUT TO NET
 983         HRRZ I,STYNTI-NFSTTY(I) ;GET IMSOC IDX OF OUTPUT CHANNEL
 984         MOVSI A,40000
 985         TDNN A,IMSOC5(I)
 986          JRST 4,.               ;SOCKET CLAIMS NOT TO BE CONNECTED??
 987 STYNT5: CONO PI,NETOFF          ;INCLUDES TTYOFF
 988         PUSHJ P,NSOSE0          ;CAN WE OUTPUT TO NET NOW?
 989          JRST STYNT6            ;NO, WAIT TILL LATER, PI LVL WILL REACTIVATE WHEN STATE CHANGES
 990         LDB T,IMSCBS            ;SINCE THIS IS PI LEVEL,
 991         MOVE Q,IMSOC7(I)        ;NO POINT IN SENDING MORE OUTPUT THAN ALLOCATED
 992         SUB Q,IMSC7I(I)
 993         IDIVM Q,T               ;T GETS NUMBER OF BYTES ALLOCATED AND NOT BUFFERED
 994         CAMLE E,T
 995          MOVE E,T
 996         JUMPLE E,STYNT6         ;NO ALLOC, SEND NOTHING
 997         EXCH R,I                ;BEFORE EXCH, R HAS TTY #, I HAS NET IMSOC IDX
 998         MOVEM D,DBBBP           ;SET UP BUFFER-POINTING VARS FOR TTY OUTPUT INTERRUPT LEVEL
 999         MOVEM E,DBBCC
1000         MOVEM E,DBBCC1
1001         PUSH P,R
1002         SETOM TYPNTF
1003         PUSHJ P,TYP             ;OUTPUT THROUGH THOSE POINTERS, INTO THE NET CHNL BUFFER
1004         SETZM TYPNTF
1005         POP P,R
1006         EXCH I,R
1007         MOVE D,DBBBP
1008         MOVE E,DBBCC
1009         MOVE Q,DBBCC1
1010         PUSHJ P,NSOFIN          ;FIGURE OUT HOW MANY CHARS WERE TYPED, AND UPDATE SOCKET.
1011          JRST STYNT4            ;MORE ROOM IN BUFFER => MAYBE TYPE SOME MORE.
1012         JRST STYNT6             ;ELSE TRY INPUT FROM NET, BUT SEND WHATEVER WE GOT
1013
1014 STYNT4: SKIPL TTYOAC(R)         ;MORE OUTPUT IN TTY BUFFER?
1015          JRST STYNT5            ;YES, PROCESS IT
1016 STYNT6: PUSHJ P,NSOFN1          ;NO, BE SURE NET BUFFER GETS SENT SOON
1017
1018 ;HERE TO TRY TO HANDLE INPUT FROM NET
1019 STYNT1: HLRZ I,STYNTI-NFSTTY(R) ;INPUT IMSOC INDEX
1020         MOVSI A,40000
1021         TDNN A,IMSOC5(I)
1022          JRST 4,.               ;SOCKET CLAIMS NOT TO BE CONNECTED?
1023 STYNT2: PUSHJ P,NETIDC          ;GET CHAR FROM NET SOCKET
1024          JRST STYNT3             ;GOT CHAR IN W
1025          JRST STYNT8             ;NO CHAR AVAIL, HANDLE OTHER STYS
1026                                  ;2 SKIPS => GIVE UP, SPECIAL CHARACTER SEEN, OR BAD STATE
1027         PUSHJ P,IMPUIP          ;WAKE UP THE TELNET SERVER
1028         MOVE I,R                ;DISCONNECT THE STY AND SOCKETS
1029         PUSHJ P,NSTYN0
1030          JRST 4,.
1031 IFE INETP,[
1032 STYNT8: SKIPE I,STYNTB          ;GET NEXT STY FROM COPIED ACTIVATION LIST
1033          JRST STYNT7
1034         POPJ P,
1035 ] ;IFE INETP
1036 .ELSE   JRST STYNT8
1037
1038 STYNT3: EXCH I,R                ;HERE IF GET CHAR FROM NET IN W.  I GETS TTY #.
1039         PUSH P,R
1040         PUSH P,I
1041         MOVE A,W
1042         CONO PI,TTYOFF
1043         PUSHJ P,NTYI5           ;GIVE CHARACTER TO TTY INPUT INTERRUPT LEVEL.
1044         CONO PI,TTYON
1045         POP P,R                 ;TTY #;  POP IN REVERSE ORDER TO UNDO THE EXCH
1046         POP P,I                 ;IMSOC IDX
1047         JRST STYNT2             ;TRY TO GET ANOTHER INPUT CHARACTER.
1048 \f
1049 ;STYNTC'S INTERFACE TO NET INPUT IOT.
1050 ;I HAS IMSOC IDX OF INPUT SOCKET.
1051 ;1 SKIP => NO DATA AVAILABLE.
1052 ;2 SKIPS => TELNET CONTROL CHARACTER FOUND, SO DISCONNECT STY AND
1053 ;INTERRUPT THE USER PROGRAM.
1054 NETIDC: MOVNI U,1               ;U=-1 TELLS NETI IT CAME FROM HERE
1055         HRRZ H,IMSOC4(I)        ;CHECK SOCKET STATE
1056         CAIN H,%NSOPN
1057          JRST POPJ1             ;NO DATA
1058         CAIGE H,%NSCLI          ;SKIP IF IN ONE OF THE TWO INPUT AVAILABLE STATES
1059          JRST POPJ2             ;STATE IS ABNORMAL, SO DISCONNECT FROM STY.
1060         JRST NETID              ;ELSE TRY AN IOT.
1061
1062 ;NETWORK UNIT INPUT.
1063 NETI:   HRRE I,A        ;SOCKET TABLE INDEX
1064         JUMPL I,IOCER1
1065 NETIB:  MOVE A,IMSOC5(I) ;ENTER HERE FROM BLOCK-MODE INPUT
1066         TLNE A,40000
1067          JRST IOCR10    ;CAN'T IOT AT M.P. LEVEL WHILE SOCKET CONNECTED TO A STY.
1068 NETID:  MOVE A,IMSC8I(I)
1069         LDB B,IMSCBS
1070         IMUL B,IMSMPC(I)
1071         ADD B,IMSOC7(I) ;TOTAL NUMBER OF BITS YET TO BE READ
1072         CAIGE A,8.      ;IF MESS REALL OF 8 OR MORE
1073          CAMG B,IMSC7I(I) ;OR BIT REALL SATISFIES "DOUBLE BUFFERING" CRITERION
1074           PUSHJ P,NETI6 ;THEN SEND ALLOCATE
1075         JUMPL U,NETI4   ;JUMP IF READING INPUT TO GIVE DIRECTLY TO A STY
1076 NETI0:  CONO PI,NETOFF  ;DON'T ALLOW INTO IMPUIN WHILE CHECKING STATE, #BITS
1077         HRRZ A,IMSOC4(I)
1078         JUMPE A,NETIB1  ;CONNECTION CLOSED
1079         CAIE A,%NSINP
1080          CAIN A,%NSCLI
1081           JRST .+3
1082            CAIE A,%NSOPN
1083             JRST IOCR10         ;SOCKET IN BAD STATE
1084         PCLT
1085         SKIPG IMSMPC(I)         ;WAIT FOR BITS TO ARRIVE
1086          PUSHJ P,UFLS
1087         CONO PI,NETON           ;NETON IN CASE DIDN'T UFLS
1088         SKIPG IMSMPC(I)         ;DID THEY?
1089          JRST NETI0             ;NO, STATE MUST HAVE CHANGED, CHECK IT AGAIN
1090
1091 NETI4:  SOSL IMSOCT(I)          ;TAKE BYTE
1092          JRST NETI4A
1093         MOVE A,IMSMPP(I)        ;END OF MESSAGE, FIND ADDRESS OF NEXT HEADER WORD
1094         MOVEI A,1(A)            ;WHICH IS IN NEXT WORD AFTER LAST BYTE LOADED
1095         CAILE A,@IMSBFE(I)
1096          HRRZ A,IMSOC6(I)       ;WRAP AROUND
1097         SOSGE B,(A)             ;GET HEADER WORD, COUNT DOWN FOR BYTE ABOUT TO TAKE
1098          JRST 4,.               ;NO MESSAGE, ALTHOUGH IMSMPC > 0
1099         MOVEM B,IMSOCT(I)       ;SAVE # BYTES LEFT IN THIS MESSAGE
1100         HLL A,IMSBFE(I)         ;SET UP BYTE POINTER LH TO LAST BYTE IN WORD
1101         MOVEM A,IMSMPP(I)       ; SO ILDB WILL GET FIRST DATA BYTE OF THIS MSG
1102         AOS IMSC8I(I)           ;INCREASE MESSAGE ALLOCATION
1103 NETI4A: MOVE TT,IMSMPP(I)       ;CHECK FOR WRAP-AROUND
1104         MOVE H,IMSOC5(I)
1105         TLNE H,2000
1106          JRST NETI2             ;JUMP IF ONE BIT BYTES
1107         CAMN TT,IMSBFE(I)
1108          JRST [ HRRZ TT,IMSOC6(I)
1109                 HLL TT,IMSPIP(I)        ;B.P. TO FIRST BYTE IN BUFFER
1110                 JRST .+1 ]
1111         ILDB W,TT
1112         JRST NETI3
1113
1114 NETI2:  LDB E,IMSCBS            ;BITS PER BYTE
1115         MOVEI W,0
1116 NETI1:  CAME TT,IMSBFE(I)
1117          JRST NETI1A
1118         HRRZ TT,IMSOC6(I)       ;WRAP AROUND
1119         HLL TT,IMSPIP(I)
1120 NETI1A: ILDB A,TT
1121         LSH W,1
1122         IORI W,(A)
1123         SOJG E,NETI1
1124 ;DROPS THROUGH
1125 \f;DROPS IN
1126
1127 NETI3:  TRNN W,200              ;IS THIS A TELNET CONTROL CHAR (>= 200)?
1128          JRST NETI3A
1129         JUMPL U,[AOS IMSOCT(I)  ;YES;  IF DIRECT-CONNECTED TO A STY, BREAK CONNECTION.
1130                  JRST POPJ2]    ; WITHOUT GOBBLING THAT CHARACTER
1131         TLNE H,400              ;IF 7-BIT ASCII MODE, REPLACE CHARACTER BY ^@.
1132          SETZ W,
1133 NETI3A: MOVEM TT,IMSMPP(I)
1134         LDB TT,IMSCBS
1135         ADDM TT,IMSC7I(I)       ;INCREASE BIT ALLOCATION
1136         CONO PI,NETOFF          ;WHILE CHANGING STATE
1137         SOSLE IMSMPC(I)         ;ONE LESS BYTE IN BUFFER
1138          JRST NETONJ            ;OK, THERE IS MORE IN BUFFER
1139         MOVNI E,1               ;YES, STATE IS CHANGING.
1140         HRRZ A,IMSOC4(I)
1141         CAIN A,%NSCLI
1142          MOVEI E,%NSCLS
1143         CAIN A,%NSINP
1144          MOVEI E,%NSOPN         ;NO INPUT AVAILABLE
1145         JUMPL E,[JRST 4,.]      ;WAS IN SOME RANDOM STATE
1146         CAIN E,%NSCLS
1147          PUSHJ P,IMPUIP         ;IF STATE CHANGING TO "CLOSED", GIVE USER AN INTERRUPT.
1148         HRRM E,IMSOC4(I)
1149         JRST NETONJ
1150
1151 ;COME HERE WHEN INPUT IOT FINDS THAT CONNECTION IS CLOSED
1152 NETIB1: CONO PI,NETON
1153         LDB D,IMSCLS
1154         CAIE D,%NCFRN
1155          JRST IOCR10    ;ABNORMAL CLOSURE, GIVE IOCER INSTEAD OF EOF
1156         MOVE TT,IMSOC5(I)
1157         POP P,D         ;GET OUR RETURN ADDRESS.
1158         ANDI D,-1
1159         CAIE D,AIOT3    ;IF WE ARE NOT DOING A UNIT MODE IOT,
1160          JRST 1(D)      ;JUST RETURN WITH 1 SKIP.
1161         TLNN TT,1400    ;SKIP IF ASCII MODE
1162          JRST IOCER2    ;EOF IN IMAGE MODE IS IOCERROR.
1163         HRROI W,EOFCH   ;EOF IN ASCII MODE RETURNS ^C.
1164         JRST 1(D)
1165
1166 NETI6:  HRRZ H,IMSOC4(I)        ;SEND ALL MSG
1167         CAIE H,%NSINP
1168          CAIN H,%NSOPN
1169           CAIA
1170            POPJ P,      ;CLOSED, DON'T SEND ALLOCATE
1171         LDB H,IMSCFH    ;HOST INDEX FOR NETOW
1172         PUSHJ P,NETOW   ;GOBBLE MAIN PROG CONTROL LINK BLOCK
1173         MOVEI J,2(I)    ;LINK #
1174         IORI J,<4_8>    ;SEND ALLOC
1175         LSH J,16.
1176         ADD J,IMSC8I(I)
1177         LSH J,4
1178         MOVEM J,IMPMPC+7
1179         MOVE J,IMSC7I(I)
1180         LSH J,4
1181         MOVEM J,IMPMPC+10
1182         PUSHJ P,STHSTM          ;STORE HOST ADDRESS, MESSAGE TYPE
1183         MOVE J,[8_24.+8_8]
1184         MOVEM J,IMPMPC+6
1185         MOVEI J,2
1186         HRRM J,IMPMPC   ;TEXT LENGTH
1187         SETZB A,TT
1188         EXCH A,IMSC8I(I)
1189         EXCH TT,IMSC7I(I)
1190         ADDM A,IMSOC8(I)
1191         ADDM TT,IMSOC7(I)
1192         JRST IMPMPQ
1193 \f
1194 ;UNIT MODE NETWORK OUTPUT (DOESN'T CLOBBER C)
1195         JRST NETSIO     ;SIOT VECTOR
1196 NETW:   HRRE I,A        ;SOCKET TABLE INDEX
1197         JUMPL I,IOCER1
1198         SKIPGE C
1199          SKIPA A,(C)
1200           UMOVE A,(C)
1201 NETWB:  CONO PI,NETOFF          ;BYTE TO OUTPUT IN A. HERE FROM BLOCK MODE.
1202         HRRZ B,IMSOC4(I)
1203         CAIE B,%NSOPN
1204         CAIN B,%NSRFN
1205          JRST .+2
1206           JRST IOCR10
1207         SKIPG IMSMPC(I)         ;SKIP IF ROOM TO PUT BYTE IN BUF
1208          JRST [ MOVSI B,400000
1209                 IORM B,IMSOC4(I) ;SET TO SEND IT NOW
1210         IFN DMIMP,CONSZ FI,70
1211                  PUSHJ P,IMPIOS
1212                 SKIPG IMSMPC(I)  ;WAIT FOR AT LEAST ONE BYTE OF ROOM
1213                  PUSHJ P,UFLS
1214                 CONO PI,NETON
1215                 SKIPG IMSMPC(I)
1216                  JRST NETWB     ;NO ROOM, STATE MUST HAVE CHANGED
1217                 JRST .+1]
1218         MOVE E,IMSOC5(I)
1219         MOVE T,IMSOC7(I)
1220         TLNE E,100000
1221          CAML T,IMSC7I(I)
1222           JRST NETW4
1223         MOVSI B,400000          ;ALLOCATION USED UP (AND FEATURE ENABLED)
1224         IORM B,IMSOC4(I)        ;SEND BUFFER NOW
1225         PUSHJ P,IMPOST
1226         CAMN T,IMSOC7(I)        ;WAIT FOR DATA TO GO OUT OR ALLOC TO COME IN
1227          PUSHJ P,UFLS
1228         JRST NETWB              ;TRY AGAIN
1229
1230 NETW4:  MOVE T,IMSMPP(I)        ;GET POINTER
1231         MOVE E,TIME
1232         CAMN T,IMSPIP(I)        ;SKIP UNLESS BUFFER EMPTY
1233          MOVEM E,IMSOCT(I)      ;SET TIME FOR FIRST BITS INTO BUF
1234         LDB B,IMSCBS            ;BYTE SIZE
1235         MOVE E,IMSOC5(I)        ;FLAGS
1236         CONO PI,NETOFF          ;WANT TO MUNG POINTERS WITHOUT PI INTERFERENCE
1237         TLNE E,2000             ;SKIP IF BYTES FIT EXACTLY IN WORD
1238          TLNN T,770000          ;SKIP IF NOT AT RIGHT END OF WORD
1239           JRST NETW2            ;IDPB, CHECK FOR POINTER WRAP
1240         LDB TT,[360600,,T]      ;GET BYTE POS
1241         CAML TT,B               ;SKIP IF BYTE SPLITS ACROSS WORDS
1242          JRST NETW1             ;JUST DO IDPB
1243         DPB TT,[301400,,T]      ;SET BYTE TO STORE IN RIGHT OF THIS WORD
1244         SUB TT,B                ;=> -(# OVERFLOW BITS)
1245         ROT A,(TT)              ;HIGH PART OF BYTE IN RIGHT END OF A
1246         DPB A,T                 ;STORE PART BYTE
1247         AOS T,IMSMPP(I)         ;INCR TO NEXT WORD
1248         MOVEI E,(T)
1249         CAILE E,@IMSBFE(I)
1250          HRR T,IMSOC6(I)        ;WRAP
1251         MOVEM A,@T              ;STASH REST OF BYTE IN LEFT PART OF NEXT WORD
1252         ADDI TT,36.             ;SET TO NEW POSITION
1253         DPB TT,[360600,,T]      ;NEW BYT POS
1254         MOVEM T,IMSMPP(I)       ;STORE UPDATED PTR
1255         JRST NETW3              ;WRAP UP
1256
1257 ;DEPOSIT A BYTE WHICH MAY WRAP AROUND
1258
1259 NETW2:  CAME T,IMSBFE(I)
1260          JRST NETW1             ;NO WRAP
1261         HRR T,IMSOC6(I)
1262         TLO T,440000
1263         MOVEM T,IMSMPP(I)
1264
1265 ;DEPOSIT BYTE KNOWN TO FIT IN WORD
1266
1267 NETW1:  IDPB A,IMSMPP(I)        ;STORE IT
1268
1269 ;COUNT THE BITS NOW
1270
1271 NETW3:  SOS IMSMPC(I)           ;1 BYTE LESS FREE
1272         LDB T,IMSCBS
1273         ADDM T,IMSC7I(I)
1274         JRST NETONJ
1275 \f
1276 ;NETWORK OUTPUT SIOT
1277 NETSIO: CONO PI,NETOFF
1278         PUSHJ P,NSOSET          ;SET UP FOR FAST SIOT
1279          JRST NSIOT1            ;CHANNEL ISN'T SET UP FOR IT => USE NORMAL SIOT LOOP.
1280         PUSH P,B
1281         PUSH P,C
1282 NETSO0: XCTR XRW,[MOVES B,@-1(P)]       ;COPY ARGS
1283         XCTR XRW,[MOVES C,@(P)]
1284 NETSO1: IBP B           .SEE NSIOOL ;FOR WHY THIS HAIR IS NEEDED
1285         XCTRI XR,[MOVE TT,(B)]
1286          SKIPA T,B
1287           JRST NETSO3           ;PAGE FAULT, CLEAN UP IMSMPP BEFORE TAKING IT
1288         HRRI T,TT
1289         LDB TT,T
1290         IDPB TT,D
1291         SOS E
1292         UMOVEM B,@-1(P)         ;UPDATE USER'S ARGS
1293         XCTR XRW,[SOSLE C,@(P)]
1294          JUMPG E,NETSO1         ;LOOP IF BOTH USER AND SYSTEM WILLING
1295         SKIPL E
1296          SKIPGE C
1297           JRST 4,.              ;WENT TOO FAR!!
1298         PUSHJ P,NSOFIN          ;FINISH UP HACKING NET CHANNEL.
1299          JRST NETSO2            ;OUTPUT BUFFER HAS MORE ROOM
1300         JUMPLE C,PPBAJ1         ;NO ROOM BUT DON'T WANT ANY MORE ANYWAY, SO RETURN
1301         SKIPG IMSMPC(I)         ;NO ROOM, WAIT FOR SOME
1302          PUSHJ P,UFLS           ;NOTE ANY STATE CHANGE WILL UNHANG
1303         POP P,C                 ;NOW TRY TO SIOT SOME MORE
1304         POP P,B
1305         MOVE D,IOTTB(H)         ;RESTORE D IN CASE GOES TO NSIOT1
1306         JRST NETSIO
1307
1308 NETSO3: PUSHJ P,NSOFIN          ;TOOK PAGE FAULT, CLEAN UP
1309          JFCL
1310         PUSHJ P,TPFLT
1311 NETSO2: JUMPLE C,PPBAJ1         ;BUFFER HAS ROOM BUT NO DESIRE TO SEND ANY MORE, RETURN
1312         CONO PI,NETOFF
1313         PUSHJ P,NSOSE0          ;SET UP TO SEND MORE
1314          JRST IOCR10            ;STATE MUST HAVE GONE BAD
1315         JRST NETSO0             ;OK, SEND MORE
1316
1317 ;SET UP FOR NET OUTPUT SIOT, OR (NSOSE0) FOR DIRECT OUTPUT FROM STY.
1318 ;AT ENTRY, A HAS LH(IOCHNM).
1319 ;CALL WITH NETOFF, AND DON'T TURN IT BACK ON BEFORE CALLING NSOFIN,
1320 ;BECAUSE WE HAVE A COPY OF IMSMPP IN D, AND PI LEVEL MIGHT BE TRYING TO MUNG IT.
1321 ;SETS D TO POINTER, E TO COUNT OF CHARS OF SPACE, AND Q TO COPY OF COUNT.
1322 ;SETS I TO IMSOC IDX.  CLOBBERS T AND TT.
1323 ;NO SKIP => CAN'T USE FAST SIOT, OR CAN'T DO DIRECT OUTPUT AT THIS MOMENT.
1324 ;IN THAT CASE, D HASN'T BEEN CLOBBERED YET.
1325 NSOSET: HRRE I,A
1326         JUMPL I,IOCER1
1327 NSOSE0: MOVE E,IMSOC5(I)
1328         HRRZ T,IMSOC4(I)
1329         CAIE T,%NSOPN
1330          CAIN T,%NSRFN          ;STATE BAD, OR BYTES CROSS WORD BOUNDARIES,
1331           TLNE E,2000
1332            JRST NETONJ          ;IMPLIES CAN'T WIN THIS WAY.
1333         SKIPG E,IMSMPC(I)
1334          JRST NSOFN1            ;JUMP IF BUFFER FULL, SET SEND BUFFER AND NETONJ
1335         MOVE D,IMSMPP(I)
1336         CAME D,IMSBFE(I)
1337          JRST NSOSE2
1338         HRR D,IMSOC6(I)         ;IF BUFFER STORING PTR POINTS AT END OF BUFFER,
1339         TLO D,440000            ;WRAP AROUND.
1340 NSOSE2: LDB Q,IMSCBS
1341         MOVEI TT,36.
1342         SKIPGE IMSOC5(I)
1343          MOVEI TT,32.
1344         IDIVM TT,Q              ;GET # BYTES/WD OF CONNECTION.
1345         HRRZ TT,IMSBFE(I)
1346         SUBI TT,(D)
1347         IMUL TT,Q               ;# BYTES BETWEEN POINTER AND END OF BUFFER.
1348         LDB T,[360600,,D]
1349         LDB Q,IMSCBS
1350         IDIVM T,Q               ;# BYTES NOT STORED IN WORD POINTER POINTS AT
1351         ADD TT,Q                ;THEY ARE AVAILABLE, TOO.
1352         CAML E,TT
1353          MOVE E,TT              ;GET MINIMUM OF FULL BYTES AND BYTES AFTER THE POINTER.
1354         MOVE T,TIME
1355         MOVE Q,IMSMPP(I)
1356         CAMN Q,IMSPIP(I)        ;SKIP IF BUFFER NOT EMPTY
1357          MOVEM T,IMSOCT(I)      ;TIME FOR FIRST BITS INTO BUF.
1358         CAILE E,600             ;DON'T LEAVE NETOFF FOR MORE THAN ONE CLOCK TICK OR SO
1359          MOVEI E,600
1360         MOVE Q,E                ;ORIGINAL E. (FOR NSOFIN)
1361         JRST POPJ1
1362
1363 ;FINISH UP AFTER NET OUTPUT SIOT OR DIRECT OUTPUT FROM STY.
1364 ;SKIP IF BUFFER FULL
1365 ;ASSUME Q,I LEFT OVER FROM NSOSET, AND D,E ADVANCED BY STORING CHARS.
1366 NSOFIN: PI2SAF                  ;NETOFF SHOULD STILL BE IN EFFECT FROM NSOSET
1367         SUBM E,Q                ;- <# BYTES XFERED>
1368         JUMPE Q,NETONJ          ;IF OUTPUT NO BYTES, DON'T CHANGE IMSMPP (IMPORTANT!)
1369         MOVEM D,IMSMPP(I)       ;UPDATE STORING POINTER OF SOCKET BUFFER
1370         LDB TT,IMSCBS
1371         IMUL TT,Q
1372         MOVNS TT
1373         ADDM TT,IMSC7I(I)       ;INCREASE COUNT OF BITS IN BUFFER
1374         ADDB Q,IMSMPC(I)        ;UPDATE COUNT OF FREE SPACE IN BUFFER.
1375         JUMPG Q,.+2             ;ANY SPACE LEFT => NO SKIP.
1376          AOS (P)
1377         JUMPG E,NETONJ          ;ONLY SEND BUFFER IF CALL OUTPUT ALL IT COULD
1378 NSOFN1: MOVSI TT,400000         ;SEND BUFFER NOW.
1379         IORM TT,IMSOC4(I)
1380         JRST IMPOST             ;TURNS NETON
1381 \f
1382 NETBO:  HRRE I,A
1383         JUMPL I,IOCER1
1384         XCTR XRW,[MOVES D,(C)]  ;TAKE TRAP GETTING POINTER IF SWAPPED OUT
1385         MOVE E,IMSOC5(I)
1386         TLNE E,1400     ;SKIP IF IMAGE MODE
1387          JRST NETBOA    ;ASCII MODE
1388         JUMPGE D,CPOPJ          ;TRANSFER NO WORDS
1389 NETBO1: UMOVEM D,(C)
1390         UMOVE A,(D)
1391         PUSHJ P,NETWB
1392         UMOVE D,(C)
1393         AOBJN D,NETBO1
1394         UMOVEM D,(C)
1395         POPJ P,
1396
1397 NETBOA: TLNN E,400      ;SKIP IF 7 BIT
1398          JRST NETBA8
1399         MOVEI E,NETBOR
1400         JRST NBTOCH
1401
1402 NETBOR: PUSH P,D
1403         PUSH P,TT
1404         PUSHJ P,NETWB
1405         POP P,TT
1406         POP P,D
1407         MOVEI E,NETBOR
1408         POPJ P,
1409
1410 NETBA8: XCTR XRW,[MOVES D,(C)]
1411         LDB TT,[410300,,D]
1412         CAIGE TT,4      ;ONLY 4 BYTES PER WORD (3 < CNT < 8)
1413          POPJ P,
1414         SKIPA TT,NETCHT-4(TT)
1415 NTBA8A:  UMOVEM D,(C)
1416         UMOVE W,(D)
1417         ILDB A,TT
1418         PUSH P,TT
1419         PUSHJ P,NETWB
1420         POP P,TT
1421         UMOVE D,(C)
1422         ADD D,[700000,,]        ;ADVANCE CHAR CNT
1423         JUMPL D,NTBA8A          ;GO TO NEXT CHAR
1424         MOVE TT,NETCHT+3
1425         ADD D,[400001,,1]       ;INCR TO NEXT WORD
1426         JUMPL D,NTBA8A
1427         UMOVEM D,(C)
1428         POPJ P,
1429
1430 NETCHT: REPEAT 4,<44-<3-.RPCNT>*10>_12.+1000,,W
1431 \f
1432 NETBI:  HRRE I,A
1433         JUMPL I,IOCER1
1434         XCTR XRW,[MOVES D,(C)]  ;ENSURE POINTER WILL BE WRITABLE
1435         MOVE E,IMSOC5(I)
1436         TLNE E,1400     ;SKIP IF IMAGE MODE
1437          JRST NETBIA    ;ASCII MODE
1438 NETBI1: UMOVEM D,(C)    ;STORE BACK POINTER
1439         XCTR XRW,[MOVES (D)]    ;ENSURE BYTE WILL BE WRITABLE
1440         PUSH P,C
1441         PUSHJ P,NETIB   ;GET NEXT BYTE
1442          CAIA           ;NORMAL RETURN.
1443           JRST POP1J    ;NO INPUT AVAIL.
1444         POP P,C
1445         UMOVE D,(C)
1446         UMOVEM W,(D)
1447         AOBJN D,NETBI1
1448         UMOVEM D,(C)
1449         POPJ P,
1450
1451 NETBIA: TLNN E,400      ;SKIP IF 7 BIT ASCII
1452          JRST NTBIA8
1453         MOVEI E,NETBIR
1454         JRST INBTCH
1455
1456 NETBIR: PUSHJ P,NETI
1457          JRST [ MOVEI E,NETBIR  ;INPUT IN W
1458                 POPJ P, ]
1459         MOVE E,[600000,,NETBCC] ;NO INPUT AVAIL
1460         JRST POPJ1
1461
1462 NETBCC: MOVEI H,EOFCH
1463         JRST POPJ2
1464
1465 NTBIA8: HRRZS E                 ;8-BIT ASCII BLOCK MODE
1466         XCTR XRW,[MOVES D,(C)]
1467         LDB TT,[410300,,D]
1468         CAIGE TT,4
1469          POPJ P,
1470         SKIPA TT,NETCHT-4(TT)
1471 NTBI8A:  UMOVEM D,(C)
1472         XCTR XRW,[MOVES (D)]
1473         JUMPL E,NTBI8B
1474         PUSH P,C
1475         PUSH P,TT
1476         PUSHJ P,NETIB
1477          JRST [ MOVEI E,0
1478                 JRST NETBI5 ]   ;NORMAL RETURN - BYTE IN W.
1479         MOVSI E,600000          ;NO BYTES AVAIL - SOCKET CLOSED.
1480 NETBI5: MOVE H,W
1481         POP P,TT
1482         POP P,C
1483         UMOVE D,(C)
1484         LDB W,[410300,,D]
1485         CAIN W,7
1486          TLNN E,200000
1487           JRST NTBI8C
1488         POPJ P,
1489 NTBI8C: UMOVE W,(D)
1490         IDPB H,TT
1491         UMOVEM W,(D)
1492         ADD D,[700000,,]
1493         JUMPL D,NTBI8A
1494         MOVE TT,NETCHT+3
1495         ADD D,[400001,,1]
1496         SKIPL E
1497          JUMPL D,NTBI8A
1498         UMOVEM D,(C)
1499         POPJ P,
1500
1501 NTBI8B: MOVEI H,EOFCH
1502         UMOVE D,(C)
1503         JRST NTBI8C
1504 \f
1505 NETCLS: HRRE I,A        ;SOCKET TABLE INDEX
1506         JUMPL I,CPOPJ
1507         MOVE T,IMSOC2(I)
1508         TRNN T,1        ;SKIP IF SEND SOCKET
1509          JRST NETCL2
1510         MOVSI T,400000
1511         IORM T,IMSOC4(I)        ;CAUSE BUFFER TO BE SENT
1512         PUSHJ P,IMPOST
1513 NETCL2: MOVSI B,600000
1514         CONO PI,CLKOFF
1515         IORM B,IMSOC1(I)        ;MARK CHANNEL TO BE CLOSED
1516         AOS IMNCS
1517         HRRZ R,UUAC(U)
1518         MOVE A,CHNBIT(R)
1519         TDNE A,MSKST2(U)
1520          ANDCAM A,IFPIR(U)
1521         MOVE I,IMSOC5(I)        ;IF CHANNEL CONNECTED TO A STY,
1522         TLNN I,40000
1523          JRST CLKONJ
1524         ANDI I,777              ;DISCONNECT THEM.
1525         PUSHJ P,NSTYN0
1526          JRST 4,.
1527         JRST CLKONJ
1528
1529 ;SEARCH PENDING QUEUE FOR LOCAL SOCKET NUMBER IN A,
1530 ;T 4.9 = 1 => LISTENING, 4.9 => 0 => ALSO CHECK
1531 ;FOREIGN SOCKET NUMBER IN B AND FOREIGN HOST NUMBER (IMPHTB INDEX) IN H
1532 ;SKIPS IF ENTRY IS FOUND.  RETURNS ENTRY TO FREE LIST.
1533 ;Q GETS ADDRESS OF ENTRY BLOCK.  RETURN WITH NETOFF
1534
1535 IMPSPQ: CONO PI,NETOFF
1536 IMSPQP: SKIPGE Q,IMPBPQ ;BEGINNING OF QUEUE
1537          POPJ P,        ;QUEUE EMPTY
1538         MOVNI J,1       ;PREVIOUS ENTRY
1539 IMSPQL: CAME A,1(Q)     ;SKIP IF SAME LOCAL SOCKET NUMBER
1540          JRST IMSPQ1    ;TRY NEXT
1541         JUMPL T,IMSPQW  ;WIN IF LISTENING SOCKET
1542         LDB W,[101000,,3(Q)]    ;FOREIGN HOST IMPHTB INDEX
1543         CAMN W,H        ;SKIP IF WRONG FOREIGN HOST
1544          CAME B,2(Q)    ;SKIP IF FOREIGN SOCKET NUMBER AGREES
1545           JRST IMSPQ1   ;TRY NEXT
1546 IMSPQW: SKIPGE W,(Q)    ;FOUND IT
1547          MOVEM J,IMPEPQ ;PATCH OUT OF THE QUEUE
1548         SKIPGE J
1549          MOVEI J,IMPBPQ
1550         MOVEM W,(J)
1551         MOVE W,IMFFPQ   ;ADD TO FREE LIST
1552         MOVEM W,(Q)
1553         MOVEM Q,IMFFPQ
1554         JRST POPJ1
1555
1556 IMSPQ1: MOVE J,Q        ;PREVIOUS ENTRY
1557         SKIPL Q,(Q)     ;NEXT ENTRY
1558          JRST IMSPQL    ;LOOP
1559         POPJ P,         ;NOT FOUND
1560 \f
1561 SUBTTL  ARPANET CLOCK LEVEL
1562
1563 OVHMTR IMP      ;NETWORK INTERRUPT LEVEL (NOT STYNET STUFF)
1564
1565 ;HERE TO TIME OUT THE RFC QUEUE
1566 IMFCT1: CONO PI,NETOFF
1567         SKIPGE Q,IMPBPQ
1568          JRST NETONJ    ;... IF QUEUE IS EMPTY
1569         MOVNI J,1       ;J HAS PTR TO PREV ELT OF LIST, FOR IMSPQW TO PATCH (DELQ).
1570 IMFCT2: LDB E,[221100,,3(Q)]    ;TIME IN 16/15'THS, MOD 512., THAT RFC WAS RECEIVED
1571         LDB TT,[051100,,TIME]   ;TIME, IN SAME UNITS, NOW.
1572         CAMLE E,TT              ;MAKE SURE THE SUB TT,E GIVES A POSITIVE ANSWER.
1573          ADDI TT,1_9            ;WE ASSUME THAT TIME >= TIME OF RECEIPT.
1574         SUB TT,E
1575         CAIGE TT,IMFCTO_<-5>
1576          JRST IMFCT3            ;THIS RFC HASN'T TIMED OUT - LOOK AT NEXT
1577         PUSHJ P,IMSPQW          ;IT HAS - FLUSH IT
1578          JFCL
1579         JRST IMFCT1             ;AND START AGAIN LOOKING FOR RFC'S TO FLUSH
1580
1581 IMFCT3: MOVE J,Q
1582         SKIPL Q,(Q)
1583          JRST IMFCT2
1584         JRST NETONJ     ;END OF QUEUE
1585 \f
1586 ;FLUSH CLOSED NETWORK CHANNELS (CALLED AT HALF SEC CLOCK)
1587 IMPCCL: MOVSI I,-IMPSTL
1588 IMPCCR: CONO PI,NETON
1589         MOVSI T,200000
1590 IMPCCZ: TDNN T,IMSOC1(I)        ;LOOK FOR CHANNELS NO LONGER OPEN.
1591          AOBJN I,IMPCCZ
1592         JUMPL I,IMPCCA
1593         POPJ P,
1594
1595 IMPCCA: CONO PI,NETOFF
1596         MOVE B,IMSOC6(I)
1597         TLNE B,600000   ;ACTIVE AT PI LEVEL OR LOCKED BY CORE JOB
1598          JRST IMPCCS
1599         HRRZ B,IMSOC4(I) ;DISPATCH ON SOCKET STATE.
1600         JRST @IMPCCT(B)
1601
1602 IMPCCT: OFFSET -.
1603 %NSCLS::IMPCC1
1604 %NSLSN::IMPCC1
1605 %NSRFC::IMPCC2
1606 %NSRCL::IMPCC1
1607 %NSRFS::IMPCC2
1608 %NSOPN::IMPCC5
1609 %NSRFN::IMPCC6
1610 %NSCLW::IMPCC7
1611 %NSCLI::IMPCC1
1612 %NSINP::IMPCC2
1613         OFFSET 0
1614
1615 ;IMP BUFFER RETURN
1616 IMPBRT: SKIPN IMSOC6(I)
1617          POPJ P,        ;NO BUF??
1618         LDB A,[221000,,IMSOC6(I)]
1619         CAIE A,377
1620          JRST IMBRT1
1621         LDB A,[121000,,IMSOC6(I)]
1622         PUSHJ P,IMEMR
1623         CAIA
1624 IMBRT1:  PUSHJ P,IBRTN
1625         SETZM IMSOC6(I)
1626         POPJ P,
1627
1628 IMPCC1: PUSHJ P,IMPBRT
1629         MOVSI A,20000
1630         TDNE A,IMSOC5(I)
1631          JSP T,IMPC5D   ;WAITING FOR FINAL RFNM
1632         SETZM IMSOC1(I)
1633         SOS IMNCS       ;WE HAVE FINISHED CLOSING ONE SOCKET
1634 IMPCCS: AOBJN I,IMPCCR  ;WE CLOSED ONE, OR GAVE UP ON ONE; LOOK AT NEXT
1635         JRST NETONJ     ;OR WE'RE FINISHED LOOKING AT ALL.
1636
1637 IMPCC2: PUSHJ P,IMPBRT
1638         SKIPLE T,IMFCQL
1639          CAIG T,2       ;SKIP IF MORE THAN 2 FREE
1640           JRST IMPCCS   ;NOT ENUF PI CONTROL QUEUE BLOCKS AVAIL
1641         LDB A,IMSCFH    ;GET HOST#
1642         SKIPGE IMPHTB(A)        ;SKIP IF NO RFNM WAIT ON LINK 0
1643          JRST IMPCCS    ;NOT NOW!
1644         PUSH P,IMPCSH
1645         MOVEM A,IMPCSH
1646         JSP T,IMSTCM
1647             12.,,3      ;12. BYTES, 3 WORDS
1648          JRST 4,.       ;NO SLOTS AVAIL.  CHECKED BEFORE
1649         MOVEI H,3_4     ;3 NOPS + CLS
1650         MOVEM H,10(Q)
1651         MOVE H,IMSOC2(I)        ;LOCAL SOCKET
1652         LSH H,4         ;MOVE INTO 32 BIT FIELD
1653         MOVEM H,11(Q)
1654         MOVE H,IMSOC3(I)        ;FOREIGN SOCKET
1655         LSH H,4
1656         MOVEM H,12(Q)
1657         PUSHJ P,IMWCQ   ;SEND CLS
1658         POP P,IMPCSH
1659         MOVEI H,%NSCLW
1660         HRRM H,IMSOC4(I)
1661         MOVE H,TIME
1662         MOVEM H,IMSOCT(I)       ;TIME CLS SENT
1663         JRST IMPCCS
1664
1665 IMPCC5: MOVE H,IMSOC2(I)
1666         TRNN H,1        ;SKIP IF SEND SOCKET
1667          JRST IMPC5B    ;RECEIVE SOCKET
1668         MOVE A,IMSPIP(I)
1669         CAMN A,IMSMPP(I) ;IS THERE STILL DATA TO SEND? AT MP LEVEL
1670          CAMN I,IMPOPI  ;OR PI LEVEL? OR RFNM WAIT?
1671 IMPCC6:   JSP T,IMPC5D  ;YES, SEND IT AND GET RFNM BEFORE SENDING CLS
1672 IMPC5B: MOVEI H,%NSRFS  ;NO, OK TO SEND A CLS NOW.
1673         HRRM H,IMSOC4(I);SET STATE SO WILL LOOP BACK TO IMPCC2
1674         JRST @IMPCCT(H)
1675
1676 IMPC5A: IORM H,IMSOC5(I)
1677         MOVE H,TIME
1678         MOVEM H,IMSOCT(I)
1679         JRST IMPCCS
1680
1681 IMPC5D: MOVSI H,10000
1682         TDNN H,IMSOC5(I)
1683          JRST IMPC5A    ;TIME-OUT NOT ALREADY STARTED - START IT.
1684 IMPC7A: MOVE H,TIME     ;ALREADY STARTED, OVER YET?
1685         SUB H,IMSOCT(I)
1686         CAIG H,IMPCTO   ;SKIP IF TIMED OUT
1687          JRST IMPCCS    ;NOT YET
1688         JRST (T)
1689
1690 IMPCC7: JSP T,IMPC7A    ;IF CLOSE TIME-OUT ISN'T UP, GIVE UP TO IMPCCS.
1691         JRST IMPCC1     ;ELSE FLUSH.
1692
1693 ;HERE FROM 1/2 SECOND CLOCK IF IMNAS IS NON-ZERO.
1694 ;WE WAKE UP ANY STYNET CHANNELS THAT NEED IT.
1695 IMPAAA: SOS IMNAS       ;DECREASE NEED-THIS-ROUTINE COUNT
1696         MOVSI I,-IMPSTL
1697 IMPAA1: MOVSI T,200000
1698         TDNN T,IMSOC5(I)
1699          AOBJN I,.-1
1700         JUMPGE I,CPOPJ
1701         CONO PI,NETOFF
1702         ANDCAM T,IMSOC5(I)
1703         PUSHJ P,IMPUIN
1704         CONO PI,NETON
1705         JRST IMPAA1
1706 \f
1707 SUBTTL  ARPANET NCP INPUT INTERRUPT LEVEL
1708
1709 ;GET HERE PI IN PROG ON NETCHN
1710 ;IMP HAS NETCHN PIA, TT HAS CONI WORD, A HAS LAST WD OF CONTROL LINK MSG
1711 ;PROCESS THE CONTROL LINK HOST-HOST PROTOCOL OPCODES.
1712 IMPBK3: AOS B,IMBLKI    ;STORE LAST WORD AS IF BLKI HAD
1713         MOVEM A,(B)
1714         MOVEI B,-IMPINB+1(B)    ;B HAS NUMBER OF WORDS READ
1715         CAMGE B,IMPNIW
1716          JRST IMPCIS    ;MESSAGE IS SHORT
1717         MOVE A,IMPCBC   ;NUMBER OF BYTES
1718         MOVE B,[441000,,IMPINB] ;8 BIT BYTE POINTER TO MESSAGE
1719         SETZM IMPNEA
1720         SETZM IMPNRA
1721 IMPBKL: SOJL A,IMPIR1   ;LOOP HERE TO PROCESS CONTROL MESSAGE
1722         MOVE H,IMPCSH   ;RESTORE HOST INDEX
1723         ILDB C,B
1724         CAIL C,IMPCDL
1725          JRST IMPCIG    ;ILLEGAL OPCODE
1726         AOS IMPCMR(C)   ;COUNT CTL MSG RCD
1727         JRST @IMPCDT(C) ;DISPATCH ON OPCODE
1728
1729 IMPCIG: BUG INFO,[NET: NEW CTL MSG FM HST ],OCT,IMPHTN(H),[COD=],OCT,C,[CT=],OCT,A
1730         JRST IMPIR1
1731
1732 IMPCIS: MOVE H,IMPCSH
1733         BUG INFO,[NET: SHORT CTL MSG FM HST ],OCT,IMPHTN(H)
1734         AOS IMNSCM
1735         JRST IMPIR1
1736
1737 IMPCDT: IMPBKL  ;NOP    ( 0)
1738         IMPRFC  ;RTS    ( 1)
1739         IMPRFC  ;STR    ( 2)
1740         IMPCLS  ;CLS    ( 3)
1741         IMPALL  ;ALL    ( 4)
1742         IMPCIG  ;GVB    ( 5)
1743         IMPCIG  ;RET    ( 6)
1744         IMPINR  ;INR    ( 7)
1745         IMPINS  ;INS    (10)
1746         IMPECO  ;ECO    (11)
1747         IMPCIG  ;ERP    (12)
1748         IMPERM  ;ERR    (13)
1749         IMPRST  ;RST    (14)
1750         IMPRRP  ;RRP    (15)
1751         IMPCIG  ;RAR    (16)
1752         IMPCIG  ;RAS    (17)
1753         IMPCIG  ;RAP    (20)
1754         IMPNXR  ;NXR    (21)
1755         IMPNXR  ;NXS    (22)
1756 IMPCDL==.-IMPCDT
1757
1758 IMSHRT: MOVNS A
1759         BUG INFO,[NET: SHORT CTL MSG HST ],OCT,IMPHTN(H),[COD=],OCT,C,[MISSING],OCT,A
1760         JRST IMPIR1
1761
1762 IMPNXR: ILDB C,B        ;LINK NUMBER FOR NXR OR NXS
1763         SOJA A,IMPBKL   ;JUST IGNORE IT, USELESS ANYWAY
1764 \f
1765 ;RFC RECEIVED  C HAS OPCODE
1766 IMPRFC: SUBI A,9        ;MUST BE AT LEAST 9 MORE BYTES
1767         JUMPL A,IMSHRT  ;MESSAGE IS SHORT
1768         ILDB D,B        ;D GETS 32 BIT FOREIGN SOCKET NUMBER
1769 REPEAT 3,[
1770         LSH D,8
1771         ILDB T,B
1772         IORI D,(T)
1773 ]
1774         ILDB E,B        ;E GETS 32 BIT LOCAL SOCKET NUMBER
1775 REPEAT 3,[
1776         LSH E,8
1777         ILDB T,B
1778         IORI E,(T)
1779 ]
1780         ILDB R,B        ;LINK NUMBER OR BYTE SIZE
1781         MOVE Q,E
1782         EQVI Q,(C)      ;Q 1.1 = 1 IF E 1.1 = C 1.1
1783         ANDI Q,1
1784         JUMPE Q,IMPRF3  ;WRONG DIRECTION RFC
1785         CAIE C,2        ;SKIP IF STR
1786          JRST IMPRF5
1787         CAILE R,36.     ;SKIP IF STR AND BYTE SIZE < 37
1788          JRST IMREFU    ;REFUSE CONNECTION
1789 IMPRF5: PUSHJ P,IMPLLS  ;LOOK FOR LOCAL SOCKET (RET INDEX IN I)
1790          JRST IMPRFQ    ;NO SUCH SOCKET.  QUEUE IT
1791         HRRZ W,IMSOC4(I)        ;SOCKET STATE
1792         CAIE W,%NSLSN   ;SKIP IF LISTENING
1793          JRST IMPRF4
1794         MOVEM D,IMSOC3(I)       ;STORE FOREIGN SOCKET NUMBER
1795         DPB H,IMSCFH            ;STORE FOREIGN HOST INDEX
1796         MOVEI Q,%NSRFC
1797         HRRM Q,IMSOC4(I)        ;RFC RECEIVED STATE
1798         CAIN C,2        ;SKIP IF RTS
1799          JRST [ LDB Q,IMSCBS    ;STR, CHECK CONNECTION BYTE SIZE
1800                 CAME Q,R
1801                  JRST IMCLDA
1802                 JRST .+2 ]
1803           DPB R,IMSCLN  ;RTS, STORE LINK #
1804         PUSHJ P,IMPUIN  ;INTERRUPT USER
1805 IMRFCX: LDB Q,IMHSBT
1806         CAIN Q,1
1807          SOS IMRFCT
1808         MOVEI Q,2
1809         DPB Q,IMHSBT    ;MARK HOST UP
1810         JRST IMPBKL
1811
1812 IMPRF3: BUG INFO,[NET: WRONG DIR RFC HST ],OCT,IMPHTN(H),[OP ],SIXBIT,[(C)[SIXBIT /RTS   STR/]-1],[SOK],OCT,E
1813         JRST IMPBKL
1814
1815 IMPRF4: CAIE W,%NSRFS   ;SKIP IF IN RFC SENT STATE
1816          JRST IMPRFQ    ;QUEUE IT
1817         LDB Q,IMSCFH
1818         CAMN Q,IMPCSH
1819          CAME D,IMSOC3(I)       ;FROM CORRECT FOREIGN SOCKET?
1820           JRST IMREFU   ;NO, REFUSE
1821         AOS IMSOC4(I)   ;PUT INTO STATE 5 - OPEN
1822         CAIE C,1        ;SKIP IF RTS
1823          JRST IMPRF2    ;STR
1824         DPB R,IMSCLN    ;STORE LINK #
1825 IMPRF1: PUSHJ P,IMPUIN  ;INTERRUPT USER
1826         JRST IMPBKL
1827
1828 IMPRF2: LDB Q,IMSCBS
1829         CAME Q,R
1830          JRST IMCLDA    ;BYTE SIZES DIFFER, REFUSE
1831         JSP T,IMSTCM
1832             8,,2        ;TEXT: 8 BYTES, 2 WORDS
1833          JRST [ AOS IMNANS
1834                 JRST IMPRF1 ]
1835         MOVEI H,2(I)
1836         LSH H,16.       ;LINK #
1837         IOR H,IMSOC8(I) ;MSG ALLOC
1838         LSH H,4
1839         TLO H,(4_28.)   ;ALL
1840         MOVEM H,10(Q)
1841         MOVE H,IMSOC7(I) ;BIT ALLOC
1842         LSH H,4
1843         MOVEM H,11(Q)
1844         PUSHJ P,IMWCQ   ;SEND IT OUT
1845         JRST IMPRF1
1846
1847 IMPRFQ: CAIL E,NETSRS   ;IF < 1000, START JOB "NETRFC"
1848          JRST IMRFQ5
1849         MOVE T,IMPHTN(H)
1850 ;       CAIE T,<IMPUS_-6>+<IMPUS&77>_9
1851         CAME T,[IMPUS3-NW%ARP]  ; Compare with our own host (minus net #)
1852          SKIPL NETUSW
1853           CAIA
1854            JRST IMREFU  ;REFUSE CONNECTION
1855         HRROI T,NTRFCL
1856         PUSHJ P,NUJBST  ;LOAD SERVER
1857          JRST IMREFU    ;RING BUFFER FULL
1858 IMRFQ5: SKIPGE Q,IMFFPQ ;SKIP IF ANY FREE SLOTS
1859          JRST IMRFQ1    ;CLS OLDEST
1860         MOVE W,(Q)
1861         MOVEM W,IMFFPQ  ;NEW FIRST FREE
1862 IMRFQ9: SETOM (Q)       ;END OF QUEUE
1863         MOVEM E,1(Q)    ;LOCAL SOCKET NUMBER
1864         MOVEM D,2(Q)    ;FOREIGN SOCKET NUMBER
1865         CAIE C,2        ;SKIP IF STR
1866          TLO R,400000   ;MARK AS RTS
1867         MOVEM R,3(Q)    ;LINK NUMBER OR BYTE SIZE
1868         DPB H,[101000,,3(Q)]    ;FOREIGN HOST INDEX
1869         LDB W,[051100,,TIME]    ;STORE TIME OF RECEIPT, IN 16/15 MOD 512.
1870         DPB W,[221100,,3(Q)]
1871         SKIPGE W,IMPEPQ ;END OF QUEUE
1872          JRST IMRFQ2    ;QUEUE EMPTY
1873         MOVEM Q,(W)     ;PUT IN AT END OF QUEUE
1874         MOVEM Q,IMPEPQ  ;NEW END OF QUEUE
1875         JRST IMRFCX
1876
1877 IMRFQ2: MOVEM Q,IMPEPQ  ;END OF QUEUE
1878         MOVEM Q,IMPBPQ  ;AND BEGINNING OF QUEUE
1879         JRST IMRFCX
1880
1881 IMRFQ1: MOVE J,IMPBPQ   ;BEGINNING OF PENDING QUEUE
1882         MOVE E,1(J)     ;LOCAL SOCKET
1883         MOVE D,2(J)     ;FOREIGN SOCKET
1884         PUSH P,IMPCSH
1885         LDB H,[101000,,3(J)]    ;FOREIGN HOST INDEX
1886         MOVEM H,IMPCSH
1887         PUSHJ P,IMPSCL  ;SEND CLS
1888          JRST IMRFQ3    ;NO BUFFERS AVAILABLE
1889         AOSA IMNRFC     ;# RFCS CLOSED
1890 IMRFQ3:  AOS IMNRFI     ;# RFCS IGNORED
1891         POP P,IMPCSH
1892         MOVE H,IMPCSH
1893         MOVE Q,IMPBPQ   ;FLUSH FIRST ENTRY ON PENDING QUEUE
1894         MOVE W,(Q)
1895         MOVEM W,IMPBPQ
1896         JRST IMRFQ9
1897
1898 IMREFU: PUSHJ P,IMPSCL  ;SEND CLS
1899          AOS IMNCNS     ;CAN'T
1900         AOS IMNRFI
1901         JRST IMPBKL
1902 \f
1903 IMPCLS: SUBI A,8        ;MUST BE AT LEAST 8 MORE BYTES
1904         JUMPL A,IMSHRT  ;MESSAGE IS SHORT
1905         ILDB D,B        ;D GETS 32 BIT FOREIGN SOCKET NUMBER
1906 REPEAT 3,[
1907         LSH D,8
1908         ILDB T,B
1909         IORI D,(T)
1910 ]
1911         ILDB E,B        ;E GETS 32 BIT LOCAL SOCKET NUMBER
1912 REPEAT 3,[
1913         LSH E,8
1914         ILDB T,B
1915         IORI E,(T)
1916 ]
1917         PUSHJ P,IMPLC   ;LOOK FOR CONNECTION
1918          JRST IMCLSQ    ;LOOK IN QUEUE
1919         MOVSI W,200000  ;SET CLS RCD BIT
1920         IORB W,IMSOC4(I)        ;RH IS STATE FOR DISPATCH
1921         JRST @IMCLDT(W)
1922
1923 IMCLDT: OFFSET -.
1924 %NSCLS::IMPCLI
1925 %NSLSN::IMPCLI
1926 %NSRFC::IM2CLS
1927 %NSRCL::IMPCLI
1928 %NSRFS::IM4CLS
1929 %NSOPN::IM5CLS
1930 %NSRFN::IM6CLS
1931 %NSCLW::IM7CLS
1932 %NSCLI::IMPCLI
1933 %NSINP::IMECLS
1934         OFFSET 0
1935
1936 IM4CLS: HLLZS IMSOC4(I) .SEE %NSCLS
1937         MOVEI W,%NCRFS
1938         JRST IMCLDB
1939
1940 IMECLS: MOVEI W,%NSCLI
1941         JRST IMCCLS
1942
1943 IMCLDA: HLLZS IMSOC4(I) .SEE %NSCLS
1944         MOVEI W,%NCBYT  ;BYTE MISMATCH
1945         JRST IMCLDB
1946
1947 IM6CLS: MOVSI W,20000   ;CLSED DURING RFNM WAIT
1948         IORM W,IMSOC5(I)
1949 IM5CLS: TDZA W,W        .SEE %NSCLS
1950 IM2CLS:  MOVEI W,%NSRCL
1951 IMCCLS: HRRM W,IMSOC4(I)        ;CHANGE STATE
1952         MOVEI W,%NCFRN
1953 IMCLDB: DPB W,IMSCLS    ;CLS REASON
1954         PUSHJ P,IMPUIN  ;INTERRUPT USER
1955 IMCLQ2: PUSHJ P,IMPSCL  ;SEND CLS
1956          AOS IMNCNS
1957         JRST IMPBKL
1958
1959 IMPSCL: JSP T,IMSTCM    ;SEND A CLS TO LOCAL SOCKET IN E AND FOREIGN SOCKET IN D (CLOBBERS D AND E)
1960             12.,,3      ;TEXT: 12 BYTES, 3 WORDS
1961          POPJ P,
1962         MOVEI H,3_4     ;3 NOPS + CLS
1963         MOVEM H,10(Q)
1964         LSH E,4
1965         MOVEM E,11(Q)   ;LOCAL SOCKET NUMBER
1966         LSH D,4
1967         MOVEM D,12(Q)   ;FOREIGN SOCKET NUMBER
1968         PUSHJ P,IMWCQ   ;SEND CLS
1969         JRST POPJ1
1970 \f
1971 IMPCLI: AOS IMNCLI
1972         JRST IMPBKL
1973
1974 IM7CLS: HLLZS IMSOC4(I) .SEE %NSCLS
1975         JRST IMPBKL
1976
1977 IMCLSQ: PUSH P,A
1978         PUSH P,B
1979         MOVE A,E        ;LOCAL SOCKET NUMBER
1980         MOVEI T,0
1981         MOVE B,D        ;FOREIGN SOCKET NUMBER
1982         PUSHJ P,IMSPQP  ;SEARCH PENDING QUEUE
1983          JRST IMCLQ1    ;NOT THERE
1984         MOVE E,A
1985         POP P,B
1986         POP P,A
1987         JRST IMCLQ2     ;SEND HIM A CLS
1988
1989 IMCLQ1: POP P,B
1990         POP P,A
1991         JRST IMPCLI     ;CAN'T FIND HIM.  IGNORE
1992
1993 IMPALL: SUBI A,7        ;MUST BE AT LEAST 7 MORE BYTES
1994         JUMPL A,IMSHRT  ;MESSAGE IS SHORT
1995         ILDB R,B        ;LINK #
1996         ILDB D,B
1997         LSH D,8
1998         ILDB T,B
1999         IORI D,(T)      ;D GETS MESSAGE ALLOCATION
2000         ILDB E,B        ;E GETS BIT ALLOCATION
2001 REPEAT 3,[
2002         LSH E,8
2003         ILDB T,B
2004         IORI E,(T)
2005 ]
2006         MOVE T,IMPCSH   ;FOREIGN HOST
2007         LSH T,8
2008         IOR R,T         ;HEADER (HOST AND LINK #)
2009         MOVEI W,1       ;TO TEST DIRECTION OF SOCKET
2010         MOVSI I,-IMPSTL
2011 IMPAL2: LDB T,IMSCHD    ;FOREIGN HOST AND LINK NUMBER
2012         SKIPGE IMSOC1(I)        ;SKIP IF SLOT NOT IN USE
2013          CAME T,R       ;SKIP IF HEADER AGREES
2014           JRST IMPAL1
2015         TDNE W,IMSOC2(I)        ;SKIP IF NOT SEND
2016          JRST IMPAL3
2017 IMPAL1: AOBJN I,IMPAL2
2018         ANDI R,377
2019         BUG INFO,[NET: IGNORED ALLOC HST ],OCT,IMPHTN(H),[LNK],OCT,R
2020         AOS IMNALI
2021         JRST IMPBKL     ;IGNORE
2022
2023 IMPAL3: SKIPL D
2024          SKIPGE E
2025           JRST 4,.
2026         LDB T,IMSCBS            ;GET BYTESIZE
2027         IDIV E,T                ;TRUNCATE TO 0 MODULO BYTESIZE
2028         IMUL E,T                ;(CLOBBER TT)
2029         SKIPL IMSOC8(I)
2030          SKIPGE IMSOC7(I)
2031           JRST 4,.
2032         ADDB D,IMSOC8(I)        ;INCREASE ALLOCATIONS
2033         ADDB E,IMSOC7(I)
2034         MOVE Q,IMSOC5(I)
2035         TLNE Q,140000           ;ACTIVATE IF USER (OR DIRECT CONN) CHECKING ALLOC
2036          PUSHJ P,IMPUIN
2037         MOVE T,IMSPIP(I)
2038         CAME T,IMSMPP(I)        ;SKIP IF OUTPUT BUFFER EMPTY
2039          PUSHJ P,IMPIOS         ;THIS GUY MAY HAVE STUFF TO GO OUT
2040         JRST IMPBKL
2041 \f
2042 IMPLLS: MOVSI I,-IMPSTL ;LOOK FOR SOCKET IN E
2043         MOVSI W,200000
2044 IMPLL2: TDNN W,IMSOC1(I)
2045          SKIPL IMSOC1(I)        ;NOT IN USE
2046           JRST IMPLL1
2047         CAME E,IMSOC2(I)        ;SKIP IF RIGHT LOCAL SOCKET NUMBER
2048 IMPLL1:  AOBJN I,IMPLL2
2049         JUMPL I,POPJ1   ;RETURN SOCKET TABLE INDEX IN RH OF I
2050         POPJ P,         ;NOT FOUND
2051
2052 ;INTERRUPT USER ASSOCIATED WITH CHANNEL IN I
2053 IMPUIN: MOVSI U,200000
2054         TDNE U,IMSOC1(I)
2055          POPJ P,                ;CHNL BEING CLOSED
2056         MOVE U,IMSOC5(I)
2057         TLNE U,40000
2058          JRST IMPUIS            ;JUMP IF SOCKET IS CONNECTED TO A STY.
2059 IMPUIP: HRRZ U,IMSOC1(I)        ;USER INDEX
2060         LDB Q,[222000,,IMSOC1(I)]       ;MASK FOR CHANNEL OPEN ON
2061 IMPUIM: AND Q,MSKST2(U)         ;ONLY ENABLED CHANNELS.
2062         PUSH P,T                ;VALIDATE THE USER INDEX
2063         MOVEI T,LUBLK
2064         IDIVM U,T
2065         IMULI T,LUBLK
2066         CAMN T,U
2067          CAML U,USRHI
2068           JRST 4,.
2069         MOVSI T,(SETZ)          ;PCLSR SO IT GETS IOC ERROR IF NEEDFUL
2070         IORM T,PIRQC(U)         ; EVEN IF IT DOESN'T HAVE NORMAL INTERRUPTS ENABLED
2071         POP P,T
2072         IORM Q,IFPIR(U)         ;GEN SECOND WORD INTERRUPT
2073         POPJ P,
2074
2075 IMPUIS: PI2SAF                  ;HERE FOR INT. ON SOCKET CONNECTED TO A STY:
2076         ANDI U,777
2077         SKIPL STYNTL-NFSTTY(U)
2078          POPJ P,                ;ALREADY ACTIVATED
2079         MOVE Q,STYNTA           ;PUT THAT STY ON THE XFER ACTIVATION LIST.
2080         MOVEM Q,STYNTL-NFSTTY(U)
2081         MOVEM U,STYNTA          ;THEN RETURN.  DON'T ACTUALLY INTERRUPT THE JOB;
2082         POPJ P,                 ;IF ANYTHING FUNNY HAS HAPPENED, STYNTC WILL INTERRUPT.
2083
2084 ;LOOK FOR CONNECTION: LOCAL SOCKET IN E, FOREIGN SOCKET IN D, FOREIGN HOST IN H
2085 IMPLC:  MOVSI I,-IMPSTL
2086 IMPLC2: SKIPGE IMSOC1(I)        ;NOT IN USE
2087          CAME E,IMSOC2(I)       ;LOCAL SOCKET NUMBER
2088           JRST IMPLC1
2089         LDB T,IMSCFH
2090         CAMN D,IMSOC3(I)        ;FOREIGN SOCKET NUMBER
2091          CAME H,T
2092 IMPLC1:   AOBJN I,IMPLC2
2093         JUMPL I,POPJ1
2094         POPJ P,
2095 \f
2096 IMPINR: SOJL A,IMSHRT   ;SHORT COUNT
2097         ILDB D,B        ;LINK #
2098         DPB H,[101000,,D] ;CONCAT HOST&LINK
2099         MOVSI I,-IMPSTL
2100         LDB E,IMSCHD    ;GET HOST FOR SOCKET
2101         CAME D,E
2102          AOBJN I,.-2    ;SEARCH FOR MATCHING HOST&LINK
2103         JUMPGE I,IMPILS ;NOT FOUND
2104 NCPIRS: HRRZ E,IMSOC4(I)        ;STATE
2105         MOVE E,CHNBIT(E)        ;BIT TO CORRESPOND
2106         TRNN E,1_%NSRFC+1_%NSRFS+1_%NSOPN+1_%NSRFN+1_%NSCLW+1_%NSINP
2107                         ;OK STATES RFCRCV, RFCSNT, OPEN, RNMWT, CLSSNT, DATA
2108          JRST IMPILS    ;IN BAD STATE
2109         TRNE E,1_%NSCLW ;IGNORE INT IF CLSSNT STATE (NOT ERROR)
2110          JRST IMPBKL
2111         MOVSI D,4000
2112         IORM D,IMSOC5(I)        ;INT FLAG 4.3 BIT OF IMSOC5(SOCK)
2113         PUSHJ P,IMPUIN  ;INT TO USER
2114         JRST IMPBKL
2115
2116 IMPINS: SOJL A,IMSHRT   ;SHORT
2117         ILDB D,B        ;LINK
2118         MOVEI I,-2(D)   ;0,1 -> 777776,777777 ILLEGAL LINKS
2119         CAIGE I,IMPSTL  ;CHECK IN RANGE 2 TO IMPSTL+1
2120          SKIPL IMSOC1(I);AND IN USE
2121           JRST IMPILS   ;BAD LINK
2122         LDB T,IMSCFH
2123         CAMN T,IMPCSH   ;SKIP IF HOST NOT MATCHED BY MSG
2124          JRST NCPIRS
2125 IMPILS: BUG INFO,[NET: BAD INT CTL MSG HST ],OCT,IMPHTN(H),[LNK ],OCT,D,[IMSOC4],OCT,IMSOC4(I)
2126         JRST IMPBKL     ;NOTE- I MAY BE -1 OR -2  OR UP TO 256, IF LNK BAD, IGNORE
2127
2128 IMPECI: AOS IMPNEI      ;WILL EVENTUALLY GIVE JOB TO MAIN PROG
2129         JRST IMPBKL
2130
2131 IMPECO: ILDB D,B        ;GET 8 BIT DATA TO ECHO
2132         SOJL A,IMSHRT
2133         SKIPE IMPNEA
2134          JRST IMPECI    ;ONLY ONE TO A CUSTOMER
2135         JSP T,IMSTCM
2136             2,,1        ;TEXT: 2 BYTES, 1 WORD
2137          JRST IMPECI
2138         LSH D,20.       ;DATA TO BE ECHOED
2139         TLO D,(10._28.) ;ERP
2140         MOVEM D,10(Q)
2141         PUSHJ P,IMWCQ   ;SEND IT OUT
2142         AOS IMPNEA
2143         JRST IMPBKL
2144
2145 IMPERM: SUBI A,11.      ;COUNT BYTES
2146         MOVE C,TIME
2147         MOVEM C,IMPERB
2148         MOVE C,IMPHTN(H)        ;REAL HOST NUMBER
2149         MOVEM C,IMPERB+1
2150         MOVE C,[441100,,IMPERB+2]
2151         MOVEI D,11.     ;BYTES TO COPY
2152         ILDB T,B        ;COPY BYTES FROM THEIR MSG
2153         IDPB T,C
2154         SOJG D,.-2
2155         BUG INFO,[NET: ERR MSG FM HST ],OCT,IMPERB+1,[MSG],OCT,IMPERB+2,OCT,IMPERB+3
2156                         ;ONLY PRINTS FIRST 8 BYTES OF ERR INFO
2157         JUMPGE A,IMPBKL ;IF COUNT OK, GET MORE
2158         JRST IMSHRT     ;SHORT COUNT
2159 \f
2160 IMPRSI: AOS IMPNRI
2161         JRST IMPBKL
2162
2163 IMPRST: MOVE T,IMPHTN(H)
2164 ;       CAIE T,<IMPUS_-6>+<IMPUS&77>_9  ;IF RST FROM OURSELVES, JUST SEND RRP
2165         CAME T,[IMPUS3-NW%ARP]
2166          PUSHJ P,IMPRSR
2167         SKIPE IMPNRA
2168          JRST IMPRSI
2169         JSP T,IMSTCM
2170             1,,1        ;TEXT: 1 BYTE, 1 WORD
2171          JRST IMPRSI
2172         MOVSI D,(13._28.)       ;RRP
2173         MOVEM D,10(Q)
2174         PUSHJ P,IMWCQ   ;SEND IT OUT
2175         PUSHJ P,IMPIOS
2176         AOS IMPNRA
2177         JRST IMPBKL
2178
2179 IMPRSR: MOVSI I,-IMPSTL ;LOOK FOR USERS OF THIS HOST
2180         MOVSI TT,200000
2181 IMPRS2: TDNN TT,IMSOC1(I)       ;GUY GOING AWAY ANYHOW
2182          SKIPL IMSOC1(I)
2183           JRST IMPRS1
2184         LDB C,IMSCFH    ;FOREIGN HOST
2185         CAME C,IMPCSH
2186          JRST IMPRS1    ;WRONG HOST
2187         HRRZ C,IMSOC4(I)
2188         MOVEI D,%NSCLS
2189         CAIN C,%NSINP
2190          MOVEI D,%NSCLI ;INPUT STILL AVAILABLE
2191         HRRM D,IMSOC4(I)
2192         MOVEI D,%NCRST
2193         DPB D,IMSCLS    ;CLS REASON IS RST
2194         PUSHJ P,IMPUIN  ;INTERRUPT USER
2195 IMPRS1: AOBJN I,IMPRS2
2196         ;IF HOST CAN SEND A RST, IT IS UP, BUT DON'T
2197         ;REALLY CONSIDER IT UP UNTIL RRP, RTS, OR STR IS RECEIVED
2198         ;I DON'T KNOW WHY IT'S DONE THIS WAY
2199         POPJ P,
2200
2201 IMPRRP: LDB J,IMHSBT
2202         SOJL J,IMPRR1
2203         JUMPG J,IMPBKL  ;ALREADY UP, MAYBE BECAUSE OF PRIOR RTS,STR
2204         MOVEI J,2
2205         DPB J,IMHSBT    ;MARK HIM UP
2206         SOS IMRFCT
2207         JRST IMPBKL
2208
2209 IMPRR1: BUG INFO,[NET: RRP W-O RST HST],OCT,IMPHTN(H)
2210         JRST IMPBKL
2211 \f
2212 ;GET CONTROL QUEUE SLOT
2213 IMGCQS: SKIPG IMFCQL    ;SKIP IF ANY LEFT
2214          JRST IMGCQL    ;NONE
2215         SKIPG Q,IMFFCQ  ;POINTER TO SLOT
2216          JRST 4,.
2217         MOVE W,(Q)
2218         MOVEM W,IMFFCQ  ;PATCH OUT OF FREE LIST
2219         SETOM (Q)
2220         SOS W,IMFCQL    ;NUMBER FREE LEFT
2221         CAIN W,1        ;SKIP IF MORE THAN ONE LEFT
2222          SETOM IMPHI    ;SET FLAG TO HOLD UP INPUT
2223         JRST POPJ1
2224
2225 IMGCQL: AOS IMNPIL
2226         POPJ P,
2227
2228 IMWCQ:  PUSHJ P,IMWPCQ
2229         JRST IMPIOS     ;START OUTPUT
2230
2231 ;ADD BLOCK IN Q TO OUTPUT CONTROL QUEUE, BASHES W
2232 IMWPCQ: SETOM (Q)
2233         SKIPGE W,IMPLCQ
2234          JRST IMWCQ1    ;CONTROL QUEUE EMPTY
2235         AOSE (W)
2236          JRST 4,.       ;END OF QUEUE DIDN'T POINT TO -1
2237         MOVEM Q,(W)
2238         MOVEM Q,IMPLCQ
2239         POPJ P,
2240
2241 IMWCQ1: MOVEM Q,IMPLCQ
2242         MOVEM Q,IMPNCQ
2243         POPJ P,
2244
2245 ;ADD MAIN PROGRAM BLOCK TO PI QUEUE (CALL AT MP LEVEL)
2246 IMPMPQ: MOVSI Q,777
2247         IORM Q,IMPMPU+1 ;NOT LOCKED BY THIS JOB ANY MORE
2248         SKIPL U         ;SKIP IF CALLED FROM DIRECT-CONNECT CLOCK LEVEL
2249          PUSHJ P,LSWDEL ;PI LEVEL WILL UNLOCK
2250         CONO PI,NETOFF
2251         MOVEI Q,IMPMPL
2252         PUSHJ P,IMWPCQ
2253         CONO PI,NETON
2254         JRST IMPOST
2255
2256 ;CALL BY JSP T,IMSTCM
2257 ;SET UP STANDARD PI CONTROL MESSAGE
2258 ;BYTE COUNT,,TEXT LENGTH
2259 ;ERROR RETURN
2260
2261 IMSTCM: PUSHJ P,IMGCQS  ;GET CONTROL QUEUE SLOT IN Q
2262          JRST 1(T)      ;NONE AVAILABLE
2263         MOVSI H,17_10.  ;MESSAGE TYPE = 0, LINK # = 0, NEW FMT
2264         MOVEM H,2(Q)
2265         MOVE H,IMPCSH   ;GET IMP AND HOST
2266         MOVE H,IMPHTN(H)
2267 IFN 1,  DPB H,[103000,,3(Q)]    ; Store host addr
2268 IFN 0,[ DPB H,[301000,,3(Q)] ;STORE HOST
2269         LSH H,-9
2270         DPB H,[102000,,3(Q)] ;STORE IMP
2271 ] ;IFN 0
2272         HLRZ H,(T)      ;BYTE COUNT
2273         LSH H,8
2274         IOR H,[8_24.]   ;BYTE SIZE = 8
2275         MOVEM H,7(Q)
2276         HRLZ H,(T)
2277         HRR H,IMPCSH
2278         MOVSM H,1(Q)    ;HOST INDEX,,TEXT LENGTH
2279         JRST 2(T)       ;NORMAL RETURN (NOTE THAT H HAS BEEN RESTORED TO IMPCSH)
2280 \f
2281 ;RECEIVED LEADER OF REGULAR MESSAGE NOT ON CONTROL LINK
2282 ;THE HOST-HOST LEADER WORD (WD 6) HAS NOT YET BEEN DATAI'ED.
2283 ;SWITCH TO 32-BIT MODE FIRST IF NECESSARY.
2284 IMPRMD:
2285 IFN INETP,[
2286         CAIE B,IMPILB+4 ; Verify that NCP leader is next word
2287          JRST IMPLD3    ; Barf...
2288 ]
2289         MOVE D,IMPCSH
2290         LSH D,8
2291         MOVE I,IMPCLN
2292         IOR D,I         ;HEADER
2293         SUBI I,2        ;SOCKET TABLE INDEX
2294         JUMPL I,IMPRM7  ;BAD LINK #
2295         SKIPGE A,IMSOC1(I)
2296          TLNE A,200000  ;SKIP IF NOT BEING CLOSED
2297           JRST IMPRM7   ;SOCKET DOESNT EXIST OR BEING CLOSED
2298         MOVEI A,1
2299         CAIGE I,IMPSTL
2300          TDNE A,IMSOC2(I)       ;SKIP IF RECEIVER
2301           JRST IMPRM7   ;BAD LINK # OR MESSAGE FOR A SENDER
2302         LDB C,IMSCHD    ;HEADER
2303         CAME D,C        ;SEE IF HEADERS AGREE
2304          JRST IMPRM7    ;NOPE, I.E. FROM WRONG HOST OR CLOSED
2305         HRRZ D,IMSOC4(I)
2306         CAIE D,%NSOPN
2307          CAIN D,%NSINP
2308           JRST IMPRMA
2309         JRST IMPRM7
2310 IMPRMA: SKIPGE IMSOC6(I)        ;SKIP IF NOT LOCKED BY CORE JOB
2311          JRST IMPRMP            ;LOCKED, COME BACK LATER
2312 IFN KAIMP,[
2313         SKIPL IMSOC5(I)         ;SKIP IF 32 BIT TRANSFER
2314          CONO IMP,IMI32C        ;SET 36 BIT INPUT
2315         SKIPGE IMSOC5(I)        ;SKIP IF NOT 32 BIT TRANSFER
2316          CONO IMP,IMI32S        ;SET 32 BIT INPUT
2317 ]IFN DMIMP,[
2318         SKIPL IMSOC5(I)         ;SKIP IF 32BIT
2319          CONO FI,FII32C         ;SET 36BIT
2320         SKIPGE IMSOC5(I)        ;SKIP IF 36 BIT
2321          CONO FI,FII32S         ;SET 32 BIT
2322 ]
2323         DATAI IMP,IMPILB+5      ;GET THE HEADER WORD
2324         LDB A,IMCBBP
2325         MOVEM A,IMPCBS
2326         LDB B,IMSCBS            ;Check for fraudulent byte size
2327         CAME A,B
2328          JRST IMPRMZ            ;Discard message
2329         LDB B,IMBCBP
2330         MOVEM B,IMPCBC
2331         MOVEM B,IMPNBI          ;SAVE BYTE COUNT FOR LATER
2332         SOSGE IMSOC8(I)
2333          JRST IMRMAF            ;MESSAGE ALLOCATION EXCEEDED
2334         JUMPE B,IMPIRT          ;ZERO LENGTH MESSAGE
2335         IMUL A,B                ;BIT COUNT
2336         MOVN D,A
2337         ADDB D,IMSOC7(I)        ;REMAINING BIT ALLOCATION
2338         JUMPL D,IMRMAH          ;BIT ALLOCATION EXCEEDED
2339         TRNE TT,IMPLW
2340          JRST IMRMAG            ;MESSAGE IS SHORT
2341         MOVSI D,200000
2342         IORB D,IMSOC6(I)        ;ACTIVE AT PI LEVEL
2343         SKIPGE IMSOC5(I)
2344          IDIVI A,32.
2345         SKIPL IMSOC5(I)
2346          IDIVI A,36.
2347         SKIPE B
2348          ADDI A,1               ;NUMBER OF WORDS MESSAGE WILL TAKE
2349         HRRZ B,IMSPIP(I)        ;ADDRESS WHERE MESSAGE HEADER WILL GO
2350         SKIPL (B)
2351          JRST 4,.               ;HEADER WORD SHOULD BE -1
2352         HRRZ C,IMSBFE(I)        ;GET ADDRESS OF LAST WORD IN BUFFER
2353         CAML B,C
2354          MOVEI B,-1(D)          ;HEADER IS LAST IN BUFFER, SO DATA IS FIRST
2355         MOVE E,B                ;RH(BLKI POINTER) IN E
2356         ADD A,B                 ;ADDRESS WHERE LAST WORD OF MESSAGE WILL GET STORED
2357         SETZM IMNWSI            ;ASSUME WILL ONLY NEED ONE BLKI
2358         CAMG A,C
2359          JRST IMPRM8            ;JUMP IF NO WRAP
2360 ;DROPS THROUGH
2361 \f;DROPS IN
2362         SUB B,C                 ;- # WDS TO READ FIRST TIME
2363         SUB A,C                 ;+ # WDS TO READ SECOND TIME
2364         SKIPGE B
2365          SKIPG A
2366           JRST 4,.              ;SCREW
2367         MOVN C,A                ;NEG OF REMAINING WORD COUNT
2368         MOVSS C                 ;TO LEFT HALF FOR BLKI POINTER
2369         HRRI C,-1(D)            ;RING AROUND TO BEGIN OF BUFFER
2370         MOVEM C,IMNWSI          ;STORE FOR INTCHN BLKI RUNOUT (FLAG IF -)
2371         ADD C,A                 ;ADR+COUNT
2372         HRRZM C,IMPNIW          ;EXPECTED END OF BLKI
2373         SKIPA A,B
2374 IMPRM8:  SUBM B,A               ;A GETS - # WORDS TO READ
2375         MOVE B,E
2376         HRL B,A                 ;BLKI POINTER
2377         SUB E,A                 ;EXPECTED LAST WORD
2378         SKIPE IMNWSI            ;IF DOING 2 BLKIS, EXPECTED END ALREADY STORED
2379          SKIPA E,IMPNIW
2380           MOVEM E,IMPNIW        ;EXPECTED LAST BLKI ADDRESS
2381         HRRZ A,IMSPIP(I)        ;SEE IF CLOBBERING GOOD-DATA PART OF BUFFER
2382         CAIL A,@IMSMPP(I)       ;SKIP IF MPP > PIP
2383          JRST [ CAIG E,(A)
2384                  CAIGE E,@IMSMPP(I)
2385                   JRST IMPRMT
2386                 JRST 4,. ]
2387         CAIGE E,@IMSMPP(I)
2388          CAIG E,(A)
2389           JRST 4,.
2390 IMPRMT: HRRZ A,IMSOC6(I)        ;SEE IF CLOBBERING CORE NOT PART OF BUFFER
2391         CAIL E,(A)
2392          CAILE E,@IMSBFE(I)
2393           JRST 4,.
2394         HRRZM I,IMPIPI          ;THIS SOCKET NOW ACTIVE AT P.I. LEVEL
2395         MOVEI C,%ISIND          ; New state = reading NCP data message
2396         JRST IMPRM9             ; Start reading
2397
2398 IMPRMP: MOVSI D,100000          ;SET INPUT HELD UP BY CORE JOB
2399         IORM D,IMSOC6(I)
2400 IFN KAIMP,[
2401         MOVE D,IMPPIA
2402         MOVEM D,IMPSVP
2403         SETZM IMPPIA    ;TURN OFF NETWORK FOR A WHILE
2404 ]
2405 IFN DMIMP,CONO FI,FIIN+0        ;SET PIA TO 0 FOR A WHILE, CORE JOB WILL GET BACK
2406         JRST IMPRET
2407
2408 IMRMAH: AOSA IMNBAE
2409 IMRMAF:  AOS IMNMAE
2410         JRST IMPIRT
2411
2412 IMPRM7: AOSA IMNMNC
2413 IMRMAG:  AOS IMNMSS
2414         JRST IMPIRT
2415 \f
2416 ; Got Last Imp Word (in A) of regular NCP data message
2417 ; Comes here from IMPBKX.
2418
2419 IMPRMB: MOVE I,IMPIPI
2420         MOVE B,IMBLKI
2421         CAMN B,IMPNIW
2422          JRST IMPRMC    ;ONE EXTRA WORD OF IMP PADDING, IGNORE IT
2423         ADD B,[1,,1]    ;ADDR TO NEXT WORD, COUNT TO ZERO
2424         CAME B,IMPNIW
2425          JRST IMPRMY
2426         MOVEM A,(B)     ;STORE LAST WORD
2427 IMPRMC: MOVE E,IMPNBI           ;# BYTES IN
2428         ADDM E,IMSMPC(I)        ;MAKE AVAIL TO M.P.
2429         MOVEM E,@IMSPIP(I)      ;STORE HEADER
2430         AOS E,IMPNIW            ;WORD AFTER MSG WILL BE NEXT HEADER
2431         CAILE E,@IMSBFE(I)
2432          HRRZ E,IMSOC6(I)       ;WRAP
2433         HRRM E,IMSPIP(I)        ;LEAVE LH OF IMSPIP ALONE
2434         CAIN E,@IMSMPP(I)
2435          JRST 4,.               ;BUFFER 1 WORD TOO SMALL?
2436         SETOM (E)
2437         MOVEI E,%NSINP
2438         HRRM E,IMSOC4(I)        ;INPUT AVAILABLE
2439         PUSHJ P,IMPUIN          ;INTERRUPT USER
2440         MOVSI D,200000          ;CLEAR ACTIVE AT P.I. LEVEL
2441         ANDCAM D,IMSOC6(I)
2442         SETOM IMPIPI
2443         JRST IMPIR1
2444
2445 IMPRMY: HRRZ E,IMPNIW           ;NOT ENDING WHERE IT'S SUPPOSED TO
2446         SUBI E,(B)              ;E GETS NUMBER OF MISSING WORDS
2447         MOVE H,IMPCSH
2448         BUG INFO,[NET: MSG FM HST ],OCT,IMPHTN(H),[SHORT ],DEC,E,[WDS, BC],DEC,IMPCBC
2449         JRST IMPRMC             ;PRETEND HOST TRANSMITTING GARBAGE
2450
2451 IMPRMZ: MOVE H,IMPCSH
2452         BUG INFO,[NET: HST ],OCT,IMPHTN(H),[SENT BYTE SIZE ],DEC,A,[SHOULD BE],DEC,B
2453         JRST IMPIRT             ;Discard message
2454 \f
2455 SUBTTL  ARPANET NCP OUTPUT INTERRUPT LEVEL
2456
2457 ;HERE ON COMPLETION OF TRANSMISSION OF CONTROL MESSAGE
2458
2459 IMPOB6: SETZM IMPOS
2460         SKIPN A,IMPSVQ
2461          JRST IMPRET            ;THAT WAS A NOP
2462         HLRZ B,1(A)             ;HOST TABLE INDEX
2463         MOVSI D,400000
2464         IORM D,IMPHTB(B)        ;SET RFNM WAIT BIT
2465         AOS IMRFCT
2466         LDB D,[051100,,TIME]
2467         DPB D,[221100,,IMPHTB(B)] ;STORE TIME TOO
2468         HLRZ T,A
2469         HRRZS A
2470         MOVE B,(A)
2471         MOVEM B,(T)
2472         JUMPGE B,IMOB7A
2473         CAME A,IMPLCQ
2474          JRST 4,.       ;IMPLCQ GAVE WRONG LAST MESS NO.
2475         MOVEM T,IMPLCQ
2476         CAIN T,IMPNCQ
2477          SETOM IMPLCQ
2478 IMOB7A: CAIN A,IMPMPL   ;SKIP IF NOT MAIN PROG BLOCK
2479          JRST [ SETOM IMPMPU
2480                 JRST IMPRET ]
2481         MOVE B,IMFFCQ
2482         CAIN B,(A)
2483          JRST 4,.       ;MAKING INFINITE LOOP
2484         MOVEM B,(A)
2485         MOVEM A,IMFFCQ
2486         AOS A,IMFCQL
2487         SKIPGE B,IMPHI  ;RETURN IF INPUT NOT HELD UP
2488          CAIG A,1       ;SKIP IF INPUT HELD UP AND NOW ENOUGH FREE
2489           JRST IMPRET
2490         SETZM IMPHI
2491         AOJE B,IMPRET   ;INPUT WAS NOT YET SUCCESSFULLY HELD UP
2492         AOJN B,[JRST 4,.]       ;IMPHI SHOULD HAVE BEEN -2
2493         AOS IMPNUH
2494         MOVE TT,IMSTAS  ;GET OLD CONI
2495         TRNE TT,IMPLW
2496 IFN KAIMP,[
2497          CONO IMP,IMI32C
2498         DATAI IMP,A
2499 ];KAIMP
2500 IFN DMIMP,[
2501          CONO FI,FII32C
2502         MOVE A,IMPSUS
2503 ];DMIMP
2504         TRNE TT,IMPLW   ;RESUME INPUT
2505          JRST IMPBKV
2506         SKIPE IMPIS
2507          JRST 4,.
2508         JRST IMSTRT
2509 \f
2510 ;HERE ON COMPLETION OF TRANSMISSION OF DATA MESSAGE
2511
2512 IMPOBG: SETZM IMPOS
2513         MOVE I,IMPOPI
2514         HRRZ Q,IMSOC4(I)
2515         CAIN Q,%NSOPN
2516          AOS IMSOC4(I) .SEE %NSRFN      ;PUT INTO RFNM WAIT STATE
2517         MOVSI A,20000
2518         CAIN Q,%NSCLS
2519          IORM A,IMSOC5(I)
2520         MOVSI Q,200000
2521         ANDCAB Q,IMSOC6(I)      ;NO LONGER ACTIVE AT P.I. LEVEL
2522         SETOM IMPOPI
2523         MOVN A,IMPNBT           ;BITS SENT
2524         ADDM A,IMSC7I(I)        ;DECREASE BITS IN BUFFER
2525         ADDB A,IMSOC7(I)        ;DECREASE ALLOCATION
2526         SKIPL A                 ;SKIP IF ALLOC LOST
2527         SOSGE IMSOC8(I)         ;SKIP IF MSG ALLOC DIDN'T LOSE
2528          JRST 4,.               ;LOST
2529         MOVE Q,IMSOC5(I)
2530         TLNN Q,140000           ;INTERRUPT USER IF DIRECT CONNECT (CHEAP), DEPEND ON ALLOC,
2531          SKIPN IMSMPC(I)        ; OR IF OUTPUT BUFFER WAS FULL,
2532           PUSHJ P,IMPUIN        ; SINCE HE MAY WANT TO SEND MORE
2533         MOVE A,IMPNBO           ;# BYTES FREED IN BUFFER BY REMOVAL OF MSG
2534         ADDM A,IMSMPC(I)        ;SPACE USED BY MESSAGE NOW FREE
2535         MOVE A,IMPNPT           ;UPDATE IMSPIP
2536         HRRZ Q,IMSOC6(I)        ;VALIDATE THIS
2537         CAILE Q,(A)
2538          JRST 4,.               ;POINTS BEFORE BUFFER
2539         HRRZ Q,IMSBFE(I)
2540         CAIGE Q,(A)
2541          JRST 4,.               ;POINTS AFTER BUFFER
2542         MOVEM A,IMSPIP(I)       ;..
2543         JRST IMPRET
2544 \f
2545 ;OUTPUT A DATA MESSAGE.
2546
2547 IMPOBD: MOVE T,TIME
2548         SUB T,IMSOCT(I)
2549         SKIPL IMSOC4(I) ;SKIP IF WANT TO SEND THIS BUFFER
2550          CAIL T,30.*2   ;SKIP IF BUFFER FIRST WRITTEN LESS THAN 2 SEC AGO
2551           JRST IMOBD1
2552         JRST IMPOBA     ;DON'T SEND NOW, GO BACK AND LOOK FOR OTHERS
2553
2554 IMOBD1: MOVE TT,IMSPIP(I)
2555         CAMN TT,IMSMPP(I)       ;SKIP IF ANY BITS TO SEND
2556          JRST IMPOBA            ;NO
2557         SKIPE IMSOC7(I)         ;SKIP IF NO BITS ALLOCATED
2558          SKIPN IMSOC8(I)        ;SKIP IF MSG ALLOCATED
2559           JRST IMPOBA           ;NO BITS OR NO MSGS ALLOWED
2560         MOVSI Q,200000
2561         IORB Q,IMSOC6(I)        ;ACTIVE AT PI LEVEL
2562
2563 ;CODE TO SEND OUT A BUFFER OR PARTIAL BUFFER
2564 ;ON ENTRY - I/ SOCKET TABLE INDEX
2565 ;           Q/ BUFFER POINTER FROM IMSOC6
2566 ;          TT/ BYTE POINTER TO FIRST BYTE TO SEND
2567 ;SETS UP  - T/ WORD SIZE (32 OR 36)
2568 ;           E/ FLAGS FROM IMSOC5
2569 ;           B/ BYTE SIZE
2570 ;           C/ # BITS TO SEND
2571
2572         SETZM IMPNBO
2573         MOVE T,IMSMPP(I)
2574         MOVEM T,IMOB0Z          ;SAVE FOR DEBUGGING
2575         MOVEI T,32.
2576         SKIPL E,IMSOC5(I)       ;SKIP IF IN 32BIT MODE
2577          MOVEI T,36.            ;SET 36BIT
2578         LDB B,IMSCBS            ;BYTE SIZE
2579         HRRZ C,IMSMPP(I)        ;COMPUTE # OF BYTES TO SEND
2580         SUBI C,(TT)
2581         JUMPL C,[MOVE D,IMSBFE(I) ;WRAPS AROUND
2582                  SUB D,Q
2583                  ADDI C,1(D)    ;SO ADD # WDS IN BUFFER
2584                  JRST .+1]
2585         IMUL C,T                ;FIRST GUESS AT NUMBER OF BITS
2586         LDB A,[360600,,TT]      ;GETS POSITION FIELD OF BYTE PTR
2587         LDB D,[360600,,IMSMPP(I)]
2588         SUBM A,D                ;CORRECTION TO NUMBER OF BITS
2589         ADD C,D                 ;C NOW HAS NUMBER OF SENDABLE BITS IN BUFFER
2590         SKIPL E                 ;SKIP IF 32BIT
2591          JUMPN A,IMOB5A         ;36BIT - JUMP IF NOT 0 (MIDDLE OF WORD)
2592         CAILE A,4               ;32BIT - SKIP IF 4, OR 36BIT 0 - SKIP IF NOT MID-WORD
2593          JRST IMOB5B            ;32BIT MID-WORD - SEND PART OR REST OF WORD
2594         CAME TT,IMSBFE(I)       ;AT RIGHT OF WORD, IS IT LAST WORD?
2595          AOSA TT                ;NO, ADVANCE TO NEXT
2596           HRR TT,Q              ;YES, WRAP AROUND TO FIRST
2597         TLO TT,440000           ;SWITCH FROM RIGHT OF WORD TO LEFT OF WORD
2598         CAMG C,IMSOC7(I)        ;SKIP IF TOO BIG FOR ALLOCATE
2599          CAILE C,8000.          ;FITS IN ALLOCATE, SKIP IF FITS IN IMP MESSAGE
2600           JRST IMOB1            ;MUST SEND LESS THAN ALL THE BITS IN BUFFER
2601 IMOB0F: MOVE D,IMSMPP(I)        ;SENDING WHOLE BUFFER
2602         LDB J,[360600,,D]       ;ADVANCE IMSMPP TO NEXT WORD BOUNDARY
2603         ADDI J,-36.(T)          ;RH(J) := # BITS TO ADVANCE TO WORD BOUNDARY
2604         MOVNI J,(J)
2605         IDIV J,B
2606         ADDM J,IMSMPC(I)        ;SUBTRACT FROM FREE THE BYTES SKIPPED OVER
2607         MOVNM J,IMPNBO          ;BUT RETURN TO FREE AFTER TRANSMISSION
2608         HLL D,IMSBFE(I)         ;NOW ADVANCE IMSMPP TO RIGHT END OF WORD
2609         MOVEM D,IMSMPP(I)       ;AND IMSPIP WILL GET SET EQUAL TO IMSMPP
2610 IMOB0A: MOVEM D,IMPNPT          ;ILDB -> FIRST BYTE TO SEND OUT NEXT TIME
2611         JUMPLE C,[JRST 4,.]     ;SOMEBODY COMPUTED BAD # BITS
2612         MOVE A,C
2613         IDIV C,B                ;C := # BYTES GETTING SENT
2614         JUMPN D,[JRST 4,.]      ;LOSS, TRYING TO SEND PARTIAL BYTE
2615         ADDM C,IMPNBO           ;# BYTES TO RETURN TO FREE AFTER MSG SENT
2616         MOVEM A,IMPNBT          ;# BITS TO SUBTRACT FROM ALLOCATION THEN
2617 ;DROPS THROUGH
2618 \f;DROPS IN
2619 ;NOW SET UP BUFFER HEADER FOR IMP MESSAGE IN IMOLDR
2620 ; TT -> FIRST WORD TO SEND
2621 ; A NUMBER OF BITS TO SEND
2622 ; C NUMBER OF BYTES
2623 ; B BYTE SIZE
2624 ; T WORD SIZE
2625 ; E FLAGS
2626
2627         LDB H,IMSCFH            ;HOST TABLE INDEX
2628         MOVEI Q,IMOLDR-2        ;HACK HACK
2629         PUSHJ P,STHSTP          ;STORE HOST NUMBER, MESSAGE TYPE 0
2630         LDB Q,IMSCLN            ;LINK NUMBER
2631         DPB Q,[001000,,IMOLDR+1]
2632         LDB Q,[221000,,IMSOC6(I)] ;GET BUFFER TYPE
2633         MOVEI D,4
2634         CAIN Q,377
2635          MOVEI D,7
2636         DPB D,[400400,,IMOLDR+1]        ;STORE HANDLING TYPE, DEPENDING ON BUFFER SIZE
2637         DPB B,[201000,,C]       ;STORE SIZE IN SAME WD AS COUNT
2638         LSH C,8
2639         MOVEM C,IMOLDR+5        ;HOST-HOST HEADER - 00,SIZE,BYTE-COUNT,0000
2640 IFN KAIMP,CONO IMP,IMO32C
2641 IFN DMIMP,CONO FI,FIO32C                ;36BIT MODE FOR HEADER, AND NO PIA YET
2642         DATAO IMP,IMOLDR        ;OUTPUT THE FIRST LEADER WORD
2643         SETZM IMOPNT            ;START AT BEGINNING OF IMOLST
2644         MOVE B,[-5,,IMOLDR]     ;SEND REST OF LEADER
2645         MOVEM B,IMOLST
2646         MOVEI B,3
2647         SKIPGE E
2648          MOVEI B,2
2649         MOVEM B,IMOMOD          ;SEND DATA IN 32 OR 36 BIT MODE AS APPROPRIATE
2650         ADDI A,-1(T)            ;ROUND UP IF NOT EXACT
2651         IDIV A,T                ;# WDS TO SEND
2652         MOVEI D,-1(TT)          ;FIRST WORD TO SEND MINUS ONE
2653         ADDI D,(A)              ;LAST WORD TO SEND
2654         CAIG D,@IMSBFE(I)       ;SKIP IF WRAP
2655          JRST IMOB7
2656         HRRZ B,IMSBFE(I)        ;COMPUTE # TO SEND FIRST TIME
2657         SUBI B,-1(TT)           ;B GETS PLUS NUMBER TO SEND FIRST TIME
2658         SUBM B,A                ;A GETS MINUS NUMBER TO SEND SECOND TIME
2659         MOVNI C,(B)
2660         HRLI C,-1(TT)           ;C GETS SWAPPED BLKO POINTER FOR FIRST TIME
2661         MOVE Q,IMSOC6(I)        ;POINTER TO BUFFER
2662 IFN KAIMP,[
2663         MOVEI B,3               ;SEND LAST WORD SEPARATELY
2664         MOVEM B,IMOBK2
2665         AOJE A,.+3
2666 ]        HRLI A,-1(Q)           ;BLKO POINTER FOR SECOND TIME
2667          MOVSM A,IMOBK2
2668 IFN KAIMP,[
2669         MOVNI A,(A)
2670         ADDI A,-1(Q)
2671         HRROM A,IMOBK3          ;STORE BLKO POINTER TO LAST WORD
2672 ]
2673         JRST IMOB8
2674
2675 IMOB7:  MOVSI C,3               ;NO WRAP, SO NO SECOND BLKO
2676         MOVSM C,IMOBK2
2677 IFN KAIMP,[
2678         SOS D
2679         HRROM D,IMOBK3          ;DO LAST WORD SEPARATELY
2680         SOJE A,IMOB8            ;SPECIAL CASE LAST WORD IS ONLY WORD
2681 ]
2682         MOVNI C,(A)             ;MAKE BLKO POINTER
2683         HRLI C,-1(TT)
2684 IMOB8:  MOVSM C,IMOBK1
2685         MOVSI TT,400000         ;TURN OFF "SEND ME"
2686         ANDCAM TT,IMSOC4(I)
2687         HRRZM I,IMPOPI          ;SAVE INDEX FOR BLKO RUNOUT
2688         AOS IMPMSS+0
2689         MOVEI C,%ISOND          ;STATE FOR "END OF DATA"
2690         JRST IMOB9
2691 \f
2692 ;BUFFER CANNOT BE SENT AS 1 MSG.  GRT ALLOC OR 8000 BITS.
2693
2694 IMOB1:  MOVE C,IMSOC7(I)        ;ALLOC
2695         CAILE C,8000.
2696          MOVEI C,8000.          ;C := MIN(BITS IN BUFFER, ALLOC, MAX IMP MSG SIZE)
2697         TLNE E,2000             ;SKIP IF BYTES EXACTLY FIT IN WORD
2698          JRST IMOB3             ;MUST SEND MULTI WORDS
2699         CAMGE C,T               ;SKIP IF ALLOC GEQ WDSIZ
2700          JRST IMOB2             ;MUST SEND PART WORD
2701         IDIV C,T                ;#WDS
2702         MOVE D,C
2703         IMUL C,T                ;#BITS IN THOSE WDS
2704 IMOB1A: ADDI D,-1(TT)           ;LAST WORD OUTPUT
2705         CAIG D,@IMSBFE(I)
2706          JRST .+3
2707           SUBI D,@IMSBFE(I)     ;WRAP AROUND
2708           ADDI D,-1(Q)
2709         HLL D,IMSBFE(I)         ;PUT IN BYTE PART (RIGHT END OF WORD)
2710         JRST IMOB0A             ;BUILD HEADER AND OUTPUT
2711
2712 ;SEND PART OF WORD BECAUSE ALLOC IS TOO SMALL
2713
2714 IMOB2:  MOVE D,TT               ;-> FIRST BYTE TO BE SENT
2715         MOVNI A,-36.(C)         ;36-BITS SENT
2716         DPB A,[360600,,D]       ;IS NEXT BYTE TO GO
2717         JRST IMOB0A
2718
2719 ;SEND PARTIAL BUFFER OF BYTES WHICH DO NOT FIT EXACTLY IN WORDS (E.G. 7BIT BYTES)
2720 ;MUST SEND A "QUANTUM" WHICH FOR LAZINESS' SAKE IS 36 BYTES
2721
2722 IMOB3:  MOVEI A,36.             ;#BITS IN A WORD
2723         IMUL A,B                ;#BITS IN A QUANTUM
2724         IDIV C,A                ;# QUANTA
2725         JUMPE C,IMOB4           ;NOT ENOUGH ALLOC FOR EVEN 1 QUANTUM, SORRY CHARLIE
2726         MOVE D,C
2727         IMUL C,A                ;#BITS TO SEND
2728         IMUL D,B                ;#WDS TO SEND (36 BYTES TAKE <BYTESIZE> WDS)
2729         JRST IMOB1A
2730
2731 ;NEED MORE ALLOCATE TO SEND A BUFFER FOR THIS ODD-SIZE CONNECTION
2732
2733 IMOB4:  MOVSI T,200000
2734         ANDCAM T,IMSOC6(I)      ;CLEAR "ACTIVE AT PI LEVEL" BIT
2735         JRST IMPOBA             ;MAYBE TRY ANOTHER ONE
2736 \f
2737 ;SENDING REST OF PARTIAL WORD (PI PTR NOT AT WORD BOUNDARY)
2738 ;A/ BITS LEFT IN WORD
2739
2740 IMOB5A: SKIPA C,A               ;36BIT GETS WHOLE WD
2741 IMOB5B:  HRREI C,-4(A)          ;32BIT GETS 4 LESS
2742         MOVNI J,-36.(A)         ;# BITS SHIFT TO LEFT JUSTIFY
2743         HRRZ D,TT
2744         CAIN D,@IMSMPP(I)       ;IF WHOLE REST OF BUFFER IS IN THIS WORD
2745          JRST [ LDB D,[360600,,IMSMPP(I)]
2746                 SUB A,D         ;A := NUMBER OF BITS TO SEND
2747                 MOVE C,(TT)     ;ALIGN BITS TO BE SENT IN LEFT OF WORD
2748                 LSH C,(J)
2749                 MOVEM C,(TT)
2750                 MOVE C,A
2751                 JRST IMOB0F ]   ;RE-ALIGN POINTERS TO WORD BOUNDARY
2752         CAMLE C,IMSOC7(I)       ;SKIP IF WILL FIT IN ALLOC
2753          JRST IMOB6             ;MUST SEND BYTES NOT LEFT JUST IN WD, AND MORE TO RIGHT
2754         MOVE D,(TT)             ;GET WORD
2755         LSH D,(J)               ;LEFT JUSTIFY
2756         MOVEM D,(TT)
2757         MOVE D,TT
2758         HLL D,IMSBFE(I)         ;ADVANCE PI POINTER TO END OF THIS WORD
2759         JRST IMOB0A             ;BUILD HDR & SEND
2760
2761 ;SEND MIDDLE PART OF WORD. BECAUSE OF SMALL ALLOCATES, THE LEFT END OF THE
2762 ;   WORD WAS SENT AND ALSO THERE IS NOT ENOUGH ALLOCATE TO SEND THE REST
2763 ;   OF THE ONE WORD.  THIS MIGHT NEVER OCCUR EXCEPT FOR 8 BIT BYTES.
2764 ;MUST MOVE GOOD BITS TO LEFT END OF WORD, WITHOUT DISTURBING BITS TO THE RIGHT
2765
2766 IMOB6:  MOVE C,IMSOC7(I)        ;CAN ONLY SEND ALLOC BITS
2767         SUB A,C                 ;POS OF LO BIT TO PICK UP
2768         DPB A,[360600,,TT]      ;POS IN BYTE PTR
2769         MOVE D,TT               ;SAVE ADVANCED PI PNTR
2770         DPB C,[300600,,TT]      ;STORE AS SIZE OF BYTE
2771         LDB R,TT                ;GET BYTE
2772         MOVNI A,-36.(C)         ;POS OF LO BIT TO STORE
2773         DPB A,[360600,,TT]      ;POS IN B PTR
2774         DPB R,TT                ;STORE BYTE AWAY
2775         JRST IMOB0A             ;SEND THE BYTE(S)
2776
2777 OVHMTR UUO      ;YET MORE RANDOM UUOS