|
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: 8406 (0x20d6)
Types: TextFile
Names: »ENQ.S«
└─⟦881c1028e⟧ Bits:30005102 8" CR80 Floppy CR80FD_0061 ( VOL: SCC.V NSC Directory: Queue_test.D )
└─⟦4f56469eb⟧
└─ ⟦this⟧ »QUEUE_TEST.D!ENQ.S«
MAINMODULE ENQ;
%LIST
"---------------------------------------------------------------
"
" ENQUEUE UTILITY:
"
"----------------------------------------------------------------
"
" QUEUES A MTCB WITH A POSSIBLE MESSAGE-FILE INTO A QUEUE
" SPECIFYED BY TERMINAL NO. AND QUEUE NO.
"
"
" CALL:
" ENQ MTCB:<MTCB_FILE> MSG:<MSG_FILE> TER= XX QUE= YY
"
" WHERE XX AND YY IS DECIMAL QUEUE NUMBERS.
"
"
%SOURCE @**GENS.D*SWELLPREFIX.D*GENERALPARAMS.S
%SOURCE @**GENS.D*SWELLPREFIX.D*MONITORNAMES.S
%SOURCE @**GENS.D*SWELLPREFIX.D*IOSPARAMS.S
%SOURCE @**SCCNAMES.D*SCCNAME.N
%SOURCE @**SCCNAMES.D*SCCDATA.N
%SOURCE @**SCCNAMES.D*NSSMTCB.N
%SOURCE @**SCCNAMES.D*SCC_PROCESS.N
%SOURCE @**NM_NAMES.D*SUPPORT.N
%SOURCE @**NM_NAMES.D*QACCESS_TYPES.S
%SOURCE @**GENS.D*UTILITYHELP.D*UTH.I
%LIST
%PRINT
" REDEFINITION OF MON INFILE,INELEMENT EXIT VALUES:
"
CONST
INFIOERROR= IF_ERROR;
INFSYNTAX= IF_SYNTAX;
INELERROR= IE_ERROR;
INELNUMBER= IE_NUMBER;
INELID= IE_IDENTIFIER;
INELSPECIAL= IE_SPECIAL;
TYPE
INFID_EXIT= INFILEID_EXITS;
INEL_EXIT= INELEMENT_EXITS;
VAR
Q_CTBL: QIOCB;
MTCB_BUF: ARRAY[0..SIZE(REAL)-1] OF INTEGER;
MTCB_INDX: INTEGER;
TER_NO: INTEGER;
QUE_NO: INTEGER;
QUE_NO_DEL:INTEGER;
MSGFILETYPE: FILETYPE;
QUEFILETYPE: FILETYPE;
MTCBFILETYPE: FILETYPE;
SIGNAL_NAME1: PROCESS_NAME;
INIT
QUEFILETYPE.NAME = 'Q MON CALL(:0:)(:0:)';
IMPORT PROCEDURE MTCBMINIT(R3;R6):ERROR_DONE;
%SOURCE READUSERPARAMS.S
%SOURCE WRITEINTEGERS.S
PROCEDURE READINTEGERS
" CALL RETURN
(R0; " MAX NO. OF INTEGERS
" INTEGERS READ
R1; " REF. INTE- UNCH
" GER ARRAY
R4; " REF. FILE UNCH
" TYPE
R6):X2; " LINK
" RETURN: LINK: NL DETECTED
" LINK+1: MAX. INTEGERS FOUND
VAR SAV0,SAV1,SAV4,SAV6: INTEGER;
CONST
NL=10;
LABEL END_INTEGER;
"---------------------------------------------------------------
BEGIN
R6 => SAV6;
R0 => SAV0;
R1 => SAV1;
R4 => SAV4;
R1 => R0;
REPEAT
SAV4 => R4;
R4@FILETYPE.S => R4;
SWITCH MON(STREAM,INELEMENT,6=>R1,R3,R4,R5,R0=>R6,R7):
INEL_EXIT TO
INELERROR:
FILEERROR(SAV4 => R4, ADDRESS('INELEMENT(:0:)') => R5,R7,R6);
INELID:
FILEERROR(SAV4 => R4, ADDRESS('ELEMENT IN(:0:)') => R5,R3=>R7,R6);
INELSPECIAL:
BEGIN
IF R3 = NL
THEN GOTO END_INTEGER;
IF R3 <> SP
THEN
FILEERROR(SAV4 => R4, ADDRESS('SPACIAL IN(:0:)') => R5,R3=>R7,R6);
END;
INELNUMBER:
BEGIN
R0+1;
SAV0 => R1-1 => SAV0;
END;
END;
UNTIL SAV0 => R1 < 1;
SAV6 => R1+1 => SAV6;
END_INTEGER:
SAV1 => R1;
R0-R1;
SAV4 => R4;
EXIT(SAV6);
END;
"---------------------------------------------------------------
PROCEDURE READMTCBD(R6);
VAR
INTGCNT: INTEGER;
SAV6: INTEGER;
CONST
WAIT_MTCB = 1;
WRITE_MASK = #7FF;
"---------------------------------------------------------------
BEGIN
R6 => SAV6;
MON (STREAM,OUTTEXTB,COUTFILETYPE.S => R4,
ADDRESS('MTCBDATA FROM: (:0:)')=> R6,R7):ERROR_DONE;
MON (STREAM,OUTREC,(2*SIZE(FILE_NAME)) => R2,
ADDRESS(MTCBFILETYPE) => R1,R4,R7):ERROR_DONE;
MON (STREAM,OUTNL,R4,R7):ERROR_DONE;
MON (STREAM,FLUSH,R4,R7):ERROR_DONE;
ADDRESS(MTCBFILETYPE) => R4;
ADDRESS(MTCB_BUF) => R1;
SIZE(MTCB_BUF) => R0 => R2;
0 => R3;
WHILE R2-1 >= 0 DO
R3 => R1@A[R2];
SWITCH READINTEGERS(R0,R1,R4,R6): X2 TO
1:
REPEAT INB(R4,R3,R6) UNTIL R3 = NL;
END;
R0 => INTGCNT;
IF R0 = 0
THEN
MON (TERMINATE,#8000 => R0,LOCATION(READMTCBD) => R1,R7);
R1 => R4;
R4@INTEGER => R1;
SWITCH MON(MTCB,CREAT,WAIT_MTCB => R0,R1,R7): X2 TO
ERR:
FILEERROR(ADDRESS(MTCBFILETYPE) => R4,ADDRESS('CREATEMTCB(:0:)')=>R5,R7,R6);
END;
R0 => MTCB_INDX;
ADDRESS(MTCB_INDX) => R0;
ADDRESS(MTCB_BUF) => R1;
SWITCH MON(MTCB,WRITE,R0,R1,WRITE_MASK => R2,R7): X2 TO
ERR:
FILEERROR(ADDRESS(MTCBFILETYPE) => R4,ADDRESS('WRITEMTCB(:0:)')=>R5,R7,R6);
END;
ADDRESS(COUTFILETYPE) => R4;
REPEAT
INTGCNT => R6;
IF R6 >= 11
THEN
8 => R0
ELSE
R6 => R0;
R6 - R0 => INTGCNT;
WRITEINTEGERS(R0,R1,R4,R6);
R1+R0;
UNTIL INTGCNT => R6 < 1;
MON (STREAM,FLUSH,COUTFILETYPE.S=>R4,R7):ERROR_DONE;
EXIT(SAV6);
END;
"---------------------------------------------------------------
PROCEDURE READMSGD (R6);
CONST
BUF_SZ = 50;
VAR
SAV6: INTEGER;
VAR
MSG_BUF: ARRAY[0..BUF_SZ-1] OF INTEGER;
VAR
END_READ: INTEGER;
CONST
READING = 0;
STOPREAD = 1;
IMF_FILE = 1;
PDB_FILE = 2;
VAR
MTCB_FADDR: FILE_ADDRESS;
"---------------------------------------------------------------
BEGIN
R6 => SAV6;
ADDRESS(MTCB_INDX) => R0;
ADDRESS(MTCB_FADDR) => R1;
SWITCH MON(MTCB,CREATEFILE,R0,R1,PDB_FILE => R2,R4,R7): X2 TO
ERR:
FILEERROR(ADDRESS(MTCBFILETYPE) => R4,ADDRESS('CREATEFILE(:0:)')=>R5,R7,R6);
END;
R4 => QUEFILETYPE.F;
ADDRESS(QUEFILETYPE) => R4;
OPENSTREAM(R4,OUTPUT_MODE => R3,R6);
ADDRESS(MTCB_FADDR) => R1;
R4@FILETYPE.S => R4;
SWITCH MON(STREAM,SETPOSITION,R1,R4,R7): X2 TO
ERR:
FILEERROR(ADDRESS(QUEFILETYPE) => R4,ADDRESS('SET POS(:0:)')=>R5,R7,R6);
END;
REPEAT
ADDRESS(MSGFILETYPE) => R4;
ADDRESS(MSG_BUF) => R1;
SIZE(MSG_BUF) => R0;
SWITCH READINTEGERS(R0,R1,R4,R6): X2 TO
0:
STOPREAD => R6 => END_READ;
END;
R0 => R2 SHIFTLL 1; " MAKE BYTE COUNT
QUEFILETYPE.S => R4;
SWITCH MON(STREAM,OUTREC,R1,R2,R4,R7): X2 TO
ERR:
FILEERROR(ADDRESS(QUEFILETYPE) => R4,ADDRESS('OUTREC(:0:)')=>R5,R7,R6);
END;
UNTIL END_READ => R6 = STOPREAD;
SWITCH MON(STREAM,FLUSH,R4,R7): X2 TO
ERR:
FILEERROR(ADDRESS(QUEFILETYPE) => R4, ADDRESS('FLUSH(:0:)')=>R5,R7,R6);
END;
ADDRESS(QUEFILETYPE) => R4;
CLOSESTREAM(R4,R6);
DISMANTLEFILE(R4,R6);
EXIT(SAV6);
END;
"---------------------------------------------------------------
PROCEDURE QUEUED (R6);
VAR SAV6: INTEGER;
CONST
Q_ENTRYNO = 0; " LAST ENTRY
"---------------------------------------------------------------
BEGIN
R6 => SAV6;
ADDRESS(Q_CTBL) => R4;
TER_NO => R0 => R4@QIOCB.W1;
QUE_NO => R0 => R4@QIOCB.W2;
Q_ENTRYNO => R0 => R4@QIOCB.W3;
MTCB_INDX => R0 => R4@QIOCB.W4;
SWITCH MON(QACCESS,INS,R4,R7): X2 TO
ERR:
FILEERROR(ADDRESS(MTCBFILETYPE) => R4,ADDRESS('ENQUEUE(:0:)')
=> R5,R7,R6);
END;
ADDRESS(SIGNAL_NAME1) => R0;
IF R0@INTEGER <> 0
THEN
MON (SENDSIGNAL,R0,R7);
EXIT(SAV6);
END;
"---------------------------------------------------------------
"
" ENQUEUE UTILITY
"
"---------------------------------------------------------------
" QUEUES A MTCB WITH A POSSIBLE
" MESSAGE FILE INTO A QUEUE SPECIFIED
" BY TERM AND QUEUE NO.
"
" CALL:
" ENQ MTCB:<MTCB_FILE> MSG:<MESSAGE_FILE>
" TER = XX QUE = YY
LABEL ENQ_CONTINUE;
"---------------------------------------------------------------
BEGIN
SWITCH MTCBMINIT(MAC_ALL => R3,R6):ERROR_DONE TO
ERR:
BEGIN
R7=>R0;
R6=>R1;
SETS(R0,15);
MON (TERMINATE,R0,R1,R7);
END;
END;
ACCEPTFILES(R6);
READSYSPARAMS(R6);
OPENSTREAM(ADDRESS(CINFILETYPE) => R4,INPUT_MODE => R3,R6);
ADDRESS(MTCBFILETYPE) => R4;
ADDRESS(CINFILETYPE) => R5;
R5@FILETYPE.F => R3 => R4@FILETYPE.F;
R5@FILETYPE.S => R3 => R4@FILETYPE.S;
MOVM(SIZE(FILE_NAME), R5@FILE_NAME, R4@FILE_NAME);
ADDRESS(MSGFILETYPE) => R4;
ADDRESS(CINFILETYPE) => R5;
R5@FILETYPE.F => R3 => R4@FILETYPE.F;
R5@FILETYPE.S => R3 => R4@FILETYPE.S;
MOVM(SIZE(FILE_NAME), R5@FILE_NAME, R4@FILE_NAME);
READUSERPARAMS(R6);
QUE_NO => R6;
IF R6 = -1
THEN
FILEERROR(ADDRESS(PFILETYPE)=>R4,ADDRESS('ILL. QUEUE NO.(:0:)')=>R5,R7,R6);
CLOSESTREAM(ADDRESS(PFILETYPE) => R4,R6);
DISMANTLEFILE(R4,R6);
ADDRESS(MTCBFILETYPE) => R4;
OPENSTREAM(R4,INPUT_MODE => R3,R6);
ADDRESS(MSGFILETYPE) => R4;
OPENSTREAM(R4,INPUT_MODE => R3,R6);
ENQ_CONTINUE:
READMTCBD(R6);
ADDRESS(MTCB_BUF) => R4;
IF R4@INTEGER = MTCB_R
THEN
BEGIN
READMSGD(R6);
END;
QUEUED(R6);
GOTO ENQ_CONTINUE;
END;
ENDMODULE «nul»