%RECORDFORMAT PARMF(%INTEGER DEST, SRCE, P1, P2, P3, P4, P5, P6) %EXTRINSICLONGINTEGER KMON %ROUTINESPEC PRHEX(%INTEGER H) %ROUTINESPEC PRINTER(%RECORD(PARMF)%NAME P) %EXTERNALROUTINESPEC PON(%RECORD(PARMF)%NAME P) %EXTERNALROUTINESPEC GPC(%RECORD(PARMF)%NAME P) %EXTERNALROUTINESPEC OPMESS(%STRING (23) MESS) %SYSTEMROUTINESPEC ITOE(%INTEGER A, L) %IF MULTIOCP=YES %THEN %START %EXTERNALROUTINESPEC SEMALOOP(%INTEGERNAME SEMA) %ROUTINESPEC RESERVE LOG %ROUTINESPEC RELEASE LOG %ROUTINESPEC AWAIT LOG ROUTE %FINISH !------------------------------------------------------------------------ !* COMMUNICATIONS RECORD FORMAT - EXTANT FROM CHOPSUPE 20L ONWARDS * %RECORDFORMAT COMF(%INTEGER OCPTYPE,IPLDEV,SBLKS,SEPGS,NDISCS, %C DLVNADDR,GPCTABSIZE,GPCA,SFCTABSIZE,SFCA,SFCK,DIRSITE, %C DCODEDA,SUPLVN,TOJDAY,DATE0,DATE1,DATE2, %C TIME0,TIME1,TIME2,EPAGESIZE,USERS,CATTAD,SERVAAD, %C %BYTEINTEGER NSACS,RESV1,SACPORT1,SACPORT0, %C NOCPS,RESV2,OCPPORT1,OCPPORT0, %C %INTEGER ITINT,CONTYPEA,GPCCONFA,FPCCONFA,SFCCONFA, %C BLKADDR,RATION,SMACS,TRANS,%LONGINTEGER KMON, %C %INTEGER DITADDR,SMACPOS,SUPVSN,PSTVA,SECSFRMN,SECSTOCD, %C SYNC1DEST,SYNC2DEST,ASYNCDEST,MAXPROCS,INSPERSEC,ELAPHEAD, %C COMMSRECA,STOREAAD,PROCAAD,SFCCTAD,DRUMTAD,TSLICE,FEPS, %C MAXCBT,SP1,SP2,SP3,SP4,SP5,SP6,SP7, %C LSTL,LSTB,PSTL,PSTB,HKEYS,HOOT,SIM,CLKX,CLKY,CLKZ, %C HBIT,SLAVEOFF,INHSSR,SDR1,SDR2,SDR3, %C SDR4,SESR,HOFFBIT,S2,S3,S4,END) ! ! This format describes "The Communication Record" which is kept ! locked in store at Public address X'80C00000'. It is readable at ! all ACR levels but writeable at ACR 1 only. Its purpose is to describe ! the hardware on which the EMAS System is running. Each entry is now ! described in more detail:- ! ! OCPTYPE The 2900 Processor on this configuration as follows ! 1 = 2950 or S1 ! 2 = 2960 or P2 ! 3 = 2970 or P3 ! 4 = 2980 or P4 ! 5 = 2972 or non-interleaved 2976 (P4/1) ! 6 = Interleaved 2976 or P4/1 ! ! IPLDEV The port/trunk/stream(or DCU/stream) of the ! device used at IPL time.(X'FFF' used for tape IPLS ! SBLKS The no of 128k blocks of main store present ! SEPGS The no of extended pages for paging(ie not including ! any pages occupied by resident code & data). ! NDISCS Then number of EDS drives avaliable ! DLVNADDR The address of an array which maps disc lvns to ! their ddt slots. ! GPCTABSIZE The size in bytes of the GPC (or DCU) table ! GPCA The address of the GPC (or DCU) table ! SFCTABSIZE The size of the SFC(ie DRUM) table ! SFCA The address of the SFC table ! SFCK The number of (useable) 1K page frames of Drum store ! available for paging.(0 = No drum configuration) ! DIRSITE The Director site address(eg X200) no longer reqd? ! DCODEDA The Disc Address of the Director (expressed as ! SUPLVN<<24!DIRSITE) ! SUPLVN The logical volume no of the disc from which the ! Sytem was "SLOADED". Various System components (eg ! DIRECT, VOLUMS will page from here ! ! TOJDAY Todays (Julien) day number. ! DATE0} These three integers define the current date(updated at ! DATE1} at 2400) as a character string such that ! DATE2} the length byte is in the bottom of DATE0 ! ! TIME0} These three integers define the clock time as a string ! TIME1} in the same format as for DATE. The time is updated ! TIME2} about every 2 seconds ! ! EPAGESIZE The number of 1K pages combined together to make up ! the logical "Extended Page" used in Emas.Currently=4 ! USERS The number of user processes (foreground+background) ! currently in existence.Includes DIRECT,VOLUMS&SPOOLR ! CATTAD Address of maxcat followed by category table. ! SERVAAD The address of the service array SERVA. ! NSACS The number of sacs found at grope time ! SACPORT1} Holds the Port no of the Store Access Controller(s) ! SACPORT0} found at grope time. SACPORT0 was used to IPL system. ! NOCPS The number of OCPS found at grope time. ! OCPPORT1} Hold the Port no of the OCPs found at grope time. ! OCPPORT0} OCPPORT0 was used to IPL the system. ! ITINT The Interval Timer interval in microsecs. Varies ! between different members of the range ! CONTYPEA The address of a 31 byte area containing the codes ! of the controllers in port-trunk order. Codes are:- ! 0 = Not relevant to EMAS ! 1 = SFC1 ! 2 = FPC2 ! 3 = GPC1 ! ! GPCCONFA} These three variables each point to a word array ! FPCCONFA} containing controller data. The first word in each ! SFCCONFA} case says how many controllers on the system. The ! remainder have Port&Trunk in top byte and Public ! segment no of comms segment in bottom byte. For GPCS ! the Public Seg no is apparently omitted! ! BLKADDR The address of first element of a word array bounds ! (1:SBLKS) containing the real address of each 128K ! block of main store. Real addresses are in the form ! RSN/SMAC NO/Address in SMAC ! RATION Information maintained by DIRECT concerning access ! rationing. Bytes from left indicate scarcity, ! pre-empt point, zero and interactive users ! respectively ! SMACS A bit mask of SMACS found at Grope time ! 2**0 bit set if SMAC 0 found etc ! TRANS The address of a 512 byte area containing 2 translate ! tables. The first is ISO to EBCDIC the second the ! exact converse ! KMON A 64 bit bitmask controlling monitoring of Kernel ! services. Bit 2**n means monitor service n. Bits can ! be set by Operator command KMON. ! DITADDR Disc index table address. The address of first ! element of an array(1:NDISCS) containing the address ! of the disc device entries. Needed for S series and ! provided for compatablity on P series ! SMACPOS The no of places that the Smac no must be left ! shifted to be in the right position to access ! a Smac image store location. Incredibly this varies ! between the 2980 and others!! ! SUPVSN The Supervisor id no as a three char string eg 22A ! PSTVA The virtual address of the Public Segment table which ! is itself a Public segment. All other information ! about PST can be found by looking at its own PST entry ! SECSFRMN The no of Seconds since midnight. Updated as for TIME ! SECSTOCD The number of seconds to System closedown if positive ! If zero or negative no close down time has yet been ! notified. Updated as for TIME ! SYNC1DEST} These are the service nos N2,N3 & N4 for process ! SYNC2DEST} parameter passing described in Supervisor Note 1 ! ASYNCDEST} ! MAXPROCS The maximum number of paged processes that the ! Supervisor is configured to run. Also the size ! of the Process array. ! INSPERSECS The number of instructions the OCP executes in 1 ! second divided by 1000(Approx average for EMAS) ! ELAPHEAD The head of a linked list of param cells holding ! service with an elapsed interval interrupt request ! outstanding ! COMMSRECA The address of an area containing details of the ! Communication streams.(private to COMMS Control) ! STOREAAD The address of first element of the store record array ! bounds (0:SEPGS-1) ! PROCAAD The address of first element of the process record ! array bounds(0:MAXPROCS) ! SFCCTAB} The addresses of two private tables provided by grope ! DRUMTAD} for use by the routine DRUM. They give details of ! the SFCS and DRUMS found on the system ! TSLICE Time slice in microsecs. Supervisor has to allow for ! differences in interval timer speeds accross the range ! FEPS Bits 0-15 are a map of FEPs found at grope time. ! 2**16 bit set if FE0 found etc. ! Bits 16-31 are a map of currently available FEPs. ! 2**0 bit set if FE0 available etc. ! MAXCBT Maximum cbt entry ! SP1->SP7 Spare locations ! LSTL} ! LSTB} ! PSTL} ! PSTB} These are the image store addresses for the following ! HKEYS} control registers:- ! HOOT} Local Segment Table Limit & Base ! SIM } Public Segment Table Limit & Base ! CLKX} Handkeys,Hooter System Interrupt Mask Register ! CLKY} and the clock X,Y & Z Registers ! CLKZ} ! HBIT A bit pattern that when ORed into Control Register ! "HOOT" operates the Hooter.(0=Hooterless machine) ! SLAVEOFF A bit pattern (top 16 bits) and Image store address ! in bottom 16 bits. ORing the top 16 bits(after ! shifting) into the image store will stop all slaving of ! operands but not instructions ! INHSSR A bit pattern and image location as for SLAVEOFF. ! ORing the bits into the location will switch off ! reporting of successful system retry ! SDR1} ! SDR2} The image store addresses of SMAC internal registers ! SDR3} needed by the Engineers after Smac errors have ! SDR4} occurred ! SESR} ! HOFFBIT A bit pattern that when ORed into a Smac Engineers ! status register will stop reporting of error ! from that Smac %CONSTRECORD(COMF)%NAME COM=X'80C00000' %SYSTEMROUTINE MOVE(%INTEGER LENGTH, FROM, TO) *LB_LENGTH; *JAT_14, *LDTB_X'18000000'; *LDB_%B; *LDA_FROM *CYD_0; *LDA_TO; *MV_%L=%DR L99: %END; ! OF MOVE %CONSTBYTEINTEGERARRAY H(0 : 15) = %C '0','1','2','3','4','5','6','7','8','9', 'A','B','C','D','E','F' %EXTERNALSTRING (8) %FN STRHEX(%INTEGER VALUE) %STRING (8) S *LD_S; *LSS_8; *ST_(%DR) *INCA_1; *STD_%TOS; *STD_%TOS *LSS_0; *LUH_VALUE *MPSR_X'24'; ! SET CC=1 *SUPK_%L=8 *LD_%TOS; *ANDS_%L=8,0,15; ! THROW AWAY ZONE CODES *LSS_H+4; *LUH_X'18000010' *LD_%TOS; *TTR_%L=8 %RESULT =S %END %EXTERNALSTRING (8) %FN HTOS(%INTEGER VALUE, PLACES) %STRING (8) S %INTEGER I %IF PLACES>8 %THEN PLACES=8 I=64-4*PLACES *LD_S; *LSS_PLACES; *ST_(%DR) *INCA_1; *STD_%TOS; *STD_%TOS *LSS_VALUE; *LUH_0; *USH_I *MPSR_X'24'; ! SET CC=1 *SUPK_%L=8 *LD_%TOS; *ANDS_%L=8,0,15; ! THROW AWAY ZONE CODES *LSS_H+4; *LUH_X'18000010' *LD_%TOS; *TTR_%L=8 %RESULT =S %END !----------------------------------------------------------------------- %EXTERNALSTRING (15) %FN STRINT(%INTEGER N) %STRING (16) S %INTEGER D0, D1, D2, D3 *LSS_N; *CDEC_0 *LD_S; *INCA_1; ! PAST LENGTH BYTE *CPB_%B; ! SET CC=0 *SUPK_%L=15,0,32; ! UNPACK 15 DIGITS SPACE FILL *STD_D2; ! FINAL DR FOR LENGTH CALCS *JCC_8,; ! N=0 CASE *LSD_%TOS; *ST_D0; ! SIGN DESCRIPTOR STKED BY SUPK *LD_S; *INCA_1 *MVL_%L=15,15,48; ! FORCE IN ISO ZONE CODES %IF N<0 %THEN BYTEINTEGER(D1)='-' %AND D1=D1-1 BYTEINTEGER(D1)=D3-D1-1 %RESULT =STRING(D1) WASZERO: %RESULT ="0" %END %EXTERNALROUTINE PKMONREC(%STRING(20)TEXT,%RECORD(PARMF)%NAME P) %INTEGER I, J, SPTR, VAL %STRING (131) S S=TEXT SPTR=LENGTH(S)+1 CHARNO(S,SPTR)=' '; SPTR=SPTR+1 %CYCLE I=ADDR(P),4,ADDR(P)+28 VAL=INTEGER(I) %CYCLE J=28,-4,0 CHARNO(S,SPTR)=H((VAL>>J)&15) SPTR=SPTR+1 %REPEAT CHARNO(S,SPTR)=' ' SPTR=SPTR+1 %REPEAT %CYCLE I=ADDR(P)+8,1,ADDR(P)+31 J=BYTEINTEGER(I) %IF J<32 %OR J>95 %THEN J='_' CHARNO(S,SPTR)=J SPTR=SPTR+1 %REPEAT CHARNO(S,SPTR)=NL LENGTH(S)=SPTR PRINTSTRING(S) %END %EXTERNALINTEGERFN REALISE(%INTEGER AD) !*********************************************************************** !* THIS FUNCTION TAKES A VIRTUAL ADDRESS AND VIA SEGMENT AND PAGE * !* TABLES RETURNS THE CORRESPONDING REAL ADDRESS. * !* NOTE: NO FACILITY FOR SHARED SEGMENTS CURRENTLY REQD. * !*********************************************************************** %CONSTINTEGER RA128=X'0FFFFF80'; ! 128 BYTE ALIGNED MASK FOR NON-PAGED SEGMENT ENTRY %CONSTINTEGER RA8=X'0FFFFFF8'; ! 8 BYTE ALIGNED MASK FOR PAGED SEGMENT ENTRY %CONSTINTEGER RA1024=X'0FFFFC00'; ! PAGE ALIGNED MASK FOR PAGE TABLE ENTRY %CONSTINTEGER PST VA=X'80040000'; ! SEGMENT TABLE BASE ADDRESS %CONSTINTEGER PUBLIC=X'80000000'; ! THESE TWO MAKE UP REAL CORE BASE ADDRESS, %CONSTINTEGER SEG64=X'01000000'; ! WHICH IS AT PSEG 64 %CONSTINTEGER PAGEDBIT=X'40000000' %INTEGER VASE; ! VIRTUAL ADDRESS OF SEGMENT TABLE ENTRY %INTEGER VAPE; ! VIRTUAL ADDRESS OF PAGE TABLE ENTRY VASE=PST VA+(AD>>15)&X'FFF8' %IF INTEGER(VASE)&PAGEDBIT#0 %START; ! PAGED SEGMENT VAPE=((INTEGER(VASE+4)&RA8)+SEG64+(AD<<14>>24)<<2)! PUBLIC ! ! IF WE HAVE TRUTHFUL SEGMENT TABLES ! (CURRENTLY WE DO NOT - SEE CHOPSUPE ROUTINE 'CONFIG') ! THEN LEST STORE BE DISCONTIGUOUS :- ! VAPE=VAPE-(INTEGER(PST VA+((VAPE>>15)&X'FFF8')+4)&X'20000') ! %RESULT =INTEGER(VAPE)&RA1024+(AD&X'3FF') %FINISH ! UN-PAGED SEGMENT %RESULT =(AD&X'3FFFF')+(INTEGER(VASE+4))&RA128 %END !! %CONSTSTRING(8) %NAME DATE=X'80C0003F' %CONSTSTRING(8) %NAME TIME=X'80C0004B' !! %INTEGERFN I2(%INTEGER AD) !AD POINTS TO THE FIRST OF A PAIR OF DECIMAL CHARACTERS. THE RESULT !IS THE NUMERIC VALUE OF THE CHAS %RESULT =10*(BYTEINTEGER(AD)&X'F')+(BYTEINTEGER(AD+1)& %C X'F') %END; !OF I2 !! %EXTERNALROUTINE DUMPTABLE(%INTEGER TABLE, ADD, LENGTH) %OWNINTEGER NEXT %INTEGER I, K, END, SPTR, VAL %STRING (132) S ADD=ADD&(-4) %IF MULTIOCP=YES %THEN RESERVE LOG NEWLINE %IF TABLE>0 %THEN %START NEXT=NEXT+1 PRINTSTRING("DT: ".DATE." ".TIME." **** SUPERVISOR DUMP TABLE: ". %C STRINT(TABLE)." ADDR ".STRHEX(ADD)." LENGTH: " %C .STRINT(LENGTH)." DUMP NO: ".STRINT(NEXT)."**** ") %FINISH END=ADD+LENGTH; I=1 S=" " %UNTIL ADD>=END %CYCLE ->INVL %IF ADD>=0; ! DUMP PUBLIC ADDRESSES ONLY *LDTB_X'18000020'; *LDA_ADD *VAL_(%LNB+1); *JCC_3, %IF I=0 %THEN %START %CYCLE K=ADD,4,ADD+28 ->ON %IF INTEGER(K)#INTEGER(K-32) %REPEAT S="O"; ->UP %FINISH ON: CHARNO(S,2)='('; SPTR=3 %CYCLE I=28,-4,0 CHARNO(S,SPTR)=H((ADD>>I)&15) SPTR=SPTR+1 %REPEAT CHARNO(S,SPTR)=')' CHARNO(S,SPTR+1)=' ' SPTR=SPTR+2 %CYCLE K=ADD,4,ADD+28 VAL=INTEGER(K) %CYCLE I=28,-4,0 CHARNO(S,SPTR)=H((VAL>>I)&15) SPTR=SPTR+1 %REPEAT CHARNO(S,SPTR)=' ' SPTR=SPTR+1 %REPEAT %IF TABLE>=0 %THEN %START CHARNO(S,SPTR)=' ' SPTR=SPTR+1 %CYCLE K=ADD,1,ADD+31 I=BYTEINTEGER(K)&X'7F' %UNLESS 32<=I<=127 %THEN I=' ' CHARNO(S,SPTR)=I SPTR=SPTR+1 %REPEAT %FINISH CHARNO(S,SPTR)=NL BYTEINTEGER(ADDR(S))=SPTR PRINTSTRING(S) S=" " UP: ADD=ADD+32 I=0 %REPEAT ->WAYOUT INVL: PRINTSTRING("ADDRESS VALIDATION FAILS ") WAYOUT: ! EXIT FREEING PATH %IF MULTIOCP=YES %THEN RELEASE LOG %END; !ROUTINE DUMP ! OWN VARIABLES FOR JOINT USE BY 'IOCP' AND 'PRINTER' %CONSTINTEGER MASK=X'80FC3FFF', BUFFBASE=X'80FC0000', PAGEMASK= %C X'80FC3000' %EXTERNALINTEGER INPTR=X'80FC0000' %EXTERNALINTEGER OUTPTR=X'80FC0000' %OWNINTEGER BUSY, DINTPEND=0, INTPEND, TESTPEND=0, INIT=0 %OWNINTEGER MODE=-1 %CONSTINTEGER SPOOLING=1, PRINTING=0 %IF MULTIOCP=YES %THEN %START %OWNINTEGER LOGSEMA=-1 ; ! SEMAPHORE FOR IOCP AND PRINTER %OWNINTEGER LOGROUTE=0; ! BOTTOM HALF HAS COUNT ! IF COUNT>0 TOPHALF HAS OCP PORT %EXTERNALROUTINE RESERVE LOG !*********************************************************************** !* CLAIMS THE LOG FOR CALLING ROUTINE. WAITS IF NEEDED. THIS ROUTINE* !* IS USED IN DUALS TO PREVENT TABLES BEING MIXED UP * !* NESTED CLAIMS AND RELEASE BY SAME OCP ARE PERMITTED * !*********************************************************************** %INTEGER MYPORT *LSS_(3); *USH_-26 *AND_3; *ST_MYPORT; ! PORT OF OCP EXECUTING THIS *INCT_LOGSEMA *JCC_8, SEMALOOP(LOGSEMA) LSEMAGOT: %IF LOGROUTE&X'FFFF'=0 %THEN ->WAYOUT %IF LOGROUTE>>16=MYPORT %THEN ->WAYOUT LOGSEMA=-1 AWAIT LOG ROUTE WAYOUT: LOGROUTE=(LOGROUTE&X'FFFF'+1)!MYPORT<<16 LOGSEMA=-1 %END %EXTERNALROUTINE RELEASE LOG !*********************************************************************** !* RELEASE THE LOG PATH * !*********************************************************************** %INTEGER MYPORT *LSS_(3); *USH_-26 *AND_3; *ST_MYPORT; ! PORT OF OCP EXECUTING THIS *INCT_LOGSEMA *JCC_8, SEMALOOP(LOGSEMA) LSEMAGOT: %IF LOGROUTE&X'FFFF'=0 %OR LOGROUTE>>16#MYPORT %THEN %C OPMESS("LOGROUTE PATHS ? ".STRHEX(LOGROUTE)) %C %ELSE LOGROUTE=LOGROUTE-1 LOGSEMA=-1 %END %ROUTINE AWAIT LOG ROUTE !*********************************************************************** !* AWAITS LOGROUTE COMING FREE AND RETURNS WITH LOGSEMA HELD * !* TIMES OUT AFTER ABOUT 5 SECS ON 2970 * !*********************************************************************** %INTEGER MYPORT,I,J %IF MONLEVEL&4#0 %START %EXTRINSICLONGINTEGER SEMATIME %INTEGER IT *LSS_(5); *ST_IT %FINISH *LSS_(3); *USH_-26 *AND_3; *ST_MYPORT; ! PORT OF OCP EXECUTING THIS %CYCLE J=1,1,2000 %CYCLE I=1,1,COM_INSPERSEC; ! WAIT ABOUT 1 MILLESEC %REPEAT; ! DONT USE RTC IN CASE OTHER ! OCP HAS CLOCK&HAS DIED *INCT_LOGSEMA *JCC_8, SEMALOOP(LOGSEMA) LSEMAGOT: %IF LOGROUTE&X'FFFF'=0 %THEN ->WAYOUT LOGSEMA=-1 %REPEAT OPMESS("LOGROUTE TIMEOUT") LOGROUTE=0; ! HAVE TIMED OUT WAYOUT: %IF MONLEVEL&4#0 %START; ! RECORD WASTED TIME *LSS_(5); *IRSB_IT; *IMYD_1 *IAD_(SEMATIME); *ST_(%DR) %FINISH %END %FINISH %SYSTEMROUTINE IOCP(%INTEGER EP, N) !*********************************************************************** !* THIS ROUTINE RECEIVES ALL THE OUTPUT FROM MAIN VIA IMP STMTS * !* SUCH AS PRINTSTRING, AND SENDS IT TO THE MAIN PRINT FILE. * !* SEGMENT P63 IS USED AS THE BUFFER. IF OUTPUT ARRIVES FASTER * !* THAN THE PRINTER CAN COPE IT IS DISCARDED. * !* A SIMILAR ROUTINE IN SLOWFILE IS USED WITH A VIRTUAL PRINTER * !*********************************************************************** %RECORD(PARMF) Q %INTEGER I, J, ADR, L, OLDINPTR, SYM, NLSEEN, MYPORT, MYMASK %STRING (63) S %RETURN %UNLESS X'280A8'&1<>8&63 ADR=ADDR(S)+1 ! J = L ! %WHILE J > 0 %CYCLE ! CHARNO(S,J) = N&127 ! J = J-1 ! %REPEAT ! ! EQUIVELANT OF ABOVE 5 LINES IS ! J=N&127 I=X'18000000'!L *LDTB_I *LDA_ADR *LB_J *MVL_%L=%DR %FINISH %ELSE %START %IF EP>=7 %THEN %START; ! PRINT STRING L=BYTE INTEGER(N); ADR=N+1 %FINISH %ELSE %START; ! PRINT SYMBOL & PRINT CH L=1; ADR=ADDR(N)+3 %FINISH %FINISH ! ! NOW PUT MESSAGE INTO BUFFER IF THERE IS ROOM ! I=1 %IF MULTIOCP=YES %THEN %START *INCT_LOGSEMA *JCC_8, SEMALOOP(LOGSEMA) SEMAGOT: %FINISH ! ! CHECK AND AWAIT THE LOGROUTE IN DUALS EXCEPT FOR SYSTEM ERRORS ! THE OTHER OCP IS HALTED HERE, SO NO POINT IN WAITING ! ALSO SYSTEM ERROR IN SINGLES CAN BREAK INTO DEVICE ERROR ! SO JOURNAL SYSTEM HAS TO BE ABLE TO COPE WITH THIS. ! %IF MULTIOCP=YES %AND LOGROUTE&X'FFFF'>0 %START *LSS_(3); *ST_MYMASK; *USH_-26; *AND_3; *ST_MYPORT %IF MYPORT#LOGROUTE>>16 %AND MYMASK&1=0 %THEN %C LOGSEMA=-1 %AND AWAIT LOG ROUTE %FINISH OLDINPTR=INPTR %WHILE I<=L %CYCLE ->END %IF BUSY=1; ! BUFFERS BUSY DISCARD OUTPUT J=(INPTR+1)&MASK %IF J&X'FFF'<=63 %THEN INPTR=J!63 %AND J=INPTR+1 %IF J#OUTPTR %THEN %START; ! ROOM FOR CURRENT CHAR SYM=BYTE INTEGER(ADR) BYTE INTEGER(J)=SYM %IF SYM=133 %THEN SYM=NL %IF SYM=NL %THEN NLSEEN=1 ADR=ADR+1; I=I+1 INPTR=J %FINISH %ELSE BUSY=1 %AND ->END %REPEAT ! ! PON A KICK TO PRINTER IF A LINE (OR PAGE IN DISC MODE) HAS BEEN COMPLETED ! AND PRINTER IS IDLE. HOWEVER IF REPORTING A RECOVERED ERROR (IE SYSERR ! INT IS MASKED OUT) REFRAIN FROM PONNING. RECOVERED ERROR MIGHT BE ! A SINGLE BIT OR RETRY FROM PON OR POFF ! *LSS_(3); *AND_1; *JAF_4,;! JUMP IF SYSERR MASKED %IF (OLDINPTR=OUTPTR %AND NLSEEN#0) %C %OR (MODE=SPOOLING %AND INPTR&PAGEMASK#OLDINPTR& %C PAGEMASK) %THEN Q_DEST=X'360000' %AND PON(Q) END: %IF MULTIOCP=YES %THEN LOGSEMA=-1 %END; ! OF ROUTINE IOCP !! %EXTERNALROUTINE PRINTER(%RECORD(PARMF)%NAME P) !*********************************************************************** !* THIS (OVER ELABORATE) VERSION OF PRINTER SUPPORTS BOTH A REAL * !* PRINTER AND A VIRTUAL (DISC) PRINTER ALLOWING SWITCHING BETWEEN * !* THE TWO AT ANY TIME. THIS WAS USEFUL IN DEVELOPMENT BUT IN A * !* SERVICE SITUATION A DISC ONLY VERSION WOULD BE SAMLLER AND EASIER* !* TO MAINTAIN. * !*********************************************************************** %ROUTINESPEC INITIALISE FILE %ROUTINESPEC CHANGE FILE %ROUTINESPEC DISCWRITE(%INTEGER AD) %ROUTINESPEC PREPORT(%INTEGER VALUE) %ROUTINESPEC DEALLOCATE MAIN PRINTER(%INTEGER REPLY ACT) %ROUTINESPEC ALLOCATE MAIN PRINTER(%INTEGER REPLY ACT) %INTEGER I, J, ACT, DMON, PAGE, PREVMODE %OWNINTEGER BUFFERAD=-1 ! RCB - REQUEST BLOCK TO PRINT LINES ON MAIN PRINTER %RECORDFORMAT RCBF(%INTEGER LFLAG,LSTBA,LBL,LBA,ALL,ALA,INITWRD,SPARE) %OWNRECORD(RCBF)%NAME RCB %OWNINTEGER PAGESTATE = 0; ! BITMASK OF PAGES WITH TRANSFERS %CONSTINTEGER PONSRC=X'360000' %CONSTINTEGER GPCSNO=X'300000' %CONSTINTEGER AUTO=X'8000' %OWNINTEGER LBE=X'80700300', ALE1, ALE2 %OWNINTEGER MNEM=M'LP', ACTSIZE=0 %OWNINTEGER DPAGE=0; ! DISC ADDRESS %OWNINTEGER CFILE=0, SECTSIZE=0 %OWNINTEGERARRAY DPAGES(0 : 1) = -1(2) %OWNINTEGER DISCDEST,TRANSTABAD=0 ! FILE HEADER BLOCK %RECORDFORMAT HDRF(%INTEGER HDR1,HDR2,HDR3,HDR4,HDR5,HDR6,HDR7,HDR8) %RECORDFORMAT ENTFORM(%INTEGER SER, PTSM, PROPADDR, %C TICKS SINCE, CAA, GRCB AD, LBA, ALA, STATE, RESP0, %C RESP1, SENSE1, SENSE2, SENSE3, SENSE4, REPSNO, BASE, %C ID, DLVN, MNEMONIC, ENTSIZE, PAW, USAW0, URCB AD, %C SENSDAT AD, LOGMASK, TRTAB AD, UA SIZE, UA AD, %C TIMEOUT, PROPS0, PROPS1) %RECORD(ENTFORM)%NAME D %OWNSTRING (8) OLDDATE, OLDTIME %OWNINTEGER OLDPDT %OWNINTEGER SOURCE8 %CONSTINTEGER MAXACT=10 %SWITCH DACT(0:MAXACT) !! !! !! %IF INIT=0 %THEN %START; ! FIRST TIME IN - INITIALISE ALLOCATE MAIN PRINTER(10) INIT=-1 %FINISH !! !! !! ACT=P_DEST&255 %IF ACT>MAXACT %THEN ACT=0; ! DONT REPORT FOR FEAR OF STARTING LOOP %IF MONLEVEL&2#0 %THEN DMON=KMON>>54&1 %IF MONLEVEL&2#0 %AND DMON#0 %AND ACT#0 %AND %C (ACT#2 %OR P_P1&X'800000'=0) %THEN PKMONREC("PRINT( IN):",P) ! DONT MONITOR CLOCK OR NORMAL TERMS ->DACT(ACT) !! !**************************************** !! NEXTLINE: %IF MODE=PRINTING %THEN BYTEINTEGER(BUFFERAD)=0 !! !!------------------------------------------------ DACT(0): ! ALARM CLOCK TICK OR EQUIVALENT %IF MULTIOCP=YES %THEN %START *INCT_LOGSEMA *JCC_8, SEMALOOP(LOGSEMA) SEMAGOT1: %FINISH %IF MODE=SPOOLING %START I=OUTPTR %CYCLE J=1,1,4 %IF (I-1)<=INPTR<(I+4096)&X'FFFFFFC0' %C %AND BUSY=0 %THEN %START %IF MULTIOCP=YES %THEN LOGSEMA=-1 %RETURN %FINISH PAGE=(I-BUFFBASE)//(EPAGESIZE*1024) %IF PAGESTATE&(1<UNBUSY; ! NOTHING TO PRINT ! CHECK WE WERE NOT INHIBITED I=BYTEINTEGER(BUFFERAD) %CYCLE J=BYTE INTEGER(OUTPTR) BYTE INTEGER(OUTPTR)=0 %IF J=10 %THEN J=133 %IF J=133 %OR J=12 %OR I=132 %START %IF I=132 %THEN BYTEINTEGER(OUTPTR)=J %C %AND J=133 %ELSE %START OUTPTR=(OUTPTR+1)&MASK %IF OUTPTR&X'FFF'<=63 %THEN OUTPTR=OUTPTR+64 %FINISH I=I+1; BYTEINTEGER(BUFFERAD+I)=J BYTEINTEGER(BUFFERAD)=I ALE1=X'58000000'+I ITOE(ALE2,I) %IF TRANSTABAD#0 %START *LD_ALE1 *LSS_TRANSTABAD *LUH_X'18000100' *TTR_%L=%DR; ! NON-PRINTABLES TO NULL %FINISH %EXIT %FINISH OUTPTR=(OUTPTR+1)&MASK %IF OUTPTR&X'FFF'<=63 %THEN OUTPTR=OUTPTR+64 %IF J#13 %THEN I=I+1 %AND BYTEINTEGER(BUFFERAD+I)=J %IF INPTR=OUTPTR %THEN BYTEINTEGER(BUFFERAD)=I %AND ->UNBUSY ! INCOMPLETE LINE %REPEAT %IF MULTIOCP=YES %THEN LOGSEMA=-1 PRINT: ! PRINT LINE IN ARRAY BUFFER(AGAIN) P=0 P_DEST=GPCSNO!12 P_SRCE=PONSRC!5 P_P1=ADDR(RCB) P_P2=INIT P_P3=X'11'; ! PAW = DO STREAM REQ,SAW - CLEAR ABNORMAL PON(P) INTPEND=1 %RETURN !! !!----------------------------------------------- DACT(5): ! EXECUTE REQUEST IS REJECTED !! PREPORT(P_P1) INTPEND=0 %RETURN !! !!----------------------------------------------- DACT(1): ! NEW LOG FILE ! P_P1=NO OF EPAGES (16) ! P_P2=DISC ADDR %IF MONLEVEL&2#0 %AND DMON=1 %THEN %C OPMESS("NEW LOG FILE ".HTOS(P_P2,8)) SECTSIZE=P_P1<<12 %IF DPAGES(0)>0 %AND DPAGES(1)>0 %START PRINTSTRING("SPURIOUS LOG FILE") %RETURN %FINISH %IF DPAGES(CFILE)=0 %THEN DPAGES(CFILE)=P_P2 %C %ELSE DPAGES((CFILE+1)&1)=P_P2 %IF DPAGE=0 %THEN INITIALISE FILE ->NEXTLINE !! !!------------------------------------------------ !! PRINTER INTERRUPTS TERMS&ATTNS, COME HERE DACT(2): J=(P_P1>>20)&15 %IF J=1 %START; ! ATTENTION %IF TESTPEND#0 %AND P_P1&AUTO#0 %C %THEN TESTPEND=0 %AND ->PRINT %RETURN; ! IGNORE ALL OTHER ATTENTIONS %FINISH INTPEND=0 !! !! MAY BE WAITING FOR LP TERM. BEFORE DEALLOCATING TO AVOID !! A SPURIOUS TERM. GOING TO THE NEXT OWNER !! %IF MODE=SPOOLING %THEN %START DEALLOCATE MAIN PRINTER(9) %RETURN %FINISH !! %IF J=8 %THEN ->NEXTLINE; ! NORM TERM. ! ABNORMAL TERM. OPMESS("ATTEND MAIN LP") TESTPEND=1; %RETURN !! !!------------------------------------------------ !! RESET TO PRINTER - AFTER D/MAINLP (OBEYING ALLOCATION RULES) !! DACT(8): SOURCE8=P_SRCE %IF MODE#PRINTING %THEN ALLOCATE MAIN PRINTER(3) %AND %RETURN P_P1=81; ! DIR ERROR "ALREADY MAIN LP" DACT(3): ! REPLY FROM ABOVE ALLOCAT P_DEST=SOURCE8 P_SRCE=PONSRC!8 %IF 0#P_P1#81 %THEN P_P1=95; ! DIR ERR "MAIM LP FAILS" PON(P) %RETURN %IF P_P1\=0; ! NO ALLOCATE DONE DACT(10): ! REPLY FROM INITIAL ALLOCATE EXIT6: %IF P_P1#0 %THEN PREPORT(P_P1) %AND %RETURN D==RECORD(P_P3) BUFFERAD=D_UA AD+32 ALE2=BUFFERAD+1 RCB==RECORD(D_UA AD) TRANSTABAD=D_TRTABAD RCB=0 RCB_LBL=4 RCB_LBA=ADDR(LBE) RCB_ALL=8 RCB_ALA=ADDR(ALE1) INIT=P_P2 MNEM=P_P6 MODE=PRINTING %IF MULTIOCP=YES %THEN %START *INCT_LOGSEMA *JCC_8, SEMALOOP(LOGSEMA) SEMAGOT4: %FINISH CHANGE FILE %IF DPAGE>0 %IF MULTIOCP=YES %THEN LOGSEMA=-1 INTPEND=0 ->NEXTLINE !! !!---------------------------------- !! DACT(6): ! EMERGENCY RESET BY HAIRY PON ! NO REPLY. USE EMERGENCY ALLOCATE P_DEST=GPCSNO!8; ! EMERGENCY ALLOCATE P_P1=M'LP'; ! ANY LP WILL DO P_P2=PONSRC!2 GPC(P); ! DIRECT CALL FOR EMERGENCY ALLOCATE ->EXIT6; !!---------------------------------------------------- DACT(7): ! CLOSE CURRENT OUTPUT %IF MONLEVEL&2#0 %AND DMON = 1 %THEN %C OPMESS("NLF ".HTOS(INPTR,8)." ".HTOS(OUTPTR,8)) PREVMODE=MODE DISCDEST=P_SRCE %IF MULTIOCP=YES %THEN %START *INCT_LOGSEMA *JCC_8, SEMALOOP(LOGSEMA) SEMAGOT5: %FINISH %IF MODE=SPOOLING %START BYTEINTEGER((INPTR+1)&MASK)=4; ! EOM CHARACTER DISCWRITE(OUTPTR) ! SUBTRACT UNUSED SPACE ACTSIZE=ACTSIZE-(X'1000'-((INPTR&X'FFF')+1)) INPTR=((INPTR+4096)&MASK)!63; ! MOVE ONTO NEXT PAGE CHANGE FILE %FINISH %ELSE %START; ! ZERO FRONT OF FIRST PAGE %IF INPTR>12=OUTPTR>>12 %START BUSY=1 I=(INPTR&PAGEMASK)!64 %WHILE I<=OUTPTR %CYCLE BYTEINTEGER(I)=0 I=I+1 %REPEAT %FINISH MODE=SPOOLING %IF DPAGES(0)=-1=DPAGES(1) %THEN CHANGE FILE %C %ELSE INITIALISE FILE ! ACT TO ACQUIRE NEW FILES IF NECCESARY %FINISH %IF MULTIOCP=YES %THEN LOGSEMA=-1 %IF PREVMODE=PRINTING %THEN DEALLOCATE MAIN PRINTER(9) ->NEXTLINE !! !!------------------------------------------------ DACT(4): ! DISC TERMINATION %IF DINTPEND=0 %START PRINTSTRING(" SPURIOUS LOG DISC INT ") %RETURN %FINISH DINTPEND=DINTPEND-1 PAGESTATE=PAGESTATE&(X'FFFFFFFF'!!(1< SEMALOOP(LOGSEMA) SEMAGOT6: %FINISH %IF P_P2#0 %START; ! ABNORMAL TERMINATION OPMESS(" LOG FILE ABTERM ".HTOS(P_P2,2)) DINTPEND=0; ! FORGET OTHER TRANSFERS OUTSTANDING ON FAULTY FILE PAGESTATE=0 CHANGE FILE %FINISH %CYCLE PAGE=(OUTPTR-BUFFBASE)//(EPAGESIZE*1024) %EXIT %IF PAGESTATE&(1<UNBUSY %IF OUTPTR-1<=INPTR<(OUTPTR+4096) %REPEAT %IF MULTIOCP=YES %THEN LOGSEMA=-1 %RETURN !!------------------------------ !! DACT(9): ! REPLY FROM DELLOCATE ! AFTER SWITCH TO SPOOLING %IF P_P1#0 %THEN PREPORT(P_P1) TESTPEND=0 BUFFERAD=-1 %RETURN !! !!------------------------------------------------- !! UNBUSY: ! RESTART IF BUFFER OFLOW OCCURRED ! LOGSEMA IS CLAIMED %IF BUSY=1 %THEN %START %IF MODE=SPOOLING %THEN INPTR=OUTPTR %IF MONLEVEL&2#0 %AND DMON = 1 %THEN OPMESS("UNBUSY") BUSY=0 I=-1 %FINISH %ELSE I=0 %IF MULTIOCP=YES %THEN LOGSEMA=-1 %IF I=-1 %THEN PRINTSTRING(" *** OUTPUT LOST *** ") %RETURN %ROUTINE INITIALISE FILE !*********************************************************************** !* SEMA MUST BE CLAIMED BEFORE CALLING THIS * !*********************************************************************** %RETURN %UNLESS MODE=SPOOLING ACTSIZE=0 OUTPTR=(OUTPTR&PAGEMASK)!64 %IF BUSY=1 %THEN INPTR=OUTPTR-1 ! PACK DATE AND TIME OLDPDT=((I2(X'80C00046')-70)<<26)!(I2(X'80C00043')<<22) %C !(I2(X'80C00040')<<17)!(I2(X'80C0004C')<<12)!(I2( %C X'80C0004F')<<6)!I2(X'80C00052') OLDTIME=TIME OLDDATE=DATE DPAGE=DPAGES(CFILE) %END %ROUTINE CHANGEFILE !*********************************************************************** !* SEMA MUST BE HELD BEFORE CALLING THIS. CAN NOT LET OTHER OCP IN * !* WHILE CHANGING FILES * !* CLOSE CURRENT SPOOL FILE AND REQUEST ANOTHER ONE * !* IF BOTH FILES CLOSED , REQUESTS HAVE ALREADY BEEN SENT, SO RETURN* !*********************************************************************** %RETURN %IF DPAGES(0)=0 %AND DPAGES(1)=0 %RETURN %IF ACTSIZE=0 %AND DPAGE#0; ! NO EMPTY FILES AGN: %IF MONLEVEL&2#0 %AND DMON=1 %THEN %C OPMESS("CHANGE FILE ".HTOS(DPAGE,8)." ".HTOS(ACTSIZE,6)) P=0 P_DEST=DISCDEST P_SRCE=PONSRC!1 P_P1=DPAGE P_P2=ACTSIZE PON(P) ACTSIZE=0 DPAGES(CFILE)=0; ! MARK FILE CLOSED CFILE=(CFILE+1)&1; ! CHANGE TO ALTERNATE FILE DPAGE=DPAGES(CFILE) %IF DPAGE>0 %THEN INITIALISE FILE %ELSE %START %IF DPAGE=-1 %THEN DPAGE=0 %AND ->AGN %FINISH %END %ROUTINE DISCWRITE(%INTEGER AD) !*********************************************************************** !* SEMA MUST BE HELD FOR CALL OF CHANGE FILE * !*********************************************************************** %RECORD(HDRF)%NAME HDR %STRING (32) SHEAD AD=AD&PAGEMASK P=0 P_P1=(AD>>12)&3; ! BLOCK 0:3 ! RETURN UNLESS NO FILE AVAILABLE OR PAGE ALREADY SENT %RETURN %IF DPAGE<=0 %OR PAGESTATE&(1<=SECTSIZE %THEN CHANGE FILE %C %ELSE DPAGE=DPAGE+1 %END %ROUTINE PREPORT(%INTEGER VALUE) OPMESS("MLP ACTIVITY ".STRINT(ACT)." FAILS ".STRINT(VALUE)) %END %ROUTINE DEALLOCATE MAIN PRINTER(%INTEGER REPLY ACT) %RECORD(PARMF) Q %IF INTPEND#0 %THEN %RETURN Q=0; Q_DEST=GPCSNO!5 Q_SRCE=PONSRC!REPLYACT Q_P1=MNEM PON(Q) %END %ROUTINE ALLOCATE MAIN PRINTER(%INTEGER REPLYACT) %RECORD(PARMF) Q Q=0; Q_DEST=GPCSNO!11 Q_P1=MNEM; Q_SRCE=PONSRC!REPLYACT Q_P2=PONSRC!2 PON(Q) %END %END; ! OF ROUTINE PRINTER !! !-------------------------------------------------------------- %SYSTEMROUTINE WRITE(%INTEGER VALUE, PLACES) %STRING (16) S %INTEGER D0, D1, D2, D3, L *LSS_VALUE; *CDEC_0 *LD_S; *INCA_1; *STD_%TOS *CPB_%B; ! SET CC=0 *SUPK_%L=15,0,32; ! UNPACK & SPACE FILL *STD_D2; *JCC_8, *LD_%TOS; *STD_D0; ! FOR SIGN INSERTION *LD_%TOS *MVL_%L=15,63,0; ! FORCE ISO ZONE CODES %IF VALUE<0 %THEN BYTEINTEGER(D1)='-' L=D3-D1 OUT: %IF PLACES>=L %THEN L=PLACES+1 D3=D3-L-1 BYTEINTEGER(D3)=L PRINTSTRING(STRING(D3)) %RETURN WASZERO: BYTEINTEGER(D3-1)='0' L=2; ->OUT %END %EXTERNALROUTINE PRHEX(%INTEGER I) ! 8-DIGIT HEX PRINT PRINTSTRING(STRHEX(I)) %END; ! PRHEX %ENDOFFILE