.
. INTER - SITE DATA INTERCHANGE COMMAND PROCESSES
.
. CONNECT
. DISCONNECT
. INTERCHANGE
. MESSAGE
.
.
. (C) Copyright 1972-1978 John Walker
.
. This software is in the public domain
.
AXR$
DEFUNCT$
FANG
.
ON INTERSITE
.
.
. LINE CONTROL CHARACTERS
.
NUL EQU 0 NULL (FILL CHARACTER)
SOH EQU 1 START OF HEADER
STX EQU 2 START OF TEXT
EOT EQU 4 END OF TRANSMISSION
SYN EQU 026 ASCII SYNC CHARACTER
ESC EQU 033 ESCAPE SEQUENCE START
.
. MESSAGE TYPE BITS
.
ACK EQU 1 ACKNOWLEDGE
NAK EQU 2 NEGATIVE ACKNOWLEDGE
ALT EQU 010 ALTERNATION BIT
.
REALTHING EQU 1 IT'S THE PHONEY THING !
DUMPING EQU 1 TURN ON INPUT, OUTPUT SNAPS
.
. PROCEDURES TO GENERATE CALLING SEQUENCES
.
P PROC *1
OUTWORD* NAME 0
DO P(1)>0 , LA A0,P(1,1),P(1,2),P(1,3)
LMJ X5,OUTWORD
END .
.
P PROC *1
OUTCHAR* NAME 0
OTC* PROC *0
DO P(1)>0 , LA,U A1,P(1,I)
LMJ X6,OUTCHAR
END .
I DO P(1)+(P(1)=0) , OTC
END .
.
P PROC 0,1
GETCHAR* NAME 0
LMJ X5,GETCHAR
END .
.
.
.
. COMMONLY USED REGISTERS THROUGHOUT COMMUNICATOR
.
CRC2 EQU A14 CYCLIC REDUNDANCY CHECK CHARACTER 2
CRC1 EQU A15 CYCLIC REDUNDANCY CHECK CHARACTER 1
. (NOTE: CRC2 MUST PRECEDE CRC1, BECAUSE
. CRC PROC COUNTS ON THIS FOR XOR).
.
. THIS PROC GENERATES THE CODING SEQUENCE TO UPDATE THE RUNNING
. CYCLIC REDUNDANCY CHECK CHARACTERS FOR A CHARACTER IN THE REGISTER
. SUPPLIED. THE CHARACTER MUST BE IN THE RANGE 0 <= CH <= 0377
. (THIS IS NOT CHECKED). THE CHARACTER WILL NOT BE CHANGED, BUT
. THE REGISTER ABOVE THE ONE CONTAINING THE CHARACTER WILL BE DESTROYED.
.
P PROC 1,3 COMPUTE CYCLIC REDUNDANCY CHECK
CRC* NAME 0
A EQU P(1,1) A REGISTER CONTAINING THE CHARACTER
LOW8 EQUF 0,,H2 LOWER 8 BITS OF REMAINDER
HIGH8 EQUF 0,,H1 UPPER 8 BITS OF REMAINDER
.
XOR A,CRC1 A+1 = A -- CRC1
XOR CRC2,REMAINDER+LOW8,A+1 CRC1 = CRC2 -- (REMAINDER(A--CRC1))
LA CRC2,REMAINDER+HIGH8,A+1 CRC2 = REMAINDER/(1*/8)
END
/.
.
. CONNECT COMMAND PROCESS
.
CONNECT* quarterword TURN ON QUARTER WORD MODE
LX X9,CDBPC,X8 LOAD PARAMETER POINTER
LX X9,PBVAL,X9 LOAD FDT FOR COMMUNICATIONS LINE
LA A0,FDPROP,X9 LOAD PROPERTIES OF FILE
ON REALTHING
TOP,U A0,EPCOMM COMMUNICATIONS LINE ?
J CONEQTW NO. ERROR, IMPROPER EQUIPMENT
OFF REALTHING
TZ FDLT,X9 HAS LINE BEEN CONNECTED ?
J CONALR YES. LINE ALREADY CONNECTED
BGET LTL ALLOCATE A LINE TABLE
SA A0,FDLT,X9 SET LINE TABLE POINTER IN FDT
AA A0,(1,0) FORM POINTER TO CLEAR LINE TABLE
LR,U R1,LTL-1 LOAD LOOP COUNTER
SZ 0,*A0 CLEAR THE LINE TABLE
JGD R1,$-1 LOOP FOR ALL WORDS
LX X3,FDLT,X9 LOAD LINE TABLE POINTER
DL A0,FDIN,X9 LOAD INTERNAL NAME FOR LTG
DS A0,LTFN,X3 SET NAME IN LINE TABLE
LA,U A0,1 LOAD A ONE
SA A0,LTQWI,X3 SET QUARTER-WORD COMPLETION ACT
SA A0,LTOUSG,X3 SET INTERRUPT ON OUTPUT COMPLETION
SA A0,LTIUSG,X3 SET INTERRUPT ON INPUT COMPLETION
LA,U A0,OUTINT LOAD OUTPUT COMPLETION ADDRESS
SA A0,LTOCRTN,X3 SET OUTPUT COMPLETION ADDRESS
LA,U A0,ININT LOAD INPUT COMPLETION ROUTINE
SA A0,LTICRTN,X3 SET INPUT COMPLETION ADDRESS
LA,U A0,20 LOAD TIMER FOR 12 SECONDS
SA A0,LTOBTIM,X3 TURN ON OUTPUT BUFFER TIMING
INITQ LTSCQ,X3 INITIALISE SUBCHANNEL QUEUE
INITQ LTOQ,X3 INITIALISE OUTPUT MESSAGE QUEUE
INITPVQ 0,LTOAQ,X3 INITIALISE OUTPUT AVAILABLE QUEUE
LA A0,FDQWM,X9 LOAD QUARTER-WORD FLAG FOR FDT
ON REALTHING=0
LA,U A0,1 SET QUARTER WORD FOR EMULATION
OFF REALTHING=0
SA A0,LTQWM,X3 SET FLAG IN LINE TABLE
.
. INITIALISE BITS-PER-CHARACTER VALUES
.
LA A0,FDBITPC,X9 LOAD BITS PER CHARACTER
ON REALTHING=0
LA,U A0,8 SET 8 BITS PER CHARACTER FOR EMULATION
OFF REALTHING=0
SA A0,LTBITPC,X3 SET BITS PER CHARACTER IN LT
LA,U A1,1 LOAD A ONE BIT
LSSL A1,,A0 TAKE 2**(BITS PER CHARACTER)
ANA,U A1,1 COMPUTE LARGEST VALUE FOR CHARACTER
SA A1,LTCMSK,X3 SET CHARACTER MASK IN LINE TABLE
.
. COMPUTE LARGEST VALUED WORD WORTH SENDING AS
. A SHORT WORD (DELIMITED BY ESC 8).
.
LA,U A1,36 LOAD BITS IN FULL WORD
AA A1,A0 ADD BITS PER CHARACTER TO ROUND UP
ANA,U A1,1 SUBTRACT ONE FOR COVERED DIVIDE
DSL A1,36 SHIFT TO GET TWO WORD NUMBER
DI A1,A0 COMPUTE BYTES REQUIRED TO HOLD A WORD
ANA,U A1,3 SUBTRACT TWO-BYTE OVERHEAD FOR
. ESCAPE 8 SEQUENCE AND ONE BYTE
. ADVANTAGE TO MAKE IT WORTH IT.
MSI,U A1,A0 COMPUTE BITS IN THAT NUMBER OF BYTES
LA,U A2,1 LOAD A ONE BIT
LSSL A2,,A1 GET SMALLEST NUMBER TO SEND AS FULL WORD
SA A2,LTOPTMX,X3 SAVE FOR COMPARISON LATER
.
LA A0,FDCTMSPD,X9 LOAD CTM SPEED ON LINE
ON REALTHING=0
LA,U A0 SET ASYNCHRONOUS FOR EMULATION
OFF REALTHING=0
LA,U A1,SYN LOAD A SYNC CHARACTER
TG,U A0,2 IS LINE SYNCHRONOUS ?
SA A1,LTSYNC,X3 NO. SET SYNC CHARACTER FOR LINE
.
LA,U A0,5 ** FUDGE **
SA A0,LTTIME,X3 SET TIMEOUT QUANTUM FOR LINE
.
. COMPUTE LENGTH OF COMMUNICATIONS BUFFER REQUIRED
.
LA,U A0,16 LOAD BITS IN CRC FOR MESSAGE
DSL A0,36 SHIFT TO DOUBLE-WORD FOR DIVIDE
DI A0,LTBITPC,X3 DIVIDE BY BITS PER CHARACTER
TZ A1 IS THERE A REMAINDER ?
AA,U A0,1 YES. INCLUDE A BYTE TO HOLD IT
AA,U A0,ICHTXTL+ICHPREL+ICHPOST ADD TEXT, PREAMBLE, POSTAMBLE
SA A0,LTICOUNT,X3 SET AS INPUT COUNT IN LINE TABLE
TZ LTSYNC,X3 IS THIS A SYNCHRONOUS LINE ?
AA,U A0,ICHNSYN YES. INCLUDE ROOM FOR SYNC CHARACTERS
SA A0,LTOCOUNT,X3 SET OUTPUT COUNT IN LINE TABLE
LA,U A1 CLEAR REMAINDER FOR WORD COMPUTATION
DSL A0,1 DIVIDE CHARACTERS BY TWO
TZ LTQWM,X3 QUARTER-WORD MODE LINE ?
DSL A0,1 YES. DIVIDE CHARACTERS BY FOUR
TZ A1 ARE THERE CHARACTERS LEFT OVER ?
AA,U A0,1 YES. ROUND TO NEXT WORD
AA,U A0,ITTEXT ADD TRANSACTION BUFFER PREAMBLE
SA A0,LTBLW,X3 SET BUFFER LENGTH IN WORDS
.
. CREATE TIMEOUT ACTIVITY FOR THE LINE TABLE
.
FORK ICTIMER CREATE A TIMEOUT ACTIVITY
.
. INCREMENT LINES ACTIVE. IF THIS IS THE FIRST LINE,
. ACQUIRE THE REAL-TIME BUFFER POOL AND RAISE TO REAL
. TIME LEVEL.
.
P ICHGLOCK LOCK MASTER INTERCHANGE LOCK
LA A0,LINEACTV LOAD LINES ACTIVE COUNT
AU,U A0,1 INCREMENT LINES ACTIVE
SA A1,LINEACTV UPDATE LINES ACTIVE
JNZ A0,NOTFLC SKIP IF NOT FIRST LINE
FORK ITC CREATE TRANSACTION PROCESSOR
BGET RTBUFL ACQUIRE ALL THE SPACE WE'LL EVER NEED
BRELP A0 RELEASE TO BUFFER POOL
ON REALTHING
RT$ 35 RAISE TO REAL TIME LEVEL
OFF REALTHING
NOTFLC V ICHGLOCK RELEASE INTERCHANGE LOCK
FORK LTIACT CREATE LT INPUT ACTIVITY
P LTOAQ,X3 WAIT FOR INPUT ACTIVITY TO BE READY
FORK LTOACT CREATE LT OUTPUT ACTIVITY
P LTOAQ,X3 WAIT FOR OUTPUT ACTIVITY
COMPLETE . COMPLETE THE COMMAND
.
.
. IMPROPER EQUIPMENT TYPE ON FILE TO BE CONNECTED
.
CONEQTW LA,U A6,BADEQT LOAD ERROR MESSAGE ADDRESS
CONERR R$DIT . FIRE UP THE EDITOR
E$MSG A6,,W EDIT THE ERROR MESSAGE
LA,U A0,,X9 LOAD INPUT FDT ADDRESS
LMJ X11,FIST APPEND FILE AND STATEMENT, PRINT
ZAP . ERROR THE COMMAND, ROADBLOCK FILES
COMPLETE . COMPLETE THE COMMAND
.
. FILE SPECIFIED ALREADY CONNECTED
.
CONALR LA,U A6,CONALM LOAD ERROR MESSAGE ADDRESS
J CONERR PROCESS CONNECT ERROR
.
BADEQT 'CANNOT CONNECT NON-COMMUNICATIONS !'
CONALM 'CONNECT ALREADY PERFORMED ON !'
/.
.
. INTERCHANGE COMMAND PROCESS
.
ICHG* quarterword TURN ON QUARTER WORD MODE
LA A13,CDOPTS,X8 LOAD OPTIONS ON COMMAND
LX X9,CDBPC,X8 LOAD FIRST PARAMETER
LX X10,PBLINK,X9 CHAIN TO SECOND PARAMETER
LX X9,PBVAL,X9 LOAD INPUT FDT ADDRESS
LX X10,PBVAL,X10 LOAD OUTPUT FDT ADDRESS
LA A0,FDPROP,X9 LOAD INPUT FILE PROPERTIES
LA A1,FDPROP,X10 LOAD OUTPUT FILE PROPERTIES
.
. CHECK FOR NEITHER FILE COMMUNICATIONS EQUIPMENT
.
TOP,U A0,EPCOMM IS INPUT FILE COMMUNICATIONS ?
TEP,U A1,EPCOMM NO. IS OUTPUT FILE A LINE ?
J $+2 YES. COMMAND IS OK
J ICNEITH NO. NEITHER FILE IS A LINE
.
. CHECK FOR BOTH FILES COMMUNICATIONS EQUIPMENT
.
TEP,U A0,EPCOMM IS FIRST FILE A LINE ?
TOP,U A1,EPCOMM YES. IS THE SECOND ONE ALSO ?
J $+2 NO. COMMAND IS OK
J ICBOTH YES. ERROR, BOTH FILES ARE LINES
AND,U A1,EPCOMM GET FLAG FOR OUTPUT FILE A LINE
LR R10,A2 LOAD OUTPUT A LINE FLAG
DL A2,X9 LOAD INPUT AND OUTPUT FDT POINTERS
TNZ R10 IS OUTPUT FILE THE COMM. LINE ?
DSC A2,36 NO. SWAP POINTERS
DS A2,X9 RESET POINTERS TO FDT'S
.
. AT THIS POINT, X9 = FILE FDT, X10 = LINE FDT
.
TNZ FDLT,X10 HAS LINE BEEN CONNECTED ?
J ICNCON NO. ISSUE ERROR MESSAGE
.
. ESTABLISH SUBCHANNEL FOR THE COMMUNICATION
.
LR R11,X9 SAVE FDT FOR FILE PARAMETER
LX X3,FDLT,X10 LOAD LINE TABLE FOR LINE
LA A1,LTSCN,X3 LOAD SUBCHANNEL NUMBER
AA,U A1,1 INCREMENT SUBCHANNEL NUMBER
SA A1,LTSCN,X3 UPDATE SUBCHANNEL NUMBER
LMJ X5,STINIT INITIALISE SUBCHANNEL TABLE
SX X8,STCDB,A0 SET COMMAND IN SUBCHANNEL
LX X9,A0 MAKE X9 SUBCHANNEL POINTER
LA A1,A0 LOAD SUBCHANNEL ADDRESS
INSERT LTSCQ,X3 INSERT SUBCHANNEL ON LT
.
. CREATE I/O FCT FOR THE FILE SPECIFICATION
.
LA A1,R11 LOAD FDT FOR FILE IN INTERCHANGE
LMJ A2,IOGET BUILD AN I/O FCT FOR FILE
SA A0,STFCT,X9 SAVE FCT IN SUBCHANNEL
LX X10,A0 SET X10 AS I/O FCT POINTER
TNZ R10 FILE SOURCE INTERCHANGE ?
J ICHFO NO. PROCESS FILE OUTPUT INTERCHANGE
.
. FILE INPUT INTERCHANGE SETUP
.
SZ STDMFCT,X9 MARK AS FILE SOURCE INTERCHANGE
LX X5,CDBPC,X8 LOAD THE PARAMETER CHAIN LINK
LX X5,PBLINK,X5 LINK TO SECOND PARAMETER
LX X5,PBLINK,X5 LINK TO THIRD PARAMETER
TZ X5 WAS THIRD PARAMETER SPECIFIED ?
J ICH3PA YES. LOAD IT
LA,U A0,0377777 NO. LOAD INFINITY BLOCK COUNT
TEP,U A13,OPTION('M') WAS THE 'M' OPTION ON ?
LA,U A0,1 YES. DEFAULT IS THEN ONE
J ICHSBC GO SET BLOCK COUNT IN FCT
ICH3PA LA A0,PBVAL,X5 LOAD THE THIRS PARAMETER
ICHSBC SA A0,IOCOUNT,X10 SET COUNT IN INPUT FCT
LA,U A0 CLEAR I/O OPTION FOR DEFAULT
TEP,U A13,OPTION('M') 'M' OPTION SPECIFIED ?
LA,U A0,'M' YES. SET 'M' I/O OPTION
SA A0,IOOPT,X10 SET I/O OPTION FOR READING
LMJ A2,INPUT CREATE AN INPUT ACTIVITY
BGET ITTEXT ALLOCATE A START INTERCHANGE TRANSACTION
SX X3,ITLT,A0 SET LINE TABLE IN TRANSACTION
SX X9,ITST,A0 SET SUBCHANNEL TABLE IN TRANS.
LA,U A1,ITYSTOUT LOAD 'START OUTPUT' TYPE
SA A1,ITTYPE,A0 SET TYPE IN TRANSACTION
LA A1,A0 LOAD TRANSACTION ADDRESS
INSERT ICHWQ PUT ON TRANSACTION QUEUE
V ICHWORK MARK TRANSACTION AVAILABLE
EXIT . TERMINATE THIS ACTIVITY
.
. FILE OUTPUT INTERCHANGE SETUP
.
ICHFO LMJ A2,IOGNF CREATE NON-I/O FCT TO DRIVE OUTPUT
SA A0,STDMFCT,X9 SAVE DUMMY FCT IN SUBCHANNEL
LX X10,A0 LOAD DUMMY FCT AS INPUT FCT
LX X9,STFCT,X9 LOAD REAL FCT AS OUTPUT FCT
.
. GET INTERCHANGE PREFIX BLOCK AND EDIT HEADER
.
GET IOBB,X10 GET INTERCHANGE PREFIX BLOCK
LX,U X7,IBDATA,A1 LOAD ADDRESS OF DATA IN BLOCK
LA A0,IPBH,X7 LOAD PREFIX BLOCK HEADER
TE A0,('*INTR*') IS IT A VALID HEADER BLOCK ?
IERR . NO. BOMB OUT
R$DITA . FIRE UP THE EDITOR
ASCII
A$LMSG ICRCSTM EDIT 'RECEIVING FILE' MESSAGE
A$FD2 IPBQUAL,X7 EDIT QUALIFIER OF FILE
A$LMSR . COPY MESSAGE TEXT
A$FD2 IPBFNAME,X7 EDIT FILE NAME
LA A4,IPBEQTW,X7 LOAD WORD WITH F-CYCLE
LSSL A4,24 SHIFT OFF UNWANTED DATE
SSL A4,24 RIGHT JUSTIFY VALUE
TZ A4 TEMPORARY FILE ?
TNE,U A4,1 IS CYCLE 1 BEING SENT ?
J ICHMNOT1 YES. SKIP EDITING
A$QCHR '(' NO. EDIT LEFT PARENTHESIS
A$DECV A4,,W EDIT ABSOLUTE F-CYCLE
A$QCHR ')' EDIT RIGHT PARENTHESIS
ICHMNOT1 A$LMSR . COPY MESSAGE TO EQUIPMENT TYPE
LA,S1 A0,IPBEQTW,X7 LOAD EQUIPMENT TYPE OF FILE
LA A0,EQTTAB,A0 LOAD EQUIPMENT TYPE MNEMONIC
SSL A0,12 SHIFT OFF PROPERTY BITS
A$FD1 . EDIT EQUIPMENT TYPE NAME
A$LMSR . COPY TO SITE NAME
A$FD1 IPBSITE,X7 EDIT SENDING SITE NAME
A$LMSR . COPY TO END OF MESSAGE
R$PRTXA 1 PRINT THE RECEIVING MESSAGE
FIELDATA
.
. ESTABLISH PROPERTIES OF SOURCE FILE FROM PREFIX BLOCK
.
LA,U A0 CLEAR I/O OPTION FOR WRITING
LA A1,IPBPROP,X7 LOAD PROPERTIES OF SOURCE FILE
TEP,U A1,EPMASS IS SOURCE A MASS STORAGE FILE ?
SNONZ IOMASS,X10 YES. SET MASS IN DUMMY FCT
TEP,U A1,EPWAD WORD-ADDRESSABLE SOURCE FILE ?
SNONZ IOWAD,X10 YES. MARK WORD ADDRESSABLE
TZ IOMASS,X10 IS INPUT A TAPE FILE ?
TNZ IOMASS,X9 NO. IS OUTPUT TAPE ?
J ICHONTP YES. HANDLE INTERCHANGE INVOLVING TAPE
LA,U A0,'D' LOAD I/O OPTION TO DUPLICATE ADDRESS
ICHSIOP SA A0,IOOPT,X9 SET I/O OPTION IN FCT
LA A0,X7 LOAD PREFIX BLOCK ADDRESS
ANA,U A0,IBDATA BACK UP TO START OF BLOCK
BRELP A0 RELEASE THE BLOCK
LMJ A2,OUTPUT CREATE AN OUTPUT ACTIVITY
P IOBB+QL,X9 WAIT FOR OUTPUT TO COMPLETE
BRELP X9 RELEASE OUTPUT FCT
BRELP X10 RELEASE INPUT FCT
. ** RELEASE SUBCHANNEL **
COMPLETE . COMPLETE THE COMMAND
.
ICHONTP TNZ IOMASS,X10 IS INPUT TAPE ?
TZ IOMASS,X9 YES. IS OUTPUT TAPE ?
J ICHDIFF NO. DIFFERENT DEVICES AT EACH END
LA,U A0,'M' YES. COPY END OF FILES ON TAPE
J ICHSIOP GO SET I/O OPTION
.
ICHDIFF TEP,U A13,OPTION('Q') IS TAPE SIMULATION DESIRED ?
J ICHSIOP YES. JUST COPY ADDRESSES
TNZ IOMASS,X9 NO. IS OUTPUT MASS STORAGE ?
J ICHDFFI NO. THIS IS MASS => TAPE
GET IOBB,X10 READ FILE LABEL BLOCK FROM TAPE
LA A0,IBLEN,A1 LOAD LENGTH OF BLOCK
TNE,U A0,28 IS THIS CORRECT LENGTH OF A LABEL ?
TZ IBSTAT,A1 WAS I/O STATUS NORMAL ON BLOCK ?
IERR J ICHGBL NO. BAD LABEL
LA A0,IBDATA,A1 LOAD LABEL FROM BLOCK READ
TNE A0,('COPYGD') WAS ORIGINAL FILE WORD ADDRESSABLE ?
SNONZ IOWAD,X10 YES. FLAG IT WORD ADDRESSABLE
TE A0,('COPYG ') IS THIS A CORRECT FORMAT TAPE ?
TNE A0,('COPYGD') OR A WORD-ADDRESSABLE COPY,G ?
IERR J ICHGBL NO. REJECT FOR BAD LABEL
LA,U A0,'G' LOAD 'G' I/O OPTION
J ICHSIOP GO SET I/O OPTION
.
ICHDFFI .
. *** GENERATE COPY,G LABEL BLOCK ***
LA,U A0,'G' LOAD 'G' I/O OPTION
J ICHSIOP SET I/O OPTION FOR OUTPUT
.
.
. INITIALISE SUBCHANNEL BUFFER
.
. LA,U A1,<SUBCHANNEL NUMBER>
. LMJ X5,STINIT
. <RETURN> A0 = SUBCHANNEL BUFFER
.
STINIT BGET STL ALLOCATE A SUBCHANNEL BUFFER
SA A1,STSCN,A0 SET SUBCHANNEL NUMBER IN BUFFER
LA,U A1,ALT LOAD INITIAL INPUT ALTERNATION
SA A1,STIALT,A0 SET TO RECEIVE 0 ALTERNATION FIRST
SZ STOALT,A0 SET TO SEND 0 ALTERNATION FIRST
SX X3,STLT,A0 SET LINE TABLE BACKPOINTER
.
. INPUT AREA INITIALISATION
.
LA,U A1,36 LOAD BITS PER WORD
SA A1,STBITL,A0 SET BITS LEFT IN TEXT WORD
SZ STIWA,A0 SET INPUT WORD ACCUMULATOR ZERO
LA,U A1,IPNXINT LOAD INITIAL RETURN ADDRESS
SA A1,STIRTN,A0 SET GET CHARACTER RETURN POINT
LA,U A1,STILEN,A0 LOAD INITIAL BUFFER POINTER
SA A1,STIBP,A0 SET TO STORE INTO STILEN INITIALLY
SZ STRETRANS,A0 CLEAR LAST OUTPUT BUFFER SENT
SZ STILEN,A0 CLEAR LENGTH OF INPUT BLOCK
SZ STMSAD,A0 CLEAR ADDRESS OF LAST BLOCK
.
J 0,X5 RETURN TO CALLER
.
. ERROR ROUTINES
.
ICNCON R$DIT . FIRE UP THE EDITOR
E$MSG ICNCOM EDIT NOT CONNECTED MESSAGE
LA,U A0,,X10 LOAD I/O FCT ADDRESS
LMJ X11,FIST EDIT FILE AND STATEMENT
ZAP . ERROR THE COMMAND
COMPLETE . COMPLETE THE COMMAND
.
ICNEITH LA,U A6,ICNEITHM LOAD 'NEITHER' MESSAGE
ICHPERR R$DIT . ENTER EDITOR
E$MSG A6,,W EDIT ERROR MESSAGE
LMJ X11,IST APPEND STATEMENT NUMBER
ZAP . ERROR THE COMMAND
COMPLETE . AND COMPLETE IT
.
ICBOTH LA,U A6,ICBOTHM LOAD ERROR MESSAGE
J ICHPERR PRINT THE ERROR MESSAGE
.
ICNCOM 'ATTEMPT TO INTERCHANGE ON UNCONNECTED !'
ICBOTHM 'BOTH FILES ARE COMMUNICATIONS FOR INTERCHANGE !'
ICNEITHM 'NEITHER FILE IS COMMUNICATIONS FOR INTERCHANGE !'
ASCII
ICRCSTM '#RECEIVING FILE &*& FROM & AT SITE &.&'
FIELDATA
/.
.
. DISCONNECT COMMAND PROCESS
.
DISCT* quarterword TURN ON QUARTER-WORD MODE
LX X9,CDBPC,X8 LOAD LINK TO PARAMETER
LX X9,PBVAL,X9 LOAD FDT ADDRESS FOR FILE
LA A0,FDPROP,X9 LOAD PROPERTIES OF FILE
TOP,U A0,EPCOMM IS FILE COMMUNICATIONS TYPE ?
J DCBEQT NO. IMPROPER EQUIPMENT TYPE
TNZ FDLT,X9 HAS FILE BEEN CONNECTED ?
J DCNCON NO. CAN'T DISCONNECT AN UNCONNECTED FIL
LX X3,FDLT,X9 LOAD ADDRESS OF FILE TABLE
INITPVQ 0,LTSCQ,X3 REINITIALISE SUBCHANNEL QUEUE AS
. A P/V QUEUE. IT WILL BE USED TO
. SYNCHRONISE TERMINATION OF THE
. LINE TABLE AND ASSOCIATED
. ACTIVITIES.
ON REALTHING
RT$ 35 RAISE TO REAL-TIME IN CASE WE ARE LAST
OFF REALTHING
V LTOAQ,X3 TELL THE OUTPUT ACTIVITY TO TERMINATE
SNONZ LTCLOSE,X3 SET TERMINATION FLAG IN LT
ACT$ LTINAME,X3 FIRE OFF INPUT ACTIVITY
P LTSCQ,X3 WAIT FOR INPUT ACTIVITY TO TERMINATE
P LTSCQ,X3 WAIT FOR OUTPUT ACTIVITY
P LTSCQ,X3 WAIT FOR TIMER TO TERMINATE
.
ON REALTHING
. ** HANG UP IF AUTO-DIAL AVAILABLE **
CMT$ LTFN,X3 TERMINATE THE LINE TERMINAL
OFF REALTHING
.
P ICHGLOCK LOCK INTERCHANGE COMMON STORAGE
LA A0,LINEACTV LOAD LINES ACTIVE COUNT
ANA,U A0,1 DECREMENT LINES ACTIVE
SA A0,LINEACTV UPDATE LINES ACTIVE
ON DEBUG
TP A0 HAS LINES ACTIVE GONE NEGATIVE ?
IERR . YES. BOMB
OFF DEBUG
JNZ A0,DCNLLA SKIP IF NOT LAST LINE ACTIVE
V ICHWORK LAST ONE. TERMINATE TRANSACTION PROCESS
DCNLLA V ICHGLOCK RELEASE INTERCHANGE STORAGE LOCK
SZ FDLT,X9 MARK LINE TERMINAL NOT CONNECTED
BRELP X3 RELEASE THE LINE TABLE
COMPLETE . COMPLETE THE COMMAND
.
. ERROR ROUTINES AND MESSAGES
.
DCBEQT LA,U A6,DCBEQM LOAD ERROR MESSAGE
DCNERR R$DIT . FIRE UP THE EDITOR
E$MSG A6,,W COPY THE ERROR MESSAGE
LA A0,X9 LOAD THE FDT ADDRESS
LMJ X11,FIST APPEND FILE IN STATEMENT
ZAP . ERROR THE COMMAND
COMPLETE . TERMINATE
.
DCNCON LA,U A6,DCNCOM LOAD ERROR MESSAGE ADDRESS
J DCNERR PRINT ERROR MESSAGE
.
.
DCBEQM 'CANNOT DISCONNECT NON-COMMUNICATIONS !'
DCNCOM 'CANNOT DISCONNECT UNCONNECTED !'
/.
.
. TRANSACTION PROCESSOR
.
NEXTRANS BRELP X7 RELEASE PREVIOUS TRANSACTION
.
ITC P ICHWORK WAIT FOR WORK TO BE AVAILABLE
REMOVE ICHWQ REMOVE NEXT TRANSACTION
TNE,U A1,ICHWQ TERMINATION ACTIVATION ?
EXIT . YES. TERMINATE WHEN ALL DONE
SA A1,X7 SAVE TRANSACTION BUFFER ADDRESS
LX X3,ITLT,X7 LOAD LINE TABLE ADDRESS
LX X9,ITST,X7 LOAD SUBCHANNEL TABLE ADDRESS
LA A0,ITTYPE,X7 LOAD TRANSACTION TYPE
TLE,U A0,MXTRT ILLEGAL TRANSACTION TYPE ?
J $+1,A0 BRANCH ON TRANSACTION TYPE
TRT0 IERR . TYPE 0: KABOOM !!
J ICHIN TYPE 1: INPUT MESSAGE TEXT
J ICHTMO TYPE 2: TIMEOUT ON OUTPUT
J ICHSTO TYPE 3: START INTERCHANGE OUTPUT
MXTRT EQU $-TRT0 HIGHEST TRANSACTION TYPE
/.
.
. PROCESS INPUT BUFFER
.
.
. INPUT BUFFER FORMAT:
.
. CONTROL MESSAGE TEXT
.
.
. SOH SOH
. <SUBCHANNEL> <SUBCHANNEL>
. <TYPE> <TYPE>
. EOT STX
. CRC1 T
. CRC2 E
. X
. T
. EOT
. CRC1
. CRC2
.
. THE TEXT CONTAINED IN THE TEXT PORTION IS A FREE-FORMAT
. BYTE STREAM OF THE SIZE BYTES THE LINE CAN HANDLE.
.
. ANY CHARACTER OTHER THAN THE 'ESCAPE' CODE IS ACCRUED INTO
. THE WORD ACCUMULATOR. WHEN 36 BITS OR MORE DATA HAVE BEEN
. ACCUMULATED, THE EXCESS, IF ANY, IS DISCARDED, AND THE WORD
. IS STORED INTO THE BUFFER. AN 'ESCAPE' TRIGGERS THE SCAN
. OF THE NEXT CHARACTER AND ITS INTERPRETATION AS FOLLOWS:
.
. ESC 1 THE PRECEDING WORD SPECIFIED THE LENGTH OF
. THE BLOCK TO FOLLOW. ALLOCATE A BUFFER WITH
. THAT TEXT CAPACITY AND POSITION THE POINTER
. TO STORE INTO THAT BUFFER.
.
. ESC 2 THE PRECEDING WORD WAS THE MASS STORAGE
. ADDRESS AT WHICH THIS BLOCK WAS READ. PUT
. THE WORD INTO THE ADDRESS WORD FOR THE BLOCK
. AND DELETE IT FROM THE TEXT PORTION.
.
. ESC 3 THE FOLLOWING BYTE IS A COUNT OF THE NUMBER
. OF TIMES TO REPLICATE THE PRECEDING WORD IN THE
. BUFFER. THIS WILL NEVER CROSS A BLOCK BOUNDARY.
. IF NO PRECEDING WORD EXISTS, ENTER THE SPECIFIED
. NUMBER OF ZERO WORDS.
.
. ESC 4 INSERT THE CODE FOR 'ESCAPE' AS A TEXT CHARACTER.
.
. ESC 5 THE BLOCK BUFFER IS COMPLETE. WRITE IT NOW.
.
. ESC 6 ALL DATA HAS BEEN TRANSMITTED FOR THIS FILE.
.
. ESC 7 THE FOLLOWING BYTE IS THE INCREMENT MINUS ONE
. WHICH, ADDED TO THE ADDRESS OF THE LAST
. BLOCK RECEIVED, GIVES THE ADDRESS OF THE
. CURRENT BLOCK. IF PRESENT IN THE FIRST
. BLOCK RECEIVED, ADD TO ZERO.
.
. ESC 8 TAKE THE BITS ACCUMULATED SO FAR AS THE NEXT
. TEXT WORD.
.
.
ICHIN LX,U X1,ITTEXT,X7 LOAD TEXT START ADDRESS
ON DUMPING
SX,H2 X1,ISPK+1 SET ADDRESS IN PACKET
LA A0,LTICOUNT,X3 LOAD INPUT COUNT FROM LT
AA,U A0,3 *QW* ROUND UP
SSL A0,2 *QW* DIVIDE BY 4 TO GET WORDS
SA,H1 A0,ISPK+1 SET LENGTH IN PACKET
LA A0,PARTBL LOAD OPTIONS
TOP,U A0,OPTION('W') TRANSACTION DUMP DESIRED ?
J ICHSNP NO. SKIP DUMP
SNAP$P ISPK DUMP INPUT BUFFER
ICHSNP .
$(2).
ISPK SNAP$PKT ,,'INPUT '
$(1) OFF DUMPING
AX X1,(1,0) FORM WORD POINTER TO TEXT
LX X2,(1,0) SET CHARACTER POINTER TO START
ON EITHER
TZ LTQWM,X3 QUARTER WORD LINE TERMINAL ?
AX,U X2,QWFETCH YES. OFFSET CHARACTER POINTER
OFF EITHER
DSL CRC2,72 CLEAR CRC ACCUMULATORS
.
. VALIDATE THE INPUT BUFFER FORMAT AND CHECK CRC
.
EX FETCH GET THE FIRST CHARACTER
CRC A0 INCLUDE IN CRC
TE,U A0,SOH IS IT START OF HEADER ?
LMJ X11,IPRJ NO. REJECT MESSAGE
EX FETCH LOAD THE SECOND CHARACTER
CRC A0 INCLUDE IT IN THE CRC
.
. LOOK UP THE SUBCHANNEL CONTROL TABLE
.
LX X9,LTSCQ+QFL,X3 LOAD LINK TO FIRST SUBCHANNEL ON LT
IPSCS LA A1,X9 LOAD SUBCHANNEL POINTER
TNE,U A1,LTSCQ,X3 SUBCHANNEL NOT FOUND ?
J NEXTRANS RIGHT. IGNORE THE MESSAGE
TNE A0,STSCN,X9 DOES SUBCHANNEL MATCH MESSAGE ?
J IPSCOK YES. THIS IS THE SUBCHANNEL
LX X9,QFL,X9 LOAD LINK TO NEXT SUBCHANNEL
J IPSCS CHECK FOR END OF LIST
.
IPSCOK EX FETCH LOAD THE NEXT CHARACTER
CRC A0 ADD INTO THE CRC
LA A6,A0 SAVE THE MESSAGE TYPE BITS
EX FETCH LOAD THE STX/EOT CHARACTER
CRC A0 INCLUDE IN THE CRC
TNE,U A0,EOT IS THIS END OF MESSAGE ?
J IPSCCRC YES. GO CHECK CRC
TE,U A0,STX NO. IS IT START OF TEXT ?
LMJ X11,IPRJ NO. REJECT MESSAGE
AND,U A6,ACK+NAK AND OFF ACK AND NAK BITS
TZ A7 IS THIS A TEXT MESSAGE ?
LMJ X11,IPRJ NO. REJECT ACK/NAK WITH TEXT
SX X1,R5 SAVE WORD POINTER AT TEXT START
SX X2,R6 SAVE CHARACTER POINTER AT TEXT START
LR,U R1,ICHTXTL-1 LOAD TEXT LENGTH IN CHARACTERS
IPTXCRC EX FETCH LOAD NEXT CHARACTER FROM TEXT
CRC A0 ADD TEXT CHARACTER TO CRC
JGD R1,IPTXCRC LOOP FOR ALL TEXT CHARACTERS
EX FETCH LOAD THE EOT FOR THE MESSAGE
CRC A0 INCLUDE IN CRC
TE,U A0,EOT WAS IT AN EOT ?
LMJ X11,IPRJ NO. REJECT MESSAGE
.
. NOW LOAD CRC FROM THE MESSAGE AND VALIDATE AGAINST
. CRC COMPUTED FROM EXAMINATION OF THE MESSAGE. THE
. 16 BIT CRC WILL SPAN AS MANY BYTES AS ARE REQUIRED
. TO HOLD IT.
.
IPSCCRC LA A3,LTBITPC,X3 LOAD BITS PER CHARACTER ON LINE
LA,U A2 CLEAR RESULT ACCUMULATOR
LA,U A4,16 LOAD NUMBER TO BITS TO ACCRUE
IPSCRCL EX FETCH GET THE NEXT BYTE
LSSL A2,,A3 SHIFT OVER CRC ACCUMULATOR
AA A2,A0 ADD IN THIS BYTE
ANA A4,A3 DECREMENT BITS LEFT TO SCAN
JZ A4,IPCRCD SKIP IF ALL OF CRC SCANNED
JP A4,IPSCRCL CONTINUE IF MORE TO SCAN
LNA A3,A4 LOAD BITS TO RIGHT JUSTIFY CRC
SSL A2,,A3 RIGHT JUSTIFY THE CRC TOTAL
IPCRCD DSL A2,8 SHIFT OFF SECOND CRC CHARACTER
SSL A3,36-8 RIGHT JUSTIFY SECOND CRC
TNE A2,CRC1 IS FIRST CRC CHAR CORRECT ?
TE A3,CRC2 YES. IS THE SECOND RIGHT, TOO ?
J IBADCRC NO. SEND A NAK FOR MESSAGE
.
. CRC GOOD. NOW ANALYSE MESSAGE
.
AND,U A6,ACK+NAK AND OFF ACK AND NAK BITS
JZ A7,IPTEXT PROCESS TEXT IF NEITHER BIT ON
TOP,U A6,ACK IS THIS AN ACK ?
J IPNAK NO. RESEND THE MESSAGE
.
. ACK RECEIVED FOR OUTPUT TEXT
.
AND,U A6,ALT ISOLATE ALTERNATION BIT
TE A7,STOALT,X9 ACK FOR MESSAGE WE SENT ?
J IPNAK NO. RESEND MESSAGE FOR WRONG ACK
LA A0,STOALT,X9 LOAD OUTPUT ALTERNATION
XOR,U A0,ALT COMPLEMENT ALTERNATION
SA A1,STOALT,X9 UPDATE OUTPUT ALTERNATION
LA A0,STRETRANS,X9 LOAD RETRANSMISSION BUFFER
SZ STRETRANS,X9 CLEAR RETRANSMISSION AVAILABLE
BRELP A0 RELEASE LAST MESSAGE
BRELP X7 RELEASE THE TRANSACTION
J ICOACKR ENTER OUTPUT CODE TO SEND NEXT MESSAGE
.
. NAK RECEIVED. RESEND TEXT BUFFER
.
IPNAK LA A1,STRETRANS,X9 LOAD PREVIOUS TEXT BUFFER
TNZ A1 IS THIS A SPURIOUS NAK ?
LMJ X11,IPRJ YES. REJECT TRANSACTION
INSERT LTOQ,X3 PUT BACK ON OUTPUT QUEUE FOR LT
V LTOAQ,X3 MARK OUTPUT AVAILABLE ON LT
J NEXTRANS GO PROCESS NEXT TRANSACTION
.
.
. TEXT MESSAGE RECEIVED
.
. DECOMPOSE MESSAGE INTO I/O BUFFERS
.
IPTEXT AND,U A6,ALT ISOLATE ALTERNATION BIT
TNE A7,STIALT,X9 DIFFERENT FROM LAST TEXT MESSAGE ?
J IPACKI NO. JUST SEND ACK AND IGNORE
SA A7,STIALT,X9 SAVE ALTERNATION OF LAST MESSAGE
LX X6,STIBP,X9 LOAD INPUT BUFFER POINTER
AX X6,(1,0) SET INCREMENT ON POINTER
LX X1,R5 LOAD WORD POINTER TO TEXT START
LX X2,R6 LOAD CHARACTER POINTER TO TEXT START
LA A4,STBITL,X9 A4 = BITS LEFT IN WORD
LA A2,STIWA,X9 RELOAD INPUT WORD ACCUMULATOR
LA A3,LTBITPC,X3 LOAD BITS PER CHARACTER ON LINE
LR,U R4,ICHTXTL LOAD CHARACTERS IN BUFFER TEXT
LX X5,STIRTN,X9 LOAD RETURN POINT TO GETCHAR
J GETCHAR GO FETCH NEXT CHARACTER
.
IPNXTC GETCHAR . LOAD THE NEXT TEXT CHARACTER
IPNXINT TNE,U A0,ESC START OF ESCAPE SEQUENCE ?
J IPESC YES. INTERPRET ESCAPE SEQUENCE
IPACCUM DSL A0,,A3 MOVE CHARACTER TO A1
LDSC A1,,A3 ACCRUE CHARACTER IN A2
. NOTE OVERFLOW BITS MAY GO TO A1
ANA A4,A3 SUBTRACT BITS LEFT IN WORD
JZ A4,IPWRD SKIP IF TEXT WORD COMPLETED
JP A4,IPNXTC CONTINUE IF MORE BITS NEEDED
.
LNA A0,A4 LOAD NUMBER OF EXTRA BITS SHIFTED IN
DSL A1,,A0 RIGHT JUSTIFY TEXT WORD
IPWRD SA A2,,*X6 SET WORD IN BUFFER
ON DEBUG
LA,U A2,,X6 LOAD BUFFER POINTER
ANA,U A2,1 BACK OFF THE INCREMENT
TNE,U A2,STILEN,X9 ARE WE STORING LENGTH ?
J IPWDBOK YES. SKIP RANGE TEST
ANA A2,STIB,X9 SUBTRACT BUFFER START
ANA,U A2,IBDATA COMPUTE WORDS STORED IN BUFFER
TG A2,STILEN,X9 HAVE WE OVERFLOWED BUFFER ?
IERR . YES. BOMB
IPWDBOK OFF DEBUG
LA,U A4,36 RELOAD BITS NEEDED FOR WORD
LA,U A2 CLEAR TEXT WORD ACCUMULATOR
J IPNXTC PROCESS NEXT CHARACTER
.
.
. PROCESS ESCAPE SEQUENCE
.
IPESC GETCHAR . LOAD TYPE OF ESCAPE SEQUENCE
TLE,U A0,MXESC IS IT A LEGAL TYPE ?
J $+1,A0 BRANCH ON ESCAPE TYPE
IPEB IERR . ILLEGAL ESCAPE SEQUENCE TYPE
J IPELEN 1: DEFINE LENGTH OF BLOCK
J IPEADR 2: DEFINE ADDRESS FOR MASS STORAGE
J IPERPC 3: SPECIFY REPEAT COUNT FOR PREVIOUS
J IPEESC 4: INSERT 'ESC' INTO TEXT
J IPEWRT 5: WRITE THE BLOCK TO FILE
J IPEEOT 6: END OF DATA. CLOSE OUTPUT FILE
J IPEINCM 7: INCREMENT MASS STORAGE ADDRESS
J IPESWRD 8: END OF SHORT WORD
MXESC EQU $-IPEB NUMBER OF DEFINED ESCAPE CODES
.
.
. ESC 1
.
. PREVIOUS WORD IS LENGTH OF BLOCK WHICH FOLLOWS
.
IPELEN LA A0,STILEN,X9 LOAD LENGTH OF INPUT BLOCK
AA,U A0,IBDATA ADD BLOCK HEADER LENGTH
BGET . ALLOCATE A BLOCK BUFFER
SA A0,STIB,X9 SAVE INPUT BLOCK ADDRESS
LA A1,STILEN,X9 LOAD LENGTH OF BLOCK
SA A1,IBLEN,A0 SET LENGTH IN BLOCK BUFFER
SZ IBSTAT,A0 CLEAR BUFFER STATUS
SZ IBLAST,A0 CLEAR LAST BUFFER FLAG
LXM,U X6,IBDATA,A0 SET POINTER TO TEXT OF BLOCK
J IPNXTC PROCESS NEXT CHARACTER
.
.
. ESC 2
.
. PREVIOUS WORD IS ADDRESS OF BLOCK ON MASS STORAGE
.
IPEADR ANX,U X6,1 DECREMENT BLOCK POINTER
LA A0,,X6 LOAD ADDRESS FOR BLOCK
SA A0,STMSAD,X9 SET ADDRESS OF THIS BLOCK IN SUBCHANNEL
J IPNXTC PROCESS NEXT CHARACTER
.
.
. ESC 3 <REPEAT>
.
. REPEAT PREVIOUS WORD NUMBER OF TIMES SPECIFIED BY
. THE NEXT BYTE.
.
IPERPC GETCHAR . LOAD NEXT CHARACTER (REPEAT COUNT)
LR R1,A0 LOAD COUNT FOR CHARACTER
LA,U A0,,X6 LOAD POINTER INTO BLOCK
ANA,U A0,1 BACK UP POINTER ONE WORD
LA A1,STIB,X9 LOAD BLOCK BUFFER ADDRESS
LA,U A2 SET DEFAULT FILL AS ZERO
TE,U A0,IBDATA-1,A1 IS SEQUENCE BEFORE ANY DATA
LA A2,,A0 NO. FILL WITH PREVIOUS WORD
J IPERPE ENTER REPEAT LOOP
IPERPL SA A2,,*X6 SET DUPLICATE WORD IN BUFFER
ON DEBUG
LA,U A1,,X6 LOAD STORE POINTER
ANA A1,STIB,X9 SUBTRACT BUFFER START
ANA,U A1,IBDATA+1 COMPUTE WORDS STORED IN BUFFER
TG A1,STILEN,X9 HAVE WE OVERFLOWED BUFFER ?
IERR . YES. BOMB OUT
OFF DEBUG
IPERPE JGD R1,IPERPL LOOP FOR REPEAT COUNT
LA,U A2 CLEAR ACCUMULATION REGISTER
J IPNXTC PROCESS NEXT CHARACTER
.
.
. ESC 4
.
. INSERT ESCAPE IN TEXT
.
IPEESC LA,U A0,ESC LOAD AN ESCAPE CHARACTER
J IPACCUM GO ACCRUE AS TEXT CHARACTER
.
.
. ESC 5
.
. WRITE BLOCK TO OUTPUT FILE
.
IPEWRT LA A1,STIB,X9 LOAD BLOCK BUFFER ADDRESS
TNZ STSCN,X9 CONTROL SUBCHANNEL ?
J IPCTXT YES. GO PROCESS DATA BLOCK
LA A0,STMSAD,X9 LOAD ADDRESS FOR THIS BLOCK
SA A0,IBMSAD,A1 SET ADDRESS IN BLOCK
ON REALTHING=0
LX X6,A1 LOAD BLOCK ADDRESS
R$DIT . FIRE UP THE EDITOR
E$FD4 ('WRITE: ') LABEL THE WRITE
E$DECV IBLEN,X6 EDIT NUMBER OF WORDS
E$FD4 (' WORDS AT ') LABEL LENGTH AND ADDRESS
E$DECV IBMSAD,X6 LABEL THE ADDRESS
R$PRTX 1 PRINT THE LINE
LA A1,STIB,X9 RESTORE BLOCK BUFFER ADDRESS
OFF REALTHING=0
LA A0,STDMFCT,X9 LOAD DUMMY I/O FCT
PUT IOBB,A0 PUT BUFFER ON I/O BOUNDED BUFFER
IPCRTN SZ STIB,X9 MARK NO INPUT BUFFER ALLOCATED
LX,U X6,STILEN,X9 RESET POINTER TO GET LENGTH
AX X6,(1,0) RESET INCREMENT IN POINTER
LA A3,LTBITPC,X3 RELOAD BITS IN A CHARACTER
LA,U A2 CLEAR WORD ACCUMULATOR
J IPNXTC GO PROCESS NEXT CHARACTER
.
.
. ESC 6
.
. END OF DATA. CLOSE OUTPUT FILE
.
IPEEOT TNZ STSCN,X9 MASTER SUBCHANNEL MESSAGE ?
J IPEOTMS YES. HANDLE END OF TRANSMISSION DIFFERE
BGET IBDATA ALLOCATE BUFFER TO TERMINATE OUTPUT
ON DEBUG
TZ STIB,X9 HAS LAST BUFFER BEEN WRITTEN ?
IERR . NO. MISSING ESC 5 AFTER LAST BLOCK
OFF DEBUG
LA A1,A0 LOAD ADDRESS OF BLOCK BUFFER
SZ IBLEN,A1 MARK BLOCK LENGTH ZERO
LA,U A0,STERM LOAD TERMINATION STATUS
SA A0,IBSTAT,A1 SET STATUS IN BLOCK
SNONZ IBLAST,A1 MARK THIS BLOCK LAST
LA A0,STDMFCT,X9 LOAD DRIVE FCT ADDRESS
PUT IOBB,A0 PLACE ON BOUNDED BUFFER
IPEEOTA LR,U R4 CLEAR CHARACTERS LEFT IN BLOCK
GETCHAR . FORCE ACKNOWLEDGE OF BLOCK
J IPEEOTA ...AND ALL OTHERS ON THIS SUBCHANNEL
.
IPEOTMS LR,U R4 CLEAR CHARACTERS LEFT IN THE BUFFER
J IPNXTC RETURN TO WATCH FOR NEXT BUFFER
.
.
. ESC 7 <INCREMENT>
.
. SETS THE ADDRESS FOR THE CURRENT BLOCK TO THE ADDRESS
. OF THE LAST BLOCK PLUS <INCREMENT>. THE LAST BLOCK
. ADDRESS IS SET TO THE CURRENT BLOCK ADDRESS.
.
IPEINCM GETCHAR . PICK UP ADDRESS INCREMENT
AA A0,STMSAD,X9 ADD TO ADDRESS OF LAST BLOCK
AA,U A0,1 ADD IN IMPLIED BUMP OF ONE
SA A0,STMSAD,X9 REPLACE ADDRESS IN SUBCHANNEL
J IPNXTC RETURN FOR NEXT CONTROL SEQUENCE
.
.
. ESC 8
.
. TERMINATES A 'SHORT WORD'. THE DATA BYTES WHICH HAVE BEEN
. RECEIVED SO FAR ARE DECLARED COMPLETE, AND ARE STORED AS
. THE NEXT DATA WORD. IF NO DATA BYTES HAVE BEEN RECEIVED,
. ZERO IS STORED.
.
IPESWRD EQUF IPWRD PROCESS JUST LIKE FULL WORD
.
.
. GET CHARACTER
.
. LMJ X5,GETCHAR
. <RETURN> A0 = CHARACTER
.
GETCHAR JGD R4,GETCAV IF BUFFER EMPTY ?
J GTCNXB YES. ACK THIS ONE AND GET ANOTHER
GETCAV EX FETCH NO. LOAD THE NEXT CHARACTER
J 0,X5 RETURN TO CALLER
.
GTCNXB SX X5,STIRTN,X9 SAVE GETCHAR RETURN POINT
.
. SAVE DECODING ENVIRONMENT AND WAIT FOR NEXT BUFFER
.
SA A2,STIWA,X9 SAVE PARTIALLY ACCUMULATED WORD
SA A4,STBITL,X9 SAVE NUMBER OF BITS ACCUMULATED
SX X6,STIBP,X9 SAVE INPUT BUFFER STORE POINTER
.
. SEND AN ACK FOR THIS TEXT BUFFER
.
IPACKI LA,U A4,ACK LOAD AN ACK AS RESPONSE
ON REALTHING=0
V WACK MARK ACK SENT FOR BUFFER
OFF REALTHING=0
IPSRESP LMJ X11,OPSETUP SET UP OUTPUT TEXT IN BUFFER
AA A4,STIALT,X9 SEND ALTERNATION OF MESSAGE ACK'ED
LA A1,A4 LOAD THE TYPE CHARACTER
CRC A1 INCLUDE IN THE CRC
EX STORE PLACE TYPE IN BUFFER
LMJ X11,OPCLOSE CLOSE THE OUTPUT BUFFER
SNONZ ITRELF,X7 MARK RELEASE UPON CHANNEL RESUME
LA A1,X7 LOAD ADDRESS OF TRANSACTION
INSERT LTOQ,X3 PLACE ON OUTPUT QUEUE FOR LT
V LTOAQ,X3 MARK OUTPUT AVAILABLE
J ITC GO PROCESS NEXT TRANSACTION
.
.
. PROCESS CONTROL SUBCHANNEL MESSAGE
.
IPCTXT LA,H1 A0,IBDATA,A1 LOAD MESSAGE TYPE
TLE,U A0,IPCMXT IS IT WITHIN RANGE ?
J $+1,A0 YES. BRANCH ON MESSAGE TYPE
IPCT0 J IPCDONE ILLEGAL. IGNORE IT
J IPCMSG 1: MESSAGE COMMAND TEXT
IPCMXT EQUF $-IPCT0 MAXIMUM CONTROL SUBCHANNEL TYPE
.
. TYPE 1 MESSAGE COMMAND TEXT
.
IPCMSG R$DIT . FIRE UP THE EDITOR
E$MSG IPCMST COPY THE MESSAGE HEADING
LA A0,STIB,X9 LOAD INPUT BUFFER ADDRESS
E$FD1 IBDATA+1,A0 EDIT SITE OF SENDER
E$MSGR . COPY TO MESSAGE TEXT
LA A0,STIB,X9 LOAD BUFFER ADDRESS
LA,H2 A1,IBDATA,A0 LOAD LENGTH OF MESSAGE TEXT
LA,U A0,IBDATA+2,A0 LOAD ADDRESS OF MESSAGE TEXT
E$COPY . COPY MESSAGE TEXT INTO LINE
R$PRTX 1 PRINT LINE AND TERMINATE
J IPCDONE GO AWAIT NEXT MESSAGE
.
IPCMST 'MESSAGE FROM !: 1'
.
.
IPCDONE BRELP STIB,X9 RELEASE THE BLOCK BUFFER
J IPCRTN GO SET UP FOR NEXT BLOCK
.
. PROCESS MESSAGE WITH BAD CRC
.
IBADCRC AND,U A6,ACK+NAK ISOLATE ACK, NAK BITS
TZ A7 BAD CRC ON ACK OR NAK ?
LMJ X11,IPRJ YES. REJECT MESSAGE
PRINT$ ('* BAD CRC * '),2 ** FLAG IT
LA,U A4,NAK LOAD A NAK FOR RESPONSE
J IPSRESP SEND RESPONSE TO MESSAGE
.
. REJECT MESSAGE
.
IPRJ SX,H2 X7,RJSPK+1 SET BUFFER ADDRESS IN SNAP PACKET
LR R14,LTBLW,X3 LOAD LENGTH TO DUMP
SR,Q2 R14,RJSPK+1 SET LENGTH IN PACKET
SNAP$P RJSPK SNAP THE BAD MESSAGE
J NEXTRANS RELEASE IT AND CONTINUE
.
RJSPK SNAP$PKT,'XAR' $-$,$-$,'REJECT'
/.
.
. TIMEOUT TRANSACTION PROCESSING
.
. THE TIMER ACTIVITY WILL PERIODICALLY SUBMIT A TIMER
. TRANSACTION FOR EACH ACTIVE LINE TABLE. WHEN THE TRANSACTION
. IS RECEIVED, THIS CODE WILL SCAN ALL ACTIVE SUBCHANNELS ON THE
. LINE TABLE AND DECREMENT THE TIMER CELL (STTIME) IN ANY
. SUBCHANNEL WHICH HAS A PENDING (UNACKNOWLEDGED) OUTPUT
. MESSAGE (STRETRANS IS NONZERO). WHEN THE TIMER COUNTS DOWN
. TO ZERO, THE MESSAGE WILL BE RETRANSMITTED AND THE COUNTER
. WILL BE RESET TO THE ORIGINAL TIMEOUT VALUE FOR THE LINE
. TABLE.
.
ICHTMO LX X9,LTSCQ+QFL,X3 LOAD LINK TO FIRST SUBCHANNEL
ICHTMN LA,U A0,,X9 LOAD SUBCHANNEL ADDRESS
TNE,U A0,LTSCQ,X3 END OF SUBCHANNEL LIST ?
J NEXTRANS YES. PROCESS NEXT TRANSACTION
TNZ STRETRANS,X9 IS THERE AN UNACKNOWLEDGED OUTPUT BUFFER
J ICHTML NO. LOOK AT NEXT SUBCHANNEL
LA A0,STTIME,X9 YES. LOAD TIMEOUT VALUE
ANA,U A0,1 DECREMENT TIMER
JNZ A0,ICHTMS SKIP IF TIMER IS NOT EXPIRED
ON REALTHING=0
LA A0,PARTBL LOAD OPTIONS FROM CALL
TOP,U A0,OPTION('Y') IS THE 'Y' OPTION ON ?
J NOTYO NO. SKIP THIS FOLLY
TNZ WACK+QN ** READY FOR ACK ** ?
J ICHTML NO. SKIP IT
P WACK YES. DECREMENT THE COUNT
BRELP STRETRANS,X9 YES. RELEASE THE MESSAGE BUFFER
SZ STRETRANS,X9 PREVENT RE-ENTRY
LA A0,STOALT,X9 LOAD OUTPUT ALTERNATION
XOR,U A0,ALT COMPLEMENT ALTERNATION
SA A1,STOALT,X9 UPDATE OUTPUT ALTERNATION
J ICOACKR BLITHER INTO ACK RECEIVED CODE
NOTYO OFF REALTHING=0
LA A1,STRETRANS,X9 EXPIRED. LOAD MESSAGE TO RESEND
INSERT LTOQ,X3 PLACE ON OUTPUT QUEUE FOR LT
V LTOAQ,X3 MARK OUTPUT AVAILABLE FOR LT
ON REALTHING=0
PRINT$ ('TIMEOUT '),2 PRINT TIMEOUT DIAGNOSTIC
OFF REALTHING=0
LA A0,LTTIME,X3 LOAD TIME QUANTUM FOR LINE TABLE
ICHTMS SA A0,STTIME,X9 UPDATE TIME IN SUBCHANNEL
ICHTML LX X9,QFL,X9 LINK TO NEXT SUBCHANNEL
J ICHTMN LOOP FOR ALL SUBCHANNELS
/.
.
. START FILE SOURCE INTERCHANGE
.
ICHSTO BGET IBDATA+IPBL GET BUFFER FOR PREFIX BLOCK
SA A0,STOB,X9 SAVE AS CURRENT OUTPUT BUFFER
.
. BUILD INTERCHANGE PREFIX BLOCK
.
LA,U A2,IPBL LOAD LENGTH OF PREFIX BLOCK
SA A2,IBLEN,A0 SET LENGTH FOR OUTPUT
SZ IBMSAD,A0 CLEAR SOURCE ADDRESS OF BLOCK
SZ IBLAST,A0 CLEAR LAST BLOCK FLAG
SZ IBSTAT,A0 CLEAR I/O STATUS
LA,U A1,IBDATA,A0 SET POINTER TO TEXT AREA
LA A2,('*INTR*') LOAD INTERCHANGE SENTINEL
SA A2,IPBH,A1 SET AS HEADER
LA A2,(LEVEL) LOAD LEVEL OF ORIGINATING FANG
SA A2,IPBFL,A1 SET ORIGINATING FANG LEVEL
LA,U A2,IPBSITE,A1 LOAD ADDRESS OF SITE WORD
LXI,U A2,3 LOAD FUNCTION FOR MCT$
LA A3,(1,021) READ 1 WORD (SITE CODE)
DS A2,IPBQUAL,A1 USE QUALIFIER FOR MCT$ PACKET
LA,U A0,IPBQUAL,A1 LOAD MCT$ PACKET ADDRESS
MCT$ . GET SITE CODE FROM MCT
LA A2,STFCT,X9 LOAD FCT FOR FILE BEING SENT
LA A3,IOOPT,A2 LOAD I/O OPTION BEING USED
SA A3,IPBIOOP,A1 SET I/O OPTION ON FILE
LA A2,IOFDT,A2 LINK TO FDT FOR SOURCE FILE
DL A3,FDQUAL,A2 LOAD QUALIFIER FOR FILE
DS A3,IPBQUAL,A1 SET QUALIFIER IN PREFIX
DL A3,FDFN,A2 LOAD FILE NAME OF FILE
DS A3,IPBFNAME,A1 SET FILE NAME IN PREFIX
LA A3,6,A2 LOAD FITEM$ GOODIES WORD
SA A3,IPBEQTW,A1 SAVE EQUIPMENT TYPE, F-CYCLE
LA A3,FDPROP,A2 LOAD SOURCE FILE PROPERTIES
SA A3,IPBPROP,A1 PUT PROPERTIES IN PREFIX
.
. SET UP COMMUNICATIONS OUTPUT BUFFER
.
BRELP X7 RELEASE THE TRANSACTION
LA A0,LTBLW,X3 LOAD COMMUNICATIONS BUFFER LENGTH
BGET . ALLOCATE COMMUNICATIONS BUFFER
SA A0,X7 SAVE AS TRANSACTION
LMJ X11,OPSETUP INITIALISE OUTPUT BUFFER
LA A1,STOALT,X9 LOAD OUTPUT ALTERNATION
CRC A1 INCLUDE IN CRC
EX STORE SET ALTERNATION IN BUFFER
. ABSENCE OF ACK, NAK FLAGS AS TEXT
LA,U A1,STX LOAD START OF TEXT FLAG
CRC A1 INCLUDE IN THE CRC
EX STORE STORE IT IN THE BUFFER
LR,U R5,ICHTXTL-1 SET TEXT LENGTH COUNTER
LA A1,STOB,X9 LOAD OUTPUT BLOCK BUFFER
J ICOSKG SKIP GET FOR THIS CANNED BUFFER
.
. PROCESS NEXT BLOCK FROM SOURCE FILE
.
ICOGET LA A0,STFCT,X9 LOAD SOURCE FILE FCT
GET IOBB,A0 GET NEXT BUFFER FROM FILE
TZ IBLEN,A1 DOES BUFFER CONTAIN DATA ?
J ICOSKG YES. GO OUTPUT THE DATA
. ** HANDLE TAPE EOF MARK **
SA A1,STOB,X9 SAVE BLOCK BUFFER ADDRESS
J ICONULB JUST OUTPUT END SEQUENCE FOR NULL BLOCK
.
ICOSKG SA A1,STOB,X9 SAVE BLOCK BUFFER ADDRESS
LX,U X8,IBDATA,A1 SET POINTER TO TEXT OF BLOCK
AX X8,(1,0) GET INCREMENT ON POINTER
LR R4,IBLEN,A1 LOAD WORDS IN BUFFER
LA A0,R4 LOAD LENGTH OF THE BLOCK
TNE A0,STILEN,X9 SAME AS LAST LENGTH SENT ?
J ICOLSAM YES. DON'T SEND LENGTH AGAIN
SA A0,STILEN,X9 NO. SAVE LENGTH OF LAST BLOCK
OUTWORD . SEND THE LENGTH
ICOLSAM OUTCHAR ESC,1 SEND ESC 1 SEQUENCE AFTER LENGTH
LA A0,STFCT,X9 LOAD SOURCE FILE FCT ADDRESS
TNZ IOMASS,A0 IS SOURCE MASS STORAGE ?
J ICONAD NO. SKIP SENDING ADDRESS
LA A1,STOB,X9 YES. LOAD BLOCK BUFFER ADDRESS
LA A0,IBMSAD,A1 LOAD ADDRESS OF THIS BLOCK
ANU A0,STMSAD,X9 COMPUTE CHANGE IN ADDRESS
JZ A1,ICONAD DON'T SEND ADDRESS IF UNCHANGED
ANU,U A1,2 GET VALUT TO CHECK FIT IN BYTE
TN A1 DID ADDRESS GO DOWN ?
TG A2,LTCMSK,X3 NO. WILL (DELTA ADDRESS - 1) FIT ?
J ICOSFAD NO. SEND FULL ADDRESS
SA A1,A6 SAVE CHANGE IN IBMSAD
OUTCHAR ESC,7 SEND ESCAPE 7 SEQUENCE
LA A1,A6 LOAD CHANGE IN IBMSAD
ANA,U A1,1 DECREMENT CHANGE TO FIT MORE IN
OUTCHAR . SEND CHANGE IN ADDRESS
J ICONAD GO SEND THE TEXT
.
ICOSFAD OUTWORD . SEND THE FULL ADDRESS WORD
OUTCHAR ESC,2 DELIMIT WITH ESCAPE 2 SEQUENCE
ICONAD LA A1,STOB,X9 LOAD BLOCK BUFFER ADDRESS
LA A0,IBMSAD,A1 LOAD ADDRESS / BLOCK NUMBER
SA A0,STMSAD,X9 UPDATE LAST BLOCK ADDRESS
.
. OUTPUT TEXT OF BLOCK
.
DSL A6,72 CLEAR LAST WORD, SUPPRESS COUNT
J ICOTXE ENTER TEXT PROCESSING LOOP
.
ICOTXS LA A0,,*X8 LOAD NEXT WORD OF TEXT
TLE A7,LTCMSK,X3 IS SUPPRESS COUNT A FULL BYTE ?
TE A0,A6 NO. IS THIS WORD SAME AS LAST ?
J ICOTPW NO. OUTPUT THE WORD
AA,U A7,1 YES. INCREMENT WORDS SUPPRESSED
J ICOTXE GO PROCESS NEXT WORD
.
ICOTPW LA A6,A0 SAVE AS LAST WORD
JZ A7,ICONSP SKIP IF NO PREVIOUS SUPPRESSED
OUTCHAR ESC,3 OUTPUT ESC 3 SEQUENCE
LA A1,A7 LOAD SUPPRESS COUNT
OUTCHAR . OUTPUT SUPPRESSED WORD COUNT
LA,U A7 CLEAR WORDS SUPPRESSED COUNT
ICONSP OUTWORD A6 OUTPUT THE TEXT WORD
ICOTXE JGD R4,ICOTXS LOOP FOR ALL WORDS IN BLOCK
JZ A7,ICOENS SUPPRESSION AT END OF BLOCK ?
OUTCHAR ESC,3 YES. OUTPUT ESC 3 SEQUENCE
LA A1,A7 LOAD SUPPRESSION COUNT
OUTCHAR . OUTPUT SUPPRESSED WORD COUNT
ICOENS OUTCHAR ESC,5 OUTPUT THE END-OF-BLOCK SEQUENCE
ICONULB LA A0,STOB,X9 LOAD OUTPUT BUFFER ADDRESS
LA A1,IBLAST,A0 LOAD LAST BLOCK FLAG
BRELP A0 RELEASE THE BLOCK BUFFER
JZ A1,ICOGET GET NEXT BLOCK IF NOT LAST
.
.
. END OF FILE PROCESSING
.
OUTCHAR ESC,6 OUTPUT THE END OF FILE SEQUENCE
ICOFILL LA A0,R5 LOAD CHARACTERS IN BUFFER
TNE,U A0,ICHTXTL-1 HAS BUFFER FLUSHED ?
J ICOBFULL YES. BUFFER IS FULL
OUTCHAR NUL NO. FILL BUFFER WITH NUL'S
J ICOFILL LOOP UNTIL BUFFER FLUSHES
.
ICOBFULL LX X8,STCDB,X9 LOAD COMMAND JUST COMPLETED
FORK COMPLETE COMPLETE THE COMMAND
TS LTSCQ+QHEAD,X3 LOCK THE QUEUE HEAD
LA A0,QFL,X9 LOAD FORWARD LINK FROM SUBCHANNEL
LA A1,QHL,X9 LOAD BACK LINK
SA A0,QFL,A1 REMOVE SUBCHANNEL FROM LT
SA A1,QHL,A0 RESET LINKS
CTS LTSCQ+QHEAD,X3 UNLOCK THE QUEUE HEAD
BRELP X9 RELEASE THE SUBCHANNEL
J NEXTRANS PROCESS NEXT TRANSACTION
. (WHICH WILL RELEASE EXTRA COMMUNICATIONS
. BUFFER POINTED TO BY X7)
.
.
. OUTPUT WORD
.
. LA A0,(<WORD>)
. LMJ X5,OUTWORD
. <RETURN>
.
OUTWORD LA A3,LTBITPC,X3 LOAD BITS PER CHARACTER
SZ STOPTWF,X9 CLEAR WORD OPTIMISED FLAG
LA,U A4,36 LOAD BITS IN A WORD
TN A0 IS SIGN BIT ON ?
TG A0,LTOPTMX,X3 NO. IS VALUE SMALL ENOUGH TO OPTIMISE ?
J OUTWL NO. SEND WHOLE WORD
JZ A0,OUTWZO IF ZERO, JUST SEND ESC 8
SNONZ STOPTWF,X9 MARK OPTIMISATION DONE
LA,U A1 CLEAR LEFT-JUSTIFIED DATA ACCUMULATOR
LX,U X11 CLEAR BITS SHIFTED COUNT
OUTWSH DSL A0,,A3 SHIFT OFF ONE BYTE
AX X11,A3 INCREMENT TOTAL SHIFT COUNT
JNZ A0,OUTWSH CONTINUE IF DATA REMAINS
LA A0,A1 IF DONE, LOAD LEFT JUSTIFIED BYTES
LA A4,X11 LOAD BITS TO SEND FOR VALUE
OUTWL LA,U A1 CLEAR TO SHIFT OFF NEXT CHARACTER
LDSC A0,,A3 SHIFT OFF NEXT CHARACTER
ANA A4,A3 COMPUTE BITS LEFT TO STORE
TP A4 MORE THAN 36 BITS SHIFTED OUT ?
LA,U A4 YES. INDICATE ENTIRE WORD OUTPUT
TE,U A1,ESC IS THIS AN ESCAPE CODE ?
J OUTNESC NO. OUTPUT IT AS IS
OUTCHAR ESC,4 YES. OUTPUT ESC 4 SEQUENCE
J OUTWLE LOOP FOR ALL BITS
.
OUTNESC OUTCHAR . OUTPUT THE CHARACTER
OUTWLE JNZ A4,OUTWL CONTINUE IF MORE BITS TO OUTPUT
TNZ STOPTWF,X9 WERE ZERO BYTES OPTIMISED OUT ?
J 0,X5 NO. RETURN FOR NEXT WORD
OUTWZO OUTCHAR ESC,8 SEND SHORT WORD DELIMITER
J 0,X5 RETURN TO CALLER
.
.
. OUTPUT CHARACTER
.
. LA,U A1,<CHARACTER>
. LMJ X6,OUTCHAR
. <RETURN>
.
OUTCHAR EX STORE PUT CHARACTER IN BUFFER
CRC A1 CALCULATE CRC FOR CHARACTER
JGD R5,,X6 RETURN IF BUFFER NOT FULL
.
. SEND OUTPUT BUFFER AND AWAIT ACK
.
SX X8,STOBP,X9 SAVE OUTPUT BUFFER POINTER
SA A0,STOWA,X9 SAVE REMNANT OF PARTIAL WORD
SA A4,STBITLO,X9 SAVE BITS LEFT TO SEND
SX X5,STORTNP,X9 SAVE RETURN POINT FOR OUTWORD
SX X6,STOCRTNP,X9 SAVE RETURN POINT FOR OUTCHAR
SR R4,STOWLB,X9 SAVE WORDS LEFT IN BUFFER
DS A6,STOSUPP,X9 SAVE LAST WORD AND SUPPRESS COUNT
LMJ X11,OPCLOSE EDIT FINAL INFORMATION IN BUFFER
SZ ITRELF,X7 FLAG NON-RELEASE ON CHANNEL RESUME
LA A0,LTTIME,X3 LOAD TIME QUANTUM FOR LINE TABLE
SA A0,STTIME,X9 START TIMER ON MESSAGE
LA A1,X7 LOAD BUFFER POINTER
SX X7,STRETRANS,X9 SET BUFFER FOR RETRANSMISSION
INSERT LTOQ,X3 OUTPUT BUFFER ON LINE TABLE
V LTOAQ,X3 MARK OUTPUT AVAILABLE
J ITC GO PROCESS NEXT TRANSACTION
.
. CONTROL COMES HERE WHEN ACK IS RECEIVED FOR OUTPUT BUFFER
.
ICOACKR LA A0,LTBLW,X3 LOAD LENGTH FOR NEXT BUFFER
BGET . ALLOCATE NEXT COMMUNICATIONS BUFFER
SA A0,X7 SAVE BUFFER POINTER
LMJ X11,OPSETUP SET UP OUTPUT BUFFER
LA A1,STOALT,X9 LOAD OUTPUT ALTERNATION BIT
CRC A1 INCLUDE ALTERNATION IN CRC
EX STORE STORE ALTERNATION IN BUFFER
LA,U A1,STX LOAD START OF TEXT
CRC A1 INCLUDE IN THE CRC
EX STORE SET START OF TEXT IN BUFFER
LA A3,LTBITPC,X3 RESTORE BITS PER CHARACTER
LX X8,STOBP,X9 RECOVER OUTPUT BUFFER POINTER
AX X8,(1,0) RESET INCREMENT IN POINTER
LA A0,STOWA,X9 LOAD OUTPUT WORD REMNANT
LA A4,STBITLO,X9 LOAD BITS LEFT TO OUTPUT
LX X5,STORTNP,X9 RELOAD RETURN FROM OUTWORD
LX X6,STOCRTNP,X9 RELOAD RETURN FROM OUTCHAR
LR R4,STOWLB,X9 LOAD WORDS LEFT IN BUFFER
DL A6,STOSUPP,X9 RELOAD SUPPRESSION WORDS
LR,U R5,ICHTXTL-1 RESET TEXT LENGTH FOR EMPTY BUFFER
J 0,X6 RETURN TO CALL OF OUTCHAR
.
.
. SET UP OUTPUT BUFFER
.
. LX,U X7,<TRANSACTION BUFFER>
. LMJ X11,OPSETUP
.
. SETS UP CRC ACCUMULATORS, SYNC CHARACTERS, SOH AND
. SUBCHANNEL NUMBER.
.
OPSETUP DSL CRC2,72 CLEAR CRC ACCUMULATORS
SX X3,ITLT,X7 SET LINE TABLE IN BUFFER
SX X9,ITST,X7 SET SUBCHANNEL IN TRANSACTION
LX,U X1,ITTEXT,X7 LOAD POINTER TO TEXT
AX X1,(1,0) GET INCREMENT ON POINTER
LX X2,(1,0) GET CHARACTER POINTER
ON EITHER
TZ LTQWM,X3 QUARTER WORD MODE LINE ?
AX,U X2,QWSTORE YES. ADVANCE TO Q.W. TABLE
OFF EITHER
TNZ LTSYNC,X3 IS THIS LINE SYNCHRONOUS ?
J OPSESOH NO. SKIP SYNC CHARACTERS
LR,U R1,ICHNSYN-1 LOAD LOOP COUNTER TO STORE SYNCS
LA A1,LTSYNC,X3 LOAD SYNC CHARACTER FOR LINE
OPSTSYN EX STORE STORE SYNC CHARACTER
JGD R1,OPSTSYN LOOP STORING SYNC CHARACTERS
OPSESOH LA,U A1,SOH LOAD START OF HEADER
CRC A1 START UP CRC WITH SOH
EX STORE PUT SOH IN BUFFER
LA A1,STSCN,X9 LOAD SUBCHANNEL NUMBER
CRC A1 INCLUDE IN CRC
EX STORE AND PUT IN BUFFER
J 0,X11 RETURN TO CALLER
.
.
. CLOSE OUTPUT BUFFER
.
. LX,U X7,<OUTPUT TRANSACTION>
. LMJ X11,OPCLOSE
. <RETURN>
.
. EOT'S AND CRC STORED IN BUFFER
.
OPCLOSE LA,U A1,EOT LOAD EOT
CRC A1 ADD INTO THE CRC
EX STORE STORE EOT AT END OF BUFFER
LA A0,CRC1 LOAD FIRST CRC CHARACTER
LSSL A0,8 SHIFT LEFT 8 BITS
AA A0,CRC2 COMPUTE 16 BIT CRC TOTAL
LSSL A0,36-16 LEFT JUSTIFY IN REGISTER
LA A3,LTBITPC,X3 LOAD BITS PER CHARACTER
LA,U A4,16 LOAD BITS TO BE OUTPUT
OPCCRC LA,U A1 CLEAR NEXT BITS REGISTER
LDSC A0,,A3 SHIFT OFF NEXT BITS
ANA A4,A3 COMPUTE BITS LEFT TO BE OUTPUT
EX STORE PUT CRC IN BUFFER
TZ A4 ALL BITS OUTPUT ?
JP A4,OPCCRC MORE BITS TO GO ?
J 0,X11 NO. RETURN
.
.
. LOAD CHARACTER TABLE
.
FETCH EQUF $,*X2 REFERENCE TO PICK A CHARACTER
FET1 .
ON ICHALF START HALF WORD CODE
LA,H2 A0,,X1
LA,H1 A0,,X1
LA,H2 A0,1,X1
LMJ X10,$+1 TRAP EXECUTE INSTRUCTION
LA,H1 A0,1,X1 LOAD LAST CHARACTER
AX,U X1,2 ADVANCE TO NEXT TWO WORDS
LXM,U X2 RESET CHARACTER POINTER
J 0,X10 RETURN AFTER EX
OFF ICHALF
.
QWFETCH EQUF $-FET1 OFFSET TO QUARTER-WORD TABLE
ON ICQUARTER START QUARTER WORD CODE
LA,Q1 A0,,X1
LA,Q2 A0,,X1
LA,Q3 A0,,X1
LMJ X10,$+1 TRAP EXECUTE REMOTE
LA,Q4 A0,,*X1 PICK UP LAST CHARACTER
LXM,U X2,QWFETCH RESET POINTER TO TABLE START
J 0,X10 RETURN TO EX
OFF ICQUARTER END QUARTER WORD CODE
.
.
. STORE CHARACTER TABLE
.
STORE EQUF $,*X2 REFERENCE TO STORE A CHARACTER
STR1 .
ON ICHALF START HALF WORD CODE
SA,H2 A1,,X1
SA,H1 A1,,X1
SA,H2 A1,1,X1
LMJ X10,$+1 TRAP EXECUTE INSTRUCTION
SA,H1 A1,1,X1 SET LAST CHARACTER IN BUFFER
AX,U X1,2 ADVANCE WORD POINTER
LXM,U X2 CLEAR CHARACTER POINTER
J 0,X10 RETURN AFTER EXECUTE
OFF ICHALF END HALF WORD CODE
.
QWSTORE EQUF $-STR1 OFFSET FOR QUARTER-WORD STORE
ON ICQUARTER START QUARTER-WORD CODE
SA,Q1 A1,,X1
SA,Q2 A1,,X1
SA,Q3 A1,,X1
LMJ X10,$+1 TRAP EXECUTE
SA,Q4 A1,,*X1 STORE LAST CHARACTER, ADVANCE POINTER
LXM,U X2,QWSTORE RESET CHARACTER POINTER
J 0,X10 RETURN TO EXECUTE
OFF ICQUARTER END QUARTER-WORD CODE
/.
.
. TIMER ACTIVITY
.
. A TIMER ACTIVITY IS CREATED FOR EVERY LINE TABLE CURRENTLY
. ACTIVE. THE TIMER WAITS FOR A SPECIFIED TIME INTERVAL AND
. SUBMITS A TIMEOUT TRANSACTION TO THE TRANSACTION PROCESSOR.
. THE TRANSACTION PROCESSOR WILL THEN SCAN FOR MESSAGES WHICH
. NEED TO BE RETRANSMITTED AND RESEND THEM.
.
ICTIMER TZ LTCLOSE,X3 IS LINE TABLE TERMINATING ?
J ICTCLS YES. FLAG TERMINATION AND EXIT
. ** TWAIT$ 2000 NO. WAIT FOR TWO SECONDS
BGET ITTEXT ALLOCATE A TRANSACTION
LA,U A1,ITYTIME LOAD TIMEOUT TRANSACTION TYPE
SA A1,ITTYPE,A0 SET TRANSACTION TYPE IN BUFFER
SX X3,ITLT,A0 PUT LINE TABLE IN TRANSACTION
LA A1,A0 LOAD TRANSACTION BUFFER ADDRESS
INSERT ICHWQ PUT TRANSACTION ON QUEUE
V ICHWORK INDICATE WORK AVAILABLE FOR TRANSACTION
TWAIT$ 20 . ***
J ICTIMER GO WAIT FOR THE NEXT TIME
.
. SHUT DOWN TIMER WHEN LINE TABLE TERMINATES
.
ICTCLS V LTSCQ,X3 MARK TIMER TERMINATED
EXIT . TERMINATE
/.
.
. LINE TABLE OUTPUT ACTIVITY
.
. THIS ACTIVITY IS DRIVEN BY TRANSACTION BUFFERS SUBMITTED
. ON THE LINE TABLE OUTPUT QUEUE, AND IS NOTIFIED OF THE
. APPEARANCE OF BUFFERS BY THE LINE TABLE OUTPUT AVAILABLE
. QUEUE. THE ACTIVITY SIMPLY SENDS THE BUFFERS DOWN THE
. LINE, AND IF THE RELEASE ON CHANNEL RESUME FLAG IS SET,
. RELEASES THEM.
.
LTOACT LA A0,QL,X4 LOAD ACTIVITY NAME
SA A0,LTONAME,X3 SET OUTPUT ACTIVITY NAME IN LT
V LTOAQ,X3 MARK OUTPUT ACTIVITY READY
ON REALTHING
RT$ 34 SWITCH TO OUTPUT ACTIVITY LEVEL
OFF REALTHING
.
LTONEXT P LTOAQ,X3 WAIT FOR A BUFFER TO OUTPUT
REMOVE LTOQ,X3 REMOVE A BUFFER FROM THE QUEUE
TNE,U A1,LTOQ,X3 IS THIS A TERMINATION REQUEST ?
J LTOTERM YES. GO TERMINATE
LA,U A0,ITTEXT,A1 LOAD OUTPUT TEXT START ADDRESS
SA A0,LTOBUF,X3 SET AS OUTPUT BUFFER IN LT
ON REALTHING
CMO$ LTFN,X3 OUTPUT THE BUFFER ON LINE
DACT$ . WAIT FOR OUTPUT COMPLETION
OFF REALTHING
ON (REALTHING=0)++DUMPING
LA A0,LTOBUF,X3 LOAD BUFFER ADDRESS
SA,H2 A0,SPK+1 SET WORD COUNT IN PACKET
LA A0,LTOCOUNT,X3 LOAD OUTPUT CHARACTER COUNT
AA,U A0,3 ROUND IT UP *QW*
SSL A0,2 DIVIDE BY FOUR *QW*
SA,H1 A0,SPK+1 SET IN PACKET
LA A0,PARTBL LOAD FANG OPTIONS
TOP,U A0,OPTION('W') ARE SNAPS DESIRED ?
J LTOSNP NO. SKIP THE SNAP
SNAP$P SPK SNAP THE OUTPUT BUFFER
LTOSNP TZ ITRELF,A1 IS OUTPUT TEXT ?
J ITOBUNGA NO. SKIP WRITE TO FILE
LA A0,SPK+1 LOAD ACCESS WORD FOR DATA
SA A0,WWIOP+4 SET IN I/O PACKET
IOW$ WWIOP WRITE DATA TO TRACE FILE
LA A0,WWIOP+5 LOAD ADDRESS IN FILE
AA,U A0,1 INCREMENT NEXT WRITE ADDRESS
SA A0,WWIOP+5 UPDATE ADDRESS IN FILE
V WWRD MARK BLOCK AVAILABLE FOR INPUT
ITOBUNGA .
$(2).
WWIOP IO$PKT,W$ 'COMM-FILE' $-$,$-$ $-$
RRIOP IO$PKT,R$ 'COMM-FILE' $-$,$-$ $-$
WWRD PVQUEUE 0
WACK PVQUEUE 0 ACK WAIT QUEUE
SPK SNAP$PKT ,,'OUTPUT'
$(1) OFF (REALTHING=0)++DUMPING
. ** CHECK STATUS **
LA A0,A1 LOAD BUFFER ADDRESS
TZ ITRELF,A1 SHOULD BUFFER BE RELEASED ?
BRELP A0 YES. RELEASE IT
J LTONEXT PROCESS NEXT OUTPUT MESSAGE
.
LTOTERM V LTSCQ,X3 MARK OUTPUT TERMINATED
EXIT . TERMINATE
.
.
. ESI OUTPUT COMPLETION ACTIVITY
.
OUTINT ACT$ LTONAME,A0 ACTIVATE THE OUTPUT ACTIVITY
/.
.
. LINE TABLE INPUT ACTIVITY
.
. THE INPUT ACTIVITY RECEIVES CONTROL BY BEING ACTIVATED
. BY THE ESI INPUT COMPLETION ACTIVITY WHENEVER A BUFFER
. IS FILLED. THE INPUT ACTIVITY HANDS THE COMPLETED
. BUFFER OFF TO THE TRANSACTION PROCESSOR, THEN RAISES
. INPUT IMMEDIATELY ON THE LINE AGAIN.
.
LTIACT LA A0,QL,X4 LOAD ACTIVITY NAME FOR ACT$
SA A0,LTINAME,X3 SET INPUT ACTIVITY NAME IN LT
ON REALTHING
RT$ 33 ADJUST REAL TIME LEVEL FOR INPUT
OFF REALTHING
LA,U A0,LTFN,X3 LOAD LINE TABLE ADDRESS
ON REALTHING
er CMS$ . INITIALISE LINE TABLE
OFF REALTHING
V LTOAQ,X3 MARK INPUT ACTIVITY READY
J LTISTART INITIALISE FOR FIRST BUFFER
.
LTINEXT .
ON REALTHING=0
LA,S1 A0,LTFN,X3 LOAD FIRST CHARACTER OF FILE NAME
TE,U A0,'I' INPUT FILE NAME
DACT$ . NO. WAIT FOR A WHILE
OFF REALTHING=0
ON REALTHING
DACT$ . WAIT FOR INPUT COMPLETION
OFF REALTHING
ON REALTHING=0
P WWRD WAIT FOR OUTPUT TO BE DONE
LA A0,LTIBUF,X3 LOAD INPUT BUFFER ADDRESS
LXI,H1 A0,WWIOP+4 GET LENGTH TO READ
SA A0,RRIOP+4 SET READ ACCESS WORD IN PACKET
IOW$ RRIOP READ IN NEXT INPUT BLOCK
LA A0,RRIOP+5 LOAD ADDRESS
AA,U A0,1 ADVANCE TO NEXT SECTOR
SA A0,RRIOP+5 UPDATE NEXT READ ADDRESS
OFF REALTHING=0
TZ LTCLOSE,X3 IS LINE TERMINATING ?
J LTITERM YES. GO TERMINATE INPUT
. ** CHECK LINE TABLE STATUS **
INSERT ICHWQ PLACE BUFFER ON TRANSACTION QUEUE
V ICHWORK MARK WORK AVAILABLE FOR TRANSACTION
.
LTISTART LA A0,LTBLW,X3 LOAD LENGTH OF INPUT BUFFER
BGET . ALLOCATE A NEW INPUT BUFFER
AA,U A0,ITTEXT COMPUTE TEXT START ADDRESS
SA A0,LTIBUF,X3 SET INPUT BUFFER ADDRESS
ON REALTHING
CMI$ LTFN,X3 FIRE UP INPUT IMMEDIATELY
OFF REALTHING
LA A1,LTIBUF,X3 LOAD BUFFER ADDRESS
ANA,U A1,ITTEXT BACK UP TO HEADER
LA,U A2,ITYIN LOAD INPUT BUFFER TYPE
SA A2,ITTYPE,A1 SET TYPE IN BUFFER
SX X3,ITLT,A1 SET LINE TABLE IN BUFFER
J LTINEXT WAIT FOR INPUT COMPLETION
.
LTITERM BRELP A1 RELEASE THE INPUT BUFFER
V LTSCQ,X3 MARK INPUT TERMINATED
EXIT . TERMINATE
.
. INPUT ESI COMPLETION ACTIVITY
.
ININT ACT$ LTINAME,A0 ACTIVATE INPUT ACTIVITY FOR LT
/.
.
. THIS SEQUENCE OF CODING GENERATES A 256 WORD POLYNOMIAL DIVISION
. REMAINDER TABLE. THIS TABLE IS USED TO COMPUTE THE CRC OF MESSAGES
. TRANSMITTED AND RECEIVED. TO REDUCE CHARACTER PROCESSING OVERHEAD,
. THE 16 BIT REMAINDER IS STORED WITH THE HIGH-ORDER 8 BITS RIGHT
. JUSTIFIED IN H1, AND THE LOW-ORDER 8 BITS RIGHT JUSTIFIED IN H2.
.
. FUNCTION TO REVERSE BITS IN 8 OR 16 BIT BYTE
.
F FUNC .
REVERSE8* NAME 7
REVERSE16* NAME 15
I DO F(0)+1 ,;
A(0) EQU A(0)++(1*/(F(0)-I+1))*(((1*/(I-1))**F(1))>0)
END A(0)
.
. PERFORM POLYNOMIAL DIVISION
.
DIVIDE* FUNC .
DIVIDEND(0) EQU DIVIDE(1)*/16 EXPAND TO 24 BITS
DIVISOR(0) EQU 0300005*/7 BITS SET FOR COEFFICIENTS
DP* PROC *0
A EQU 24-I BIT BEING PROCESSED ON THIS INVOKATION
DO (DIVIDEND(0)**(1*/A))>0 ,;
DIVIDEND*(0) EQU DIVIDEND(0)--DIVISOR(0)
DIVISOR*(0) EQU DIVISOR(0)/2
END
I DO 8 , DP
END DIVIDEND(0)
.
. GENERATE THE TABLE ENTRIES
.
REMAINDER* PROC 0,1
Z EQU REVERSE16(DIVIDE(REVERSE8(I-1)))
* Z/(1*/8),Z**0377
END
.
ON . *** REDUCE ASSEMBLY TIME ***
REMAINDER .
I DO 256 , REMAINDER
OFF . ** REDUCE ASSEMBLY TIME **
OFF INTERSITE
/.
.
. INTERCEPT ROUTINES FOR INTERCHANGE DECONFIGURED
.
ON INTERSITE=0
.
CONNECT* . TRAP 'CONNECT' COMMAND
DISCT* . TRAP 'DISCONNECT' COMMAND
ICHG* . TRAP 'INTERCHANGE' COMMAND
MESAIS* . TRAP 'MESSAGE' COMMAND
.
R$DIT . FIRE UP THE EDITOR
E$MSG ISNCOM COPY NOT CONFIGURED MESSAGE
LMJ X11,IST EDIT STATEMENT NUMBER
COMPLETE . TERMINATE
.
ISNCOM 'INTER-SITE INTERCHANGE NOT CONFIGURED. IGNORED COMMAND !'
OFF INTERSITE=0
END