%EXTRINSICLONGINTEGER KMON %EXTERNALROUTINESPEC SEMALOOP(%INTEGERNAME SEMA) %ROUTINESPEC PRHEX(%INTEGER H) %ROUTINESPEC PRINTER(%RECORDNAME P) %EXTERNALROUTINESPEC PON(%RECORDNAME P) %EXTERNALROUTINESPEC OPMESS(%STRING (23) MESS) %SYSTEMROUTINESPEC ITOE(%INTEGER A, L) %RECORDFORMAT PARMF(%INTEGER DEST, SRCE, P1, P2, P3, P4, P5, %C P6) !------------------------------------------------------------------------ %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) !------------------------------------------------------------------------ ! MASTER RESIDENT TRANSLATE TABLES FOR EMAS2900 %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 %OWNINTEGER TRANSTABAD=0 %ROUTINE ETOE(%INTEGER AD, L) %INTEGER J %RETURN %IF TRANSTABAD=0 J=TRANSTABAD *LB_L *JAT_14, *LDTB_X'18000000' *LDB_%B *LDA_AD *LSS_J *LUH_X'18000100' *TTR_%L=%DR L99: %END %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 PTREC(%RECORDNAME P) %RECORDFORMAT PARMAF(%INTEGER DEST, SRCE, %INTEGERARRAY P(1:6)) %RECORDSPEC P(PARMAF) %INTEGER I, J, SPTR, VAL %STRING (120) S 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 !! !! 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. !! %EXTERNALINTEGERFN REALISE(%INTEGER AD) %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)! %C 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 NEXT=NEXT+1; ADD=ADD&(-4) PRINTSTRING(" DT: ".DATE." ".TIME." **** SUPERVISOR DUMP TABLE: ". %C STRINT(TABLE)." ADDR ".STRHEX(ADD).' LENGTH: ' %C .STRINT(LENGTH).' DUMP NO: '.STRINT(NEXT).'**** ') 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 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 CHARNO(S,SPTR)=' ' SPTR=SPTR+1 CHARNO(S,SPTR)=NL BYTEINTEGER(ADDR(S))=SPTR PRINTSTRING(S) S=" " UP: ADD=ADD+32 I=0 %REPEAT %RETURN INVL: PRINTSTRING("ADDRESS VALIDATION FAILS ") %END; !ROUTINE DUMP ! OWN VARIABLES FOR JOINT USE BY 'IOCP' AND 'PRINTER' %CONSTINTEGER MASK=X'80FC3FFF', BUFFBASE=X'80FC0000', PAGEMASK= %C X'80FC3000' %OWNINTEGER LOGSEMA=-1 ; ! SEMAPHORE FOR IOCP AND PRINTER %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 %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. * !* A CYCLIC BUFFER IS MAINTAINED IN PAGE 2 AND ONE OTHER BUFFER * !* IS USED IN SEGMENT PUBLIC 63. IF OUTPUT ARRIVES FASTER * !* THAN THE PRINTER CAN COPE IT IS DISCARDED. * !* A SIMILAR ROUTINE IN SLOWFILE IS USED WITH A VIRTUAL PRINTER * !*********************************************************************** %RECORD Q(PARMF) %INTEGER I, J, ADR, L, OLDINPTR, SYM, NLSEEN %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 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<32 %AND SYM#NL %THEN SYM='?' %IF SYM=NL %THEN NLSEEN=1 ADR=ADR+1; I=I+1 INPTR=J %FINISH %ELSE BUSY=1 %AND ->END %REPEAT %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(%RECORDNAME P) !*********************************************************************** !*********************************************************************** %OWNINTEGER DMON %INTEGER I, J %OWNBYTEINTEGERARRAY BUFFER(0:133) ! RCB - REQUEST BLOCK TO PRINT LINES ON MAIN PRINTER %OWNINTEGER LFLAG=X'40000', LSTBA=X'8080', LBL=4, LBA=0, ALL=8, %C ALA=0, INITWRD=0 %OWNBYTEINTEGERARRAY PAGESTATE(0 : 3) = 0(4) %CONSTINTEGER PONSRC=X'360000' %CONSTINTEGER GPCSNO=X'300000' %CONSTHALFINTEGER AUTO=X'8000' %CONSTINTEGER READONLY=1, WRITEABLE=0 %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, GPCREJ ! FILE HEADER BLOCK %OWNINTEGER HDR1=0, HDR2=32, HDR3=0, HDR4=3 %OWNINTEGER HDR5=0,HDR6=0,HDR7=-256,HDR8=0 %RECORDNAME D(ENTFORM) %OWNSTRING (8) OLDDATE, OLDTIME %OWNINTEGER OLDPDT %OWNINTEGER SOURCE8 %SWITCH DACT(0:12) %RECORDSPEC P(PARMF) !! !! !! %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)) 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 * !*********************************************************************** %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(P_P1)#WRITEABLE %IF MONLEVEL&2#0 %AND DMON=1 %THEN %C OPMESS("DISCW ".HTOS(AD,8)." ".HTOS(DPAGE,8)) %IF DPAGE&15=0 %START; ! HEADER PAGE HDR1=SECTSIZE HDR3=HDR1 HDR6=OLDPDT MOVE(32,ADDR(HDR1),AD) SHEAD="DT: ".OLDDATE." ".OLDTIME." OCPTYPE " BYTEINTEGER(ADDR(SHEAD)+31)=BYTEINTEGER(X'80C00003')+48 MOVE(32,ADDR(SHEAD)+1,AD+32) %FINISH P_DEST=X'210002' P_SRCE=PONSRC!4 P_P2=DPAGE P_P3=AD PON(P) DINTPEND=DINTPEND+1; ! REMEMBER DISC TERM. PENDING PAGESTATE(P_P1)=READONLY; ! LOCK PAGE UNTIL DISC WRITE COMPLETE ACTSIZE=ACTSIZE+4096 %IF ACTSIZE>=SECTSIZE %THEN CHANGE FILE %C %ELSE DPAGE=DPAGE+1 %END !! !! %ROUTINE PREPORT(%INTEGER TYPE, VALUE) %CONSTSTRING (8) %ARRAY M(1 : 3) = %C "DEALLOC.","ALLOC.","PRINT" OPMESS("MLP ".M(TYPE)." FAILS ".TOSTRING(VALUE+'0')) %END !! %ROUTINE DEALLOCATE MAIN PRINTER(%INTEGER REPLY ACT) %RECORD Q(PARMF) !* %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 Q(PARMF) Q=0; Q_DEST=GPCSNO!11 Q_P1=MNEM; Q_SRCE=PONSRC!REPLYACT Q_P2=PONSRC!2 PON(Q) %END !! %ROUTINE TAKE DEALLOCATE REPLY %IF P_P1#0 %AND P_P1#2 %THEN PREPORT(1,P_P1) TESTPEND=0 %END !! %ROUTINE TAKEALLOCATE REPLY %IF P_P1#0 %THEN PREPORT(2,P_P1) %AND %RETURN D==RECORD(P_P3) TRANSTABAD=D_TRTABAD INIT=P_P2 MNEM=P_P6 MODE=PRINTING %END !! !! %IF INIT=0 %THEN %START; ! FIRST TIME IN - INITIALISE LBA=ADDR(LBE) ALA=ADDR(ALE1) ALE2=ADDR(BUFFER(1)) ALLOCATE MAIN PRINTER(12) INIT=-1 %FINISH !! !! !! I=P_DEST&255 %IF I>12 %THEN I=0; ! DONT REPORT FOR FEAR OF STARTING LOOP %IF MONLEVEL&2#0 %AND KMON&(LENGTHENI(1)<<54)# 0 %THEN %C DMON=1 %ELSE DMON=0 %IF MONLEVEL&2#0 %%AND DMON#0 %AND I#0 %START PRINTSTRING(" PRINT( IN): ") PTREC(P) %FINISH ->DACT(I) !! !**************************************** !! NEXTLINE: BUFFER(0)=0 !! !!------------------------------------------------ DACT(0): ! ALARM CLOCK TICK OR EQUIVALENT %IF MULTIOCP=YES %THEN %START *INCT_LOGSEMA *JCC_8, SEMALOOP(LOGSEMA) SEMAGOT1: %FINISH %IF INPTR=OUTPTR %THEN ->UNBUSY; ! ->UNBUSY %IF MODE=SPOOLING %START SP: 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 %IF PAGESTATE(I<<18>>30)=WRITEABLE %C %THEN DISCWRITE(I) I=(I+4096)&MASK %REPEAT %FINISH %IF MODE!INTPEND!TESTPEND!DINTPEND#0 %START %IF MULTIOCP=YES %THEN LOGSEMA=-1 %RETURN %FINISH I=BUFFER(0) %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; BUFFER(I)=J BUFFER(0)=I %IF MULTIOCP=YES %THEN LOGSEMA=-1 ALE1=X'58000000'+I ITOE(ALE2,I) ETOE(ALE2,I) ->PRINT %FINISH OUTPTR=(OUTPTR+1)&MASK %IF OUTPTR&X'FFF'<=63 %THEN OUTPTR=OUTPTR+64 %IF J#13 %THEN I=I+1 %AND BUFFER(I)=J %IF INPTR=OUTPTR %START BUFFER(0)=I ->UNBUSY; ! ->UNBUSY %FINISH ! 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(LFLAG); ! ADDR OF 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 !! %IF GPCREJ&X'FF'=0 %THEN PREPORT(3,P_P1) %C %ELSE GPCREJ=GPCREJ+1 INTPEND=0 %RETURN !! !!----------------------------------------------- DACT(1): ! NEW LOG FILE %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 !! !!------------------------------------------------ !! INTERRUPTS TERMS,ATTNS, AND ABN. TERMS. COME HERE DACT(2): !! !! MAY BE WAITING FOR LP TERM. BEFORE DEALLOCATING TO AVOID !! A SPURIOUS TERM. GOING TO THE NEXT OWNER !! %IF MODE=SPOOLING %THEN %START INTPEND=0 TESTPEND=0 DEALLOCATE MAIN PRINTER(12) %RETURN %FINISH !! J=(P_P1>>20)&15 %IF J=1 %START; ! ATTENTION %IF TESTPEND#0 %AND P_P1&AUTO#0 %C %THEN TESTPEND=0 %AND ->PRINT %ELSE %RETURN %FINISH INTPEND=0 %IF J=8 %THEN ->NEXTLINE; ! NORM TERM. !! ABNORMAL TERM. OPMESS('ATTEND MAIN LP') TESTPEND=1; %RETURN !! !! !!------------------------------------------------ !! RESET PRINTER - HOPEFULLY !! DACT(8): SOURCE8=P_SRCE %IF MODE=PRINTING %START P_P1=0 EXIT8: P_DEST=SOURCE8 P_SRCE=PONSRC!8 %IF MODE=PRINTING %THEN P_P1=0 %ELSE P_P1=101 PON(P) ->EXIT6 %FINISH ALLOCATE MAIN PRINTER(3) %RETURN !! !!---------------------------------- !! RESET PRINTER FORCEFULLY !! DACT(6): %IF MODE=PRINTING %START EXIT6: GPCREJ=0 %RETURN %IF 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 %FINISH DEALLOCATE MAIN PRINTER(10) %RETURN !! !!---------------------------------------------------- DACT(7): ! CLOSE CURRENT OUTPUT %IF MONLEVEL&2#0 %AND DMON = 1 %THEN %C OPMESS("NLF ".HTOS(INPTR,8)." ".HTOS(OUTPTR,8)) I=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 %THEN %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 I=PRINTING %THEN DEALLOCATE MAIN PRINTER(12) ->NEXTLINE !! !!------------------------------------------------ DACT(4): ! DISC TERMINATION %IF DINTPEND=0 %START PRINTSTRING(" SPURIOUS LOG DISC INT ") %RETURN %FINISH DINTPEND=DINTPEND-1 PAGESTATE(P_P1)=WRITEABLE J=BUFFBASE+(P_P1<<12) ! ! ZERO BLOCK - NULL CHARACTER ! *LDTB_X'18001000' *LDA_J *MVL_%L=%DR,0,0 %IF MULTIOCP=YES %THEN %START *INCT_LOGSEMA *JCC_8, 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 %CYCLE I=0,1,3 PAGESTATE(I)=WRITEABLE %REPEAT CHANGE FILE %FINISH %WHILE PAGESTATE((OUTPTR&X'3000')>>12)=WRITEABLE %C %THEN %CYCLE OUTPTR=((OUTPTR+4096)&PAGEMASK)!64 ->UNBUSY %IF OUTPTR-1<=INPTR<(OUTPTR+4096) %REPEAT %IF MULTIOCP=YES %THEN LOGSEMA=-1 %RETURN DACT(9): ! SPARE %RETURN !!----------------------------------------- !! PART 2 OF DACT(6) - RESET PRINTER FORCEFULLY !! DACT(10): TAKEDEALLOCATEREPLY ALLOCATEMAINPRINTER(11) %RETURN !! !!--------------------------------------- !! PART 3 OF DACT(6) - RESET PRINTER FORCEFULLY !! DACT(11): TAKEALLOCATEREPLY ->EXIT6 !! !!--------------------------------- !! PART 2 OF DACT(8) - RESET PRINTER HOPEFULLY !! DACT(3): TAKEALLOCATEREPLY ->EXIT8 !! !!------------------------------ !! DACT(12): %IF P_SRCE&X'FF'=11 %THEN TAKEALLOCATEREPLY %C %ELSE TAKEDEALLOCATEREPLY %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 *** ') %IF MODE=SPOOLING %THEN ->SP %END; ! OF ROUTINE PRINTER !! !-------------------------------------------------------------- %SYSTEMROUTINE WRITE(%INTEGER VALUE, PLACES) %STRING (16) S %INTEGER D0, D1, D2, D3, L PLACES=PLACES&15 *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