!* COMMUNICATIONS RECORD FORMAT - EXTANT FROM CHOPSUPE 19A ONWARDS * %RECORDFORMAT COMF(%INTEGER OCPTYPE,IPLDEV,SBLKS,SEPGS,NDISCS, %C DDTADDR,GPCTABSIZE,GPCA,SFCTABSIZE,SFCA,SFCK,DIRSITE, %C DCODEDA,SUPLVN,WASKLOKCORRECT,DATE0,DATE1,DATE2, %C TIME0,TIME1,TIME2,EPAGESIZE,USERS,CATTAD,DQADDR, %C SACPORT,OCPPORT,ITINT,CONTYPEA,GPCCONFA,FPCCONFA,SFCCONFA, %C BLKADDR,DPTADDR,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,SP0,SP1,SP2,SP3, %C SP4,SP5,SP6,SP7,SP8,SP9, %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) ! MISC. ROUTINE SPECS %EXTERNALROUTINESPEC PTREC(%RECORDNAME P) %EXTERNALSTRING(8)%FNSPEC STRHEX(%INTEGER N) %RECORDFORMAT PARMF(%INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6) %EXTERNALROUTINESPEC PON(%RECORDNAME P) %EXTERNALROUTINESPEC INHIBIT(%INTEGER N) %EXTERNALROUTINESPEC UNINHIBIT(%INTEGER N) %EXTERNALROUTINESPEC DISPLAYTEXT(%INTEGER VID,L,POS,%STRING(41)TX) %EXTERNALROUTINESPEC DUMPTABLE(%INTEGER T,A,L) ?%EXTRINSICLONGINTEGER KMON %OWNRECORDNAME COM(COMF) %OWNINTEGER TRANSIZE %EXTERNALSTRING(15)%FNSPEC HTOS(%INTEGER N,M) !----------------------------------------------------------------------- %EXTERNALROUTINE MONITOR(%STRING(63) S) PRINT STRING(S." ") %MONITOR %STOP %END !----------------------------------------------------------------------- %EXTERNALROUTINE OPMESS2(%INTEGER OPER,%STRING(63)MESS) !*********************************************************************** !* PON A MESSAGE TO THE OPER. IN PREPARATION FOR INTERRUPT DRIVEN * !* OPERATOR ROUTINES WHICH CAN NOT BE CALLED * !*********************************************************************** %STRING(23) T %RECORD P(PARMF) %INTEGER I T<-MESS P_DEST=X'320007'!OPER<<8 P_SRCE=0 %CYCLE I=0,1,23 BYTE INTEGER(ADDR(P_P1)+I)=BYTE INTEGER(ADDR(T)+I) %REPEAT PON(P) %END %EXTERNALROUTINE OPMESS(%STRING(63) MESS) OPMESS2(0,MESS) %END !* %ROUTINE DECWRITE2(%INTEGER VALUE,AD) !*********************************************************************** !* WRITE VALUE AS 2 DECIMAL ISO CHARACTERS INTO AD & AD+1 * !* BETTER AS JUMP & LINK SUBROUTINE OF UPDATE TIME * !*********************************************************************** *LSS_VALUE; *IMDV_100 *LSS_%TOS; *IMDV_10 *USH_8; *IAD_%TOS; *IAD_X'3030' *LDA_AD; *LDTB_X'58000002' *ST_(%DR) %END %ROUTINE KDATE(%INTEGERNAME D,M,Y,%INTEGER K) !*********************************************************************** !* K IS DAYS SINCE 1STJAN1900 RETURN D:M:Y (2DIGIT Y ONLY) * !*********************************************************************** %INTEGER W ! K=K+693902; ! DAYS SINCE CEASARS BDAY ! W=4*K-1 ! Y=W//146097 ! K=W-146097*Y ! D=K//4 ! K=(4*D+3)//1461; ! D=4*D+3-1461*K ! D=(D+4)//4 ! M=(5*D-3)//153 ! D=5*D-3-153*M ! D=(D+5)//5 ! Y=K *LSS_K; *IAD_693902 *IMY_4; *ISB_1; *IMDV_146097 *LSS_%TOS; *IDV_4; *IMY_4; *IAD_3 *IMDV_1461; *ST_(Y) *LSS_%TOS; *IAD_4; *IDV_4 *IMY_5; *ISB_3; *IMDV_153 *ST_(M); *LSS_%TOS *IAD_5; *IDV_5; *ST_(D) %IF M<10 %THEN M=M+3 %ELSE M=M-9 %AND Y=Y+1 %END %EXTERNALROUTINE UPDATE TIME !*********************************************************************** !* WORK OUT THE TIME OF DAY FROM THE REAL TIME CLOCK * !*********************************************************************** %INTEGER RTC1,RTC2,JDAY,HRS,MINS,SECS,DD,MM,YY,ISA %OWNINTEGER YESTERJDAY %LONGINTEGER WORK *RRTC_0; *ST_RTC1 %IF RTC1&1#RTC2>>31 %START; ! INT PENDING ISA=COM_CLKX *LSS_1; *IAD_RTC1; *ST_RTC1 *LB_ISA; *ST_(0+%B); ! UPDATE CLOCK X REG BY SOFTWARE %FINISH RTC2=RTC2<<1; ! NOW IN MILLESECS WORK=LONGINTEGER(ADDR(RTC1))//1000000 JDAY=WORK//86400 WORK=WORK-86400*LENGTHENI(JDAY) %IF 0>31 %START; ! GUARD BIT SET *LSS_1; *IAD_T0; *LB_ISA *ST_(0+%B) %FINISH T1=T1<<1 *LSS_MILLESECS; *IMY_2 *IAD_1; *IMYD_512; ! ACC=DELAY IN MICROSECS *IAD_T0; *ST_T0 L1: *RRTC_0; *ST_T2 %IF T2&1#T3>>31 %START; ! GUARD BIT SET *LSS_1; *IAD_T2 *LB_ISA; *ST_(0+%B) %FINISH T3=T3<<1 *LSD_T2 *UCP_T0; *JCC_4, %END %%EXTERNALINTEGERFN STOI(%STRINGNAME S) %STRING(50) P %INTEGER TOTAL,SIGN,AD,I,J,HEX HEX=0; TOTAL=0; SIGN=1 AD=ADDR(P) L1: %IF S->(" ").S %THEN ->L1; ! CHOP LEADING SPACES %IF S->("-").S %THEN SIGN=-1 %IF S->("X").S %THEN HEX=1 %AND ->L1 P=S %UNLESS S->P.(" ").S %THEN S='' I=1 %WHILE I<=BYTEINTEGER(AD) %CYCLE J=BYTE INTEGER(I+AD) ->FAULT %UNLESS '0'<=J<='9' %OR (HEX#0 %AND 'A'<=J<='F') %IF HEX=0 %THEN TOTAL=10*TOTAL %ELSE TOTAL=TOTAL<<4+9*J>>6 TOTAL=TOTAL+J&15; I=I+1 %REPEAT %IF HEX#0 %AND I>9 %THEN ->FAULT %IF I>1 %THEN %RESULT=SIGN*TOTAL FAULT: S=P." ".S %RESULT=X'80808080' %END %EXTERNALROUTINE SLAVESONOFF(%INTEGER ONOFF) !*********************************************************************** !* TURN OFF ALL SLAVES IF ONOFF=0 * !* TURN ON ALL SLAVES IF ONOFF=-1 * !* OR TURN OFF AND ON SLECTIVELY IF ONOFF == A BITMASK * !*********************************************************************** %INTEGER I,J,K I=COM_SLAVEOFF J=I>>16; I=I&X'FFFF' K=J!!(-1); J=J&(ONOFF!!(-1)) %IF COM_OCPTYPE=3 %THEN J=J!X'80000000';! CLEAR BIT 2970 ONLY *LB_I; *LSS_(0+%B) *AND_K; *OR_J; *ST_(0+%B) %END %CONSTINTEGER DIRACT=X'10014',VOLACT=X'20014',SPOOLACT=X'30014', %C MESSACT=X'5' %EXTERNALROUTINE PARSE COM(%INTEGER SRCE,%STRINGNAME S) !*********************************************************************** !* TRANSCRIBE A COMMAND TO A PON MESSAGE AND PON IT * !*********************************************************************** %INTEGERFNSPEC TAPEPLACE(%INTEGERNAME A,B,%STRINGNAME S,%INTEGER F) %INTEGERFNSPEC DISCPLACE(%INTEGERNAME A,B,%STRINGNAME S,%INTEGER F) %OWNINTEGER SRCESERV=0 %CONSTINTEGER LIMIT=25,COMREP=X'3E0000' %CONSTBYTEINTEGERARRAY PARAMS(1:LIMIT)=2,1,0,0,0,0,0,3,2,0,0,1(5),0,2,2, 0,1,1,2,2,2; %CONSTSTRING(7)%ARRAY COMMAND(1:LIMIT)="PON ","SRCE ","PLOT ", "PLOD ","LABEL ","ILABEL ","UNPLOT ","RREAD ", "SLOAD ","DUMP ","PRIME ","POFFMON","TSLICE ", "INH ","UNINH ","DIRVSN ","MAINOP ","XDUMP ", "REP ","DDUMP ","SLAVES ","ISR ","ISW ","KMON ", "SHOW "; %SWITCH SWT(1:LIMIT) %RECORD PP(PARMF) %INTEGERARRAY DATA(1:6) %INTEGER I,J,K, OP %LONGINTEGER L %STRING(63)P,Q PP=0 OP=SRCE>>8&255 PRINTSTRING("INMESS :- ".S." ") %CYCLE I=1,1,LIMIT ->FOUND %IF S->(COMMAND(I)).P %REPEAT %CYCLE I=2,1,5 %IF LENGTH(S)>=I %AND CHARNO(S,I)='/' %THEN ->TEXTIN %REPEAT ERR: OPMESS2(OP,'????') PRINTSTRING("PARSE REJECTS :".S." ") %RETURN FOUND: ! COMMAND RECOGNISED J=PARAMS(I); ! (MINIMUM) NO OF PARAMETERS K=1 %WHILE K<=J %CYCLE DATA(K)=STOI(P) ->ERR %IF DATA(K)=X'80808080' K=K+1 %REPEAT ->SWT(I) TEXTIN: ! OPERATOR TO USER PROCESS S->P.("/").Q %IF LENGTH(Q)>23 %THEN ->ERR %IF P="D" %THEN PP_DEST=DIRACT+COM_SYNC1DEST<<16 %AND ->ON %IF P="V" %THEN PP_DEST=VOLACT+COM_SYNC1DEST<<16 %AND ->ON %IF P="S" %THEN PP_DEST=SPOOLACT+COM_SYNC1DEST<<16 %AND ->ON K=STOI(P); %IF K<0 %THEN ->ERR PP_DEST=K<<16+MESSACT+COM_ASYNCDEST<<16;! DACT=5 FOR OPMESS IN ON: PP_SRCE=SRCE %WHILE LENGTH(Q)>0 %AND CHARNO(Q,LENGTH(Q))=' ' %THEN %C LENGTH(Q)=LENGTH(Q)-1 STRING(ADDR(PP_P1))=Q ->POUT SWT(1): ! PON (VARIABLE PARAMS) PP_DEST=DATA(1)<<16!DATA(2) %CYCLE K=0,1,5 I=STOI(P) %IF I=X'80808080' %AND P->("""").Q.("""").P %START STRING(ADDR(PP_P1)+4*K)=Q K=K+LENGTH(Q)//4 %FINISH %ELSE INTEGER(ADDR(PP_P1)+4*K)=I %REPEAT %IF SRCESERV=0 %THEN PP_SRCE=SRCE %ELSE PP_SRCE=SRCESERV POUT: PRINT STRING("INMESS: "); PTREC(PP) PON(PP) %RETURN SWT(2): ! SRCE = SRCE SERV NO FOR PON SRCESERV=DATA(1) %RETURN SWT(3): ! PLOT T F D PGE NPAGES PP_DEST=X'240000'; ! BULK MOVER PP_SRCE=COMREP!SRCE&X'FF00' ->ERR %UNLESS TAPEPLACE(PP_P2,PP_P3,P,1)=0 ->ERR %UNLESS DISCPLACE(PP_P4,PP_P5,P,1)=0 I=STOI(P) ->ERR %UNLESS I>0 PP_P1=X'04020000'+I PP_P6=M'PLOT' ->POUT SWT(4): ! PLOD FD FP TD TP NP PP_DEST=X'240000' PP_SRCE=COMREP!SRCE&X'FF00' ->ERR %UNLESS DISCPLACE(PP_P2,PP_P3,P,1)=0 ->ERR %UNLESS DISCPLACE(PP_P4,PP_P5,P,1)=0 I=STOI(P) ->ERR %UNLESS I>0 PP_P1=X'02020000'+I PP_P6=M'PLOD' ->POUT SWT(5): ! LABEL SWT(6): ! ILABEL=IPL LABEL ->ERR SWT(7): ! UNPLOT DISCADDR TAPEADDR NPAGES PP_DEST=X'240000'; ! BULK MOVER PP_SRCE=COMREP!SRCE&X'FF00' ->ERR %UNLESS DISCPLACE(PP_P2,PP_P3,P,1)=0 ->ERR %UNLESS TAPEPLACE(PP_P4,PP_P5,P,1)=0 I=STOI(P) ->ERR %UNLESS I>0 PP_P1=X'02040000'+I PP_P6=M'PLOT' ->POUT SWT(8): ! RREAD DEV CNT Q ->ERR SWT(9): ! SLOAD DEV PAGE(CHOPSUPE ONLY) ->ERR SWT(10): ! DUMP T D NPAGES PP_DEST=X'240000'; PP_SRCE=COMREP!SRCE&X'FF00' ->ERR %UNLESS TAPEPLACE(PP_P4,PP_P5,P,0)=0 ->ERR %UNLESS DISCPLACE(PP_P2,PP_P3,P,0)=0 I=STOI(P) ->ERR %UNLESS I>0 PP_P1=X'02040000'+I PP_P6=M'DUMP' ->POUT SWT(11): ! PRIME T D NPAGES PP_DEST=X'240000'; PP_SRCE=COMREP!SRCE&X'FF00' ->ERR %UNLESS TAPEPLACE(PP_P2,PP_P3,P,0)=0 ->ERR %UNLESS DISCPLACE(PP_P4,PP_P5,P,0)=0 I=STOI(P) ->ERR %UNLESS I>0 PP_P1=X'04020000'+I PP_P6=M'PRME' ->POUT SWT(12): ! POFFMON ->ERR SWT(13): ! TSLICE PP_DEST=1<<16 PP_SRCE=SRCE PP_P1=DATA(1) ->POUT SWT(14): ! INH INHIBIT(DATA(1)); %RETURN SWT(15): ! UNINH UNINHIBIT(DATA(1)); %RETURN SWT(16): ! DIRVSN COM_DIRSITE=X'200'+(DATA(1)&3)*64 COM_DCODEDA=COM_SUPLVN<<24!COM_DIRSITE %RETURN SWT(17): ! MAINOP PP_DEST=X'32000A' PP_SRCE=SRCE PP_P1=-1; ! MAKE CURRENT OPER MAIM OPER ->POUT SWT(18): ! XDUMP DUMPTABLE(32,DATA(1),DATA(2)) %RETURN SWT(19): ! REP AT WITH I=DATA(1) *LDTB_X'18000004'; *LDA_I; *VAL_(%LNB+1) *JCC_7, J=INTEGER(I); INTEGER(I)=DATA(2) OPMESS2(OP,STRHEX(DATA(2)).' REPS '.STRHEX(J)) %RETURN SWT(20): ! DDUMP DISCADDR PP_DEST=X'240000' PP_SRCE=COMREP!SRCE&X'FF00' ->ERR %UNLESS DISCPLACE(PP_P2,PP_P3,P,1)=0 PP_P1=X'02050001' PP_P4=0; PP_P5=0; PP_P6=M'DDMP' ->POUT SWT(21): ! SLAVES ONOFF(0=OFF) SLAVESONOFF(DATA(1)) %RETURN SWT(22): ! IMAGE STORE READ&DISPLAY I=DATA(1); *LB_I *LSS_(0+%B); *ST_J OPMESS2(OP,"IS ".STRHEX(I)."=".STRHEX(J)) %RETURN SWT(23): ! IMAGE STORE WRITE I=DATA(1); J=DATA(2) *LB_I; *LSS_J; *ST_(0+%B) %RETURN SWT(24): ! KMON SERV ONOFF ? I=DATA(1) ? J=DATA(2) ? ->ERR %UNLESS 0<=J<=1 ? L=LENGTHENI(1)<64 %THEN J=64 *LDTB_X'18000000' *LDB_J; *LDA_I *VAL_(%LNB+1) *JCC_3, %CYCLE OPMESS(HTOS(I,4)." ".HTOS(INTEGER(I),8)." ". %C HTOS(INTEGER(I+4),8)) I=I+8; J=J-8 %EXIT %IF J<=0 %REPEAT %RETURN %INTEGERFN DISCPLACE(%INTEGERNAME A,B,%STRINGNAME S,%INTEGER FLAG) !*********************************************************************** !* EXTRACT A DISC NO OR LABEL FROM S AND SET A&B IN BULKMOVER FORMAT* !* FLAG=0 IF NO PAGE NO EXPECTED(WHEN PAGE 0 ASSUMED) * !*********************************************************************** %INTEGER I,J,K %STRING(63)P I=STOI(S); B=0; K=0 %IF I>=0 %THEN A=I+M'ED00' %AND ->PAGE AGN: %RESULT=1 %UNLESS S->P.(" ").S ->AGN %IF P='' %RESULT=1 %UNLESS LENGTH(P)=6 %CYCLE I=0,1,5 BYTEINTEGER(ADDR(J)+I)=CHARNO(P,I+1) %REPEAT A=J; B=K; ! 6 CHAR VOL LABEL PAGE: %IF FLAG#0 %START I=STOI(S) %IF I<0 %THEN %RESULT=1 B=B&X'FFFF0000'+I %FINISH %RESULT=0 %END %INTEGERFN TAPEPLACE(%INTEGERNAME A,B,%STRINGNAME S,%INTEGER FLAG) !*********************************************************************** !* EXTRACT A TAPE NO OR LABEL FROM S AND SET A&B IN BULKMOVER FORMAT* !* FLAG=0 IF NO CHAP NO EXPECTED (WHEN 1 IS ASSUMED) * !*********************************************************************** %INTEGER I,J,K %STRING(63)P I=STOI(S); B=1; K=1 %IF I>=0 %THEN A=X'0031006E'+I %AND ->CHAP AGN: %RESULT=1 %UNLESS S->P.(" ").S ->AGN %IF P='' %RESULT=1 %UNLESS LENGTH(P)=6 STRING(ADDR(J))=P A=J; B=K CHAP: %IF FLAG#0 %THEN %START I=STOI(S) %IF I<0 %THEN %RESULT=1 B=B&X'FFFFFF00'+I&255 %FINISH %RESULT=0 %END %END %%EXTERNALROUTINE COMREP(%RECORDNAME P) !*********************************************************************** !* THIS ROUTINE COLLECTS THE REPLIES FROM ROUTINES KICKED BY THE * !* OPERATOR USING OPCOMM AND PARSE * !*********************************************************************** %RECORDSPEC P(PARMF) %INTEGER OPER,I %SWITCH SW(0:3) OPER=P_DEST>>8&X'FF' ->SW(P_DEST&15) SW(0): ! BULK MOVER REPLIES %IF P_P1=0 %THEN OPMESS2(OPER,'LOAD OK') %ELSE %C OPMESS2(OPER,'LOAD FAILED '.STRHEX(P_P1)) %RETURN SW(1): ! REPLY FROM DEALLOCATE TAPE %IF P_P2#0 %THEN OPMESS("DEALLOC FAILS - ".STRING(ADDR(P_P3))) %RETURN %END %EXTERNALINTEGERFN HANDKEYS %INTEGER ISA ISA=COM_HKEYS *LB_ISA *LSS_(0+%B); *EXIT_-64 %END %EXTERNALSTRING(255)%FN STRSP(%INTEGER N) %STRING(255) S %UNLESS 0 *LSS_%TOS *ST_PC INTEGER(X'800000E0')=0; ! ZERO SOFTWARE SYSCALL COUNT %RESULT=PC SYSCALLI:*JLK_%TOS ! ! THIS HORRIBLE PIECE OF CODING DEALS WITH SYSTEM CALLS. WE HAVE A RT CALL ! WITH UNKNOWN NO OF PARAMETERS SET UP TOGETHER WITH LNB+0-2. ! LNB +3,4 UNDEFINED AND USABLE.CAN CORRUPT XNB & DR (PLI SAYS SO).MUST ! PRESERVE THE OTHERS (ESP. ACC SIZE!). THE REASON FOR DOING THIS HERE ! IS THAT WE APPEAR TO THE LOCAL CONTROLLER TO BE THE USER SO WE CAN ! PAGE FAULT OF RUN OUT OF TIME ETC. IF WE SWITCH STACKS TO LOCAL ! CONTROLLER PROPER WE CAN WRITE IN IMP BUT THE VALUE OF THIS IS OFFSET ! BY HAVING TO PRECHECK ADDRESSES SO AS NOT TO HAVE ANY PAGE OR OTHER ! FAULTS. IF THIS SEQUENCE FAILS WE RESTORE ALL REGS AND USE OUT 15 ! INTO THE LOCAL CONTROLLER TO FORCE A CONTINGENCY ! *ST_%TOS; ! SAVE ACC WHATEVER ITS SIZE *STB_%TOS; ! SAVE B *CPSR_%B; *ADB_16; *STB_%TOS; ! SAVE ACC SIZE IN PSR *STD_(%LNB+3); ! SAVE SYS CALL DESCRIPTOR ! ! READY TO GO--- FOLLOW LOGIC OF ROUTINE SYS CALL ! BEWARRE OF INWARD RETURNS. ORIGINALLY INDICATED BY I=J=0 BUT IN LATER ! MOD LEVELS ARE INDICATED BY LINK (E1) DESCRIPTOR IN DR RATHER THAN ! THE NORMAL SYSTEM CALL (E3) DESCRIPTOR. CODE MUST ALLOW FOR BOTH ! *LCT_X'800000E0'; ! CTB TO IST ENTRY FOR SYSCALL *LSS_(%LNB+3); *USH_-24; ! CHECK DESCRIPTOR CODE BYTE *ICP_X'E1'; *JCC_8,; ! TAKE LINK AS INWARD RETURN *LSS_(%LNB+3); *AND_X'FFFF'; *ST_%B; ! I VALUE TO B *LSS_(%CTB+6); *AND_X'FFFF'; ! SCTI LIMIT FROM IST *ICP_%B; *JCC_12,; ! LIMIT VIOLATED BY I *MYB_8; *ADB_(%CTB+7); *LXN_%B; ! XNB TO SCTI ENTRTY *LSS_(%XNB+0); *AND_X'FFFF'; ! SCT LIMIT *ICP_(%LNB+4); *JCC_12,; ! LIMIT VIOLATED BY J *LB_(%LNB+4); *JAT_12,;! J=0 INWARD RETURN *MYB_16; *ADB_(%XNB+1); *LXN_%B; ! XNB TO RELEVANT SCT ENTRY *LSS_(%XNB+0); *AND_X'F00000'; ! ACR ACCESS KEY *SLSS_(%LNB+1); *AND_X'F00000'; ! USERS ACR BEFORE SYSCALL *ICP_%TOS; *JCC_2,; ! USER NOT ALLOWED THIS CALL *LB_(%XNB+0) *JAF_14,; ! JUMP FOR OUTWARD CALLS ! ! THE FOLLOWING IF FRIG TO ROUTE TASK CALLS (TOP 2 BITS 0) AS SOFTWARE ! INWARD CALLS INSTEAD OF LAST 2 LINES ! ! *SLSS_(%XNB+0) ! *AND_X'C0000000' ! *ST_%B ! *LSS_%TOS; ! RESET ACC ! *JAT_13, ! ! CHECK THAT ACR IS NOT GOING TO BE INCREASE ! *SLSS_(%XNB+1); *AND_X'F00000'; ! NEW ACR FROM SCTE ENTRY *ICP_%TOS; *JCC_2,; ! NEW ACR LESS PRIVILEGED ! ! UPDATE COUNT (KEPT IN LNB POSN IN IST) OF SOFT SYSTEM CALLS ! *LSS_1; *IAD_(%CTB+0); *ST_(%CTB+0) ! ! CHECK VALIDITY OF SCTE DESCRIPTOR ! *LSS_(%XNB+2); *USH_-25; *USH_1; ! TYPE LESS BCI BIT *UCP_X'E0'; *JCC_8,; ! CODE DESCRIPTOR *UCP_X'B0'; *JCC_8,; ! DESCRIPTOR DESCRIPTOR *UCP_X'30'; *JCC_8,; ! 64-BIT VECTOR DESCRIPOTR *UCP_X'28'; *JCC_7,; ! 32-BIT VECTOR DESCRIPTOR DESOK: ! CAN MAKE THE CALL *LD_(%XNB+2); ! DESCRIPTOR TO DR *LSS_%TOS; *AND_X'FF0F'; ! OLD PM CC &ACS *OR_(%XNB+1); *ST_(1); ! WITH NEW ACR & PRIV->NEW PSR *LB_%TOS; ! RESET B *L_%TOS; ! RESET ACC AT OLD SIZE *J_(%DR); ! INTO USER CODE OUTWARD: ! OUTWARD CALL ! ! FIRST CHECK THAT ACR IS NOT GOING TO BE DECREASED ! *SLSS_(%XNB+1); *AND_X'F00000'; ! NEW ACR *ICP_%TOS; *JCC_4,; ! OUTWARD CALL GOES INWARD ! ! CHECK FOR AND REJECT (PRO TEM) TASK CALLS ! *LSS_%B; *USH_-30; *JAT_4, ! ! VALIDATE NEW STACK AND COPY ACCROSS PARAMETERS ETC ! *LSS_(%XNB+0); *USH_18; *ST_%B; ! ADDRESS OF FREE STACK *STSF_%TOS; *LSS_%TOS; *USH_-18 *USH_18; *UCP_%B; *JCC_8,; ! OUTWARD CALL TO SAME STACK *LSS_(%XNB+0); *AND_X'10000'; ! TEST "EMAS" BIT *JAT_4,; ! ICL STACKS START AT WORD0 *LDTB_X'28000010'; *LDA_%B; ! EMAS STACKS HAVE STNDRD HEADR *VAL_(%XNB+1); *JCC_7,; ! NO ACCESS *LSS_(%DR); *IAD_3; *AND_-4; ! FIND FIRST FREE WORD IN STACK *IAD_%B; *ST_%B; ! AMEND B PAST PRELOADED STACK ICLST: ! B HAS NEW LNB ADDRESS *STSF_%TOS; *LSS_%TOS; ! TOS TO ACC *STLN_%TOS; *ISB_%TOS; ! BYTES OF PARAMETERS IN ACC *ST_%TOS *LDTB_X'18000000'; *LDB_%TOS; ! SET UP BYTE VECTOR DESCPTR *LDA_%B; *VAL_(%XNB+1); ! CHECK CAN WRITE PARAMS *JCC_7,; ! STACK INVALID *STLN_%TOS; *LSS_%TOS *LUH_X'1800FFFF'; *MV_%L=%DR; ! COPY PARAMETERS(+TEMPORARIES) ! ! FRIG UP LINK DESCRIPTOR TO FORCE INWARD RETURN ! *LDTB_X'28000010'; *LDA_%B; ! 16 WORD DESCRIPTOR TO NEW FRAME *LSS_(%LNB+3); *ST_(%DR+1); ! SYSCALL 'I' WORD *LSS_0; *ST_(%DR+2); ! J=0 FOR INWARD RETURN ! ! VALIDATE SSN+1 MUST BE ONLY 128 BYTES LONG IE KNOWN AND LOCKED DOWN ! BY THE LOCAL CONTOLLER BEFORE SYSTEM CALL STARTS ! *LSS_%B; *USH_-18; *IAD_1 *USH_18; *ST_%TOS; *LDA_%TOS; ! DR TO 16 WORDS OF NEW SSN+1 *VAL_X'00100000'; *JCC_7, *INCA_128; *VAL_X'00100000' *JCC_14,; ! MORE THAN 128 BYTES LONG *INCA_-128; ! BACK TO FIRST 16 WORD ! ! SET UP SSN+1 USING INFO FROM CURRENT CONTEXT & SCTE. ALSO INCORPORATE ! CHECKS ON SCTE DESCRIPTOR WHILE DIGGING OUT THE NEW PC ! *STB_(%DR); ! NEW LNB *ISB_X'40000'; *ST_(%DR+7); ! SSN *LSS_(%XNB+3); *ST_(%DR+11); ! NEW DR1 *LSS_(%XNB+2); *ST_(%DR+10); ! DR0 *USH_-25; *USH_1; ! TYPE BYTE LESS BCI BIT *UCP_X'B0'; *JCC_8,; ! DESCRIPTOR= TYPE 2 64 BIT *UCP_X'30'; *JCC_8,; ! DESCRIPTOR= TYPE 0 64 BIT *UCP_X'28'; *JCC_8,; ! DESCRIPTOR= TYPE 0 32 BIT *UCP_X'E0'; *JCC_7,; ! NOT CODE DESCRIPTOR *LSS_(%XNB+3); *J_; ! PC FROM CODE DESC VDES: *STD_%TOS; *LSD_((%XNB+2)); ! GET PC FROM VECTOR DESCPTR *MPSR_X'11'; *LD_%TOS; ! GET PC LOSE TOP 32 BITS ALLDES: *ST_(%DR+2); ! NEW PC *LSS_(3); *ST_(%DR+3); ! OLD SSR *LSS_(5); *ST_(%DR+5); ! TRANSFER INTERVAL TIMER *LSS_(6); *ST_(%DR+6); ! TRANSFER INSTRN COUNTER *LSS_%TOS; *ST_%TOS; *AND_X'FF0F';! GET OLD PM CC & ACS *OR_(%XNB+1); *ST_(%DR+1); ! NEW PSR ! ! THE ACC IS DIFFICULT. PICK UP FROM TOS FORCE TO 128 BITS CHANGE DR ! AND STORE. NEW ACS IN PSR WILL DISCARD TOP PORTION IF NECESSARY ! *MPSR_%TOS; *LB_%TOS; *STB_(%DR+9);! TRANFER OLD B REG *L_%TOS; *MPSR_X'13'; ! ACC TO 128 BITS *LDTB_X'38000004'; *ST_(%DR+3); ! WORDS 12-15 *LDTB_X'28000010'; *STSF_%B *STLN_%TOS; *SBB_%TOS; *ADB_(%DR);! ADD IN NEW LNB *STB_(%DR+4); ! TO GET NEW VALUE OF SF ! ! NEW SSN+1 READY FOR ACTIVATE. SET UP CURRENT SSN+1 FOR SUBSEQUENT ! INWARD RETURN. MUST INHIBIT INTERRUPTS AS A REGISTER DUMP INTO ! THIS SSN+1 WOULD BE VERY INCONVENIENT! ! *STSF_%TOS; *LSS_%TOS; *USH_-18 *IAD_1; *USH_18; ! CURRENT SSN+1 ADDR IN ACC *SLSS_X'FFE'; *LXN_%TOS; ! XNB TO CURRENT SSN+1 *ST_(3); ! MASK OUT ALL INT XCEPT SE *LSS_(%DR+3); *ST_(%XNB+3); ! SSR FROM NEW SSN+1 TO OLD *LSD_(%LNB+1); *ST_(%XNB+1); ! PC &PSR FOR RETURN *LSS_(7); *ST_(%XNB+7); ! SSN(CTB) *STLN_(%XNB+4); ! NEW SF = CURRENT LNB *LSS_(%LNB+0); *ST_(%XNB+0); ! NEW LNB= CURRENT(LNB+0) ! ! SSN+1 NOW READY FOR RETURN EXCEPT FOR ACC,ACS CC ETC WHICH ARE NOT YET ! KNOWN. REACTIVATE ON NEW STACK USING ACTIVATE WORDS IN PROCESS LIST ! WORD 4 OF IST ENTRY IS ADDRESS OF X28000004/ADRR DESCRIPTOR FOR ! FOUR ACTIVATE WORDS IN PROCESS LIST ENTRY OF THIS (NB! THIS ! HENCE DOUBLE INDIRECTION) PROCESS ! ASSACT: *LSS_(%DR); *USH_-18; *USH_18 *LXN_(%CTB+4); ! POINTS TO DESCRIPTOR *LXN_(%XNB+1); ! NOW POINTS TO ACT WORDS *ST_(%XNB+3); ! UPDATE LAST WORD (=SSN ADDR) *ACT_(%XNB+0); ! AND ACTIVATE IT ! INWARDRET: ! INWARD RETURN *LSS_(%LNB+0); *USH_-18; *UAD_1; ! FIND SSN+1 TO RETURN TO *USH_18; *ST_%B; *LXN_%B; ! XNB TO SSN+1 *LDTB_X'28000010'; *LDA_%B; ! DR TO SSN+1 *VAL_X'00100000'; *JCC_7,; ! NO SUCH SSN+1 *LSS_(%DR); *UCP_(%LNB+0); ! CHECK LNBS *JCC_7,; ! LNBS DONT AGREEE *AND_-2; *ST_(%DR); ! REMOVE BOTTOM BIT WHICH CAN ! BE LEFT BY PRECALL BEFORE *ACT ! ! COPY B,ACC,CC &PM TO NEW CONTEXT ! *LB_%TOS; ! MPSR WORD OFF STACK *LSS_%TOS; *ST_(%XNB+9); ! TRANSFER B *MPSR_%B; *L_%TOS; ! RESTORE ACC *MPSR_X'13'; *ST_(%XNB+12); ! ACC TO NEW CONTEXT *LSS_%B; *AND_X'FF0F'; ! GET PM,CC&ACS *SLSS_(%XNB+1); *AND_X'FF0000'; ! GET ACC&PRIV BEFORE OWRD CALL *OR_%TOS; *ST_(%XNB+1); ! & COMBINE INTO NEW PSR *LSS_(5); *ST_(%XNB+5); ! TRANSFER INTERVAL TIMER *LSS_(6); *ST_(%XNB+6); ! TRANSFER INSTRN COUNTER *LSS_X'FFE'; *ST_(3); ! MASK OUT ALL INT BAR SYS ERR *J_; ! AND ACTIVATE ON FORMER STACK NOCANDO: ! FAILURE OFF TO CONTINGENCY *MPSR_%TOS; ! RESET ACC SIZE *LB_%TOS; ! RESET B *L_%TOS; ! RESET ACC *LD_(%LNB+3); ! RESET SYTEM CALL DESCRIPTOR *OUT_15; ! STACK SWITCH & EXIT ! ! FAILURE . RETURN FAILURE SUBCLASS (SYSTEM B COMPATALBLE WHERE POSSIBLE) ! IN XNB THIS BEING ONLY REGISTER AVAILABLE.(NB XNB HAS ONLY 30 BITS!) ! FAIL0: *LXN_0; *J_ FAIL1: *LXN_4; *J_ FAIL2: *LXN_8; *J_ FAIL3: *LXN_12; *J_ FAIL4: *LXN_16; *J_ FAIL5: *LXN_20; *J_ FAIL33: *LXN_132; *J_ FAIL34: *LXN_136; *J_ !***Z %END; ! OF ROUTINE SYSTEMCALL %EXTERNALROUTINE MOVE(%RECORDNAME P) !*********************************************************************** !* CALLED ON SERVICE 36 TO TRANSFERS GROUPS OF PAGES BETWEEN * !* FAST DEVICES. REPLIES ARE ON SERVICE 37. * !* FAST DEVICE TYPES ARE:- * !* DEV=1 DRUM (SPECIFIED AS SERVICE & PAGE IN AMEM ) * !* DEV=2 DISCFILE (SPECIFIED AS [MNEMONIC OR LVN] & PAGE) * !* DEV=3 ARCHTAPE (SPECIFIED AS SERVICE(PREPOSND BY VOLUMS)) * !* DEV=4 TAPE (SPECIFIED AS STRING(6)LAB,BYTE CHAP NO) * !* DEV=5 FUNNY (READS GIVE ZERO PAGE,WRITES IN HEX TO LP) * !* DEV=6 SINK (THROWS AWAY INPUT FOR TAPE CHECKING) * !* * !* CAN HANDLE UP TO FOUR MOVES AT A TIME. EACH MOVE USES * !* ONE BUFFER AND APART FROM CLEARS ONLY HAS ONE TRANSFER * !* OUTSTANDING AT ANY ONE TIME TIME. * !* ALL WRITES ARE CHECKED BY RE-READING * !*********************************************************************** %INTEGERFNSPEC CHECK(%INTEGERNAME MNEM, PAGE, %INTEGER RTYEP) %RECORDFORMAT BME(%INTEGER DEST, SRCE, STEP, COUNT, FDEV, %C TODEV, L, FDINF1, FDINF2, TODINF1, TODINF2, IDENT, CORE %C , READ, CDEX, UFAIL, WTRANS, FVL1, FVL2, TVL1, TVL2) %OWNRECORDARRAY BMS(1:4)(BME) %RECORDNAME BM(BME) %RECORDSPEC P(PARMF) %OWNINTEGER MASK %CONSTINTEGER TAPE POSN=9, FILE POSN=8, WRITE=2, READ PAGE=1 %CONSTINTEGER WRITETM=10, MAX TRANS=16, REWIND=17, BACK READ=6 %CONSTINTEGER REQSNO=X'240000', PRIVSNO=X'250000', MAXMASK= %C X'1E', GETPAGE=X'50000', RETURNPAGE=X'60000', %C CLAIM TAPE=X'31000C', RELEASE TAPE=X'310007', COMREP= %C X'3E0001', ZEROEPAGEAD=X'804C0000', PDISCSNO=X'210000' %CONSTLONGINTEGER LONGONE=1 %INTEGER I, INDEX, PAGE, FILE, SNO, FAIL %SWITCH STEP(1:12) ! ? %IF KMON&(LONGONE<<(P_DEST>>16))#0 %THEN PRINTSTRING(" MOVE: ") %AND PTREC(P) %IF P_DEST>>16=PRIVSNO>>16 %START; !NAME MNEM,PAGEREPLY INDEX=P_DEST&255 %IF 1<STEP(BM_STEP) %FINISH ! ! THIS THE THE ENTRY FOR A NEW REQUEST ! %CYCLE INDEX=1,1,4 %IF MASK&1<>16);! ALL BUFFERS IN USE BM_DEST=P_DEST BM_SRCE=P_SRCE BM_FDEV=P_P1>>24 BM_TODEV=P_P1>>16&255 BM_READ=READ PAGE %IF P_P1&X'8000'#0 %THEN BM_READ=BACK READ BM_L=P_P1&X'7FFF' BM_FDINF1=P_P2 BM_FDINF2=P_P3 BM_TODINF1=P_P4 BM_TODINF2=P_P5 BM_IDENT=P_P6 BM_COUNT=0; BM_STEP=0 BM_UFAIL=0; BM_FVL1=0; BM_FVL2=0 BM_WTRANS=0; BM_TVL1=0; BM_TVL2=0 %IF BM_L=0 %THEN ->REQFAIL; ! MOVE 0 PAGES DISALLOWED %IF BM_FDEV=2 %AND CHECK(BM_FDINF1,BM_FDINF2,READPAGE)#0 %C %THEN ->REQFAIL %IF BM_TODEV=2 %AND CHECK(BM_TODINF1,BM_TODINF2,WRITE)#0%C %THEN ->REQFAIL %IF BM_TODEV=3 %AND (BM_TODINF2>2 %OR BM_TODINF2<0) %C %THEN ->REQFAIL; ! 0,1,OR 2 TMARKS ONLY ALLOWED P_DEST=GETPAGE; ! REQUEST ONE (EXTENDED) PAGE BM_STEP=0 %IF BM_FDEV>=5 %START BM_CDEX=0 BM_CORE=ZEROEPAGEAD ->CORE GOT %FINISH PONIT:P_SRCE=PRIVSNO!INDEX BM_STEP=BM_STEP+1 PON(P) %RETURN STEP(1): ! CORE PAGE FROM CORE ALLOT BM_CDEX=P_P2; ! CORE INDEX NO(FOR RETURNING) BM_CORE=P_P4 CORE GOT: ! BY HOOK OR BY CROOK ->FDEVPOSD %UNLESS BM_FDEV=4; ! UNLESS A MAG TAPE ! ! CODE HERE TO CLAIM THE INPUT TAPE AND PUT ITS SERVICE NO IN INF1 ! %IF BM_FDINF1>>24#0 %START; ! TAPE LABEL NOT SERVICE NO P_DEST=CLAIM TAPE P_P2=X'00040001'; ! TAPE FOR READING P_P3=BM_FDINF1; P_P4=BM_FDINF2 BM_FVL1=BM_FDINF1; BM_FVL2=BM_FDINF2;! REMEMBER FOR RELEASE BM_STEP=1; ->PONIT STEP(2): ! REPLY FROM CLAIM TAPE %IF P_P2#0 %THEN ->POSFAIL BM_FDINF1=P_P3; ! SERVICE NO FOR TAPE BM_FDINF2=BM_FDINF2&255; ! CHAPTER NO OF FILE %FINISH SNO=BM_FDINF1 BM_STEP=2 FILE=BM_FDINF2&255 TAPEPOS: ! TAPE POSITION TO 'FILE' P_DEST=SNO P_P1=FILE; ! IDENT FOR LATER P_P2=REWIND ->PONIT; ! SKIP BACK TO BT STEP(3): ! FROM TAPE AT BT STEP(6): ! TO TAPE AT BT ->POSFAIL %UNLESS FAIL=4 %OR FAIL=0 P_DEST=P_SRCE P_P2=P_P1<<16!1<<8!TAPE POSN ->PONIT; ! SKIP FORWARD N FILES STEP(4): ! FROMTAPE AT RIGHT FILE ->POSFAIL %UNLESS FAIL=0 ! ! THIS BULK MOVER MOVES TAPE CHAPTERS ONLY ! FDEVPOSD: ->POSCOMPLETE %UNLESS BM_TODEV=4; ! OPUT TAPE NEEDS POSITIONING ! ! CODE HERE TO CLAIM THE OUTPUT TAPE ! %IF BM_TODINF1>>24#0 %START; ! TAPE GIVEN AS LABEL NOT SNO P_DEST=CLAIM TAPE P_P2=X'00040002'; ! TAPE FOR WRITING P_P3=BM_TODINF1; P_P4=BM_TODINF2 BM_TVL1=BM_TODINF1; BM_TVL2=BM_TODINF2 BM_STEP=4; ->PONIT STEP(5): ! REPLY FROM CLAIM OUTPUT TAPE %IF P_P2#0 %THEN ->POSFAIL BM_TODINF1=P_P3 BM_TODINF2=BM_TODINF2&255; ! CHAPTER NO %FINISH SNO=BM_TODINF1 FILE=BM_TODINF2&255 BM_STEP=5 ->TAPEPOS STEP(7): ! BOTH DEVICES POSITONED ->POSFAIL %UNLESS FAIL=0 POSCOMPLETE: READ PG: BM_COUNT=BM_COUNT+1 %IF BM_FDEV<5 %THEN %START; ! NOT FROM A ZERO PAGE P_DEST=BM_FDINF1 P_P3=BM_CORE %IF BM_FDEV=3 %OR BM_FDEV=4 %THEN %START P_P2=TRANSIZE<<16!BM_READ %FINISH %ELSE %START P_P2=BM_FDINF2-1+BM_COUNT %FINISH BM_STEP=7 P_P1=BM_COUNT ->PONIT %FINISH %ELSE FAIL=0 STEP(8): ! PAGE READ ->READ FAIL %UNLESS FAIL=0 %IF BM_TODEV<5 %THEN %START %CYCLE P_DEST=BM_TODINF1 P_SRCE=PRIVSNO!INDEX BM_STEP=8 P_P3=BM_CORE %IF BM_TODEV=4 %OR BM_TODEV=3 %THEN %START P_P2=TRANSIZE<<16!WRITE %FINISH %ELSE %START P_P2=BM_TODINF2-1+BM_COUNT %FINISH P_P1=BM_COUNT PON(P) BM_STEP=9 BM_WTRANS=BM_WTRANS+1 %RETURN %IF BM_FDEV<5 %OR BM_WTRANS>=MAX TRANS %OR %C BM_COUNT>=BM_L BM_COUNT=BM_COUNT+1 %REPEAT %FINISH %ELSE %START BM_WTRANS=BM_WTRANS+1 DUMPTABLE(34,BM_CORE,TRANSIZE)%IF BM_TODEV=5 %FINISH STEP(9): ! PAGE WRITTEN BM_WTRANS=BM_WTRANS-1 ->WRITEFAIL %UNLESS FAIL=0 ->READ PG %IF BM_COUNTTMFAIL %UNLESS FAIL=0 P_DEST=BM_TODINF1 P_P1=M'BMTM' P_P2=WRITE TM %IF BM_TODEV=3 %AND BM_TODINF2#0 %START;! ARCH TAPE NEEDS TM? BM_STEP=BM_STEP+2-BM_TODINF2; ! ONE OR TWO TMS ->PONIT %FINISH ->PONIT %IF BM_TODEV=4 STEP(11): !BOTH TMS WRITTEN ->TMFAIL %UNLESS FAIL=0 WAYOUT: !DEALLOCATE CORE %RETURN %UNLESS BM_WTRANS=0 P_DEST=RETURN PAGE P_SRCE=0; ! REPLY NOT WANTED P_P2=BM_CDEX PON(P) %UNLESS BM_FDEV>=5; ! RETURN CORE P_DEST=RELEASE TAPE P_SRCE=COMREP %IF BM_FDEV=4 %AND BM_FVL1#0 %START P_P2=X'00040000'!BM_FDINF1&X'FFFF' P_P3=BM_FVL1; P_P4=BM_FVL2; P_P5=1 PON(P); ! RELEASE FROM TAPE %FINISH %IF BM_TODEV=4 %AND BM_TVL1#0 %START P_P2=X'00040000'!BM_TODINF1&X'FFFF' P_P3=BM_TVL1; P_P4=BM_TVL2; P_P5=1 PON(P); ! RELEASE OUTPUT TAPE %FINISH REPLY: !SET UP REPLY P_DEST=BM_SRCE P_SRCE=REQSNO P_P1=BM_UFAIL P_P2=BM_IDENT PON(P); !REPLY TO REQUEST %IF MASK=MAXMASK %THEN UNINHIBIT(REQSNO>>16) MASK=MASK!!1<REPLY POSFAIL: ! UNABLE TO POS TAPE BM_UFAIL=-3 ->WAYOUT TMFAIL: ! TAPE MARK DID NOT WRITE! ->ETWONTM %IF FAIL=4 BM_UFAIL=-4 %IF BM_UFAIL=0 ->WAYOUT ETWONTM: ! END OF TAPE WARNING BM_UFAIL=-5 ->WAYOUT READFAIL: ! UNABLE TO READ %IF BM_UFAIL=0 %THEN %C BM_UFAIL=READPAGE<<24!P_P1!FAIL<<16 ->WAYOUT WRITEFAIL: ! UNABLE TO WRITE PAGE %IF BM_UFAIL=0 %THEN %C BM_UFAIL=WRITE<<24!P_P1!FAIL<<16 ->WAYOUT ! %INTEGERFN CHECK(%INTEGERNAME MNEM,PAGE,%INTEGER RTYPE) !*********************************************************************** !* CHECKS A DISC ID VOR VALIDITY & AVAILABILITY * !*********************************************************************** %RECORDFORMAT DDTFORM(%INTEGER SER, PTS, PROPADDR, STICK, STATS, %C RQA, LBA, ALA, STATE, IW1, IW2, SENSE1, SENSE2, SENSE3, %C SENSE4, REPSNO, BASE, ID, DLVN, MNEMONIC, %C %STRING (6) LAB, %BYTEINTEGER MECH) %RECORDNAME DDT(DDTFORM) %INTEGER I,L,V1,V2 L=6; V1=MNEM; V2=PAGE %CYCLE I=0,1,COM_NDISCS-1 DDT==RECORD(INTEGER(COM_DITADDR+4*I)) %IF (DDT_MNEMONIC=MNEM %OR STRING(ADDR(L)+3)=DDT_LAB%OR %C MNEM=DDT_DLVN) %AND 4<=DDT_STATE<=7 %THEN %START MNEM=PDISCSNO!RTYPE %IF STRING(ADDR(L)+3)=DDT_LAB %THEN PAGE=PAGE&X'FFFF' PAGE=PAGE!DDT_DLVN<<24 %RESULT=0 %FINISH %REPEAT %RESULT=1 %END %END %ENDOFFILE