|
DataMuseum.dkPresents historical artifacts from the history of: CR80 Hard and Floppy Disks |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CR80 Hard and Floppy Disks Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 23396 (0x5b64)
Types: TextFile
Names: »CTERM.MAIN.S«
└─⟦c174207bd⟧ Bits:30005194 8" CR80 Floppy CR80FD_0192 ( VOL: FLOPPY )
└─⟦194c604ac⟧
└─ ⟦this⟧ »CTERM.0001.D!CTERM.MAIN.S«
"PAGE «ff»
LABEL
GET_NEXT_EVENT,
WAIT_EVENT,
READ_ANO_LIST,
ENQUEUE_TO_MDS,
RETURN_NACK,
ILLEGAL_MESSAGE,
CCIS_FAILURE;
BEGIN "OF MAINMODULE
ADDRESS(FILE_SYSTEM) => R0;
ADDRESS(VOLUME_MOVHEAD) => R1;
SWITCH MON(IO,GETROOT,R0,R1,R4,R7):
ERROR_DONE TO
ERR: BEGIN CTERM_ERROR_CALL; GETROOT_MOVHEAD_ERROR; END;
END;
R4 => FILEID_MOVHEAD;
ADDRESS(FILE_SYSTEM) => R0;
ADDRESS(VOLUME_FIXHEAD) => R1;
SWITCH MON(IO,GETROOT,R0,R1,R4,R7):
ERROR_DONE TO
ERR: BEGIN CTERM_ERROR_CALL; GETROOT_FIXHEAD_ERROR; END;
END;
R4 => FILEID_FIXHEAD;
"PAGE «ff»
"INIT RDF (GET RDF-FILEID)
"-------------------------
ADDRESS(RDF_NAME) => R1;
SWITCH MON(IO,LOOKUP,R1,R2,R4,R7):
ERROR_DONE TO
ERR: BEGIN CTERM_ERROR_CALL; LOOKUP_RDF_ERROR; END;
END;
R2 => RDF_FILE_ID;
"INITIALIZE USE OF MTCB-MONITOR
"-----------------------------
5 => R0; "SUBSYSTEM NUMBER (SAME AS PIP)
ADDRESS(WORK_AREA) => R1; "REF WORK_SPACE
FILEID_MOVHEAD => R2; "MOVHEAD
FILEID_FIXHEAD => R3; "FIXHEAD
SWITCH MON(MTCB,INITMTCB,R0,R1,R2,R3,R7):
ERROR_DONE TO
ERR: BEGIN CTERM_ERROR_CALL; INITMTCB_ERROR; END;
END;
GET_STATUS_CCIS(R6);
STATUS_CCIS => R0;
IF R0 = CCIS_LINK_NOT_EXIST THEN TRP(7);
"PAGE «ff»
%WHEN CCIS_VERSION = TRUE SKIP
"CHECK IF RESTART
"----------------
ADDRESS(CONFIG_NAME) => R0;
ADDRESS(0@CONFIG_TYPE.CONSTANT_BLOCK.START_RESTART_FLAG) => R1;
ADDRESS(TERM_NO_CCIS) => R2; "TERM_NO_CCIS USED TEMPORARY
1 => R3;
SWITCH MON(REGION,RCOPYN,R0,R1,R2,R3,R7):
ERROR_DONE TO
ERR: BEGIN CTERM_ERROR_CALL; GET_START_RESTART_FLAG_ERROR; END;
END;
"IF RESTART THEN GET CHECKPOINTED CCIS_STATUS
"--------------------------------------------
IF R2@INTEGER = 1 THEN "RESTART TRUE
BEGIN
ADDRESS(CHECKP_MESS_BUF0) => R7;
CHECKPOINT_CTERM(R7,R6);
"IF CCIS_LINK WAS OPEN THEN OPEN IT AGAIN
"----------------------------------------
ADDRESS(CHECKP_MESS_BUF0) => R7;
R7@CHECKPOINT_MESSAGE.W3 => R0;
IF R0 = CCIS_LINK_OPEN THEN
BEGIN
1 => R0 => MES_BUF[0];
0 => R0 => MES_BUF[1];
ADDRESS(CTERM_NAME) => R0; "SIMULATE SUPERVISOR
ADDRESS(MES_BUF) => R1; "COMMAND: OPEN LINK REQUEST
MON(SENDMESSAGE,R0,R1,R2,R7);
END;
END;
%COMPILE
"PAGE «ff»
"UPDATE COMMAND WORD IN CHECKPOINT MESSAGE BUFFER 0 (IN FUTURE USED AT STORAGE)
"------------------------------------------------------------------------------
(STORE_CHECKPOINT SHIFTLL 15) +
(SYSTEM_CHECKPOINTS SHIFTLL 8) +
(CHECKPOINT_SINGLE_WORD SHIFTLL 4) => R0 => CHECKP_MESS_BUF0.COMMAND;
"GET CCIS-TERMINAL NUMBER
"------------------------
ADDRESS(CONFIG_NAME) => R0;
ADDRESS(0@CONFIG_TYPE.CONSTANT_BLOCK.CCIS_TERM_NO) => R1;
ADDRESS(TERM_NO_CCIS) => R2;
1 => R3;
SWITCH MON(REGION,RCOPYN,R0,R1,R2,R3,R7):
ERROR_DONE TO
ERR: BEGIN CTERM_ERROR_CALL; GET_TERM_NO_CCIS_ERROR; END;
END;
"GET CCIS TERMINAL CONTROL BLOCK (TCB)
"--------------------------------------
ADDRESS(0@PROCESS_DESCRIPTOR.WORK) => R7;
SIZE(TCB_TYPE) => R1 => R7@INTEGERS[0]; "CALCULATE OFFSET IN XTCBCR
CLR(R7@INTEGERS[1]);
TERM_NO_CCIS => R1;
R7@LONG * R1;
R7@INTEGER => R1; "R1:= OFFSET
ADDRESS(XTCBCR_NAME) => R0;
ADDRESS(TCB_CCIS) => R2;
SIZE(TCB_TYPE) => R3;
SWITCH MON(REGION,RCOPYN,R0,R1,R2,R3,R7):
ERROR_DONE TO
ERR: BEGIN CTERM_ERROR_CALL; GET_TCB_CCIS_ERROR; END;
END;
"PAGE «ff»
GET_NEXT_EVENT:
"=============
"INSPECT AMOS-MESSAGE-EVENT QUEUE FOR CONTROL-MESSAGES
"-----------------------------------------------------
0 => R0;
ADDRESS(MES_BUF) => R1;
BMMESSAGE IOR BMDELAY => R2;
MON(INSPECTEVENTS,R0,R1,R2,R7);
IF R0 = BNMESSAGE THEN
BEGIN
IF R1@INTEGER = 0 THEN "MESSAGE RECEIVED
BEGIN
ADDRESS(MES_BUF[1]) => R0; "MTCB-INDEX
READ_MTCB(R0,R1,R7,R6);
IF R7@PSEUDO_MTCB_TYPE.TAGFIELD = TYPE_PSEUDO_MTCB
THEN GOTO WAIT_EVENT;
"ELSE
END;
MON(SAVEEVENT,R2,R7);
GOTO GET_NEXT_EVENT;
END;
MON(RECOVEREVENTS,BNMESSAGE=>R2,R7);
WAIT_EVENT:
"=========
ADDRESS(MES_BUF) => R1;
BMMESSAGE IOR
BMANSWER IOR
BMZEROPHASE => R2;
MON(WAITEVENT,R0,R1,R2,R7);
"PAGE «ff»
IF R0 = BNMESSAGE THEN
BEGIN
IF R1@INTEGER = 0 THEN "MESSAGE RECIEVED FROM CCIS
BEGIN
MON(SENDANSWER,R1,R2,R7); "RETURN ANSWER
R1 => R7;
R7@INTEGERS[1] => R0 => MTCBID;
"IF CCIS LINK HAS FAILED THEN IGNORE MESSAGE
"-------------------------------------------
GET_STATUS_CCIS(R6);
STATUS_CCIS => R2;
IF R2 = CCIS_LINK_FAILED THEN GOTO CCIS_FAILURE;
ADDRESS(MTCBID) => R0;
READ_MTCB(R0,R1,R7,R6);
R7@REAL_MTCB_TYPE.LENGTH => R2;
" R7@PSEUDO_MTCB_TYPE.WORD4 => R2;
ADDRESS(FILEADDR) => R7;
R2 => R7@INTEGERS[ADDRESS(0@FILE_ADDRESS.BYTE_COUNT)];
R7 => R1;
OPEN_MTCB_FILE(R0,R1,R2,R4,R6);
READ_MESSAGE(R6); "READ CONTROL_MESSAGE OR FIRST OF NARRATIVE
ADDRESS(MTCB_BUFFER) => R7;
R7@REAL_MTCB_TYPE.TAGFIELD => R0;
"PAGE «ff»
IF R0 = TYPE_PSEUDO_MTCB THEN "CONTROL MESSAGE
BEGIN
ADDRESS(BUFFER) => R0;
R0@TEXT[OFFSET_CATEGORY=>R7] => R2; "CHECK CATEGORY
IF R2 <> CCIS_CATEGORY THEN
BEGIN
CTERM_LOCAL_FIX_UP_ERROR_CALL; ILLEGAL_CATEGORY;
GOTO ILLEGAL_MESSAGE;
END;
R0@TEXT[OFFSET_TYPE=>R7] => R2; "GET TYPE (SUBCATEGORY)
IF R2 <> MESSAGE_ACK LOGAND R2 <> MESSAGE_NACK THEN
BEGIN "OF NOT ACK/NACK
IF R2 = OPEN_LINK_AGREEMENT THEN
BEGIN
STATUS => R0;
IF R0[OUTSTANDING_OPEN_REQUEST] THEN
BEGIN
UPDATE_CCIS_STATUS(CCIS_LINK_OPEN=>R0,R6);
REPORT_CCIS_STATUS(FODCCIS_OPEN_OK=>R0,R6);
CLEAN_OUTSTANDING_OPEN_REQUEST_CALL;
END;
END
ELSE
IF R2 = OPEN_LINK_REJECTION THEN
BEGIN
UPDATE_CCIS_STATUS(CCIS_LINK_CLOSED=>R0,R6);
REPORT_CCIS_STATUS(FODCCIS_OPEN_NOT_OK=>R0,R6);
CLEAN_OUTSTANDING_OPEN_REQUEST_CALL;
END
ELSE
"PAGE «ff»
IF R2 = CLOSE_LINK THEN
BEGIN
UPDATE_CCIS_STATUS(CCIS_LINK_CLOSED=>R0,R6);
REPORT_CCIS_STATUS(FODCCIS_CLOSE_OK=>R0,R6);
%WHEN CCIS_VERSION = TRUE SKIP
END
ELSE
BEGIN
CTERM_LOCAL_FIX_UP_ERROR_CALL; UNKNOWN_CONTROL_MESSAGE;
GOTO ILLEGAL_MESSAGE;
%COMPILE
END;
0 => R2 => MES_BUF[0]; "RETURN ACK
MESSAGE_ACK => R2 => MES_BUF[1];
CONTROL_CHANNEL => R2 => MES_BUF[2];
END "OF NOT ACK/NACK
ELSE
BEGIN "OF ACK/NACK
"GET CHANNEL_NO
"--------------
IF R2 = MESSAGE_ACK THEN OFFSET_ACK_CHANNEL_NO => R7
ELSE OFFSET_NACK_CHANNEL_NO => R7;
R0@TEXT[R7] => R3 - '0';
IF R3 >>= 2 THEN
BEGIN
CTERM_LOCAL_FIX_UP_ERROR_CALL; ILLEGAL_ACK_NACK;
GOTO ILLEGAL_MESSAGE;
END;
R2 => MES_BUF[1]; "PREP ACK/NACK NOTICE TO CPIP
R3 => MES_BUF[2];
1 => R3 => MES_BUF[0];
END; "OF ACK/NACK
END "OF CONTROL MESSAGE
ELSE
"PAGE «ff»
"REAL MTCB I.E NARRATIVE MESSAGE
"-------------------------------
BEGIN
MESSAGE_NACK => R0 => MES_BUF[1]; "USED AT NACK-PROCESSING
"CHECK IF LINK IS OPEN
"---------------------
STATUS_CCIS => R0;
IF R0 <> CCIS_LINK_OPEN THEN "CLOSE NOT OK
REPORT_CCIS_STATUS(FODCCIS_CLOSE_NOT_OK=>R0,R6);
"PREPARE QUEUING + CHECKPOINTING
"-------------------------------
MTCBID => R0 => QIOCB.W4; "INSERT MTCB-INDEX
R0 => CHECKP_MESS_BUF1.W1;
"CHECK MESSAGE AND FILL MTCB
"---------------------------
ADDRESS(BUFFER) => R6;
ADDRESS(MTCB_BUFFER) => R5;
"CHECK MESSAGE LENGTH
"--------------------
FILEID => R4; "GET FILE-LENGTH
F_BYTESIZE => R2;
SWITCH MON(IO,GETFILEINFORMATION,R2,R3,R4,R7):
ERROR_DONE TO
ERR: BEGIN CTERM_ERROR_CALL; GETFILEINFORMATION_ERROR; END;
END;
IF R3 <> 0 LOGOR R2 >>= MAX_FILE_LENGTH+1 THEN
BEGIN
CTERM_LOCAL_FIX_UP_ERROR_CALL; ILLEGAL_FILE_LENGTH;
GOTO RETURN_NACK;
END;
R6@INTEGERS[REF_MESSAGE_LENGTH] => R1;
IF R1 <> R2 THEN
BEGIN
CTERM_LOCAL_FIX_UP_ERROR_CALL; ILLEGAL_MESSAGE_LENGTH;
GOTO RETURN_NACK;
END;
R2 - 4; "MAX. ADDRESS_LIST_OFFSET
"PAGE «ff»
"CHECK ADDRESS LIST-, SIGNAL HEADER-, MSG_ID-OFFSET
"--------------------------------------------------
R6@INTEGERS[REF_ADDRESS_LIST_OFFSET] => R1;
IF R2 << R1 THEN
BEGIN
CTERM_LOCAL_FIX_UP_ERROR_CALL; ILLEGAL_ANO_LIST_OFFSET;
GOTO RETURN_NACK;
END;
R1 => R5@REAL_MTCB_TYPE.WORD6;
R6@INTEGERS[REF_SIC_REFERENCE] => R2;
IF R2 >>= R1 THEN
BEGIN
CTERM_LOCAL_FIX_UP_ERROR_CALL; ILLEGAL_SIC_OFFSET;
GOTO RETURN_NACK;
END;
R6@INTEGERS[REF_SIGNAL_HEADER_LENGTH] => R2 + BINARY_HEADER_LENGTH;
IF R1 << R2 THEN
BEGIN
CTERM_LOCAL_FIX_UP_ERROR_CALL; ILLEGAL_REF_SIGNAL_HEADER;
GOTO RETURN_NACK;
END;
R6@INTEGERS[REF_MSG_ID_OFFSET] => R2;
IF R2 >>= R1 THEN
BEGIN
CTERM_LOCAL_FIX_UP_ERROR_CALL; ILLEGAL_REF_MSGID;
GOTO RETURN_NACK;
END;
"PAGE «ff»
"CHECK ACTION+INFO PRECEDENCE
"----------------------------
R6 => R0;
R0@TEXT[REF_ACTION_PREC=>R7] => R1;
IF R1 >>= 7 LOGOR R1 = 0 THEN
BEGIN
CTERM_LOCAL_FIX_UP_ERROR_CALL; ILLEGAL_ACTION_PREC;
GOTO RETURN_NACK;
END;
R1 => R5@REAL_MTCB_TYPE.APREC;
R1 => QIOCB.W2; "MDS QUEUE-NUMBER
R1 => CHECKP_MESS_BUF1.W3;
R0@TEXT[REF_INFO_PREC=>R7] => R1;
IF R1 >>= 7 LOGOR R1 = 0 THEN
BEGIN
CTERM_LOCAL_FIX_UP_ERROR_CALL; ILLEGAL_INFO_PREC;
GOTO RETURN_NACK;
END;
R1 => R5@REAL_MTCB_TYPE.IPREC;
"CHECK CLASSIFICATION AND SPECIAL HANDLING
"-----------------------------------------
R0@TEXT[REF_SPEC_CODE=>R7] => R1;
IF R1 <> 0 THEN
BEGIN
CTERM_LOCAL_FIX_UP_ERROR_CALL; ILLEGAL_SIC_CODE;
GOTO RETURN_NACK;
END;
CLR(R5@REAL_MTCB_TYPE.SPEC);
R0@TEXT[REF_CLASSIFICATION=>R7] => R1;
TCB_CCIS[K_USC_OFFSET=>R7] => R2;
IF R2 << R1 THEN
BEGIN
CTERM_LOCAL_FIX_UP_ERROR_CALL; ILLEGAL_CLASSIFICATION;
GOTO RETURN_NACK;
END;
R1 => R5@REAL_MTCB_TYPE.CLASS;
"PAGE «ff»
"FILL IN REST OF MTCB AND UPDATE
"-------------------------------
CLR(R5@REAL_MTCB_TYPE.MTYPE); "MAIN TYPE: NARRATIVE MESSAGE
CLR(R5@REAL_MTCB_TYPE.WORD7); "DISTRIBUTION TYPE: LOCALLY RELEASED
"UPDATE CODE
#1 + "ACTION PRECEDENCE
#2 + "INFO PRECEDENCE
#4 + "CLASSIFICATION
#8 + "SPECIEL HANDLING CODE
#10 + "MAIN TYPE
%WHEN CCIS_VERSION = TRUE SKIP "TO INHIBIT RETRIEVAL TIME PRINTOUT
#200 + "WORD6 (REF_ANO-LIST)
%COMPILE
#400 => R2; "WORD7
ADDRESS(MTCBID) => R0;
MODIFY_MTCB(R0,R1,R2,R6);
"INSERT RELEASE DTG IN BINARY_HEADER
"-----------------------------------
ADDRESS(WORK_AREA) => R5;
CLR(R5@INTEGER); "MODE := 0 (INTEGER ONLY)
MON(GETDTG,R5,R7);
TRP(7);
ADDRESS(FILEADDR_DTG) => R1;
ADDRESS(BLE_DTG) => R2;
FILEID => R4;
SWITCH MON(IO,MODIFYBYTES,R1,R2,R4,R7):
ERROR_DONE TO
ERR: BEGIN CTERM_ERROR_CALL; INSERT_ACCEPT_DTG_ERROR; END;
END;
"CHECKPOINT ENQUEUING TO MDS
"---------------------------
ADDRESS(CHECKP_MESS_BUF1) => R7;
CHECKPOINT_CTERM(R7,R6);
"PAGE «ff»
"GET AND STORE MESSAGE ID
"------------------------
ADDRESS(BUFFER) => R0 => R7;
ADDRESS(MSG_ID) => R1;
R7@INTEGERS[REF_MSG_ID_OFFSET] => R4 + BINARY_HEADER_LENGTH;
IF R4 >>= (SIZE(BUFFER)-SIZE(MSG_ID)) THEN TRP(7); "MSG_ID CONTAINED IN BUFFER ?
0 => R7;
REPEAT
R0@TEXT[R4] => R2;
R2 => R1@TEXT[R7];
INCD(R4,R7);
UNTIL R7 = SIZE(MSG_ID)*2;
"PERFORM MESSAGE JOURNAL LOG: MESSAGE RELEASED
"---------------------------------------------
MESS_JOURNAL_ENTRY(1=>R0,R6);
"PAGE «ff»
"UPDATE STATISTICS (IN CRIT.REG.:'STATIC')
"-----------------------------------------
"DETERMINE 'NO OF ANOS' (ANALYSE ANO-LIST)
"-----------------------------------------
ADDRESS(BUFFER) => R6; "PREPARE READ OF ANO-LIST
ADDRESS(FILEADDR) => R7;
R6@INTEGERS[REF_ADDRESS_LIST_OFFSET] => R0;
R0 => R7@INTEGERS[ADDRESS(0@FILE_ADDRESS.FIRST_BYTE)];
CLR(R7@INTEGERS[(ADDRESS(0@FILE_ADDRESS.FIRST_BYTE)+1)]);
R6@INTEGERS[REF_MESSAGE_LENGTH] => R1;
R1 - R0; "LENGTH OF ANO LIST
R1 => R7@INTEGERS[ADDRESS(0@FILE_ADDRESS.BYTE_COUNT)];
0 => R3; "ANO COUNTER
READ_ANO_LIST:
"============
READ_MESSAGE(R6);
ADDRESS(FILEADDR) => R7;
R7@FILE_ADDRESS.TRANSFERRED_BYTES => R01; "R0 CONTAIN NO_OF_BYTES
R0 SHIFTRL 1; "NO OF ANO'S READ
"PAGE «ff»
%WHEN CCIS_VERSION = TRUE SKIP
ADDRESS(BUFFER) => R6;
WHILE R0 <> 0 DO
BEGIN
R6@INTEGER => R1 => R2;
R1 EXTRACT 8; "ANO/AIG
R2 SHIFTRL 13; "ANO TYPE
IF R2 = TO_ADDRESS LOGOR
R2 = INFO_ADDRESS LOGOR
R2 = NEG_TO_ADDRESS LOGOR
R2 = NEG_INFO_ADDRESS THEN
R3 + 1
ELSE
"PAGE «ff»
IF R2 = XMT_AIG_ADDRESS THEN
R3 - 1
ELSE
IF R2 = TO_AIG_ADDRESS THEN
BEGIN
R6 => R2; "SAVE R6
IF R1 << 100 THEN "LEGAL AIG
BEGIN
ADDRESS(WORK_AREA) => R4;
R1 => R6;
MON(RDF,GET_AIG_EXIST,R4,R5,R6,R7); "DOES IT EXIST ?
TRP(7);
IF R5 = TRUE THEN
BEGIN
RDF_FILE_ID => R4;
ADDRESS(AIG_BUFFER) => R5;
R1 => R5@GET_ANO_AIG_WORK.AIG;
ADDRESS(WORK_AREA) => R6;
SWITCH MON(RDF,GET_ANO_AIG,R4,R5,R6,R7):
ERROR_DONE TO
ERR: BEGIN CTERM_ERROR_CALL; GET_AIG_ERROR; END;
END;
R3 + R5@GET_ANO_AIG_WORK.ENTRY_LENGTH;
END;
END;
R2 => R6; "REESTABLISH R6
END;
R0 - 1;
R6 + 1;
END; "OF WHILE
ADDRESS(FILEADDR) => R7; "MORE ANO'S ?
R7@FILE_ADDRESS.BYTE_COUNT => R01;
IF NOT (R0 = 0 LOGOR R1[15]) THEN
GOTO READ_ANO_LIST; "YES !
R3 => R4; "NO_OF_ANOS
"PAGE «ff»
ADDRESS(STATIC_NAME) => R0;
SWITCH MON(REGION,RENTER,R0,R7):
ERROR_DONE TO
ERR: BEGIN CTERM_ERROR_CALL; ENTER_STATIC_ERROR; END;
END;
"CALCULATE INDEX IN STATIC-REGION
"--------------------------------
ADDRESS(MTCB_BUFFER) => R6;
R6@REAL_MTCB_TYPE.CLASS => R2;
R2 SHIFTLL 3 => R1;
R2 SHIFTLL 1 + R1; "R2 := CLASS * 24 (24=SIZE(STATIC_RECOD)*NO_OF_PREC'S)
R6@REAL_MTCB_TYPE.APREC => R1 - 1;
R1 SHIFTLL 2 + R2; "R1 := PREC * 4(=SIZE(STATIC_RECORD)
ADDRESS(STATIC_RECORD) => R2;
SIZE(STATIC_RECORD) => R3;
SWITCH MON(REGION,RGETN,R0,R1,R2,R3,R7):
ERROR_DONE TO
ERR: BEGIN CTERM_ERROR_CALL; READ_STATIC_ERROR; END;
END;
R2 => R7;
R7@STATIC_RECORD_TYPE.NO_OF_ANOS + R4;
INC(R7@STATIC_RECORD_TYPE.NO_OF_MESSAGES);
R6@REAL_MTCB_TYPE.LENGTH => R4; 0 => R5;
R7@STATIC_RECORD_TYPE.NO_OF_BYTES + R45;
SWITCH MON(REGION,RPUTN,R0,R1,R2,R3,R7):
ERROR_DONE TO
ERR: BEGIN CTERM_ERROR_CALL; UPDATE_STATIC_ERROR; END;
END;
SWITCH MON(REGION,RLEAVE,R0,R7):
ERROR_DONE TO
ERR: BEGIN CTERM_ERROR_CALL; LEAVE_STATIC_ERROR; END;
END;
%COMPILE
"PAGE «ff»
%WHEN CCIS_VERSION = FALSE SKIP
%WHEN ACCEPTANCE_TEST = TRUE SKIP
"UPDATE ANO-LIST: EXCHANGE FM_ANO WITH FM_CCIS_ANO + TO_CCIS_ANO WITH 'TO_FM_ANO'
"GET CCIS-NOMINAL ANO
"--------------------
ADDRESS(TCB_CCIS) => R4;
R4@INTEGERS[U_ANO_OFFSET] => R4;
R4 EXTRACT 13;
ADDRESS(BUFFER) => R6;
"GET AND UPDATE FM_ANO
"---------------------
R6@INTEGER => R5 EXTRACT 13;
R4 => R3 + (FM_ADDRESS SHIFTLL 13);
R3 => R6@INTEGER;
R4 SHIFTRL 8 EXTRACT 5; "LOCAL NM-ID
"EXCHANGE ALL TO-CCIS ADDRESSEES WITH TO-FM_ADDRESS
"--------------------------------------------------
WHILE R0 <> 0 DO
BEGIN
R6@INTEGER => R1 => R2 => R3;
R1 EXTRACT 13; "ANO/AIG
R2 SHIFTRL 13; "ANO TYPE
R3 SHIFTRL 8 EXTRACT 5; "NM-ID
IF (R2 = TO_ADDRESS LOGOR
R2 = INFO_ADDRESS LOGOR
R2 = NEG_TO_ADDRESS LOGOR
R2 = NEG_INFO_ADDRESS) LOGAND
R3 = R4 THEN
BEGIN
R6 => R3;
ADDRESS(WORK_AREA) => R6;
R1 => R6@GET_ANO_TERM_WORK.ANO;
SETS(R6@GET_ANO_TERM_WORK.ANO,8);
MON(RDF,GET_ANO_TERM,R6,R7);
TRP(7);
R6@GET_ANO_TERM_WORK.TERM_NO => R7;
R3 => R6;
TERM_NO_CCIS => R3;
IF R7 = R3 THEN
BEGIN
R5 => R3 + (R2 SHIFTLL 13);
R3 => R6@INTEGER;
END;
END
ELSE
IF R2 = TO_AIG_ADDRESS THEN
BEGIN
R5 => R3 + (TO_ADDRESS SHIFTLL 13);
R3 => R6@INTEGER;
END;
R0 - 1;
R6 + 1;
END; "OF WHILE
ADDRESS(FILEADDR) => R7;
R7@FILE_ADDRESS.TRANSFERRED_BYTES => R12;
R7@FILE_ADDRESS.FIRST_BYTE - R12;
R7@FILE_ADDRESS.BYTE_COUNT + R12;
ADDRESS(BLE_BUFFER) => R2;
WRITE_MESSAGE(R2,R6);
ADDRESS(FILEADDR) => R7; "MORE ANO'S ?
R7@FILE_ADDRESS.BYTE_COUNT => R01;
IF NOT (R0 = 0 LOGOR R1[15]) THEN
GOTO READ_ANO_LIST; "YES !
%COMPILE
"PAGE «ff»
ENQUEUE_TO_MDS:
"--------------
%WHEN ACCEPTANCE_TEST = TRUE SKIP
%WHEN CCIS_VERSION = FALSE COMPILE
ADDRESS(QIOCB) => R4;
MDS_TERM_NO => R0 => R4@QIOCB_TYPE.W1;
LAST_ENTRY => R0 => R4@QIOCB_TYPE.W3;
NO_WAIT_PRIVILEGED_QACCESS => R0 => R4@QIOCB_TYPE.W5;
SWITCH MON(QACCESS,WRITE_ELEMENT,R4,R7):
ERROR_DONE TO
ERR: BEGIN
CTERM_ERROR_CALL; ENQUEUE_TO_MDS_ERROR;
MON(WAITEVENT,30*10=>R0,BMDELAY=>R2,R7); "WAIT 30 SECONDS, TRY AGAIN
GOTO ENQUEUE_TO_MDS; "AT LOCAL FIX UP:
END; "ERROR CODE #0805 - QUEUE OVERFLOW
END;
%COMPILE
%WHEN CCIS_VERSION = FALSE SKIP
"ENQUEUE A COPY TO TERMINAL NO 1
ADDRESS(QIOCB) => R4;
1 => R0 => R4@QIOCB_TYPE.W1;
3 => R0 => R4@QIOCB_TYPE.W2; "LP-QUEUE
LAST_ENTRY => R0 => R4@QIOCB_TYPE.W3;
MTCBID => R0 => R4@QIOCB_TYPE.W4;
WAIT_PRIVILEGED_QACCESS => R0 => R4@QIOCB_TYPE.W5;
SWITCH MON(QACCESS,WRITE_ELEMENT,R4,R7):
ERROR_DONE TO
ERR: BEGIN
CTERM_ERROR_CALL; 8888;
END;
END;
%COMPILE
MESSAGE_ACK => R0 => MES_BUF[1]; "INSERT ACK
RETURN_NACK: "NACK ALREADY INSERTED
"==========
0 => R0 => MES_BUF[0];
NARRATIVE_CHANNEL => R0 => MES_BUF[2];
END; "OF NARRATIVE MESSAGE
"PAGE «ff»
ADDRESS(CPIP_NAME) => R0; "INFORM CPIP
ADDRESS(MES_BUF) => R1;
MON(SENDMESSAGE,R0,R1,R2,R7);
ILLEGAL_MESSAGE:
"==============
ADDRESS(MTCBID) => R0;
CLOSE_MTCB_FILE(R0,R4,R6);
CCIS_FAILURE:
"===========
MTCBID => R0;
RELEASE_MTCB(R0,R6);
RELEASE_MTCB(R0,R6);
GOTO GET_NEXT_EVENT;
END; "OF MESSAGE RECIEVED
"PAGE «ff»
IF R1@INTEGER = 1 THEN "SUPERVISOR COMMAND RECIEVED
BEGIN
R1 => R4;
R4@INTEGERS[1] => R0; "GET COMMAND
R4 + 4; "REF COMPLETION CODE
"CHECK COMMAND-VALIDITY AND INSERT COMPLETION
"--------------------------------------------
IF R0 >>= 2 THEN TRP(7);
GET_STATUS_CCIS(R6);
STATUS_CCIS => R3;
IF (R0 = 0 LOGAND R3 <> CCIS_LINK_CLOSED) THEN "OPEN REQUEST + NOT CLOSED
BEGIN
1 => R4@INTEGER; "UNEXPECTED COMMAND
MON(SENDANSWER,R1,R2,R7);
GOTO GET_NEXT_EVENT;
END;
0 => R4@INTEGER; "OK COMPLETION
MON(SENDANSWER,R1,R2,R7); "RETURN ANSWER
IF R0 = 0 THEN "OPEN LINK REQUEST
BEGIN
MON(SETCYCLE,OPEN_LINK_TIMEOUT=>R0,R7);
ADDRESS(STATUS) => R0;
SETS(R0@INTEGER,OUTSTANDING_OPEN_REQUEST);
OPEN_LINK_REQUEST => R0 => MES_BUF[1];
END "OF OPEN LINK REQUEST
ELSE
"PAGE «ff»
IF R0 = 1 THEN "CLOSE LINK REQUEST
BEGIN
UPDATE_CCIS_STATUS(CCIS_LINK_CLOSED=>R0,R6);
REPORT_CCIS_STATUS(FODCCIS_CLOSE_OK=>R0,R6);
CLEAN_OUTSTANDING_OPEN_REQUEST_CALL;
CLOSE_LINK => R0 => MES_BUF[1];
END; "OF CLOSE LINK REQUEST
0 => R0 => MES_BUF[0];
ADDRESS(CPIP_NAME) => R0; "INFORM CPIP
ADDRESS(MES_BUF) => R1;
MON(SENDMESSAGE,R0,R1,R2,R7);
GOTO GET_NEXT_EVENT;
END; "OF SUPERVISOR COMMAND
TRP(7); "ILLEGAL SUPERVISOR COMMAND
END; "OF BNMESSAGE
"PAGE «ff»
IF R0 = BNANSWER THEN
BEGIN
GOTO GET_NEXT_EVENT;
END; "OF BNANSWER
IF R0 = BNZEROPHASE THEN
BEGIN
"OPEN_LINK_REQUEST TIMEOUT
"-------------------------
STATUS => R0;
IF R0[OUTSTANDING_OPEN_REQUEST] THEN
BEGIN
UPDATE_CCIS_STATUS(CCIS_LINK_CLOSED=>R0,R6);
REPORT_CCIS_STATUS(FODCCIS_OPEN_NOT_OK=>R0,R6);
END;
CLEAN_OUTSTANDING_OPEN_REQUEST_CALL;
GOTO GET_NEXT_EVENT;
END; "OF BNZEROPHASE
TRP(7); "ILLEGAL EVENT TYPE
END; "OF MAINMODULE