Re: What is the Telpar OS?
Posted: Mon Jan 11, 2010 2:58 am
Source for Mike's version of PL360???MONITOR 10/14/75 VERSION 05 (PREVIOUS: MONITOR 10/14/75 VERSION 04)
$NOCLOSE
BEGIN COMMENT
SYSTEM/360 SUPERVISOR
TELPAR, INC.
4300 SIGMA ROAD
DALLAS, TEXAS
(214) 233-6631
WRITTEN BY MICHAEL GREEN;
GLOBAL 65 PROCEDURE LEVEL0(R1);
BEGIN COMMENT INTERRUPT LEVEL PROCESSING ROUTINES;
GLOBAL 64 BASE R2; COMMENT STORAGE FOR LEVEL0;
INTEGER YEAR,DAY,SECOND, COMMENT TIME OF DAY AND DATE;
JOBTIME, COMMENT JOB PROCESSING TIME IN SECONDS;
MAXTIME, COMMENT MAXIMUM NO OF SECONDS FOR JOB;
USERMEMORY, COMMENT START OF USER MEMORY AREA;
ENDMEMORY, COMMENT ADDRESS OF LAST BYTE IN MEMORY;
ENDJOBCOUNT, COMMENT JOB CONTROL END JOB SEMAPHORE;
OPERATORCOUNT, COMMENT SEMAPHORE FOR OPERATOR COMMAND PROGRAM;
FIRSTPCB, COMMENT POINTER TO START OF PROCESS QUEUE;
LASTPCB, COMMENT POINTER TO LAST PCB IN PROCESS QUEUE;
FREEPCB, COMMENT POINTER TO AVAILABLE PCB LIST;
CURRENTPCB, COMMENT POINTER TO CURRENT PCB;
NUMBEROFPCBS=16, COMMENT NUMBER OF PROCESS CONTROL BLOCKS;
PCBSIZE=216, COMMENT SIZE OF PROCESS CONTROL BLOCK (BYTES);
LOCKOUTCOUNT, COMMENT NUMBER OF PROCESSES LOCKED OUT IN CANCEL;
MAXPCBNO; COMMENT NUMBER OF LAST PROCESS STARTED;
BYTE PROTECTION, COMMENT MACHINE HAS STORAGE PROTECT;
FLOATINGPOINT, COMMENT MACHINE HAS FLOATING POINT;
CANCELFLAG; COMMENT ANY CANCEL REQUESTED;
INTEGER TIMER SYN 80; COMMENT INTERVAL TIMER LOCATION;
INTEGER ENDSUPERVISOR SYN 76; COMMENT SET BY IPL ROUTINE;
INTEGER CONSOLEADDRESS SYN 76; COMMENT SET AFTER IPL ON ATTENTION;
ARRAY 2 INTEGER SAVEPSW SYN 704; COMMENT INITIAL PSW SAVE AREA;
ARRAY 4 INTEGER SAVEREGS SYN 712; COMMENT INITIAL REGISTER SAVE;
LONG REAL RINGBELLCCW=#0B00000020000001L; COMMENT CONSOLE BELL;
COMMENT DEFINITION OF FIELDS IN PROCESS CONTROL BLOCK;
BYTE STATUS SYN 0; COMMENT STATUS OF PROCESS:
0 - READY FOR EXECUTION, 1 - WAITING FOR SEMAPHORE CHANGE,
2 - WAITING FOR I/O COMPLETION, 3 - WAITING FOR I/O DEVICE,
4 - WAITING FOR CANCEL RECOVERY, 5 - WAITING FOR TIME INTERVAL,
6 - WAITING FOR PROGRAM CHECK RECOVERY,
128 - 134 - PROCESS WITH STATUS 0 - 6 STOPPED ON CANCEL;
INTEGER LINK SYN 0, COMMENT LINK TO NEXT PCB;
SEMAPHORE SYN 4, COMMENT ADDRESS OF SEMAPHORE WAITED FOR;
INTERVAL SYN 4, COMMENT SECONDS REMAINING IN WAIT INTERVAL;
CANCELCODE SYN 4, COMMENT CODE TO IDENTIFY CANCEL, SEE JOB SEQ;
IODEVICE SYN 4; COMMENT ADDRESS OF I/O DEVICE INVOLVED IN WAIT;
ARRAY 2 INTEGER CSW SYN 8; COMMENT SAVED CHANNEL STATUS WORD;
ARRAY 10 INTEGER CCWS SYN 16; COMMENT ROOM FOR 5 CHANNEL COMMANDS;
ARRAY 2 INTEGER PSWSUSPEND SYN 56; COMMENT PROCESS SUSPENDED PSW;
ARRAY 16 INTEGER REGSUSPEND SYN 64; COMMENT PROCESS SUSPENDED REG;
ARRAY 2 INTEGER PSWSVC SYN 128; COMMENT SVC SAVED PSW;
ARRAY 8 INTEGER REGSVC SYN 136; COMMENT SVC SAVED REGISTERS 15-6;
ARRAY 5 BYTE DISKRECORDID SYN 168; COMMENT DISK RECORD ID FIELD;
BYTE SVCGOING SYN 173; COMMENT - #FF INDICATES SVC IN PROGRESS;
SHORT INTEGER IOSTATUS SYN 174; COMMENT I/O DEVICE SENSE BYTES;
ARRAY 8 BYTE DISKCOUNTID SYN 176; COMMENT DISK COUNT FIELD;
INTEGER PRGCHKMASK SYN 184, COMMENT PROCESS ALLOWED PROGRAM CHKS;
IOTIMEOUT SYN 188; COMMENT USED FOR TIMED I/O;
ARRAY 3 INTEGER LEVEL1WORK SYN 192; COMMENT WORK AREA FOR LEVEL1;
INTEGER PCBNUMBER SYN 204; COMMENT NUMBER IDENTIFIES PROCESS;
ARRAY 6 BYTE DISKSEEKADR SYN 208; COMMENT BBCCHH SEEK ADDRESS;
SHORT INTEGER LEVEL1MOREWK SYN 214;
BYTE SVCLOCKOUT SYN PRGCHKMASK(2), COMMENT INDICATES SVC LOCKED;
SVCCANCEL SYN PRGCHKMASK(3); COMMENT 1 - CANCEL, 2 - STOP;
EXTERNAL 67 PROCEDURE PROCESSSVC(R1); NULL; COMMENT SVC 16 AND UP;
EXTERNAL 69 PROCEDURE LEVEL1(R1); NULL; COMMENT STARTED HERE;
FUNCTION LPSW(8,#8200);
PROCEDURE SUSPEND(R1);
BEGIN COMMENT IF THERE IS A CURRENTLY ACTIVE PROCESS, SAVE ITS PSW
AND REGISTER CONTENTS AND PLACE ITS PCB AT THE END OF THE PCB
QUEUE;
R0:=R1; R1:=CURRENTPCB;
IF R1 ~= 0 THEN BEGIN COMMENT PROCESS ACTIVE;
STM(R3,R14,REGSUSPEND(R1+12)); COMMENT SAVE REGISTERS;
LM(R3,R6,SAVEREGS); STM(R4,R6,REGSUSPEND(R1));
REGSUSPEND(R1+60):=R3; COMMENT NOW SAVE PSW;
LM(R3,R4,SAVEPSW); STM(R3,R4,PSWSUSPEND(R1));
R3:=LASTPCB; R4:=FIRSTPCB; LASTPCB:=R1;
IF R4 = 0 THEN FIRSTPCB:=R1 ELSE BEGIN
IC(R5,STATUS(R3)); LINK(R3):=R1; STC(R5,STATUS(R3));
END;
R5:=0; LINK(R1):=R5; CURRENTPCB:=R5;
COMMENT STATUS IS 0 AND NO CURRENT PROCESS;
END;
R1:=R0; COMMENT RESTORE RETURN ADDRESS;
END;
PROCEDURE SETUP(R1);
BEGIN COMMENT IF CURRENTPCB POINTS TO A PCB, SET UP THAT
PROCESS FOR RESUMPTION;
R3:=CURRENTPCB; IF R3 ~= 0 THEN BEGIN
LM(R5,R7,REGSUSPEND(R3)); R4:=REGSUSPEND(R3+60);
STM(R4,R7,SAVEREGS); COMMENT RESTORE REGISTER CONTENTS;
LM(R4,R5,PSWSUSPEND(R3)); STM(R4,R5,SAVEPSW);
LM(R3,R14,REGSUSPEND(R3+12)); COMMENT AND PSW;
END;
END;
PROCEDURE MAKECURRENT(R7);
BEGIN COMMENT REMOVE PCB FROM QUEUE AND MAKE IT THE CURRENT PCB.
R3 = @PCB TO BE REMOVED, R4 = @PREVIOUS PCB OR 0 IF
R3 = @FIRST PCB;
R5:=LINK(R3) AND #FFFFFF;
IF R4 = 0 THEN FIRSTPCB:=R5 ELSE BEGIN
IC(R6,STATUS(R4)); LINK(R4):=R5; STC(R6,STATUS(R4));
END;
IF R5 = 0 THEN LASTPCB:=R4; CURRENTPCB:=R3;
END;
PROCEDURE FINDREADY(R1);
BEGIN COMMENT FIND FIRST READY PCB AND MAKE CURRENT.
IF NONE ARE READY, SET UP FOR WAIT STATE;
BYTE FOUNDREADY;
R3:=FIRSTPCB; R4:=0; RESET(FOUNDREADY);
WHILE ~FOUNDREADY AND R3 ~= 0 DO BEGIN COMMENT SEARCH;
CLI(0,STATUS(R3)); IF = THEN BEGIN COMMENT FOUND ONE;
SET(FOUNDREADY); MAKECURRENT;
END ELSE BEGIN COMMENT TRY NEXT;
R4:=R3; R3:=LINK(R3) AND #FFFFFF;
END;
END;
IF ~FOUNDREADY THEN BEGIN COMMENT SET UP FOR WAIT;
R3:=#FF070000; R4:=0; STM(R3,R4,SAVEPSW);
END;
END;
PROCEDURE FINDWAITING(R1);
BEGIN COMMENT FIND PCB FOR FIRST PROCESS WAITING FOR A SEMAPHORE
AND MAKE IT THE CURRENT PCB. R0 = @SEMAPHORE.
IF NONE ARE WAITING FOR THE SEMAPHORE, SET CONDITION CODE
TO ~= ELSE SET TO =;
BYTE FOUNDWAITING;
R3:=FIRSTPCB; R4:=0; RESET(FOUNDWAITING);
WHILE ~FOUNDWAITING AND R3 ~= 0 DO BEGIN COMMENT SEARCH;
CLI(1,STATUS(R3)); IF = AND R0 = SEMAPHORE(R3) THEN BEGIN
SET(FOUNDWAITING); MAKECURRENT; COMMENT FOUND ONE;
END ELSE BEGIN COMMENT TRY NEXT PCB;
R4:=R3; R3:=LINK(R3) AND #FFFFFF;
END;
END;
TEST(FOUNDWAITING); COMMENT SET CONDITION CODE);
END;
PROCEDURE CANCELKILL(R8);
BEGIN COMMENT KILL USER PROCESSES FOR CANCEL AND PROGRAM CHECK;
FUNCTION HIO(8,#9E00);
R0:=#3FFFFFFF; MAXTIME:=R0; R1:=FIRSTPCB;
WHILE R1 ~= 0 DO BEGIN
IF SVCGOING(R1) THEN TM(#01,PSWSVC(R1+1)) ELSE
TM(#01,PSWSUSPEND(R1+1));
IF OVERFLOW THEN BEGIN COMMENT GOT USER PROCESS;
IF SVCLOCKOUT(R1) THEN BEGIN COMMENT SVC LOCKED OUT;
CLI(1,SVCCANCEL(R1)); IF ~= THEN BEGIN
R0:=LOCKOUTCOUNT+1; LOCKOUTCOUNT:=R0;
END;
MVI(1,SVCCANCEL(R1)); COMMENT MARK AS BEING CANCELLED;
CLI(1,STATUS(R1)); IF = THEN BEGIN COMMENT P WAIT;
R3:=SEMAPHORE(R1); R0:=B3+1; B3:=R0;
MVI(0,STATUS(R1)); OI(#10,PSWSUSPEND(R1+4));
END;
END ELSE BEGIN COMMENT NOT LOCKED OUT, KILL IT;
OI(#80,STATUS(R1));
CLI(#82,STATUS(R1)); IF = THEN BEGIN COMMENT KILL I/O;
R3:=IODEVICE(R1); HIO(B3);
END;
END;
END;
R1:=LINK(R1) AND #FFFFFF; COMMENT TRY NEXT PCB;
END;
SET(CANCELFLAG); COMMENT MARK JOB CANCELLED;
R0:=LOCKOUTCOUNT; IF R0 = 0 THEN BEGIN COMMENT START JOB CNTRL;
R0:=@ENDJOBCOUNT; FINDWAITING; IF ~= THEN FINDREADY;
END ELSE FINDREADY;
END;
GLOBAL 66 PROCEDURE IOSTUFF(R1);
BEGIN COMMENT ROUTINE TO HANDLE ALL I/O INITIATION AND INTERRUPT
PROCESSING. THE CURRENT PROCESS HAS ALREADY BEEN SUSPENDED.
R8 = @PCB, R9 = 1 FOR DOIO, 2 FOR I/O INTERRUPT, R10 = I/O
DEVICE ADDRESS. ON ERROR OR NORMAL TERMINATION (DEVICE END),
SET CONDITION CODE AS FOLLOWS:
= - NORMAL END, < - UNIT CHECK, > - UNIT EXCEPTION (ONLY),
OVERFLOW - DEVICE NOT OPERATIVE;
LONG REAL SENSECCW=#0400000020000002L, COMMENT SENSE COMMAND;
WAITPSW=#0002000000000003L; COMMENT CHANNEL CHECK WAIT;
ARRAY 2 INTEGER IOCSW SYN 64, OLDPRG SYN 40, NEWPRG SYN 104;
INTEGER CAW SYN 72, SENSEADDRESS SYN SENSECCW;
BYTE FOUNDIOWAIT, FOUNDDEVWAIT;
FUNCTION SIO(8,#9C00), TIO(8,#9D00), HIO(8,#9E00);
PROCEDURE PUTATHEAD(R12);
BEGIN COMMENT PUT CURRENT PCB AT HEAD OF QUEUE;
R1:=CURRENTPCB; R0:=FIRSTPCB; LINK(R1):=R0;
FIRSTPCB:=R1; R0:=LASTPCB;
IF R0 = 0 THEN LASTPCB:=R1;
R0:=0; CURRENTPCB:=R0;
END;
PROCEDURE CHECKCONSOLE(R11);
BEGIN COMMENT CHECK FOR CONSOLE ATTENTION;
TM(#80,IOCSW(4)); IF OVERFLOW THEN BEGIN COMMENT GOT IT;
TM(#01,IOCSW(4)); IF = THEN BEGIN
COMMENT UNLESS UNIT EXCEPTION TOO;
CONSOLEADDRESS:=R10; COMMENT FOUND CONSOLE ADDRESS;
R0:=@OPERATORCOUNT; FINDWAITING;
IF = THEN PUTATHEAD; COMMENT MAKE FIRST;
END;
END;
END;
PROCEDURE FINDCHANWAIT(R11);
BEGIN COMMENT FIND PROCESS WAITING FOR CHANNEL OR ANY READY
PROCESS IF NONE WAITING FOR CHANNEL;
BYTE FOUNDCHANWAIT;
R8:=FIRSTPCB; RESET(FOUNDCHANWAIT); R10:=R10 AND #F00;
WHILE ~FOUNDCHANWAIT AND R8 ~= 0 DO BEGIN COMMENT SEARCH;
R0:=IODEVICE(R8) AND #F00;
CLI(3,STATUS(R8)); IF = AND R0 = R10 THEN BEGIN
R9:=1; R10:=IODEVICE(R8); SET(FOUNDCHANWAIT);
COMMENT FOUND ONE, SET UP TO START I/O NOW;
END ELSE R8:=LINK(R8) AND #FFFFFF; COMMENT TRY NEXT PCB;
END;
IF ~FOUNDCHANWAIT THEN BEGIN COMMENT NONE WAITING;
FINDREADY; R9:=0;
END;
END;
WHILE R9>0 DO CASE R9 OF BEGIN COMMENT AROUND AND AROUND WE GO;
BEGIN COMMENT START I/O OPERATION;
R0:=0; R1:=0; STM(R0,R1,IOCSW); COMMENT CLEAR STUFF;
IOSTATUS(R8):=R0; STM(R0,R1,CSW(R8));
R0:=@CCWS(R8); CAW:=R0; COMMENT CCW ADDRESS;
COMMENT SET PROTECTION KEY IF ANY;
IC(R0,PSWSUSPEND(R8+1)); R0:=R0 AND #F0; STC(R0,CAW);
SIO(B10); IF = THEN BEGIN COMMENT STARTED I/O;
MVI(2,STATUS(R8)); FINDREADY; R9:=0;
COMMENT FIND SOMETHING TO DO;
END ELSE IF > THEN BEGIN COMMENT CHANNEL BUSY;
MVI(3,STATUS(R8)); FINDREADY; R9:=0;
COMMENT FIND SOMETHING TO DO;
END ELSE IF OVERFLOW THEN BEGIN COMMENT NOT OPERATIVE;
OI(#30,PSWSUSPEND(R8+4)); FINDREADY; R9:=0;
COMMENT SET RETURN CODE AND FIND SOMETHING TO DO;
END ELSE BEGIN COMMENT CSW STORED, ANALYZE IT;
TM(#10,IOCSW(4)); IF = THEN BEGIN COMMENT START ERROR;
R4:=0; R3:=FIRSTPCB;
WHILE R3 ~= R8 DO BEGIN COMMENT MOVE PCB;
R4:=R3; R3:=LINK(R3) AND #FFFFFF;
END;
MAKECURRENT; PUTATHEAD;
SET(FOUNDIOWAIT); R9:=3;
END ELSE BEGIN COMMENT DEVICE OR CONTROL BUSY;
MVI(3,STATUS(R8)); R0:=IOCSW(4) AND #AFFF0000;
IF R0 = 0 THEN BEGIN COMMENT FIND SOMETHING TO DO;
FINDREADY; R9:=0;
END ELSE BEGIN COMMENT PENDING INTERRUPT, ANALYZE;
NI(#AF,IOCSW(4)); R9:=2;
END;
END;
END;
END;
BEGIN COMMENT FIND PROCESS ASSOCIATED WITH INTERRUPT;
R3:=FIRSTPCB; R4:=0; RESET(FOUNDIOWAIT);
WHILE ~FOUNDIOWAIT AND R3 ~= 0 DO BEGIN COMMENT SEARCH;
CLI(2,STATUS(R3));
IF = AND R10 = IODEVICE(R3) THEN BEGIN
MAKECURRENT; PUTATHEAD;
SET(FOUNDIOWAIT); R8:=R3; COMMENT FOUND IT;
END ELSE BEGIN COMMENT TRY NEXT PCB;
R4:=R3; R3:=LINK(R3) AND #FFFFFF;
END;
END;
R9:=3; COMMENT NOW ANALYZE CHANNEL STATUS;
END;
BEGIN COMMENT ANALYZE CHANNEL STATUS;
IF FOUNDIOWAIT THEN BEGIN COMMENT SAVE CSW;
R0:=IOCSW OR CSW(R8); CSW(R8):=R0;
R0:=IOCSW(4) OR CSW(R8+4); CSW(R8+4):=R0;
END;
TM(#0F,IOCSW(5)); IF = THEN BEGIN COMMENT NO CHANNEL CHK;
TM(#30,IOCSW(5)); IF = THEN BEGIN COMMENT NO PRG CHKS;
TM(#02,IOCSW(4)); IF = THEN BEGIN
COMMENT NO UNIT CHECK;
TM(#01,IOCSW(4)); COMMENT UNIT EXCEPTION;
IF OVERFLOW AND FOUNDIOWAIT THEN
OI(#20,PSWSUSPEND(R8+4));
TM(#04,IOCSW(4)); IF = THEN BEGIN
COMMENT NO DEVICE END;
TM(#50,IOCSW(4)); COMMENT TAPE & DISK ONLY;
IF OVERFLOW AND FOUNDIOWAIT THEN BEGIN
NI(#CF,PSWSUSPEND(R8+4));
OI(#10,PSWSUSPEND(R8+4));
MVI(0,STATUS(R8));
END;
CHECKCONSOLE; FINDCHANWAIT;
COMMENT ASSUME CHANNEL END, NO HARM IF NOT;
END ELSE BEGIN COMMENT DEVICE END, RESTART PCB;
IF FOUNDIOWAIT THEN MVI(0,STATUS(R8));
CHECKCONSOLE;
TM(#28,IOCSW(4)); IF = THEN BEGIN
COMMENT JUST DEVICE END;
R8:=FIRSTPCB; RESET(FOUNDDEVWAIT);
COMMENT SEARCH FOR PROCESS WAITING
FOR DEVICE;
WHILE ~FOUNDDEVWAIT AND R8 ~= 0 DO BEGIN
CLI(3,STATUS(R8));
IF = AND R10 = IODEVICE(R8) THEN BEGIN
COMMENT FOUND ONE;
R9:=1; SET(FOUNDDEVWAIT);
END ELSE R8:=LINK(R8) AND #FFFFFF;
COMMENT TRY NEXT PCB;
END;
IF ~FOUNDDEVWAIT THEN BEGIN
FINDREADY; R9:=0;
END;
END ELSE FINDCHANWAIT;
COMMENT KEEP CHANNEL AND CONTROL BUSY;
END;
END ELSE BEGIN COMMENT UNIT CHECK;
IF FOUNDIOWAIT THEN BEGIN
COMMENT GET I/O STATUS BYTES;
R0:=@IOSTATUS(R8); SENSEADDRESS:=R0;
MVI(4,SENSECCW); R0:=@SENSECCW; CAW:=R0;
SIO(B10); WHILE ~= DO SIO(B10);
TIO(B10); WHILE > DO TIO(B10);
COMMENT SET UNIT CHECK CONDITION CODE;
OI(#10,PSWSUSPEND(R8+4));
END;
FINDCHANWAIT; COMMENT CHANNEL WAS FREE;
END;
END ELSE BEGIN COMMENT I/O INCORRECT LENGTH, PROGRAM
OR PROTECTION CHECK;
IF FOUNDIOWAIT THEN BEGIN COMMENT SIMULATE PRG CHK;
R4:=0; R3:=FIRSTPCB;
WHILE R3 ~= R8 DO BEGIN
R4:=R3; R3:=LINK(R3) AND #FFFFFF;
END;
MAKECURRENT; SETUP;
LM(R0,R1,SAVEPSW); R0:=R0 AND #FFFF0000;
STM(R0,R1,OLDPRG); LM(R15,R2,SAVEREGS);
LPSW(NEWPRG);
END ELSE FINDCHANWAIT; COMMENT ELSE IGNORE IT;
END;
END ELSE BEGIN COMMENT CHANNEL CHECK;
R0:=@RINGBELLCCW; CAW:=R0; R1:=CONSOLEADDRESS;
HIO(B1); SIO(B1); WHILE > DO SIO(B1);
LPSW(WAITPSW); COMMENT TRY TO RING BELL AND QUIT;
END;
END;
END;
SETUP; LM(R15,R2,SAVEREGS); LPSW(SAVEPSW);
COMMENT DONE WITH I/O, GO DO SOMETHING;
END;
PROCEDURE EXTERNALINTERRUPT(R3);
BEGIN COMMENT SET UP AND HANDLE EXTERNAL INTERRUPTS;
ARRAY 2 INTEGER OLDEXT SYN 24, IOCSW SYN 64;
ARRAY 2 INTEGER OLDSVC SYN 32, NEWSVC SYN 96;
INTEGER SAVEPCB; BYTE ENDINTERVAL;
FUNCTION HIO(8,#9E00);
PROCEDURE MAKENEWPSW(R1);
BEGIN COMMENT SET NEW PSW TO TRANSFER TO POINT OF CALL;
ARRAY 2 INTEGER NEWEXT SYN 88;
FUNCTION RETURN(0,#07F3);
R0:=#00040000; R1:=R1 AND #FFFFFF;
STM(R0,R1,NEWEXT); RETURN;
END;
MAKENEWPSW; COMMENT SAVE REGISTERS AND PSW;
STM(R15,R2,SAVEREGS); LM(R0,R1,OLDEXT);
STM(R0,R1,SAVEPSW); R2 := REFTABLE(256); R15 := REFTABKE(260);
R0 := R0 AND #80;
IF R0 ^= 0 THEN BEGIN COMMENT TIMER INTERRUPT;
R0 := 76800; TIMER := R0; COMMENT RESET TIMER TI 1 SECOND;
R0 := SECOND + 1; SECOND := R0;
IF R0 > 86400 THEN BEGIN COMMENT ADJUST DATE AT MIDNIGHT;
R0 := 0; SECOND := R0;
R0:= DAY + 1; DAY := R0; R1 := YEAR AND 3;
IF R0 > 366 THEN COMMENT DONT FORGET LEAP YEAR;
IF R0 = 367 OR R1 ^= 0 THEN BEGIN
R0 := 1; DAY := R0; R0 := YEAR + 1; YEAR := R0;
END;
END;
R0 := JOBTIME + 1; JOBTIME := R0; COMMENT KEEP JOB INTERVAL TIMER;
R1 := FIRSTPCB; RESET(ENDINTERVAL); COMMENT WAITING PROCESSES;
WHILE R1 ^= 0 DO BEGIN COMENT SEARCH FOR THEM;
CLI(5,STATUS(R1)); IF = THEN BEGIN COMMENT FOUND ONE;
***********************************************************************
* This block just marks where the tape was bad. Been repaired-11/2000 *
- Ronald H. Tatum
* ALAN WEAVER - 01/07/97 *
* *
* *
* BLOCK 21 (OUT OF 192) WAS INVALID ON 800 BPI SOURCE TAPE. *
* *
* *
* *
***********************************************************************
???????????????????????????????????????????????????????????????????????
R0:=INTERVAL(R1)-1; INTERVAL(R1):=R0;
IF R0 <= 0 THEN BEGIN COMMENT END OF WAIT;
MVI(0,STATUS(R1));
IF ~ENDINTERVAL THEN SAVEPCB:=R1;
COMMENT MARK FIRST; SET(ENDINTERVAL);
END;
END;
CLI(2,STATUS(R1)); IF = THEN BEGIN COMMENT CHECK TIMEOUT;
R0:=IOTIMEOUT(R1)-1; IOTIMEOUT(R1):=R0;
IF R0 < 0 THEN BEGIN COMMENT TIME LIMIT EXCEEDED;
R0:=R1; R1:=IODEVICE(R1); HIO(B1); R1:=R0;
IF < THEN BEGIN COMMENT CSW STORED, UPDATE;
R0:=IOCSW(4) AND #FF0000 OR CSW(R1+4);
CSW(R1+4):=R0;
END;
END;
END;
R1:=LINK(R1) AND #FFFFFF; COMMENT TO NEXT PCB;
END;
IF ENDINTERVAL THEN BEGIN COMMENT FOUND FINISHED PROCESS;
SUSPEND; R3:=FIRSTPCB; R4:=0;
WHILE R3 ~= SAVEPCB DO BEGIN COMMENT SET UP FOR RESTART;
R4:=R3; R3:=LINK(R3) AND #FFFFFF;
END;
MAKECURRENT; SETUP;
END;
R0:=JOBTIME; IF R0 > MAXTIME THEN BEGIN COMMENT CANCEL JOB;
LM(R0,R1,SAVEPSW); R0:=R0 AND #FFFF0000 OR #100;
STM(R0,R1,OLDSVC); LM(R15,R2,SAVEREGS); LPSW(NEWSVC);
COMMENT FAKE CANCEL CALL;
END;
END;
LM(R15,R2,SAVEREGS); LPSW(SAVEPSW); COMMENT RESTART PROCESS;
END;
PROCEDURE SUPERVISORCALL(R3);
BEGIN COMMENT SET UP AND HANDLE SUPERVISOR CALLS;
ARRAY 2 INTEGER OLDSVC SYN 32;
FUNCTION HIO(8,#9E00);
PROCEDURE MAKENEWPSW(R1);
BEGIN COMMENT SET NEW PSW TO TRANSFER TO POINT OF CALL;
ARRAY 2 INTEGER NEWSVC SYN 96;
FUNCTION RETURN(0,#07F3);
R0:=#00040000; R1:=R1 AND #FFFFFF;
STM(R0,R1,NEWSVC); RETURN;
END;
PROCEDURE CHECKR0(R1);
BEGIN COMMENT IF PROBLEM PROGRAM CALL, CHECK ADDRESS IN R1
FOR VALIDITY;
BYTE ADDRESSOK;
SET(ADDRESSOK); TM(#01,SAVEPSW(1));
IF OVERFLOW THEN BEGIN COMMENT OK, CHECK ADDRESS;
R0:=SAVEREGS(4) AND 3;
IF R0 ~= 0 THEN RESET(ADDRESSOK) ELSE BEGIN
R0:=SAVEREGS(4);
IF R0 > ENDMEMORY OR R0 < USERMEMORY THEN
RESET(ADDRESSOK);
END;
END;
TEST(ADDRESSOK); COMMENT SET CONDITION CODE;
END;
MAKENEWPSW; COMMENT SAVE REGISTERS AND PSW;
STM(R15,R2,SAVEREGS); LM(R0,R1,OLDSVC);
STM(R0,R1,SAVEPSW); R2:=REFTABLE(256); R15:=REFTABLE(260);
CLI(0,SAVEPSW(2)); IF = THEN NI(#CF,SAVEPSW(4));
R0:=R0 AND #FF;
IF R0 >= 16 THEN BEGIN COMMENT LEVEL 1 SUPERVISOR CALLS;
R1:=CURRENTPCB; STM(R3,R6,REGSVC(R1+16)); R4:=R1;
LM(R0,R3,SAVEREGS); STM(R0,R3,REGSVC(R4));
LM(R0,R1,SAVEPSW); STM(R0,R1,PSWSVC(R4));
SET(SVCGOING(R4)); COMMENT REGISTERS AND PSW SAVED FOR SVC;
R0:=#FF040000; R1:=REFTABLE(268);
STM(R0,R1,SAVEPSW); SAVEREGS:=R1; COMMENT GO PROCESSSVC;
END ELSE BEGIN COMMENT LEVEL 0 SUPERVISOR CALLS;
R1:=CURRENTPCB;
IF R1 ~= 0 THEN BEGIN COMMENT SET UP FOR POSS. CANCEL;
MVC(3,CANCELCODE(R1),1);
IF R0 ~= 0 THEN MVI(2,CANCELCODE(R1+3));
CLI(0,SAVEPSW(2)); IF ~= THEN MVI(3,CANCELCODE(R1+3));
END;
R1:=R0+1; WHILE R1 > 0 DO CASE R1 OF BEGIN COMMENT DO SVC;
BEGIN COMMENT CANCEL JOB;
R1:=CURRENTPCB; IF R1 ~= 0 THEN BEGIN
SUSPEND; R1:=LASTPCB;
R0:=CANCELCODE(R1); TM(#01,PSWSUSPEND(R1+1));
IF = AND R0 = 1 THEN R0:=REGSUSPEND(R1);
CANCELCODE(R1):=R0;
IF SVCGOING(R1) THEN TM(#01,PSWSVC(R1+1)) ELSE
TM(#01,PSWSUSPEND(R1+1));
IF OVERFLOW AND ~SVCLOCKOUT(R1) THEN
MVI(4,STATUS(R1));
COMMENT TAKEN CARE OF ACTIVE USER PROCESS;
END;
CANCELKILL; SETUP; R1:=0;
END;
BEGIN COMMENT START PROCESS;
R1:=FREEPCB; IF R1 = 0 THEN BEGIN
COMMENT NO FREE PCB, INDICATE AND RETURN;
R0:=SAVEREGS(8) AND #CFFFFFFF OR #10000000;
SAVEPSW(4):=R0; COMMENT USE ADDRESS IN R1;
SAVEREGS(4):=R1; R1:=0;
END ELSE BEGIN
SUSPEND; R3:=LASTPCB; R1:=FREEPCB;
R0:=LINK(R1) AND #FFFFFF; FREEPCB:=R0;
COMMENT COPY PCB CONTENTS INTO NEW PCB;
FOR R4:=8 STEP 4 UNTIL PCBSIZE DO BEGIN
R5:=R4-4; R0:=B3(R5); B1(R5):=R0;
END;
R0:=REGSUSPEND(R3+4); PSWSUSPEND(R3+4):=R0;
COMMENT OLD PROCESS RETURNS TO ADDRESS IN R1;
R0:=MAXPCBNO+1; MAXPCBNO:=R0; PCBNUMBER(R1):=R0;
REGSUSPEND(R3):=R0; NI(#CF,PSWSUSPEND(R3+4));
REGSUSPEND(R1):=R0; COMMENT LET BOTH KNOW NUMBER;
CURRENTPCB:=R1; SETUP; R1:=0;
END;
END;
BEGIN COMMENT STOP PROCESS;
TM(#01,SAVEPSW(1)); IF OVERFLOW THEN BEGIN
R1:=CURRENTPCB; R0:=0; COMMENT COUNT USER PCBS;
WHILE R1~=0 DO BEGIN
IF SVCGOING(R1) THEN TM(#01,PSWSVC(R1+1)) ELSE
TM(#01,PSWSUSPEND(R1+1));
IF OVERFLOW THEN R0:=R0+1;
R1:=LINK(R1) AND #FFFFFF; COMMENT TRY NEXT PCB;
END;
END ELSE R0:=1; COMMENT FORCE OK IF SYSTEM CALL;
IF R0 = 0 THEN R1:=1 ELSE BEGIN
R1:=CURRENTPCB; R0:=FREEPCB; COMMENT NOW STOP IT;
COMMENT RETURN PCB TO FREE LIST;
LINK(R1):=R0; FREEPCB:=R1; R0:=0;
CURRENTPCB:=R0; FINDREADY; SETUP; R1:=0;
END;
END;
BEGIN COMMENT P OPERATION - WAIT ON SEMAPHORE;
CHECKR0; IF ~= THEN R1:=1 ELSE BEGIN
R1:=CURRENTPCB; CLI(0,SVCCANCEL(R1));
IF ~= THEN OI(#10,SAVEPSW(4)) ELSE BEGIN
COMMENT IF IN STOP OR CANCEL, SKIP P;
R1:=SAVEREGS(4);
R0:=B1-1; B1:=R0; COMMENT DECREMENT SEMAPHORE;
IF R0 < 0 THEN BEGIN COMMENT WAIT FOR V;
SUSPEND; R1:=LASTPCB; MVI(1,STATUS(R1));
R0:=REGSUSPEND(R1) AND #FFFFFF;
SEMAPHORE(R1):=R0; FINDREADY; SETUP;
END;
END;
R1:=0;
END;
END;
BEGIN COMMENT V OPERATION - RELEASE PROCESS ON SEMAPHORE;
CHECKR0; IF ~= THEN R1:=1 ELSE BEGIN
R1:=SAVEREGS(4);
R0:=B1+1; B1:=R0; COMMENT INCREMENT SEMAPHORE;
IF R0 <= 0 THEN BEGIN COMMENT FIND FIRST WAITING;
SUSPEND; R1:=LASTPCB;
R0:=REGSUSPEND(R1) AND #FFFFFF;
FINDWAITING; IF ~= THEN FINDREADY; SETUP;
END;
R1:=0;
END;
END;
BEGIN COMMENT DOIO OPERATION;
TM(#01,SAVEPSW(1)); IF OVERFLOW THEN R1:=1 ELSE BEGIN
SUSPEND; R8:=LASTPCB; R10:=REGSUSPEND(R8);
COMMENT ONLY SUPERVISOR CAN CALL;
IODEVICE(R8):=R10;
R0:=#3FFFFFFF; IOTIMEOUT(R8):=R0;
R9:=1; IOSTUFF; COMMENT LET IOSTUFF DO DIRTY WORK;
END;
END;
BEGIN COMMENT WAIT FOR TIME INTERVAL;
SUSPEND; R1:=LASTPCB; R0:=REGSUSPEND(R1);
INTERVAL(R1):=R0; IF R0 > 0 THEN MVI(5,STATUS(R1));
FINDREADY; SETUP; R1:=0;
END;
BEGIN COMMENT RETURN FROM LEVEL 1 SUPERVISOR CALL;
R1:=CURRENTPCB; COMMENT CHECK IN LEVEL 1 SVC;
IF SVCGOING(R1) THEN BEGIN
R4:=R1; LM(R0,R3,REGSVC(R4)); STM(R0,R3,SAVEREGS);
LM(R0,R1,PSWSVC(R4)); STM(R0,R1,SAVEPSW); R1:=R4;
LM(R3,R6,REGSVC(R1+16)); RESET(SVCGOING(R1));
R1:=0; COMMENT RESTORED STUFF;
END ELSE R1:=1; COMMENT NOT IN LEVEL 1 SVC;
END;
BEGIN COMMENT STOP SPECIFIED PROCESS;
INTEGER SAVENEXT, SAVELAST;
BYTE FOUNDIT, USERMODE;
RESET(USERMODE); COMMENT USER CAN STOP USER PROCESSES;
TM(#01,SAVEPSW(1)); IF OVERFLOW THEN SET(USERMODE);
R1:=FIRSTPCB; RESET(FOUNDIT);
R0:=0; SAVELAST:=R0; R0:=SAVEREGS(4);
WHILE ~FOUNDIT AND R1 ~= 0 DO
IF R0 = PCBNUMBER(R1) THEN SET(FOUNDIT) ELSE BEGIN
SAVELAST:=R1; R1:=LINK(R1) AND #FFFFFF;
END;
IF FOUNDIT THEN BEGIN COMMENT FOUND PROCESS;
IF SVCGOING(R1) THEN TM(#01,PSWSVC(R1+1)) ELSE
TM(#01,PSWSUSPEND(R1+1));
IF = AND USERMODE THEN R1:=1 ELSE BEGIN
IF SVCLOCKOUT(R1) THEN BEGIN
OI(#10,SAVEPSW(4));
CLI(0,SVCCANCEL(R1));
IF = THEN MVI(2,SVCCANCEL(R1));
END ELSE BEGIN
R0:=LINK(R1) AND #FFFFFF; SAVENEXT:=R0;
R0:=FREEPCB;
CLI(2,STATUS(R1)); IF = THEN BEGIN
LINK(R1):=R0; FREEPCB:=R1;
COMMENT HALT ANY I/O;
R1:=IODEVICE(R1); HIO(B1);
END ELSE BEGIN
LINK(R1):=R0; FREEPCB:=R1;
END;
R1:=SAVELAST;
IF R1 ~= 0 THEN BEGIN
R0:=STATUS(R1) SHLL 24 OR SAVENEXT;
LINK(R1):=R0;
END ELSE BEGIN
R0:=SAVENEXT; FIRSTPCB:=R0;
END;
R0:=SAVENEXT; IF R0 = 0 THEN LASTPCB:=R1;
END;
R1:=0;
END;
END ELSE BEGIN
OI(#20,SAVEPSW(4)); R1:=0;
END;
END;
BEGIN COMMENT FIND FIRST CANCELLED PROCESS;
BYTE FOUNDIT;
TM(#01,SAVEPSW(1)); IF OVERFLOW THEN R1:=1 ELSE BEGIN
COMMENT MUST BE SUPERVISOR;
R1:=FIRSTPCB; RESET(FOUNDIT);
WHILE ~FOUNDIT AND R1 ~= 0 DO BEGIN
TM(#80,STATUS(R1));
IF OVERFLOW THEN SET(FOUNDIT) ELSE
R1:=LINK(R1) AND #FFFFFF;
END;
SAVEREGS(8):=R1; R1:=0;
IF ~FOUNDIT THEN OI(#10,SAVEPSW(4));
END;
END;
BEGIN COMMENT RETURN TO JOB CONTROL;
R0:=0; R1:=FIRSTPCB;
WHILE R1 ~= 0 DO BEGIN COMMENT LAST USER PROCESS?;
IF SVCGOING(R1) THEN TM(#01,PSWSVC(R1+1))
ELSE TM(#01,PSWSUSPEND(R1+1));
IF OVERFLOW THEN R0:=R0+1;
R1:=LINK(R1) AND #FFFFFF;
END;
IF R0 > 0 THEN R1:=1 ELSE BEGIN
R1:=CURRENTPCB; R0:=FREEPCB; LINK(R1):=R0;
FREEPCB:=R1; R0:=0; CURRENTPCB:=R0;
R0:=@ENDJOBCOUNT; FINDWAITING;
IF ~= THEN R1:=1 ELSE BEGIN
SETUP; R1:=0;
END;
END;
END;
BEGIN COMMENT DOIO OPERATION WITH TIMEOUT;
TM(#01,SAVEPSW(1)); IF OVERFLOW THEN R1:=1 ELSE BEGIN
SUSPEND; R8:=LASTPCB; R10:=REGSUSPEND(R8);
COMMENT ONLY SUPERVISOR CAN CALL;
IODEVICE(R8):=R10;
R0:=REGSUSPEND(R8+4); IOTIMEOUT(R8):=R0;
R9:=1; IOSTUFF; COMMENT LET IOSTUFF DO DIRTY WORK;
END;
END;
BEGIN COMMENT SET PROTECTION KEY FOR PROCESSSVC;
TM(#01,SAVEPSW(1)); IF OVERFLOW THEN R1:=1 ELSE BEGIN
R1:=CURRENTPCB;
R0:=PSWSVC(R1) AND #00F00000 OR SAVEPSW;
SAVEPSW:=R0; R1:=0;
END;
END;
BEGIN COMMENT RESET PROTECTION KEY FOR PROCESSSVC;
TM(#01,SAVEPSW(1)); IF OVERFLOW THEN R1:=1 ELSE BEGIN
NI(#0F,SAVEPSW(1)); R1:=0;
END;
END;
BEGIN COMMENT ENTER SVC ROUTINE LOCKOUT MODE;
TM(#01,SAVEPSW(1)); IF OVERFLOW THEN R1:=1 ELSE BEGIN
R1:=CURRENTPCB;
IF SVCLOCKOUT(R1) THEN R1:=1 ELSE BEGIN
SET(SVCLOCKOUT(R1)); R1:=0;
END;
END;
END;
BEGIN COMMENT LEAVE SVC ROUTINE LOCKOUT MODE;
TM(#01,SAVEPSW(1)); IF OVERFLOW THEN R1:=1 ELSE BEGIN
R1:=CURRENTPCB;
IF ~SVCLOCKOUT(R1) THEN R1:=1 ELSE BEGIN
RESET(SVCLOCKOUT(R1)); CLI(0,SVCCANCEL(R1));
IF = THEN R1:=0 ELSE BEGIN
CLI(2,SVCCANCEL(R1)); COMMENT STOP OR CANCEL;
IF = THEN R1:=3 ELSE BEGIN
SUSPEND; R1:=LASTPCB; OI(#80,STATUS(R1));
R0:=LOCKOUTCOUNT-1; LOCKOUTCOUNT:=R0;
IF R0 = 0 THEN BEGIN COMMENT START JOBCTL;
R0:=@ENDJOBCOUNT; FINDWAITING;
IF ~= THEN FINDREADY;
END ELSE FINDREADY;
SETUP; R1:=0;
END;
END;
END;
END;
END;
END;
END;
LM(R15,R2,SAVEREGS); LPSW(SAVEPSW); COMMENT RESTART PROCESS;
END;
PROCEDURE PROGRAMCHECK(R3);
BEGIN COMMENT SET UP AND HANDLE PROGRAM CHECKS;
ARRAY 2 INTEGER OLDPRG SYN 40;
LONG REAL WAIT1PSW=#0002000000000001L,
WAIT2PSW=#0002000000000002L;
INTEGER CAW SYN 72;
FUNCTION SIO(8,#9C00), HIO(8,#9E00), SRL(9,#8800);
PROCEDURE MAKENEWPSW(R1);
BEGIN COMMENT SET NEW PSW TO TRANSFER TO POINT OF CALL;
ARRAY 2 INTEGER NEWPRG SYN 104;
FUNCTION RETURN(0,#07F3);
R0:=#00040000; R1:=R1 AND #FFFFFF;
STM(R0,R1,NEWPRG); RETURN;
END;
MAKENEWPSW; COMMENT SAVE REGISTERS AND PSW;
STM(R15,R2,SAVEREGS); LM(R0,R1,OLDPRG);
STM(R0,R1,SAVEPSW); R2:=REFTABLE(256); R15:=REFTABLE(260);
R1:=CURRENTPCB; IF R1 ~= 0 THEN BEGIN COMMENT ACTIVE PROCESS;
R1:=R0 AND #F; R0:=#80000000; SRL(R0,B1);
R1:=CURRENTPCB; R0:=R0 AND PRGCHKMASK(R1);
IF R0 ~= 0 THEN BEGIN COMMENT ALLOWABLE PROGRAM CHECK;
OI(#30,SAVEPSW(4)); COMMENT SET OVERFLOW;
LM(R15,R2,SAVEREGS); LPSW(SAVEPSW); COMMENT RETURN;
END;
SUSPEND; R1:=LASTPCB;
IF ~SVCLOCKOUT(R1) THEN MVI(6,STATUS(R1)) ELSE
OI(#30,PSWSUSPEND(R1+4));
IF SVCGOING(R1) THEN TM(#01,PSWSVC(R1+1)) ELSE
TM(#01,PSWSUSPEND(R1+1));
IF = THEN BEGIN COMMENT SUPERVISOR PROCESS LEVEL;
R0:=@RINGBELLCCW; CAW:=R0; R1:=CONSOLEADDRESS;
HIO(B1); SIO(B1); WHILE > DO SIO(B1);
LPSW(WAIT1PSW); COMMENT RING BELL AND QUIT;
END;
CANCELKILL; SETUP;
LM(R15,R2,SAVEREGS); LPSW(SAVEPSW);
END ELSE BEGIN COMMENT SUPERVISOR INTERRUPT LEVEL;
R0:=@RINGBELLCCW; CAW:=R0; R1:=CONSOLEADDRESS;
HIO(B1); SIO(B1); WHILE > DO SIO(B1);
LPSW(WAIT2PSW); COMMENT RING BELL AND QUIT;
END;
END;
PROCEDURE MACHINECHECK(R3);
BEGIN COMMENT SET UP AND HANDLE MACHINE CHECKS;
LONG REAL WAITPSW=#0002000000FFFFFFL;
INTEGER CAW SYN 72;
FUNCTION SIO(8,#9C00), HIO(8,#9E00);
PROCEDURE MAKENEWPSW(R1);
BEGIN COMMENT SET NEW PSW TO TRANSFER TO POINT OF CALL;
ARRAY 2 INTEGER NEWMCH SYN 112;
FUNCTION RETURN(0,#07F3);
R0:=0; R1:=R1 AND #FFFFFF;
STM(R0,R1,NEWMCH); RETURN;
END;
MAKENEWPSW; COMMENT TRY TO RING BELL AND WAIT FOREVER;
R2:=REFTABLE(256); R15:=REFTABLE(260);
R0:=@RINGBELLCCW; CAW:=R0; R1:=CONSOLEADDRESS;
HIO(B1); SIO(B1); WHILE > DO SIO(B1); LPSW(WAITPSW);
END;
PROCEDURE IOINTERRUPT(R3);
BEGIN COMMENT SET UP AND HANDLE I/O INTERRUPTS;
ARRAY 2 INTEGER OLDIO SYN 56;
PROCEDURE MAKENEWPSW(R1);
BEGIN COMMENT SET NEW PSW TO TRANSFER TO POINT OF CALL;
ARRAY 2 INTEGER NEWIO SYN 120;
FUNCTION RETURN(0,#07F3);
R0:=#00040000; R1:=R1 AND #FFFFFF;
STM(R0,R1,NEWIO); RETURN;
END;
MAKENEWPSW; COMMENT SAVE REGISTERS AND PSW;
STM(R15,R2,SAVEREGS); LM(R0,R1,OLDIO);
STM(R0,R1,SAVEPSW); R2:=REFTABLE(256); R15:=REFTABLE(260);
SUSPEND; R8:=0; R9:=2; R10:=SAVEPSW AND #FFF;
IOSTUFF; COMMENT LET IOSTUFF DO THE DIRTY WORK;
END;
ARRAY 432 LONG REAL PCBTABLE; COMMENT ACTUAL PCB STORAGE.
USE (NUMBEROFPCBS*PCBSIZE)/8 AS ARRAY SIZE;
COMMENT INITIALIZE ALL VARIABLES AND TABLES;
R0:=0; YEAR:=R0; DAY:=R0; SECOND:=R0;
JOBTIME:=R0; ENDJOBCOUNT:=R0; OPERATORCOUNT:=R0;
MAXPCBNO:=R0; FIRSTPCB:=R0; LASTPCB:=R0; LOCKOUTCOUNT:=R0;
RESET(CANCELFLAG); R0:=#3FFFFFFF; MAXTIME:=R0;
R0:=ENDSUPERVISOR+7 AND _8; USERMEMORY:=R0; COMMENT SET BY IPL;
R0:=#FFFFFF; ENDMEMORY:=R0; COMMENT ASSUME BIG MEMORY AT FIRST;
R6:=@PCBTABLE; FREEPCB:=R6; COMMENT SET UP FREE PCB LIST;
FOR R4:=2 STEP 1 UNTIL NUMBEROFPCBS DO BEGIN
IF R4=NUMBEROFPCBS THEN R7:=0 ELSE R7:=R6+PCBSIZE;
LINK(R6):=R7; R6:=R6+PCBSIZE;
END;
CURRENTPCB:=R6; COMMENT LEAVE ONE PCB FOR INITIALIZATION PROCESS;
R5:=R6+PCBSIZE-4; R0:=0;
FOR R7:=R6 STEP 4 UNTIL R5 DO B7:=R0; COMMENT INITIALIZE PCB;
COMMENT SET UP TO START PROCEDURE LEVEL1 AS FIRST PROCESS;
R0:=REFTABLE(276); REGSUSPEND(R6+60):=R0;
PSWSUSPEND(R6+4):=R0; R0:=#FF040000; PSWSUSPEND(R6):=R0;
BEGIN COMMENT NOW FIND MEMORY SIZE;
PROCEDURE SIZE(R1);
BEGIN COMMENT CLEAR MEMORY UNTIL PROGRAM CHECK OCCURS;
ARRAY 2 INTEGER NEWPRG SYN 104;
FUNCTION XC(13,#D700);
R0:=0; STM(R0,R1,NEWPRG); COMMENT RETURN WHEN DONE;
FOR R3:=USERMEMORY+255 AND _256 STEP 256 UNTIL #FFFF00 DO
XC(255,B3,B3);
END;
SIZE; R3:=R3-1; ENDMEMORY:=R3; COMMENT NOW KNOW SIZE;
END;
BEGIN COMMENT SET UP STORAGE PROTECTION IF IT EXISTS;
PROCEDURE PROTECT(R1);
BEGIN COMMENT PROGRAM CHECK INDICATES NO PROTECTION;
ARRAY 2 INTEGER NEWPRG SYN 104;
FUNCTION SSK(1,#0800);
R0:=0; STM(R0,R1,NEWPRG); COMMENT RETURN WHEN DONE;
FOR R3:=ENDMEMORY AND _2048 STEP _2048 UNTIL 0 DO
SSK(R0,R3);
SET(PROTECTION);
END;
RESET(PROTECTION); PROTECT;
END;
BEGIN COMMENT SEE IF MACHINE HAS FLOATING POINT;
PROCEDURE CHECKFLOAT(R1);
BEGIN COMMENT PROGRAM CHECK INDICATES NO FLOATING POINT;
ARRAY 2 INTEGER NEWPRG SYN 104;
FUNCTION LTDR(0,#2200);
R0:=0; STM(R0,R1,NEWPRG); COMMENT RETURN WHEN DONE;
LTDR; SET(FLOATINGPOINT);
END;
RESET(FLOATINGPOINT); CHECKFLOAT;
END;
R0:=0; CONSOLEADDRESS:=R0; COMMENT NO CONSOLE YET;
COMMENT NOW INITIALIZE INTERRUPT HANDLING ROUTINES;
EXTERNALINTERRUPT; SUPERVISORCALL; PROGRAMCHECK; MACHINECHECK;
IOINTERRUPT;
R0:=76800; TIMER:=R0; COMMENT START UP ONE SECOND TIMER;
SETUP; LM(R15,R2,SAVEREGS); LPSW(SAVEPSW);
COMMENT AND AWAY WE GO;
END;
$PAGE
GLOBAL 67 PROCEDURE PROCESSSVC(R1);
BEGIN COMMENT LEVEL1 SUPERVISOR CALL ROUTINES;
ARRAY 27 LONG REAL PCB SYN B6; COMMENT SEE LEVEL0 FOR DETAILS;
ARRAY 2 INTEGER CSW SYN PCB(8), PSW SYN PCB(128);
ARRAY 10 INTEGER CCWS SYN PCB(16);
ARRAY 8 INTEGER REGS SYN PCB(136);
ARRAY 5 BYTE DISKRECORDID SYN PCB(168);
ARRAY 2 BYTE SENSE SYN PCB(174);
ARRAY 8 BYTE DISKCOUNTID SYN PCB(176);
BYTE PRGCHKMASK SYN PCB(185);
INTEGER TIMEOUT SYN PCB(188);
ARRAY 3 INTEGER WORK SYN PCB(192);
ARRAY 6 BYTE DISKSEEKADR SYN PCB(208);
ARRAY 2 BYTE SCRATCH SYN PCB(214);
EXTERNAL 68 BASE R5; COMMENT SEE LEVEL1 FOR DETAILS;
ARRAY 64 INTEGER SEGLENGTHTBL, CONSOLETRT,
OVERLAYADR;
ARRAY 16 SHORT INTEGER OVERLAYSEG;
INTEGER OVERLAYDEV, OVERLAYLOCK;
ARRAY 3 INTEGER OVERLAYWORK;
ARRAY 10 INTEGER RETRANSLATE;
ARRAY 4 INTEGER HEXTBL SYN RETRANSLATE;
ARRAY 2 INTEGER FREEDUMPLIM, SEGDUMPMASK;
ARRAY 8 INTEGER LOGUNITTBL, LOGUNITSAVE, TAPEDRIVES;
ARRAY 32 INTEGER DISKDRIVES;
ARRAY 4 SHORT INTEGER TRKPERCYL, PADDIV, TRKCAP, RECPAD,
PADMUL, DISKTYPE, LOCKOUT, LOCKLIM, FIRSTTRK, OTHERTRK;
ARRAY 12 SHORT INTEGER MONTHS;
INTEGER ERRMSGLOCK;
ARRAY 26 BYTE ERRMSG;
ARRAY 8 BYTE ERRANS;
INTEGER ASKJOB;
ARRAY 9 BYTE IOERRTXT;
ARRAY 8 BYTE SAMEMSG;
ARRAY 7 BYTE CANCELRPY;
ARRAY 6 BYTE RETRYRPY;
ARRAY 16 BYTE ELAPSED;
ARRAY 11 BYTE ASKRPYMSG;
COMMENT ASSIGN TABLE LAYOUT;
SHORT INTEGER DRIVENO SYN 0;
BYTE PROTECTED SYN 2, JOBREAD SYN 3, JOBWRITE SYN 4,
JOBASSIGNED SYN 5, EXTENTCNT SYN 6, DISKUNIT SYN 7,
TAPEMODE SYN EXTENTCNT;
INTEGER ASSIGNLOCK SYN 8;
ARRAY 8 BYTE ASSIGNNAME SYN 12, AREANAME SYN 20;
ARRAY 32 SHORT INTEGER EXTENTS SYN 28;
SHORT INTEGER STARTTRACK SYN EXTENTS, NOTRACKS SYN EXTENTS(2);
BYTE SHARED SYN 92;
COMMENT DISK DRIVE TABLE LAYOUT;
SHORT INTEGER DISKADDRESS SYN DISKDRIVES,
DISKDRIVETYPE SYN DISKDRIVES(2);
INTEGER VTOCLOCK SYN DISKDRIVES(4);
ARRAY 8 BYTE DISKLABEL SYN DISKDRIVES(8);
COMMENT TAPE DRIVE TABLE LAYOUT;
SHORT INTEGER TAPEADDRESS SYN TAPEDRIVES,
TAPEDRIVETYPE SYN TAPEDRIVES(2);
PROCEDURE OPENLINE(R3);
BEGIN COMMENT MAKE PRINT BUFFER AVAILABLE;
EXTERNAL 72 BASE R4; COMMENT SEE LEVEL1 BUFFERING PROCESS;
INTEGER EMPTY, FULL, PTR, STARTB, ENDB, WTRLOCK, LINENO;
SVCLOCK; R0:=@WTRLOCK; P; IF ~= THEN SVCUNLOCK;
R0:=@EMPTY; P; IF ~= THEN BEGIN
R0:=@WTRLOCK; V; SVCUNLOCK;
END;
R2:=PTR;
END;
PROCEDURE CLOSELINE(R3);
BEGIN COMMENT FINISH UP PRINT BUFFER HANDLING;
EXTERNAL 72 BASE R4; COMMENT SEE LEVEL1 BUFFERING PROCESS;
INTEGER EMPTY, FULL, PTR, STARTB, ENDB, WTRLOCK, LINENO,
ADDRESS, GETPTR, NOBUFF;
BYTE JOBSTART;
R2:=PTR; MVI(3,B2); R0:=LINENO-1;
IF R0 < 0 THEN BEGIN COMMENT NEW PAGE;
R0:=59; MVI(#8B,B2);
END;
IF JOBSTART THEN BEGIN
RESET(JOBSTART); NI(#FC,B2);
END;
LINENO:=R0; R2:=R2+133;
IF R2 = ENDB THEN R2:=STARTB; PTR:=R2; R2:=LINENO;
R0:=@FULL; V; R0:=@WTRLOCK; V; SVCUNLOCK;
END;
PROCEDURE WRITECONSOLE(R3);
BEGIN COMMENT WRITE MESSAGE ON CONSOLE;
INTEGER CONSOLE SYN 76;
R0:=R0 OR #09000000; CCWS:=R0;
R1:=R1 OR #20000000; CCWS(4):=R1;
R2:=0;
WHILE R2 = 0 DO BEGIN
R0:=CONSOLE; IF R0 = 0 THEN BEGIN
R0:=1; WAIT;
END ELSE BEGIN
DOIO; IF = THEN R2:=1 ELSE BEGIN
IF OVERFLOW THEN BEGIN
R0:=1; WAIT;
END ELSE BEGIN
MVC(7,CCWS(8),CCWS);
R0:=#0B000000; R1:=#20000001;
STM(R0,R1,CCWS); R0:=CONSOLE; DOIO;
MVC(7,CCWS,CCWS(8)); R0:=5; WAIT;
COMMENT BELL WAS RUNG, WAIT FOR FIX;
END;
END;
END;
END;
END;
PROCEDURE READCONSOLE(R3);
BEGIN COMMENT READ FROM CONSOLE;
BYTE USERCALL SYN CCWS(32);
INTEGER CONSOLE SYN 76;
SHORT INTEGER RESLENGTH SYN CSW(6);
FUNCTION LIT(2,#4100);
PROCEDURE RINGBELL(R1);
BEGIN
MVC(15,CCWS(16),CCWS); R0:=#0B000000; CCWS:=R0;
R0:=#20000001; CCWS(4):=R0; R0:=CONSOLE; DOIO;
MVC(15,CCWS,CCWS(16));
END;
IF R1 < #1000 THEN BEGIN COMMENT FAKE REQUEST MESSAGE;
R1:=R1 OR #B0000; R2:=@ASKRPYMSG;
END;
R2:=R2 OR #09000000; CCWS:=R2;
R2:=R0 AND #FFFFFF OR #0A000000; CCWS(8):=R2;
CCWS(32):=R0; R0:=R1 SHRL 16 OR #60000000;
CCWS(4):=R0; R1:=R1 AND #FFFF OR #20000000;
CCWS(12):=R1; R2:=0;
WHILE R2 = 0 DO BEGIN
R0:=CONSOLE; IF R0 = 0 THEN BEGIN
R0:=1; WAIT;
END ELSE BEGIN
R1:=120; IF USERCALL THEN SETKEY; TIMEDDOIO;
IF = THEN BEGIN
RESETKEY; R0:=TIMEOUT;
IF R0 < 0 THEN RINGBELL ELSE BEGIN
R2:=1; R1:=CCWS(12) AND #FFFF-RESLENGTH;
END;
END ELSE IF OVERFLOW THEN BEGIN
RESETKEY; R0:=1; WAIT;
END ELSE IF < THEN BEGIN
RESETKEY; R2:=TIMEOUT; RINGBELL;
IF R2 >= 0 THEN BEGIN
R0:=5; WAIT;
END;
R2:=0;
END;
END;
END;
END;
PROCEDURE IOERREDIT(R3);
BEGIN COMMENT SETUP FOR I/O ERROR MESSAGE;
SVCLOCK; R0:=@ERRMSGLOCK; P; IF ~= THEN SVCUNLOCK;
R0:=DRIVENO(R1);
IF DISKUNIT(R1) THEN BEGIN COMMENT DISK OR TAPE;
MVI("D",ERRMSG); R2:=R0 SHLL 4; R2:=@DISKADDRESS(R2);
END ELSE BEGIN
MVI("T",ERRMSG); R2:=R0 SHLL 2; R2:=@TAPEADDRESS(R2);
END;
R0:=R0+1; ERRMSG(2):=R0; TR(0,ERRMSG(2),HEXTBL);
UNPK(3,2,ERRMSG(4),B2); TR(2,ERRMSG(4),HEXTBL(_240));
MVI(" ",ERRMSG(1)); MVI(" ",ERRMSG(3));
UNPK(4,2,ERRMSG(16),CSW(4)); TR(3,ERRMSG(16),HEXTBL(_240));
UNPK(4,2,ERRMSG(21),SENSE); TR(3,ERRMSG(21),HEXTBL(_240));
MVI(" ",ERRMSG(20)); MVC(8,ERRMSG(7)," I/O ERR ");
MVC(7,ERRANS," "); R0:=@ERRANS; R1:=#190007;
R2:=@ERRMSG;
END;
PROCEDURE IOERRDONE(R3);
BEGIN COMMENT FINISH I/O ERROR MESSAGE HANDLING;
R1:=@ERRANS(R1); MVI(21,B1);
TR(7,ERRANS,CONSOLETRT); R1:=0;
CLC(6,ERRANS,CANCELRPY); IF = THEN R1:=1;
COMMENT REPLY WAS "CANCEL";
CLC(5,ERRANS,RETRYRPY); IF = THEN R1:=2;
COMMENT REPLY WAS "RETRY";
IF R1 > 0 THEN BEGIN COMMENT PROPER REPLY;
R0:=@ERRMSGLOCK; V; SVCUNLOCK;
END ELSE BEGIN
R0:=@ERRANS; R1:=#190007; R2:=@ERRMSG;
MVI("*",ERRMSG(7)); MVC(7,ERRANS," ");
END;
END;
PROCEDURE IOCANCEL(R1);
BEGIN COMMENT RETURN TO SYSTEM OR CANCEL USER;
TM(#01,PSW(1)); IF = THEN BEGIN
OI(#30,PSW(4)); SVCEXIT;
END ELSE BEGIN
R0:=5; CANCEL;
END;
END;
GLOBAL 74 PROCEDURE TAPEIO(R4);
BEGIN COMMENT INITIATE TAPE I/O AND HANDLE ERRORS;
SHORT INTEGER LENGTH SYN WORK(4), RESLENGTH SYN CSW(6);
INTEGER ASSIGNPT SYN WORK(8), IOADDR SYN WORK;
BYTE ERRCNT SYN WORK(6), BSADDED SYN WORK(7),
OP SYN IOADDR, IONOTDONE SYN ASSIGNPT;
R0:=R0 AND #FFFFFF; IOADDR:=R0; OP:=R2; LENGTH:=R1;
R0:=0; ERRCNT:=R0; RESET(BSADDED);
IF R1 > #7FFF OR R1 <= 0 THEN BEGIN
R0:=2; CANCEL;
END;
IF R2 = #01 AND R1 < 18 THEN BEGIN
R0:=2; CANCEL;
END;
IF R2 = #02 AND R1 < 12 THEN BEGIN
R0:=2; CANCEL;
END;
R1:=REGS(12); TM(#01,PSW(1));
IF OVERFLOW OR R1 <= 8 THEN BEGIN COMMENT FURTHER CHECKS;
IF R1 > 8 OR R1 <= 0 THEN BEGIN
R0:=2; CANCEL;
END;
R1:=R1 SHLL 2; R1:=LOGUNITTBL(R1-4);
IF R1 = 0 THEN BEGIN
R0:=6; CANCEL;
END;
END;
ASSIGNPT:=R1; SET(IONOTDONE);
IF DISKUNIT(R1) THEN BEGIN
R0:=7; CANCEL;
END;
IF R2 = #1F OR R2 = #01 THEN BEGIN
IF PROTECTED(R1) THEN BEGIN
R0:=8; CANCEL;
END ELSE SET(JOBWRITE(R1));
END ELSE RESET(JOBWRITE(R1));
WHILE IONOTDONE DO BEGIN COMMENT BUILD CCWS;
R0:=IOADDR; R1:=LENGTH OR #20000000;
IF BSADDED THEN BEGIN
STM(R0,R1,CCWS(16));
R0:=#27000000; R1:=#60000001;
END;
STM(R0,R1,CCWS(8));
R1:=ASSIGNPT; R2:=DRIVENO(R1) SHLL 2;
R0:=TAPEMODE(R1) SHLL 24; R1:=#60000001;
STM(R0,R1,CCWS); R0:=TAPEADDRESS(R2);
SETKEY; DOIO; R1:=ASSIGNPT;
IF = THEN BEGIN COMMENT OK;
RESETKEY; CLI(#02,OP); IF = THEN BEGIN
R0:=LENGTH-RESLENGTH; REGS(8):=R0;
END;
RESET(IONOTDONE);
END ELSE IF > THEN BEGIN COMMENT END TAPE OR END FILE;
RESETKEY; CLI(#02,OP); IF = THEN BEGIN
R0:=0; REGS(8):=R0;
END;
OI(#10,PSW(4)); RESET(IONOTDONE);
END ELSE IF OVERFLOW THEN BEGIN
RESETKEY; IOERREDIT; MVC(6,ERRMSG(8),"NOT OPR");
R0:=@ERRMSG; R1:=15; WRITECONSOLE;
R0:=@ERRMSGLOCK; V; SVCUNLOCK; IOCANCEL;
END ELSE BEGIN
RESETKEY;
TM(#40,SENSE); IF OVERFLOW THEN BEGIN
TM(#40,CSW(4)); IF = OR R0 ~= #0F THEN BEGIN
IOERREDIT; MVC(6,ERRMSG(8),"NOT RDY");
WHILE R1 > 2 DO BEGIN
R1:=#F0007; READCONSOLE; IOERRDONE;
END;
IF R1 = 1 THEN IOCANCEL;
END ELSE RESET(IONOTDONE); COMMENT END OF UNLOAD;
END ELSE BEGIN
TM(#08,SENSE); IF OVERFLOW THEN BEGIN
COMMENT DATA ERROR, RETRY;
SET(BSADDED); R0:=ERRCNT+1;
IF R0 > 20 THEN BEGIN
IOERREDIT;
WHILE R1 > 2 DO BEGIN
READCONSOLE; IOERRDONE;
END;
IF R1 = 1 THEN IOCANCEL;
R0:=0;
END;
ERRCNT:=R0;
END ELSE BEGIN COMMENT SOME OTHER ERROR;
TM(#50,CSW(4)); IF OVERFLOW THEN BEGIN
IF BSADDED THEN BEGIN COMMENT WHERE CU BUSY;
R0:=CSW AND #FFFFFF; R1:=@CCWS(16);
IF R0 ~= R1 THEN RESET(BSADDED);
END;
END ELSE BEGIN COMMENT NOT CONTROL UNIT BUSY;
IOERREDIT;
WHILE R1 > 2 DO BEGIN
READCONSOLE; IOERRDONE;
END;
IF R1 = 1 THEN IOCANCEL;
TM(#20,SENSE); IF OVERFLOW THEN BEGIN
TM(#04,CSW(4)); IF OVERFLOW THEN BEGIN
R0:=OP;
IF R0 = #01 OR R0 = #1F THEN
SET(BSADDED);
END;
END;
END;
END;
END;
END;
END;
END;
GLOBAL 75 PROCEDURE DISKIO(R4);
BEGIN COMMENT INITIATE DISK I/O AND HANDLE ERRORS;
SHORT INTEGER LENGTH SYN WORK(4), RESLENGTH SYN CSW(6),
CYLINDER SYN DISKRECORDID, HEAD SYN DISKRECORDID(2);
INTEGER ASSIGNPT SYN WORK(8), IOADDR SYN WORK;
BYTE OP SYN IOADDR, ERRCNT SYN WORK(6), FORMAT SYN WORK(7),
OVERLAYSW SYN SCRATCH,
IONOTDONE SYN ASSIGNPT, RECORD SYN DISKRECORDID(4);
FUNCTION DISKEXIT(0,#07F4);
IOADDR:=R0; OP:=R2; LENGTH:=R1; R0:=0; ERRCNT:=R0;
IF R1 <= 0 OR R1 > #7FFF THEN BEGIN
R0:=2; CANCEL;
END;
IF R2 = #1D OR R2 = 0 THEN SET(FORMAT) ELSE RESET(FORMAT);
MVI(0,DISKCOUNTID(5));
IF OVERLAYSW THEN BEGIN
R1:=OVERLAYDEV; IF R1 = 0 THEN BEGIN
R0:=2; CANCEL;
END;
END ELSE BEGIN
R1:=REGS(12); TM(#01,PSW(1));
IF OVERFLOW OR R1 <= 8 THEN BEGIN
IF R1 > 8 OR R1 <= 0 THEN BEGIN
R0:=2; CANCEL;
END;
R1:=R1 SHLL 2; R1:=LOGUNITTBL(R1-4);
IF R1 = 0 THEN BEGIN
R0:=6; CANCEL;
END;
END;
END;
ASSIGNPT:=R1; MVI(#FF,IONOTDONE);
IF ~DISKUNIT(R1) THEN BEGIN
R0:=7; CANCEL;
END;
R0:=R3 AND #FF; R3:=R3 SHRA 8;
IF R0 = 0 OR R3 < 0 THEN BEGIN
R0:=2; CANCEL;
END;
RECORD:=R0; SVCLOCK;
R0:=@ASSIGNLOCK(R1); P; IF ~= THEN SVCUNLOCK;
R0:=EXTENTCNT(R1); R2:=1;
WHILE R0 > 0 AND R3 >= NOTRACKS(R1) DO BEGIN
R3:=R3-NOTRACKS(R1); R0:=R0-1; R1:=R1+4;
END;
IF R0 > 0 THEN BEGIN
R3:=R3+STARTTRACK(R1); R2:=0;
END;
R1:=ASSIGNPT; R0:=@ASSIGNLOCK(R1); V; SVCUNLOCK;
IF R2 ~= 0 THEN BEGIN
OI(#20,PSW(4)); DISKEXIT;
END;
R1:=DRIVENO(R1) SHLL 4; R1:=DISKDRIVETYPE(R1) SHLL 1;
R0:=TRKPERCYL(R1-2); R3:=R3/R0;
CYLINDER:=R3; HEAD:=R2; MVC(4,DISKCOUNTID,DISKRECORDID);
MVC(3,DISKSEEKADR(2),DISKRECORDID); MVC(1,DISKSEEKADR,0S);
IF FORMAT THEN BEGIN
R0:=RECORD-1; RECORD:=R0;
END;
R1:=ASSIGNPT; CLI(#05,OP);
IF = OR FORMAT THEN BEGIN
IF PROTECTED(R1) THEN BEGIN
R0:=8; CANCEL;
END ELSE SET(JOBWRITE(R1));
END ELSE SET(JOBREAD(R1));
R0:=IONOTDONE;
WHILE R0 > 0 DO BEGIN
IF R0 = #FF THEN BEGIN
MVC(1,DISKCOUNTID(6),LENGTH);
R0:=@DISKSEEKADR OR #07000000; R1:=#60000006;
STM(R0,R1,CCWS); R0:=@DISKRECORDID OR #31000000;
R1:=#60000005; STM(R0,R1,CCWS(8));
R0:=@CCWS(8) OR #08000000; CCWS(16):=R0;
R0:=IOADDR; R1:=LENGTH OR #20000000;
IF FORMAT THEN BEGIN
STM(R0,R1,CCWS(32)); MVI(#1D,CCWS(32));
R0:=@DISKCOUNTID OR #1D000000; R1:=#A0000008;
END;
STM(R0,R1,CCWS(24)); CLI(0,OP);
IF = THEN BEGIN
MVI(#20,CCWS(28)); MVI(0,DISKCOUNTID(7));
END;
END ELSE MVI(#FF,IONOTDONE);
R1:=ASSIGNPT; R2:=DRIVENO(R1) SHLL 4;
R0:=DISKADDRESS(R2); IF ~OVERLAYSW THEN SETKEY; DOIO;
IF = THEN BEGIN COMMENT I/O OK;
RESETKEY; MVI(0,IONOTDONE);
R0:=OP; IF R0 ~= 0 AND R0 ~= #1D THEN BEGIN
R0:=LENGTH-RESLENGTH; IF ~OVERLAYSW THEN REGS(8):=R0;
END;
END ELSE IF > THEN BEGIN COMMENT END FILE FOUND;
RESETKEY; MVI(0,IONOTDONE);
R0:=0; IF ~OVERLAYSW THEN REGS(8):=R0; OI(#10,PSW(4));
END ELSE IF OVERFLOW THEN BEGIN COMMENT NOT OPERATIVE;
RESETKEY; IOERREDIT;
MVC(6,ERRMSG(8),"NOT OPR");
R0:=@ERRMSG; R1:=15; WRITECONSOLE;
R0:=@ERRMSGLOCK; V; SVCUNLOCK; IOCANCEL;
END ELSE BEGIN COMMENT ALL OTHER ERRORS;
RESETKEY; TM(#40,SENSE); IF OVERFLOW THEN BEGIN
IOERREDIT; MVC(6,ERRMSG(8),"NOT RDY");
WHILE R1 > 2 DO BEGIN
R1:=#F0007; READCONSOLE; IOERRDONE;
END;
IF R1 = 1 THEN IOCANCEL;
END ELSE BEGIN
TM(#40,SENSE(1)); IF OVERFLOW THEN BEGIN
CLI(#11,CCWS(24)); IF ~= THEN BEGIN
OI(#10,PSW(4)); MVI(#11,CCWS(24));
MVI(#20,CCWS(28)); MVI(#0F,IONOTDONE);
R0:=LENGTH-RESLENGTH; REGS(8):=R0;
MVC(1,DISKCOUNTID(6),0S);
COMMENT ERASE REST OF TRACK;
END ELSE MVI(0,IONOTDONE); COMMENT TRY ONCE;
END ELSE BEGIN
TM(#08,SENSE(1)); IF OVERFLOW THEN BEGIN
TM(#02,SENSE(1)); IF = THEN BEGIN
OI(#20,PSW(4)); MVI(0,IONOTDONE);
END;
END;
CLI(0,IONOTDONE); IF ~= THEN BEGIN
TM(#02,SENSE); IF OVERFLOW THEN BEGIN
R2:=@CCWS(16) OR #16000000;
CCWS(8):=R2; R2:=#20000004;
CCWS(12):=R2; DOIO;
COMMENT READ ALTERNATE TRACK ADDRESS;
IF = THEN
MVC(3,DISKSEEKADR(2),CCWS(16))
ELSE BEGIN
R0:=ERRCNT+1; ERRCNT:=R0;
END;
END ELSE BEGIN
TM(#50,CSW(4)); COMMENT 2 CHAN - BUSY;
IF = OR ~= THEN BEGIN
R0:=ERRCNT+1; ERRCNT:=R0;
END;
END;
R0:=ERRCNT;
IF R0 > 10 THEN BEGIN
IOERREDIT;
WHILE R1 > 2 DO BEGIN
READCONSOLE; IOERRDONE;
END;
IF R1 = 1 THEN IOCANCEL;
R0:=0; ERRCNT:=R0;
END;
END;
END;
END;
END;
R0:=IONOTDONE;
END;
END;
BEGIN COMMENT GET POINTER TO CURRENT PCB;
EXTERNAL 64 BASE R4;
INTEGER YEAR, DAY, SECOND, JOBTIME, MAXTIME, USERMEMORY,
ENDMEMORY, ENDJOBCOUNT, OPERATORCOUNT, FIRSTPCB,
LASTPCB, FREEPCB, CURRENTPCB;
R6:=CURRENTPCB;
END;
R1:=PSW AND #FF-15;
IF R1 <= 35 THEN CASE R1 OF BEGIN
BEGIN COMMENT READ A CARD;
EXTERNAL 70 BASE R4; COMMENT SEE LEVEL1 BUFFERING PROCESS;
INTEGER FULL, EMPTY, PTR, STARTB, ENDB, RDRLOCK, ADDR,
WPTR, NOBUFF;
BYTE ACTIVE, EOF, CTRLCARD, EOFFOUND, READCTRL;
PROCEDURE ADVANCE(R3);
BEGIN COMMENT MOVE TO NEXT BUFFER;
R0:=@EMPTY; V; R1:=R1+80;
IF R1 = ENDB THEN R1:=STARTB; PTR:=R1;
END;
R2:=REGS(4); SVCLOCK; R0:=@RDRLOCK; P;
IF ~= THEN SVCUNLOCK;
IF CTRLCARD THEN BEGIN COMMENT HAVE CONTROL CARD;
R1:=PTR; CLC(4,B1,"%EOF ");
IF = THEN OI(#20,PSW(4)) ELSE OI(#10,PSW(4));
IF READCTRL THEN BEGIN COMMENT ALLOWED TO READ IT;
MVC(79,B2,B1); ADVANCE;
RESET(CTRLCARD); RESET(EOFFOUND);
END ELSE BEGIN COMMENT NOT ALLOWED, FORCE UP TO 2 EOFS;
IF EOFFOUND THEN BEGIN
R0:=@RDRLOCK; V; SVCUNLOCK;
R0:=9; CANCEL;
END;
SET(EOFFOUND); SETKEY;
MVC(4,B2,"%EOF "); MVC(74,B2(5),B2(4));
RESETKEY;
END;
END ELSE BEGIN COMMENT GET A CARD;
R0:=@FULL; P; IF ~= THEN BEGIN
R0:=@RDRLOCK; V; SVCUNLOCK;
END;
R1:=PTR; IF READCTRL THEN BEGIN COMMENT CAN READ ANYTHNG;
CLI("%",B1); IF = THEN BEGIN
CLC(4,B1,"%EOF ");
IF = THEN OI(#20,PSW(4)) ELSE OI(#10,PSW(4));
END;
MVC(79,B2,B1); ADVANCE;
END ELSE BEGIN COMMENT CAN'T READ CONTROL CARDS;
CLI("%",B1); IF = THEN BEGIN
SETKEY; MVC(4,B2,"%EOF "); CLC(4,B1,"%EOF ");
IF = THEN MVC(74,B2(5),B1(5))
ELSE MVC(74,B2(5),B2(4)); RESETKEY;
CLC(4,B1,"%EOF ");
IF = THEN BEGIN
OI(#20,PSW(4)); ADVANCE;
END ELSE BEGIN
OI(#10,PSW(4)); SET(CTRLCARD);
END;
END ELSE BEGIN
SETKEY; MVC(79,B2,B1); RESETKEY; ADVANCE;
END;
END;
END;
R0:=@RDRLOCK; V; SVCUNLOCK;
END;
BEGIN COMMENT PUNCH A CARD;
EXTERNAL 71 BASE R4; COMMENT SEE LEVEL1 BUFFERING PROCESS;
INTEGER EMPTY, FULL, PTR, STARTB, ENDB, PCHLOCK,
ADDR, WPTR, NOBUFF;
BYTE JOBSTART, JOBFLUSH, ACTIVE, JOBPUNCH;
R2:=REGS(4); SVCLOCK; R0:=@PCHLOCK; P;
IF ~= THEN SVCUNLOCK; R0:=@EMPTY; P;
IF ~= THEN BEGIN
R0:=@PCHLOCK; V; SVCUNLOCK;
END;
R1:=PTR; MVC(79,B1(1),B2);
IF ~JOBSTART THEN RESET(B1) ELSE BEGIN
RESET(JOBSTART); SET(B1);
END;
R1:=R1+81;
IF R1 = ENDB THEN R1:=STARTB; PTR:=R1;
SET(JOBPUNCH); COMMENT USER PUNCHED AT LEAST ONE CARD;
R0:=@FULL; V; R0:=@PCHLOCK; V; SVCUNLOCK;
END;
BEGIN COMMENT SET LINENO SO NEXT LINE ON NEW PAGE;
EXTERNAL 72 BASE R4; COMMENT SEE LEVEL1 FOR DETAILS;
INTEGER EMPTY, FULL, PTR, STARTB, ENDB, WTRLOCK, LINENO;
SVCLOCK; R0:=@WTRLOCK; P; IF ~= THEN SVCUNLOCK;
R0:=0; LINENO:=R0; R0:=@WTRLOCK; V; SVCUNLOCK;
END;
BEGIN COMMENT LINK TO PRINT ROUTINES;
OPENLINE; R1:=REGS(4); MVC(131,B2(1),B1);
CLOSELINE; IF R2 = 0 THEN OI(#10,PSW(4));
END;
BEGIN COMMENT LINK TO READCONSOLE;
R0:=REGS(8); R1:=R0 AND #FFFF; R0:=R0 SHRL 16;
IF R0 > 128 OR R1 > 128 OR R1 = 0 THEN BEGIN
R0:=2; CANCEL;
END;
LM(R0,R2,REGS(4)); R0:=R0 OR #FF000000;
R2:=R2 AND #FFFFFF; READCONSOLE; REGS(8):=R1;
END;
BEGIN COMMENT LINK TO WRITECONSOLE;
LM(R0,R1,REGS(4)); R0:=R0 AND #FFFFFF;
IF R1 > 128 OR R1 <= 0 THEN BEGIN
R0:=2; CANCEL;
END;
WRITECONSOLE;
END;
BEGIN COMMENT READ TAPE;
LM(R0,R1,REGS(4)); R2:=#02; TAPEIO;
END;
BEGIN COMMENT WRITE TAPE;
LM(R0,R1,REGS(4)); R2:=#01; TAPEIO;
END;
BEGIN COMMENT MARK TAPE;
R0:=0; R1:=1; R2:=#1F; TAPEIO;
END;
BEGIN COMMENT REWIND TAPE;
R0:=0; R1:=1; R2:=#07; TAPEIO;
END;
BEGIN COMMENT FORWARD SPACE RECORD;
R0:=0; R1:=1; R2:=#37; TAPEIO;
END;
BEGIN COMMENT FORWARD SPACE FILE;
R0:=0; R1:=1; R2:=#3F; TAPEIO;
END;
BEGIN COMMENT BACK SPACE RECORD;
R0:=0; R1:=1; R2:=#27; TAPEIO;
END;
BEGIN COMMENT BACK SPACE FILE;
R0:=0; R1:=1; R2:=#2F; TAPEIO;
END;
BEGIN COMMENT READ DISK;
BYTE OVERLAYSW SYN SCRATCH;
L
(Message over 64 KB, truncated)