%CONTROL X'0FFFFFFF' !* MODIFIED 14/06/79 ! !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! ! NEW CTM INTERFACE FOR 5X32 RELEASE OF SYSTEM B. ! FLAG ICL9CECTM32 DETERMINES WHETHER CALLS ARE MADE ON THE NEW ! CTM PROCEDURES OR ON THE OLD TUM PROCEDURES ! ICL9CECTM32=1 NEW CTM ! ICL9CECTM32=0 OLD TUM ! !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! ! FILE DESCRIPTION RECORD FORMAT %RECORDFORMAT AFDFORM(%INTEGER LINK,DSNUM, %C %BYTEINTEGER STATUS,ACCESSROUTE,VALIDACTION,%C CURSTATE,MODEOFUSE,ACCESSMODE,FILEORG, %C DEVCLASS,RECTYPE,FLAGS,LM,RM, %C %INTEGER ASVAR,AREC,RECSIZE,MINREC,MAXREC, %C MAXSIZE,ROUTECCY,C0,C1,C2,C3,TRANSFERS, %C DARECNUM,%LONGINTEGER RECCCY,NEWCCY,SPARE, %C %STRING(31) IDEN) ! !------------------------------------------------------------- ! ! OLD TUM SPECS ! !------------------------------------------------------------- ! %EXTERNALINTEGERFNSPEC ICLCTM GIVE PROCESS TIME(%INTEGER OPTION, %C PTIME0,PTIME1) %EXTERNALINTEGERFNSPEC ICLCTM READ INTERRUPT DATA(%INTEGER %C INTDATA0,INTDATA1,COUNT0,COUNT1) %EXTERNALINTEGERFNSPEC ICLCTM INFORM(%INTEGER CONT,%LONGINTEGER ENTRY) %EXTERNALINTEGERFNSPEC ICLCTM LOG MESSAGE(%INTEGER TYPE,NR, %C %LONGINTEGER MSGDESC) ! !-------------------------------------------------------------- ! ! NEW CTM SPECS ! !----------------------------------------------------------- %EXTERNALINTEGERFNSPEC NEWCTM READID(%INTEGER INTDATA0,INTDATA1, %C %LONGINTEGER NUMWORDS) %EXTERNALINTEGERFNSPEC NEWCTM DISCARDID %EXTERNALINTEGERFNSPEC NEWCTM DATETIME(%LONGINTEGER INTIME,DATE,TIME,NR) %EXTERNALINTEGERFNSPEC NEWCTM JS READ(%LONGINTEGER JSV,INT,STR,NR) %EXTERNALINTEGERFNSPEC NEWCTM JS WRITE(%LONGINTEGER JSV,INT,STR,NR) %EXTERNALROUTINESPEC NEWCTM STOP(%LONGINTEGER RESULT1,RESULT2, %C %INTEGER RESPVAL) %EXTERNALINTEGERFNSPEC NEWCTM JSBEGIN(%LONGINTEGER DUMMY) %EXTERNALINTEGERFNSPEC NEWCTM JSEND(%LONGINTEGER DUMMY) %EXTERNALINTEGERFNSPEC NEWCTMSELECTRAM(%LONGINTEGER CCY, %C LOCNAME,%INTEGER PPAIRS0,PPAIRS1) %EXTERNALINTEGERFNSPEC NEWCTM READDESC(%LONGINTEGER CURRENCY, %C LOCNAME,FULLNAME,%INTEGER PPDR0,PPDR1) %EXTERNALINTEGERFNSPEC NEWCTM WORKAREA(%LONGINTEGER NAMEDESC, %C %INTEGER PPDR0,PPDR1, %C %LONGINTEGER AREADESC) %EXTERNALINTEGERFNSPEC NEWCTM SET VS ATT(%LONGINTEGER AREADESC, %C %INTEGER PPDR0,PPDR1) %EXTERNALINTEGERFNSPEC NEWCTM WORKFILE(%INTEGER %C FROUTE0,FROUTE1, %C LOCFNAM0,LOCFNAM1, %C DROUTE0,DROUTE1, %C LOCDNAM0,LOCDNAM1, %C FULLDNAM0,FULLDNAM1, %C INITSIZE,MAXSIZE) ! !------------------------------------------------------------- ! %SYSTEMINTEGERFNSPEC PROCERR(%INTEGER RC,TYPE) %SYSTEMROUTINESPEC DUMP(%INTEGER AD,L) ! %INTEGERFNSPEC JSBEGIN %INTEGERFNSPEC JSEND %INTEGERFNSPEC FILEACT(%INTEGER AFD,ACT) ! ! !-------------------------------------------------------------- ! ! CONSTANTS !--------------------------------------------------------------- ! %CONSTINTEGER YES=1, %C NO=0, %C TRUE=1, %C FALSE=0 %CONSTINTEGER ALL CONTINGENCIES = 100000 %CONSTINTEGER READSTATE=2, %C WRITESTATE=3, %C READMODE=1, %C WRITEMODE=2, %C SELECTACT=12 %CONSTINTEGER BYTEDESC=X'18000000', %C WORDDESC=X'28000000', %C LONGDESC=X'30000000', %C NILDESC=-1 %CONSTLONGINTEGER NIL=-1 ! !---------------------------------------------------------------- ! ! GLOBALS ! !---------------------------------------------------------------- ! %EXTRINSICINTEGER ICL9CECTM32 %EXTRINSICINTEGER CTMREPORT %OWNINTEGER LEVEL %OWNINTEGERARRAY PPAIRS(0:26) ! ! !* %ROUTINE MOVE(%INTEGER LENGTH, FROM, TO) %INTEGER I %RETURNIF LENGTH <= 0 I = X'18000000'!LENGTH *LSS_FROM *LUH_I *LDTB_I *LDA_TO *MV_%L=%DR %END; !OF MOVE !* ! ! !********************************************************** !* !* RAM !* !********************************************************** ! %INTEGERFN RAM(%LONGINTEGER ACCESS,%INTEGER PPLEN,PPADDR) %INTEGER RC,PPDESC0,PPDESC1,NUM !* %IF CTMREPORT#0 %THENSTART PRINTSTRING("RAM ") DUMP(ADDR(ACCESS),16) DUMP(PPADDR,PPLEN<<2) %FINISH %IF PPLEN=0 %THEN %START PPDESC0=NILDESC PPDESC1=NILDESC NUM=1 %FINISH %ELSE %START PPDESC0=WORDDESC! PPLEN PPDESC1=PPADDR NUM=1 %FINISH *PRCL_4 *LSD_PPDESC0 *ST_%TOS *LD_ACCESS *RALN_7 *CALL_(%DR) *ST_RC ! %IF RC#0 %THEN RC=PROCERR(RC,NUM) %RESULT=RC %END ! ! !********************************************************** !* !* OPEN FILE !* !********************************************************** ! %SYSTEMINTEGERFN OPENFILE(%INTEGER ADDRFILEDESC,MODE) ! AFD IS ADDR OF FILE DESC ! MODE=1 FOR READING ! MODE=2 FOR WRITING ! MODE=3 FOR APPEND WRITE ! MODE=4 FOR DA FILES ! !?; %INTEGER J,K,FIRST %CONSTINTEGER DA=4, %C APP=3 %CONSTINTEGER EOF=153 %CONSTINTEGER NOWRITEPERM=9064 %CONSTINTEGER NWP32=9095 %CONSTINTEGER READSTATE=2, %C WRITESTATE=3 %CONSTINTEGERARRAY EXTDEST(0:2) = 0, 11, 0 %CONSTINTEGERARRAY SETWRITE(0:2) = 12, 2, 0 %CONSTINTEGERARRAY CPAIRS(0:11) = 7, 0, 0, 19,X'30000001', 0, 24,X'30000001', 0, 29, 2, 0 %CONSTINTEGERARRAY SQPARMS(0:11)= 9,X'28000001', 0, 4, 0, 0, 5, 1, 0, 12, 1, 0 %CONSTINTEGERARRAY DAPARMS(0:14) =9, -1, -1, 3,X'18000004', 0, 4, 4, 0, 5, 0, 0, 12, 1, 0 %RECORDNAME AFD(AFDFORM) %INTEGER RC,IRC,I,PPLEN,USAGE %LONGINTEGER ACCESS1,ACCESS2,PPDESC ! !///////////////////////////////////////////////////////////////// !///////////////////////////////////////////////////////////////// ! !* %IF CTMREPORT#0 %THENSTART PRINTSTRING("OPENFILE ") DUMP(ADDR(ADDRFILEDESC),8) DUMP(ADDRFILEDESC,128) %FINISH AFD==RECORD(ADDRFILEDESC) PPLEN=0 ! ! POSN AND DISP SPECIFY NEXT RECORD FOR FORWARD SEQUENTIAL I/O ! BUFFER,RECORDSIZE,ACCESS1,ACCESS2 AND FILECURR ARE TAKEN FROM AFD ! SET ACTION & ALLIGNMENT DEPEND ON MODE. ! MOVE(60,ADDR(CPAIRS(0)),ADDR(PPAIRS(PPLEN))) PPAIRS(1)=BYTEDESC!AFD_MAXREC; ! DESC TO BUFFER AREA PPAIRS(2)=AFD_AREC PPAIRS(5)=ADDR(AFD_C2); ! ADDR OF AREA FOR ACCESS2 PPAIRS(8)=ADDR(AFD_C0); ! ADDR OF AREA FOR ACCESS1 %IF MODE=APP %THEN PPAIRS(10)=3 PPLEN=12 ! %IF MODE=DA %THEN %START MOVE(60,ADDR(DAPARMS(0)),ADDR(PPAIRS(PPLEN))) PPAIRS(PPLEN+5)=ADDR(AFD_DARECNUM) PPLEN=PPLEN+15 %FINISH %ELSE %START MOVE(48,ADDR(SQPARMS(0)),ADDR(PPAIRS(PPLEN))) PPAIRS(PPLEN+2)=ADDR(AFD_RECSIZE) PPAIRS(PPLEN+10)=2 %UNLESS MODE=1; ! ACT = WRITE UNLESS MODE=READ PPLEN=PPLEN+12 %FINISH ! !* FIRST=0 AGAIN: %IF CTMREPORT#0 %THENSTART PRINTSTRING("PPLEN=") WRITE(PPLEN,2) NEWLINE DUMP(ADDR(PPAIRS(0)),PPLEN<<2) %FINISH !* RC=NEWCTM SELECTRAM(AFD_NEWCCY,NIL,WORDDESC!PPLEN,ADDR(PPAIRS(0))) ! %IF RC#0 %THEN RC=PROCERR(RC,2) %IF RC=EOF %THEN RC=0 %IF RC=175 %AND FIRST=0 %THENSTART FIRST=1 PPAIRS(PPLEN)=16 PPAIRS(PPLEN+1)=X'01000000' PPAIRS(PPLEN+2)=0 ->AGAIN %FINISH %IF RC>0 %THEN %RESULT=RC AFD_CURSTATE=READSTATE %IF MODE#WRITEMODE %THEN %RESULT=RC ! ! WRITE MODE - DO EXTENDED DESTROY ! ACCESS1=LONGINTEGER(ADDR(AFD_C0)) MOVE(12,ADDR(EXTDEST(0)),ADDR(PPAIRS(0))) IRC=RAM(ACCESS1,3,ADDR(PPAIRS(0))) %IF IRC=EOF %THEN IRC=0 %IF IRC>0 %THEN %RESULT=IRC %IF IRC<0 %THEN RC=IRC ! ! SET WRITE MODE FOR SUBSEQUENT ACCESSES ! MOVE(12,ADDR(SETWRITE(0)),ADDR(PPAIRS(0))) IRC=RAM(ACCESS1,3,ADDR(PPAIRS(0))) %IF IRC>0 %THEN %RESULT=IRC %IF IRC<0 %THEN RC=IRC AFD_CURSTATE=WRITESTATE %IF CTMREPORT#0 %THENSTART PRINTSTRING("RC=") WRITE(RC,5) NEWLINE DUMP(ADDRFILEDESC,128) %FINISH %RESULT=RC %END; ! OF OPEN FILE ! !********************************************************** !* !* FILEACT !* !********************************************************** ! %SYSTEMINTEGERFN FILEACT(%INTEGER ADDRFILEDESC,ACT) ! ! VALUES OF ACT ARE:- ! 1 SET FORWARD READ ! 2 EXTENDED DESTROY AND SET TO FORWARD WRITE ! 3 REWIND AND SET TO FORWARD READ ! 4 BACKSPACE AND SET TO FORWARD READ ! 5 POSITION AT END OF FILE AND SET TO FORWARD WRITE ! 6 SKIP ONE RECORD AND SET TO FORWARD READ ! 7 DESELECT RAM ! %CONSTINTEGERARRAY CPPAIRS(0:8) = 4, 0, 0, 5, 1, 0, 0, 0, 0 %CONSTINTEGERARRAY EXTDEST(0:2) = 0, 11, 0 %CONSTINTEGERARRAY DESELREC(0:2)= 0, 13, 0 %CONSTINTEGERARRAY DESELRAM(0:2)= 0, 12, 0 %CONSTLONGINTEGER WD=X'2800000000000000' %CONSTINTEGERARRAY PTABLE(0:2,3:6) = 2, 0, 1, 0, -1, 0, 1, 0, 2, 0, 1, 0 %CONSTINTEGERARRAY OLDPOSPPS(0:11)= 4, 0, 0, 5, 1, 0, 6, 0, 0, 0, 0, 0 %LONGINTEGER ACCESS1 %INTEGER RC,IRC,MODE %SWITCH ACTION(1:7) %RECORDNAME AFD(AFDFORM) ! ! !* %IF CTMREPORT#0 %THENSTART PRINTSTRING("FACT ") WRITE(ACT,3) NEWLINE DUMP(ADDRFILEDESC,128) %FINISH AFD==RECORD(ADDRFILEDESC) ACCESS1=LONGINTEGER(ADDR(AFD_C0)) ->ACTION(ACT) ! ! ACTION(1): MODE=READMODE ->SETRW ACTION(2): MOVE(12,ADDR(EXTDEST(0)),ADDR(PPAIRS(0))) MODE=WRITEMODE RC=RAM(ACCESS1,3,ADDR(PPAIRS(0))) %IF RC>0 %THEN %RESULT=RC ->SETRW ACTION(3): ACTION(4): MODE=READMODE %IF AFD_CURSTATE=WRITESTATE %THEN %START MOVE(12,ADDR(DESELREC(0)),ADDR(PPAIRS(0))) RC=RAM(ACCESS1,3,ADDR(PPAIRS(0))) %IF RC>0 %THEN %RESULT=RC MOVE(36,ADDR(CPPAIRS(0)),ADDR(PPAIRS(0))) PPAIRS(4)=-1 RC=RAM(ACCESS1,9,ADDR(PPAIRS(0))) %IF RC>0 %THEN %RESULT=RC %FINISH ->POSITION ACTION(5): MODE=WRITEMODE ->POSITION ACTION(6): MODE=READMODE ->POSITION ACTION(7): %IF AFD_ACCESSMODE=13 %THEN %RESULT=0;! NOT FOR DA MOVE(12,ADDR(DESELRAM(0)),ADDR(PPAIRS(0))) RC=RAM(ACCESS1,3,ADDR(PPAIRS(0))) %RESULT=RC ! ! POSITION: MOVE(36,ADDR(CPPAIRS(0)),ADDR(PPAIRS(0))) PPAIRS(1)=PTABLE(0,ACT) PPAIRS(4)=PTABLE(1,ACT) RC=RAM(ACCESS1,9,ADDR(PPAIRS(0))) %IF RC > 0 %THEN %RESULT=RC SETRW: MOVE(36,ADDR(CPPAIRS(0)),ADDR(PPAIRS(0))) PPAIRS(7)=MODE PPAIRS(6)=SELECTACT RC=RAM(ACCESS1,9,ADDR(PPAIRS(0))) %RESULT=RC %END; ! OF FILEACT ! !************************************************************* !* !* DA FILE OP !* !************************************************************* ! %SYSTEMINTEGERFN DA FILE OP(%INTEGER ADDRFILEDESC,OP,DISP) ! OP=1 READ ! OP=2 WRITE %CONSTINTEGERARRAY CPAIRS(0:5) = 5,0,0, 0,0,0 %CONSTINTEGER READACT=1, %C WRITEACT=3 %INTEGER RC,ACT %LONGINTEGER ACCESS1 %RECORDNAME AFD(AFDFORM) ! !* %IF CTMREPORT#0 %THENSTART PRINTSTRING("DA FILE OP ") DUMP(ADDR(ADDRFILEDESC),12) DUMP(ADDRFILEDESC,128) %FINISH AFD==RECORD(ADDRFILEDESC) %IF OP=1 %THEN ACT=READACT %ELSE ACT=WRITEACT AFD_DARECNUM=DISP ACCESS1=LONGINTEGER(ADDR(AFD_C0)) %IF AFD_CURSTATE#OP+1 %THEN %START AFD_CURSTATE=OP+1 PPAIRS(0)=0 PPAIRS(1)=ACT PPAIRS(2)=0 RC=RAM(ACCESS1,3,ADDR(PPAIRS(0))) %FINISH %ELSE %START RC=RAM(ACCESS1,0,0) %FINISH %RESULT=RC %END; ! OF DA FILE OP ! ! !********************************************************** !* !* READ FILE DESC !* !********************************************************** ! %SYSTEMINTEGERFN READ FILE DESC(%INTEGER ADDRFILEDESC) ! ! FILLS IN DETAILS ABOUT FILE IN SUBSYSTEM FILE DESC RECORD ! %RECORDNAME AFD(AFDFORM) %INTEGERARRAY PPAIRS(1:15) %INTEGER RC %CONSTINTEGERARRAY CPAIRS(1:15)= 101, 0, 0, 104, 0, 0, 105, 0, 0, 102, 0, 0, 103, 0, 0 AFD==RECORD(ADDRFILEDESC) MOVE(60,ADDR(CPAIRS(1)),ADDR(PPAIRS(1))) RC=NEWCTM READ DESC(AFD_NEWCCY, NIL,NIL, WORDDESC!9,ADDR(PPAIRS(1))) %IF RC#0 %THEN RC=PROCERR(RC,6) AFD_DEVCLASS=1 %IF PPAIRS(5)=PPAIRS(8) %THEN AFD_RECTYPE=1 %ELSE AFD_RECTYPE=0 AFD_FILEORG=PPAIRS(2) AFD_MAXREC=PPAIRS(5) AFD_MINREC=PPAIRS(8) %RESULT=RC %END; ! OF READ FILE DESC ! !************************************************************ !* !* NEW AREA !* !************************************************************ ! %SYSTEMINTEGERFN NEW AREA(%INTEGER SIZE,MAXSIZE,MODE, %C %LONGINTEGER AREADESC,NAMEDESC) ! ! SIZE = INITIAL SIZE OF AREA ! MAXSIZE = MAX SIZE OF AREA IF OF VARIABLE SIZE ! MODE = DENSE/LOCALISED/SPARSE/SERIAL ! AREADESC = DESC TO LONGWORD WHICH IS TO CONTAIN AREA DESC ! %STRING(16) NAME %INTEGER PPLEN,RC,NUM %OWNINTEGERARRAY PPAIRS(0:11) = 1, 0, 0, 5, 0, 0, 0, 0, 0, 0, 0, 0 ! PPAIRS(1)=SIZE PPAIRS(4)=MODE PPLEN=6 %IF MAXSIZE>-2 %THEN %START; ! VARIABLE LENGTH RECORDS PPAIRS(6)=7 PPAIRS(7)=MAXSIZE PPLEN=9 %FINISH RC=NEWCTM WORKAREA(NIL,WORDDESC!PPLEN,ADDR(PPAIRS(0)),AREADESC) %IF RC#0 %THEN RC=PROCERR(RC,4) %RESULT=RC %END; ! OF NEW AREA ! ! !************************************************************ !* !* CHANGE AREA PROPERTIES !* !******************************************************************* ! %SYSTEMINTEGERFN CHANGE AREA PROPERTIES(%LONGINTEGER AREADESC, %C %INTEGER READ,WRITE,EXEC,MODE,SIZE,CONTENT) ! ! OLD BBASE ROUTINE CAN CHANGE THE FOLLOWING PROPERTIES OF AN AREA ! READ : WRITE : EXEC : MODE : SIZE : CONTENT ! NEW CTM PROCEDURE CAN CHANGE THE ABOVE PROPERTIES AND ALSO ! HOLDCOUNT : I/O AREA ! THESE LAST TWO ARE NOT IMPLEMENTED IN THE INTERFACE ROUTINE ! ! THERE ARE CERTAIN CONSISTENCY RULES WHICH MUST BE OBEYED ! IE. IF WRITE=YES(1) THEN READ MUST ALSO BE YES(1) ! %INTEGER RC,PPLEN %INTEGERARRAY PPAIRS(0:17) %ROUTINESPEC PROCESSPARMS(%INTEGER PPAIR ID,VALUE) ! ! PPLEN=0 READ=YES %IF WRITE=YES ! ! ! CONSTRUCT THE PARAMETER PAIR LIST ! PROCESSPARMS(2,READ); PROCESSPARMS(3,WRITE); PROCESSPARMS(4,EXEC) PROCESSPARMS(5,MODE); PROCESSPARMS(1,SIZE); PROCESSPARMS(22,CONTENT) ! ! ---------------------------------- ! RC=NEWCTM SET VS ATT(AREADESC,WORDDESC!PPLEN,ADDR(PPAIRS(0))) %IF RC#0 %THEN RC=PROCERR(RC,5) %RESULT=RC ! ! %ROUTINE PROCESSPARMS(%INTEGER PPAIRID,VALUE) ! ! THIS ROUTINE ADDS THE PARAMETER DATA TO THE PARM PAIR LIST IN ! THE APPROPRIATE FORMAT UNLESS THE VALUE IS <0 INDICATING THAT ! THE PROPERTY IS NOT TO BE UPDATED. ! %IF VALUE < 0 %THEN %RETURN PPAIRS(PPLEN)=PPAIRID PPAIRS(PPLEN+1)=VALUE PPAIRS(PPLEN+2)=0 PPLEN=PPLEN+3 %RETURN %END; ! OF PROCESS PARMS %END; ! OF CHANGE AREA PROPERTIES ! !******************************************************* !* !* WORK FILE !* !******************************************************* ! %SYSTEMINTEGERFN WORKFILE(%INTEGER ADDRFILEDESC,SIZE,TYPE) ! ! ADDR FILE DESC IS ADDR OF SUBSYSTEM FILE DESCRIPTION ! SIZE IS INIT SIZE OF FILE ! TYPE INDICATES WHICH FILE DESCRIPTION TO USE ! %INTEGERARRAY ENDR(0:3) %RECORDNAME AFD(AFDFORM) %INTEGER RC,IRC %STRING(12) WFDESC %STRING(9) STDM %STRING(22) SPOC %CONSTSTRING(9) CSTDM=E":STD.STDM" %CONSTSTRING(12) CSTDLIST=E":STD.STDLIST" %CONSTSTRING(22) CSPOC=E"SPOOLOUT(FALSE,RESULT)" ! RC=0 AFD==RECORD(ADDRFILEDESC) %IF TYPE=1 %THEN WFDESC=CSTDLIST %ELSE WFDESC=CSTDM IRC=NEWCTM WORKFILE(LONGDESC!1, ADDR(AFD_NEWCCY), %C NILDESC,NILDESC, 0,0, NILDESC,NILDESC, %C BYTEDESC!LENGTH(WFDESC),ADDR(WFDESC)+1, %C SIZE, -1) %IF IRC#0 %THEN IRC=PROCERR(IRC,3) %IF IRC>0 %THEN %RESULT=RC %IF IRC < 0 %THEN RC=IRC ! IRC=JSBEGIN %IF IRC>0 %THEN %RESULT=IRC %IF IRC<0 %THEN RC=IRC IRC=JSEND %IF IRC>0 %THEN %RESULT=IRC %IF IRC<0 %THEN RC=IRC ! ! IRC=READ FILE DESC(ADDRFILEDESC) %IF IRC#0 %THEN RC=IRC %RESULT=RC %END; ! OF WORK FILE ! !****************************************************** !* !* JS BEGIN !* !****************************************************** ! %SYSTEMINTEGERFN JSBEGIN %INTEGER RC RC=NEWCTM JSBEGIN(NIL) %IF RC#0 %THEN RC=PROCERR(RC,8) %RESULT=RC %END; ! OF JSBEGIN ! !****************************************************** !* !* JS END !* !****************************************************** ! %SYSTEMINTEGERFN JS END %INTEGER RC RC=NEWCTM JSEND(NIL) %IF RC#0 %THEN RC=PROCERR(RC,9) %RESULT=RC %END; ! OF JSEND ! !****************************************************** !* !* READ ID !* !****************************************************** ! %SYSTEMINTEGERFN READ ID(%INTEGER INTDATA0,INTDATA1, %C %LONGINTEGER NUMWORDS) ! ! PARAMS INTDATA IS AN AREA INTO WHICH THE REGS ARE DUMPED ! NUMWORDS IS NUMBER OF WORDS RETURNED ! %INTEGER COUNT,RC %IF ICL9CECTM32=2 %THEN %START RC=NEWCTM READID(INTDATA0,INTDATA1,NUMWORDS) %IF RC#0 %THEN RC=PROCERR(RC,11) %FINISH %ELSE %START COUNT=9999 %IF INTDATA0&X'FFFF'>18 %THEN INTDATA0=WORDDESC!18 RC=ICLCTM READ INTERRUPT DATA(INTDATA0,INTDATA1,WORDDESC!1,ADDR(COUNT)) %IF RC#0 %THEN RC=PROCERR(RC,111) %FINISH %RESULT=RC %END; ! OF READ ID ! !****************************************************** !* !* DISCARD ID !* !****************************************************** ! %SYSTEMINTEGERFN DISCARDID %INTEGER RC RC=NEWCTM DISCARDID %IF RC#0 %THEN RC=PROCERR(RC,12) %RESULT=RC %END; ! OF DISCARD ID ! !****************************************************** !* !* QUIT !* !****************************************************** ! %SYSTEMROUTINE QUIT %INTEGER RC NEWCTM STOP(0,0,-1) %END !* %SYSTEMROUTINE STOPBASE QUIT %END;! STOPBASE ! !****************************************************** !* !* JS READ !* !****************************************************** ! %SYSTEMINTEGERFN JS READ(%LONGINTEGER JSVNAME,INT,STR,NR) %INTEGER RC RC=NEWCTM JSREAD(JSVNAME,INT,STR,NR) %IF RC#0 %THEN RC=PROCERR(RC,14) %RESULT=RC %END; ! OF JS READ ! !****************************************************** !* !* JS WRITE !* !****************************************************** ! %SYSTEMINTEGERFN JS WRITE(%LONGINTEGER JSVNAME,INT,STR,NR) %INTEGER RC RC=NEWCTM JSWRITE(JSVNAME,INT,STR,NR) %IF RC#0 %THEN RC=PROCERR(RC,13) %RESULT=RC %END; ! OF JS WRITE ! !****************************************************** !* !* DATE TIME !* !****************************************************** ! %SYSTEMINTEGERFN DATE TIME(%LONGINTEGER INPUTTIME,DATE,TIME, %C %INTEGER NR) %INTEGER RC RC=NEWCTM DATE TIME(INPUTTIME,DATE,TIME,1) %IF RC#0 %THEN RC=PROCERR(RC,15) %RESULT=RC %END; ! OF DATE TIME ! ! ! ! !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! ! THE FOLLOWING ROUTINES ARE IMPLEMENTED USING ONLY ! OLD TUM PROCEDURE CALLS FOR 5X32. ! THE NEW CTM PROCEDURES ARE NOT AVAILABLE UNTIL 5X36 ! !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! !**************************************************************** !* !* LOG !* !**************************************************************** ! %SYSTEMINTEGERFN LOG(%INTEGER TYPE,NR,%LONGINTEGER MSGDESC) ! ! PARAMS --- TYPE IS THE MSG TYPE -- JOBJOURNAL=4 ! NR SHOULD ALWAYS BE 0 ! %INTEGER RC RC=ICLCTM LOG MESSAGE(TYPE,FALSE,MSGDESC) %IF RC#0 %THEN RC=PROCERR(RC,117) %RESULT=RC %END; ! OF LOG MSG ! !**************************************************** !* !* PRIME CONTINGENCY !* !**************************************************** ! %SYSTEMINTEGERFN PRIMECONTINGENCY(%LONGINTEGER ENTRY1,ENTRY2) %INTEGER RC ! RC=ICLCTM INFORM(ALL CONTINGENCIES,ENTRY1) %IF RC#0 %THEN RC=PROCERR(RC,110) %RESULT=RC %END; ! OF PRIME CONTINGENCY ! !********************************************************* !* !* READ CPU TIME !* !********************************************************* ! %SYSTEMINTEGERFN READ CPU TIME %INTEGER RC %INTEGERARRAY PT(0:1) ! RC=ICLCTM GIVE PROCESS TIME(TRUE,LONGDESC!1,ADDR(PT(0))) %IF RC#0 %THEN RC=PROCERR(RC,116) %IF RC>0 %THEN %RESULT=0 %RESULT=(PT(1)+500)//1000 %END; ! OF READ CPU TIME ! %ENDOFFILE