! ! ! VERSION OF 18/01/80 ! ! !* COMMUNICATIONS RECORD FORMAT - EXTANT FROM CHOPSUPE 20A 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 %BYTEINTEGER NSACS,RESV1,SACPORT1,SACPORT0, %C NOCPS,RESV2,OCPPORT1,OCPPORT0, %C %INTEGER 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,TSLICE,SP0,SP1, %C SP2,SP3,SP4,SP5,SP6,SP7,SP8, %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 OPMESS2(%INTEGER OP,%STRING(63)TXT) %EXTERNALROUTINESPEC OPMESS3(%STRING(63)TXT) %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) %IF MONLEVEL&2#0 %THEN %START %EXTRINSICLONGINTEGER KMON %FINISH %IF MONLEVEL&256#0 %START %EXTERNALROUTINESPEC TRACER(%STRING(63) S) %FINISH %OWNRECORDNAME COM(COMF) %OWNINTEGER TRANSIZE %EXTERNALSTRING(15)%FNSPEC STRINT(%INTEGER I) %EXTERNALSTRING(15)%FNSPEC HTOS(%INTEGER N,M) %CONSTINTEGER UNASSIGNED = X'80808080' %CONSTINTEGER RESIDENT = 64 %CONSTINTEGER LAST PROC = MAXPROCS-1 !------------------------------------------------------------------------ %EXTERNALLONGINTEGERFN CLOCK %LONGINTEGER L *RRTC_0 *ST_L %RESULT=(L>>33<<32!L&X'0FFFFFFFF')<<1 %END; ! OF CLOCK ! ! ! !------------------------------------------------------------------------ %EXTERNALROUTINE WAIT(%INTEGER MILLESECS) %INTEGER T0,T1,T2,T3,ISA ISA=COM_CLKX *RRTC_0; *ST_T0 %IF T0&1#T1>>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; ! OF WAIT ! ! ! !------------------------------------------------------------------------ %EXTERNALROUTINE HOOT(%INTEGER NUM) %INTEGER J, HOOTISA, HOOTBIT HOOTBIT = COM_HBIT HOOTISA = COM_HOOT %IF HOOTISA # 0 %START; ! P2 HAS NO HOOTER %CYCLE J = 1,1,NUM *LB_HOOTISA *LSS_(0+%B) *OR_HOOTBIT *ST_(0+%B) WAIT(40) *LB_HOOTISA *LSS_(0+%B) *SLSS_-1 *NEQ_HOOTBIT *AND_%TOS *ST_(0+%B) WAIT(40) %REPEAT %FINISH WAIT(300) %END; ! OF HOOT ! ! ! !------------------------------------------------------------------------ %EXTERNALROUTINE GET PSTB(%INTEGERNAME PSTB0, PSTB1) %CONSTINTEGER PST VA = X'80040000'; ! VA OF PUBLIC SEG TABLE ! MACHINE-INDEPENDENT VERSION ! PUBLIC SEGMENT 1 IS MAPPED TO THE PST ITSELF %RECORDFORMAT EF(%INTEGER LIM, RA) %RECORDNAME E(EF) E == RECORD(PST VA+8); ! ONTO THE PST ENTRY FOR SEG 1 ! E_LIM GIVES THE SIZE OF THE PST (BYTES) ! FOR DOUBLE WORDS, >>3, AND THIS IS THE TOP PUBLIC SEG WHICH IS ! POTENTIALLY AVAILABLE. TO GET THE VA LIMIT THEREFORE WE <<18. ! WE ADD THE TOP BIT AND ALSO THE BOTTOM 7 BITS >>3 AND <<18, WHICH ! IS THE '3C'. PSTB0 = ((E_LIM&X'0003FF80')<<15)!X'803C0000' PSTB1 = E_RA&X'0FFFFFC0' %END; ! OF GET PSTB ! ! ! ! !------------------------------------------------------------------------ %SYSTEMROUTINE ITOE(%INTEGER AD, L) %INTEGER J J = COM_TRANS *LB_L; *JAT_14, *LDTB_X'18000000'; *LDB_%B; *LDA_AD *LSS_J; *LUH_X'18000100' *TTR_%L=%DR L99: %END; ! OF ITOE ! ! ! !------------------------------------------------------------------------ %SYSTEMROUTINE ETOI(%INTEGER AD, L) %INTEGER J J = COM_TRANS+256 *LB_L; *JAT_14, *LDTB_X'18000000'; *LDB_%B; *LDA_AD *LSS_J; *LUH_X'18000100' *TTR_%L=%DR L99: %END; ! OF ETOI ! ! ! !------------------------------------------------------------------------ %EXTERNALROUTINE MONITOR(%STRING(63) S) PRINT STRING(S." ") %MONITOR %STOP %END; ! OF MONITOR ! ! ! !------------------------------------------------------------------------ %EXTERNALROUTINE OPMESS(%STRING(63) MESS) OPMESS2(0, MESS) %END; ! OF OPMESS ! ! ! !------------------------------------------------------------------------ ! WRITES VALUE AS TWO DECIMAL ISO DIGITS ! INTO AD AND AD+1 %ROUTINE DECWRITE2(%INTEGER VALUE,AD) *LSS_VALUE; *IMDV_10 *USH_8; *IAD_%TOS; *IAD_X'3030' *LDA_AD; *LDTB_X'58000002' *ST_(%DR) %END; ! OF DECWRITE2 ! ! ! !------------------------------------------------------------------------ ! K IS DAYS SINCE 1ST JAN 1900 ! RETURNS D, M, Y 2 DIGIT Y ONLY %ROUTINE KDATE(%INTEGERNAME D,M,Y,%INTEGER K) ! %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; ! OF KDATE ! ! ! !------------------------------------------------------------------------ ! GET TIME OF DAY FROM REAL TIME CLOCK %EXTERNALROUTINE UPDATE TIME %INTEGER RTC1,RTC2,JDAY,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(" ").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; ! OF STOI ! ! ! !------------------------------------------------------------------------ %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; ! OF SLAVES ON OFF ! ! ! !------------------------------------------------------------------------ %ROUTINE RESPOND(%INTEGER SRCE,%STRING(40)TXT) %RECORD PP(PARMF) PP_SRCE = 0 PP_DEST = SRCE << 16 ! 7; ! 7 IS A CONVENTIONAL DACT %IF LENGTH(TXT)>23 %THEN LENGTH(TXT)=23 STRING(ADDR(PP_P1)) = TXT PON(PP) %END; ! OF RESPOND ! ! ! !------------------------------------------------------------------------ %CONSTINTEGER DIRACT=X'10014',VOLACT=X'20014',SPLACT=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=29 %CONSTINTEGER BMREP = X'3D0000' %CONSTBYTEINTEGERARRAY PARAMS(1:LIMIT)=2,1,0(5),0,2,0,0,0,1(4),0,2,2, 0,1,1,2,2,2,0,0,0,0; %CONSTSTRING(7)%ARRAY COMMAND(1:LIMIT)="PON ","SRCE ","PLOT ", "PLOD ","LABEL ","ILABEL ","UNPLOT ","STARTD", "SLOAD ","DUMP ","PRIME ","OPER ","TSLICE ", "INH ","UNINH ","DIRVSN ","P ","XDUMP ", "REP ","DDUMP ","SLAVES ","ISR ","ISW ","KMON ", "SHOW ","GPC ","B ","F ","TRACE "; %CONSTSTRINGNAME TIME = X'80C0004B' %SWITCH SWT(1:LIMIT) %RECORD PP(PARMF) %INTEGERARRAY DATA(1:6) %INTEGER I,J,K, OP, SSNO %LONGINTEGER L %STRING(63)PRE %STRING(63)P,Q %IF LENGTH(S) = 0 %THEN %RETURN; ! IGNORE NULL LINES PP=0 SSNO = SRCE >> 16 %IF SSNO = X'32' %START; ! COMPUTE PREFIXED LINE FOR OPERLOG ! CALLED FROM AN OPER OP = 3<<24 ! M'OP0' ! SRCE>>8&7 PRE = STRING(ADDR(OP))." ".S %FINISH %ELSE %START I = (SSNO - RESIDENT) & LAST PROC PRE = STRINT(I) PRE = " ".PRE %IF I < 10 PRE = PRE."/ ".S %FINISH ! ! %CYCLE I=1,1,LIMIT ->FOUND %IF S->(COMMAND(I)).P %REPEAT OPMESS3(PRE) %CYCLE I=2,1,5 %IF LENGTH(S)>=I %AND CHARNO(S,I)='/' %THEN ->TEXTIN %REPEAT ERR: RESPOND(SSNO,"????".S); ! ERROR RESPONSE %RETURN FOUND: ! COMMAND RECOGNISED %UNLESS I=17 %OR I=27 %OR I=28 %THEN OPMESS3(PRE); ! DONT LOG S, B OR F J=PARAMS(I); ! (MINIMUM) NO OF PARAMETERS K=1 %WHILE K<=J %CYCLE DATA(K)=STOI(P) ->ERR %IF DATA(K)=UNASSIGNED; ! REQUIRED PARAMETER NOT GIVEN K=K+1 %REPEAT PP_DEST = X'240000'; ! BULK MOVER, NEARLY ALWAYS RIGHT! PP_SRCE = BMREP ! (SRCE >> 16); ! LIKEWISE ->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=SPLACT+COM_SYNC1DEST<<16 %AND ->ON K=STOI(P); %IF K<0 %THEN ->ERR ! K = K << 16 ! MESSACT; ! DACT = 5 FOR OPMESS IN %IF CHARNO(Q,1) = '/' %C %THEN PP_DEST = K + COM_SYNC1DEST << 16 %C %AND %C Q -> ("/").Q %C %ELSE PP_DEST = K + COM_ASYNCDEST << 16 ! 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=UNASSIGNED %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: PRINTSTRING(TIME." COMMAND "); 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 ->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 ->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 ->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): ! STARTD. RESTART "DIRECT" PROCESS PP_DEST=X'30011' PP_SRCE=0 ->POUT SWT(9): ! SLOAD DEV PAGE(CHOPSUPE ONLY) ->ERR SWT(10): ! DUMP T D NPAGES ->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 ->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): ! OPER PP_DEST=X'0032000C'!SRCE&X'FF00' ->DEVTEXT 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): ! S PICTURE SCREEN I = STOI(P) %IF I = UNASSIGNED %START ! PICTURE NOT GIVEN AS NUMERIC SWT17A: %IF P -> (" ").P %THEN -> SWT17A %UNLESS P -> Q.(" ").P %START Q = P P = "" %FINISH PP_P1 = -1 STRING(ADDR(PP_P3)) = Q %FINISH %ELSE %START PP_P1 = I %FINISH I = STOI(P) %IF I = UNASSIGNED %THEN I = 0 PP_P2 = I PP_DEST = (SRCE >> 8) << 8 ! 19; ! SHOW PICTURE PP_SRCE = 0 -> 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) RESPOND(SSNO,STRHEX(DATA(2)).' REPS '.STRHEX(J)) %RETURN SWT(20): ! DDUMP DISCADDR ->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 RESPOND(SSNO,"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 %IF MONLEVEL&2#0 %THEN %START 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 RESPOND(SSNO, %C 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 %FINISH SWT(26): ! GPC PP_DEST=X'300001' DEVTEXT: ! OPER JOINS HERE ->ERR %IF LENGTH(P)>23 PP_SRCE = SRCE STRING(ADDR(PP_P1))=P ->POUT SWT(27): ! B (PGB) PP_P1 = -1 -> SWT28A SWT(28): ! F (PGF) PP_P1 = 1 SWT28A: I = STOI(P) %IF I = UNASSIGNED %THEN I = 0 PP_P2 = I PP_DEST = (SRCE >> 8) << 8 ! 18; ! PGB,F PP_SRCE = 0 -> POUT SWT(29): !TRACE EVENTS %IF MONLEVEL&256#0 %START TRACER(P) %FINISHELSESTART -> ERR %FINISH ! ! ! %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; ! OF PARSE COM ! ! ! %EXTERNALROUTINE BMREP(%RECORDNAME P) !*********************************************************************** !* TRANSLATES RESPONSES FROM BULK MOVER INTO * !* TEXT FORM BEFORE PASSING THEM BACK TO * !* THE ORIGINAL CALLER (ON DACT 1) * !*********************************************************************** %RECORDSPEC P(PARMF) %STRING(23)TXT %IF P_P1 = 0 %C %THEN TXT = "LOAD OK" %C %ELSE TXT = "LOAD FAILS ".STRHEX(P_P1) RESPOND(P_DEST,TXT) %END; ! OF BMREP !------------------------------------------------------------------------ %EXTERNALROUTINE COMREP(%RECORDNAME P) !*********************************************************************** !* TRANSLATES THE ERROR RESPONSE FROM DE ALLOCATE TAPE IN BULK * !* MOVER AND LOGS IT * !*********************************************************************** %RECORDSPEC P(PARMF) ! REPLY FROM DE-ALLOCATE TAPE IN MOVE %UNLESS P_P2 = 0 %START OPMESS2(0,"DEALLOC FAILS:".STRING(ADDR(P_P3))) %FINISH %END; ! OF COMREP ! ! ! !------------------------------------------------------------------------ %EXTERNALINTEGERFN HANDKEYS %INTEGER ISA ISA=COM_HKEYS *LB_ISA *LSS_(0+%B); *EXIT_-64 %END; ! OF HANDKEYS ! ! ! !------------------------------------------------------------------------ %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 * ! Failure flags (returned in P_P1) are as follows (at least * ! for moves to/from disc): * !* * !* P_P1 = RW<<24 ! FAIL<<16 ! RELPAGE * !* * ! where RW = 1 means a READ failed * !* 2 means a WRITE failed. * !* FAIL = flag from PDISC: * !* 1 = transferred with errors (i.e. cyclic * !* check fails) * !* 2 = request rejected * !* 3 = transfer not effected (e.g. flagged * !* track encountered) * !* and RELPAGE = relative page no of failing page, counting * !* first page of request as zero. * !*********************************************************************** %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' %INTEGER I, INDEX, PAGE, FILE, SNO, FAIL %SWITCH STEP(1:12) ! %IF MONLEVEL&2#0 %AND KMON>>(P_DEST>>16)&1#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 ! ! The format of the failure flags given below is described in comment at ! the head of this routine. ! 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; ! OF CHECK ! ! ! %END; ! OF MOVE ! ! ! %ENDOFFILE