Retro1.org codex

*DECK KSENDHM 
USETEXT NIPDEF
USETEXT AHEADER 
USETEXT FREETAB 
USETEXT LLCB
USETEXT PARAMS
USETEXT PT
USETEXT SUPMSG
USETEXT TNT 
 
 PRGM KSENDHM;               # PROCESS NAM K DISPLAY SEND COMMAND      #
 
 STARTIMS;
 STOPIMS; 
 
# 
      EXTERNAL REFERENCES 
# 
      XREF
        BEGIN 
        PROC MGETS;          # GET BUFFER                              #
        PROC NFOB;           # LINK MESSAGE TO NETWORK                 #
        PROC XTRACE;         # TRACE ROUTINE CALL                      #
        LABEL RJMAIN; 
        END 
# 
      LOCAL DEFINITIONS 
# 
      DEF MAX$NN # 255 #; # HIGHEST NETWORK NODE NUMBER ALLOWED        #
# 
      LOCAL VARIABLES 
# 
      ITEM DHN;              # DESTINATION HOST NODE NUMBER            #
      ITEM DNODE C(10);      # DESTINATION NODE IN OCTAL DISPLAY       #
      ITEM KRC;              # ERROR RETURN CODE                       #
      ITEM I;                # INDUCTION VARIABLE                      #
      ITEM TEMP;             # TEMPORARY                               #
 
      BASED ARRAY HMSG$TEXT [0:0] S(4); 
        BEGIN                # HOP MESSAGE TEXT                        #
        ITEM HMSG$WORD1  U(00,00,60); # TEXT WORD 1                    #
        ITEM HMSG$WORD2  U(01,00,60); # TEXT WORD 2                    #
        ITEM HMSG$WORD3  U(02,00,60); # TEXT WORD 3                    #
        ITEM HMSG$WORD4  U(03,00,60); # TEXT WORD 4                    #
        END 
 
      CONTROL EJECT;
 
      BEGIN # KSENDHM # 
 
      CONTROL IFEQ DEBUG,1; 
      XTRACE("KSDHM");       # TRACE CALL                              #
      CONTROL FI; 
 
      DNODE = PARAMS6;       # DESTINATION HOST NODE NUMBER            #
      KRC = 0;               # INITIALIZE RETURN CODE                  #
      DHN = 0;               # INITIALIZE DESTINATION NODE             #
 
      FOR I=0 STEP 1 WHILE I LS WC
                       AND KRC EQ 0 
                       AND C<I>DNODE NQ " " 
      DO # CONVERT DESTINATION HOST NODE NUMBER INTO BINARY            #
        BEGIN 
        TEMP = C<I>DNODE;    # ONE DIGIT                               #
        IF TEMP GQ "0"
          AND TEMP LQ "9" 
        THEN                 # ALLOW ONLY DECIMAL VALUE                #
          DHN = DHN*10 + (TEMP-O"33");
        ELSE                 # ERROR, MUST BE IN DECIMAL               #
          KRC = 8;
        END 
 
      IF KRC EQ 0 
      THEN
        BEGIN # LOCATE H-H LOGICAL LINK WITH TN = DHN                  #
        P<LLCB> = 0; # INITIALIZE LLCB ADDRESS                         #
        IF DHN LS TNTBS[0]
        THEN # DESTINATION NODE WITHIN TNT RANGE                       #
          BEGIN # SEARCH FOR A H-H LOGICAL LINK                        #
          P<LLCB> = TNTLLAD[DHN]; # FWA OF LLCB                        #
          FOR TEMP=TEMP WHILE P<LLCB> NQ 0 # LLCB EXISTS               #
                          AND (NOT LLCBHH[0] # NOT H-H LINK            #
                          OR LLCBWOF[0]) # LINK FAILED                 #
          DO # GET NEXT LOGICAL LINK IN CHAIN                          #
            P<LLCB> = LLCBFP[0]; # RESET LLCB ADDRESS                  #
          END 
        IF P<LLCB> NQ 0 
        THEN # LOCATE H-H LOGICAL LINK TO DESTINATION NODE             #
          BEGIN 
          IF LLCBHRL[0] LQ HRLV0
          THEN # DESTINATION HOST ALLOWS NO TRAFFIC AT MAX FL          #
            KRC = 9;
          END 
        ELSE # NO H-H LOGICAL LINK FOUND                               #
          KRC = 10; 
        END 
 
      IF KRC EQ 0 
      THEN
        BEGIN # SEND HOP/SEND TO DESTINATION HOST                      #
        MGETS(LHOPSD+BLKHSIZE+ABHSIZE,TEMP,TRUE); 
        P<AHEADER> = TEMP+BLKHSIZE; # FWA OF ABH                       #
        ABHABT[0] = APPCMD; 
        ABHACT[0] = CT8ASCII; 
        ABHTLC[0] = LHOPSDR;
        P<SUPMSG> = P<AHEADER>+ABHSIZE; 
        P<SMNIP> = P<SUPMSG>; # FORMAT HOPN/SEND                       #
        P<HMSG$TEXT> = PARAMS2; # HOP MESSAGE TEXT FWA                 #
        PFCSFC[0] = HOPSEND;
        HOPMSG1[0] = HMSG$WORD1[0]; # SEND UP TO 40 CHARS              #
        HOPMSG2[0] = HMSG$WORD2[0]; 
        HOPMSG3[0] = HMSG$WORD3[0]; 
        HOPMSG4[0] = HMSG$WORD4[0]; 
        NFOB(TEMP,P<LLCB>); # SEND HOPN/SEND TO NETWORK                #
        END 
 
      PARAMS7 = KRC; # SET RETURN CODE                                 #
      GOTO RJMAIN;
      END # KSENDHM # 
      TERM