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; LM(R0,R1,REGS(4)); R2:=#06; R3:=REGS(16); RESET(OVERLAYSW); DISKIO; END; BEGIN COMMENT WRITE DISK; BYTE OVERLAYSW SYN SCRATCH; LM(R0,R1,REGS(4)); R2:=#05; R3:=REGS(16); RESET(OVERLAYSW); DISKIO; END; BEGIN COMMENT FORMAT WRITE DISK; BYTE OVERLAYSW SYN SCRATCH; LM(R0,R1,REGS(4)); R2:=#1D; R3:=REGS(16); RESET(OVERLAYSW); DISKIO; END; BEGIN COMMENT USER DUMP FACILITY; LONG REAL WORK2 SYN CSW; SHORT INTEGER WORK3 SYN SCRATCH; EXTERNAL 64 BASE R4; COMMENT SEE LEVEL0 FOR DETAILS; INTEGER YEAR, DAY, SECOND, JOBTIME, MAXTIME, USERMEMORY, ENDMEMORY; EXTERNAL 78 BASE R3; COMMENT SEE LEVEL1; ARRAY 80 BYTE BEGINCARD, EXECUTECARD; ARRAY 2 INTEGER FREESPACE; R1:=REGS(4) AND #FFFFFF; R0:=REGS(8); R2:=R0+R1-1; IF R1 < FREESPACE OR R2 > FREESPACE(4) OR R0 <= 0 THEN BEGIN R0:=2; CANCEL; END; COMMENT CAN ONLY DUMP OWN STUFF; R2:=R1 AND 3+3; R0:=R0+R2 AND _4; R1:=R1 AND _4; STM(R0,R1,WORK); WHILE R0 > 0 DO BEGIN OPENLINE; R1:=WORK(4) AND _32; WORK(8):=R1; UNPK(6,3,B2(11),WORK(9)); TR(5,B2(11),HEXTBL(_240)); R3:=0; WHILE R1 = WORK(8) AND R3 < 256 DO BEGIN R0:=REFTABLE(R3) AND #FFFFFF; IF R1 >= R0 AND R0 > 0 THEN BEGIN R1:=SEGLENGTHTBL(R3); COMMENT LOADED SEGS ONLY; R0:=R0+R1-1; R1:=WORK(8); IF R1 <= R0 THEN BEGIN R0:=REFTABLE(R3) AND #FFFFFF; R1:=R1-R0; END ELSE R3:=R3+4; END ELSE R3:=R3+4; END; IF R1 = WORK(8) THEN BEGIN MVI(" ",B2(1)); MVC(8,B2(2),B2(1)); END ELSE BEGIN WORK3:=R1; UNPK(4,2,B2(4),WORK3); TR(3,B2(4),HEXTBL(_240)); MVC(2,B2(8)," "); R3:=R3 SHRL 2; CVD(R3,WORK2); UNPK(1,7,B2(1),WORK2); OI("0",B2(2)); R1:=WORK(8); MVI(" ",B2(3)); END; MVC(4,B2(17)," "); R3:=WORK; FOR R0:=1 STEP 1 UNTIL 8 DO BEGIN IF R3 <= 0 OR R1 < WORK(4) THEN BEGIN MVI(" ",B2(22)); MVC(7,B2(23),B2(22)); END ELSE BEGIN MVC(3,WORK(8),B1); UNPK(8,4,B2(22),WORK(8)); TR(7,B2(22),HEXTBL(_240)); R3:=R3-4; END; MVC(2,B2(30)," "); R1:=R1+4; R2:=R2+11; END; MVC(22,B2(22),B2(21)); WORK:=R3; WORK(8):=R1; CLOSELINE; R0:=WORK; R1:=WORK(8)-32; R2:=WORK(8); IF R0 > 32 AND R1 >= WORK(4) THEN BEGIN CLC(31,B1,B2); IF = THEN BEGIN COMMENT DUPLICATE LINE; R0:=R0-32; WORK:=R0; R1:=R2+32; WORK(4):=R1; OPENLINE; MVI(" ",B2(1)); MVC(130,B2(2),B2(1)); MVC(7,B2(22),SAMEMSG); CLOSELINE; R0:=WORK; R1:=WORK(4); R2:=R1-32; R3:=1; WHILE R3 > 0 AND R0 > 32 DO BEGIN CLC(31,B1,B2); IF ~= THEN R3:=0 ELSE BEGIN R0:=R0-32; R1:=R1+32; R2:=R2+32; END; END; WORK:=R0; WORK(4):=R1; END ELSE WORK(4):=R2; END ELSE WORK(4):=R2; END; END; BEGIN COMMENT EDIT DATE; EXTERNAL 64 BASE R4; COMMENT SEE LEVEL0 FOR DETAILS; INTEGER YEAR, DAY; LM(R0,R1,YEAR); CVD(R0,WORK); R2:=REGS(4); SETKEY; UNPK(1,7,B2(6),WORK); OI("0",B2(7)); MVI("/",B2(5)); RESETKEY; R0:=R0 AND 3; R2:=0; R3:=MONTHS; IF R0 = 0 THEN R0:=29 ELSE R0:=28; WHILE R1 > R3 DO BEGIN R1:=R1-R3; R2:=R2+2; IF R2 = 2 THEN R3:=R0 ELSE R3:=MONTHS(R2); END; R0:=R2 SHRL 1+1; CVD(R1,WORK); R2:=REGS(4); SETKEY; UNPK(1,7,B2(3),WORK); OI("0",B2(4)); MVI("/",B2(2)); RESETKEY; CVD(R0,WORK); SETKEY; UNPK(1,7,B2,WORK); OI("0",B2(1)); RESETKEY; END; BEGIN COMMENT GET TIME IN 60 THS OF A SECOND; EXTERNAL 64 BASE R4; COMMENT SEE LEVEL0 FOR DETAILS; INTEGER YEAR, DAY, SECOND, JOBTIME; INTEGER TIMER SYN 80; R2:=0; R3:=76800-TIMER; LM(R0,R1,SECOND); R3:=R3/1280; R0:=R0*60S+R3; R1:=R1*60S+R3; STM(R0,R1,REGS(4)); END; BEGIN COMMENT WRITE JOB ELAPSED TIME; OPENLINE; BEGIN EXTERNAL 64 BASE R4; COMMENT SEE LEVEL0 FOR DETAILS; INTEGER YEAR, DAY, SECOND, JOBTIME; INTEGER TIMER SYN 80; R0:=0; R1:=76800-TIMER; R3:=JOBTIME; R1:=R1/768; MVC(15,B2(1),ELAPSED); CVD(R0,WORK); UNPK(1,7,B2(26),WORK); OI("0",B2(27)); MVI(".",B2(25)); R0:=0; R1:=R3/60; CVD(R0,WORK); UNPK(1,7,B2(23),WORK); OI("0",B2(24)); MVI(":",B2(22)); R0:=0; R1:=R1/60; CVD(R0,WORK); UNPK(1,7,B2(20),WORK); OI("0",B2(21)); MVI(":",B2(19)); CVD(R1,WORK); UNPK(1,7,B2(17),WORK); OI("0",B2(18)); MVI(" ",B2(28)); MVC(103,B2(29),B2(28)); END; CLOSELINE; IF R2 = 0 THEN OI(#10,PSW(4)); END; BEGIN COMMENT SET USER DUMP LIMITS; EXTERNAL 78 BASE R4; COMMENT SEE LEVEL1 FOR DETAILS; ARRAY 80 BYTE BEGINCARD, EXECUTECARD; ARRAY 2 INTEGER FREESPACE; R0:=REGS(4) AND #FFFFFF; R1:=REGS(8); R2:=R0+R1; IF R0 < FREESPACE OR R1 < 0 OR R2 > FREESPACE(4) THEN IF R1 ~= 0 THEN BEGIN R0:=2; CANCEL; END; STM(R0,R1,FREEDUMPLIM); END; BEGIN COMMENT SET ALLOWED PROGRAM CHECKS MASK; R0:=REGS(4) AND #FF XOR #FF; PRGCHKMASK:=R0; END; BEGIN COMMENT SET SEGMENT DUMP MASK; LM(R0,R1,REGS(4)); STM(R0,R1,SEGDUMPMASK); END; BEGIN COMMENT SUPPLY I/O DEVICE TYPE; R1:=REGS(12); IF R1 > 8 OR R1 <= 0 THEN BEGIN R0:=2; CANCEL; END; R1:=R1 SHLL 2; R3:=LOGUNITSAVE(R1-4); R1:=LOGUNITTBL(R1-4); IF R1 = 0 THEN OI(#20,PSW(4)) ELSE BEGIN IF DISKUNIT(R1) THEN BEGIN R2:=DRIVENO(R1) SHLL 4; R2:=DISKDRIVETYPE(R2) SHLL 1; OI(#10,PSW(4)); COMMENT INDICATE DISK DRIVE; R0:=PADDIV(R2-2) SHLL 16+TRKCAP(R2-2); R1:=RECPAD(R2-2) SHLL 16+PADMUL(R2-2); STM(R0,R1,REGS(4)); REGS(16):=R3; END; END; END; BEGIN COMMENT MARK DISK; BYTE OVERLAYSW SYN SCRATCH; R0:=0; R1:=1; R2:=0; R3:=REGS(16); RESET(OVERLAYSW); DISKIO; END; BEGIN COMMENT MARK UNIT AS PROTECTED; R1:=REGS(12); IF R1 > 8 OR R1 <= 0 THEN BEGIN R0:=2; CANCEL; END; R2:=R1 SHLL 2; R2:=LOGUNITTBL(R2-4); IF R2 = 0 THEN BEGIN R0:=6; CANCEL; END; IF ~SHARED(R2) THEN SET(PROTECTED(R2)); END; BEGIN COMMENT REWIND AND UNLOAD TAPE; TM(#01,PSW(1)); IF OVERFLOW THEN BEGIN R0:=2; CANCEL; END; R0:=0; R1:=1; R2:=#0F; TAPEIO; END; BEGIN COMMENT RING BELL ON CONSOLE; INTEGER CONSOLE SYN 76; R0:=#0B000000; R1:=#20000001; STM(R0,R1,CCWS); R0:=CONSOLE; IF R0 = 0 THEN OI(#10,PSW(4)) ELSE BEGIN DOIO; IF ~= OR OVERFLOW THEN OI(#10,PSW(4)); END; COMMENT RETURN WHETHER IT WORKS OR NOT; END; BEGIN COMMENT START USER MODE; EXTERNAL 64 BASE R4; COMMENT SEE LEVEL0 FOR DETAILS; INTEGER YEAR, DAY, SECOND, JOBTIME, MAXTIME, USERMEMORY, ENDMEMORY, ENDJOBCOUNT, OPERATORCOUNT, FIRSTPCB, LASTPCB, FREEPCB, CURRENTPCB, NUMBEROFPCBS, PCBSIZE, LOCKOUTCOUNT, MAXPCBNO; BYTE PROTECTION, FLOATINGPOINT, CANCELFLAG; IF PROTECTION THEN OI(#11,PSW(1)) ELSE OI(#01,PSW(1)); IF CANCELFLAG THEN BEGIN R0:=1; CANCEL; END; END; BEGIN COMMENT LOAD OVERLAY SEGMENT; BYTE OVERLAYSW SYN SCRATCH, SEGMENTNO SYN SCRATCH(1), BB1 SYN B1; SHORT INTEGER RESLENGTH SYN CSW(6); R0:=@OVERLAYLOCK; P; COMMENT LOADER FIXES UP IF CANCELLED; R1:=PSW(4); R2:=BB1(1) SHLL 2; R3:=BB1 SHLL 1; R1:=R1+2; PSW(4):=R1; R1:=@SEGLENGTHTBL(R2); IF R2 > 252 OR R3 > 30 OR R3 = 0 THEN BEGIN R0:=2; CANCEL; END; IF BB1 THEN BEGIN COMMENT NOT THERE, GET SEGMENT; R4:=OVERLAYSEG(R3); IF R4 >= 0 THEN BEGIN R4:=@SEGLENGTHTBL(R4); SET(B4); END; OVERLAYSEG(R3):=R2; SEGMENTNO:=R2; R0:=REFTABLE(R2); R1:=SEGLENGTHTBL(R2) AND #FFFFFF; R2:=OVERLAYADR(R2); STM(R0,R2,OVERLAYWORK); R3:=R2; SET(OVERLAYSW); WHILE R1 > 0 DO BEGIN COMMENT READ SEGMENT FRAGMENTS; R2:=#06; DISKIO; TM(#30,PSW(4)); IF ~= THEN BEGIN R0:=10; CANCEL; END; R0:=OVERLAYWORK+OVERLAYWORK(4)-RESLENGTH; OVERLAYWORK:=R0; R1:=RESLENGTH; OVERLAYWORK(4):=R1; R3:=OVERLAYWORK(8) AND _256+257; OVERLAYWORK(8):=R3; END; R2:=SEGMENTNO; R1:=@SEGLENGTHTBL(R2); RESET(B1); END; R0:=REFTABLE(R2); REGS:=R0; R0:=@OVERLAYLOCK; V; END; BEGIN COMMENT SAVE DISK ADDRESS FOR USER; R1:=REGS(12); IF R1 > 8 OR R1 <= 0 THEN BEGIN R0:=2; CANCEL; END; R1:=R1 SHLL 2; R2:=LOGUNITTBL(R1-4); IF R2 = 0 THEN BEGIN R0:=6; CANCEL; END; IF ~DISKUNIT(R2) THEN BEGIN R0:=7; CANCEL; END; R0:=REGS(16); LOGUNITSAVE(R1-4):=R0; END; BEGIN COMMENT GET ASSIGN NAME FOR USER; R1:=REGS(12); IF R1 > 8 OR R1 <= 0 THEN BEGIN R0:=2; CANCEL; END; R1:=R1 SHLL 2; R2:=LOGUNITTBL(R1-4); IF R2 = 0 THEN BEGIN R0:=6; CANCEL; END; R1:=REGS(4); SETKEY; MVC(7,B1,ASSIGNNAME(R2)); RESETKEY; END; BEGIN COMMENT DO P OPERATION ON ASKJOB; R0:=@ASKJOB; P; END; BEGIN COMMENT LET USER DO SPECIAL I/O; FUNCTION GETCC(0,#0500); EXTERNAL 70 BASE R2; COMMENT READER DATA; INTEGER RDRFULL,RDREMPTY,RDRPTR,RDRSTARTB,RDRENDB,RDRLOCK, RDRADDR; EXTERNAL 71 BASE R3; COMMENT PUNCH DATA; INTEGER PCHEMPTY,PCHFULL,PCHPTR,PCHSTARTB,PCHENDB,PCHLOCK, PCHADDR; EXTERNAL 72 BASE R4; COMMENT PRINTER DATA; INTEGER PRTEMPTY,PRTFULL,PRTPTR,PRTSTARTB,PRTENDB,PRTLOCK, PRTLINENO,PRTADDR; INTEGER CONSOLE SYN 76; LM(R0,R1,REGS(4)); COMMENT CHECK DEVICE ADDRESS AND TIME; IF R0=RDRADDR OR R0=PCHADDR OR R0=PRTADDR OR R0=CONSOLE OR R0=0 OR R1<=0 THEN BEGIN R0:=2; CANCEL; END; FOR R2:=0 STEP 4 UNTIL 28 DO BEGIN COMMENT CHECK TAPE&DISK; R3:=R2 SHLL 2; IF R0=DISKADDRESS(R3) OR R0=TAPEADDRESS(R2) THEN BEGIN R0:=2; CANCEL; END; END; LM(R2,R3,REGS(12)); R4:=@CCWS; COMMENT NOW CHECK CCW DATA; IF R3<=0 OR R3>5 THEN BEGIN R0:=2; CANCEL; END; WHILE R3>0 DO BEGIN COMMENT MOVE CCWS INTO PCB; MVC(7,B4,B2); CLI(8,B4); IF = THEN BEGIN COMMENT ADJUST TIC ADDRESS; R5:=@CCWS+B4; B4:=R5; END; R3:=R3-1; R4:=R4+8; R2:=R2+8; END; SETKEY; TIMEDDOIO; GETCC; RESETKEY; R0:=R0 AND #30000000 OR PSW(4); PSW(4):=R0; R0:=TIMEOUT; R1:=@CSW; R2:=@SENSE; STM(R0,R2,REGS(8)); COMMENT GIVE USER CSW, SENSE, TIME AND COND CODE; END; END; SVCEXIT; END; $PAGE GLOBAL 69 PROCEDURE LEVEL1(R1); BEGIN COMMENT JOB SEQUENCER, BUFFERING AND CONSOLE PROCESSES; EXTERNAL 64 BASE R13; COMMENT SEE LEVEL0 FOR DETAILS; INTEGER YEAR, DAY, SECOND, JOBTIME, MAXTIME, USERMEMORY, ENDMEMORY, ENDJOBCOUNT, OPERATORCOUNT, FIRSTPCB, LASTPCB, FREEPCB, CURRENTPCB, NUMBEROFPCBS, PCBSIZE, LOCKOUTCOUNT, MAXPCBNO; BYTE PROTECTION, FLOATINGPOINT, CANCELFLAG; ARRAY 27 LONG REAL PCB SYN B12; COMMENT SEE LEVEL0 FOR DETAILS; BYTE STATUS SYN PCB, SVCGOING SYN PCB(173); ARRAY 2 INTEGER CSW SYN PCB(8), PSWSUSPEND SYN PCB(56), PSWSVC SYN PCB(128); ARRAY 16 INTEGER REGSUSPEND SYN PCB(64); ARRAY 8 INTEGER REGSVC SYN PCB(136); ARRAY 10 INTEGER CCWS SYN PCB(16); SHORT INTEGER SENSE SYN PCB(174); INTEGER PCBNUMBER SYN PCB(204), CANCELCODE SYN PCB(4); GLOBAL 78 BASE R7; COMMENT USER USEFUL DATA; ARRAY 80 BYTE BEGINCARD, COMMENT BEGIN CARD OF CURRENT JOB; EXECUTECARD; COMMENT EXECUTION CALL CARD OF CURRENT PROGRAM; ARRAY 2 INTEGER FREESPACE; COMMENT LIMITS OF USER FREE SPACE; GLOBAL 70 BASE R10; COMMENT STORAGE FOR READER PROCESS; INTEGER RDRFULL, COMMENT FULL BUFFER SEMAPHORE; RDREMPTY, COMMENT EMPTY BUFFER SEMAPHORE; RDRGETPTR, COMMENT POINTER TO NEXT FULL BUFFER; RDRSTARTB, COMMENT START OF BUFFERS; RDRENDB, COMMENT END OF BUFFERS; RDRLOCK, COMMENT SEMAPHORE LOCK ON READER DATA; RDRADDRESS=#00C, COMMENT READER ADDRESS; RDRPUTPTR, COMMENT POINTER TO NEXT EMPTY BUFFER; RDRNOBUFF=2; COMMENT NUMBER OF BUFFERS; BYTE RDRACTIVE, COMMENT KEEPS READER GOING; RDRENDFILE, COMMENT LAST I/O HAD ENDFILE STATUS; RDRCTRLCARD, COMMENT CONTROL CARD WAS READ; RDREOFFOUND, COMMENT USER GOT ONE %EOF FOR CONTROL CARD; RDRREADCTRL, COMMENT CAN READ CONTROL CARDS; RDRTYPE=#FF; COMMENT #00 - 2501 OR 1442, #FF - 2540; ARRAY 7 BYTE RDRREPLY; COMMENT REPLY AREA FOR ERRORS; GLOBAL 71 BASE R9; COMMENT STORAGE FOR PUNCH PROCESS; INTEGER PCHEMPTY, COMMENT EMPTY BUFFER SEMAPHORE; PCHFULL, COMMENT FULL BUFFER SEMAPHORE; PCHPUTPTR, COMMENT POINTER TO NEXT EMPTY BUFFER; PCHSTARTB, COMMENT START OF BUFFERS; PCHENDB, COMMENT END OF BUFFERS; PCHLOCK, COMMENT SEMAPHORE LOCK ON PUNCH DATA; PCHADDRESS=#00D, COMMENT PUNCH ADDRESS; PCHGETPTR, COMMENT POINTER TO NEXT FULL BUFFER; PCHNOBUFF=2; COMMENT NUMBER OF BUFFERS; BYTE PCHJOBSTART, COMMENT FIRST RECORD OF JOB; PCHFLUSH, COMMENT FLUSH TO NEXT JOB; PCHACTIVE, COMMENT KEEPS PUNCH GOING; PCHJOBPUNCH, COMMENT JOB PUNCHED AT LEAST ONE CARD; PCHTYPE=#FF, COMMENT #00 - 1442, #FF - 2540; PCHERRFLG; COMMENT USED TO INDICATE PUNCH ERROR RECOVERY; ARRAY 7 BYTE PCHREPLY; COMMENT REPLY AREA FOR ERRORS; ARRAY 80 BYTE PCHRETRY; COMMENT HOLD LAST CARD FOR RETRY; BYTE PCHJOBFLAG SYN MEM; COMMENT START OF JOB FLAG; GLOBAL 72 BASE R8; COMMENT STORAGE FOR PRINTER PROCESS; INTEGER PRTEMPTY, COMMENT EMPTY BUFFER SEMAPHORE; PRTFULL, COMMENT FULL BUFFER SEMAPHORE; PRTPUTPTR, COMMENT POINTER TO NEXT EMPTY BUFFER; PRTSTARTB, COMMENT START OF BUFFERS; PRTENDB, COMMENT END OF BUFFERS; PRTLOCK, COMMENT SEMAPHORE LOCK ON PRINTER DATA; PRTLINENO, COMMENT NUMBER OF LINES LEFT ON PAGE; PRTADDRESS=#00E, COMMENT PRINTER ADDRESS; PRTGETPTR, COMMENT POINTER TO NEXT FULL BUFFER; PRTNOBUFF=2; COMMENT NUMBER OF BUFFERS; BYTE PRTJOBSTART, COMMENT FIRST RECORD OF JOB; PRTFLUSH, COMMENT FLUSH TO NEXT JOB; PRTACTIVE; COMMENT KEEPS PRINTER GOING; ARRAY 7 BYTE PRTREPLY; COMMENT REPLY AREA FOR ERRORS; BYTE PAGEFLG SYN MEM; COMMENT FIRST BYTE IN BUFFER IS CARRIAGE CONTROL OP CODE. NORMALLY HAS TWO LOW ORDER BITS SET. LACK INDICATES START OF JOB; GLOBAL 68 BASE R11; COMMENT STORAGE FOR LEVEL1; ARRAY 64 INTEGER SEGLENGTHTBL, COMMENT LENGTH OF USER SEGMENTS; CONSOLETRT=( COMMENT TRANSLATE TABLE FOR CONSOLE REPLIES; 5(#26262626),#26252626,10(#26262626),#27262626,9(#26262626), #26262624,5(#26262626), #260A0B0C,#0D0E0F10,#11122626, #26262626,#26131415,#16171819,#1A1B2626,#26262626,#26261C1D, #1E1F2021,#22232626,5(#26262626),#260A0B0C,#0D0E0F10, #11122626,#26262626,#26131415,#16171819,#1A1B2626,#26262626, #26261C1D,#1E1F2021,#22232626,#26262626,#00010203,#04050607, #08092626,#26262626), COMMENT "0"-"9"=#00-#09, "A"-"Z"=#0A-#23, ","=#24, " "=#27, ERROR=#26, ENDLINE=#25; OVERLAYADR; COMMENT DISK ADDRESS OF OVERLAY SEGMENT; ARRAY 16 SHORT INTEGER OVERLAYSEG; COMMENT SEG NO OF LOADED SEG; INTEGER OVERLAYDEV, COMMENT POINTER TO ASSIGN BLOCK FOR OVERLAY; OVERLAYLOCK; COMMENT LOCK FOR OVERLAY DATA; ARRAY 3 INTEGER OVERLAYWORK; COMMENT WORK AREA FOR OVERLAY LOADER; ARRAY 10 INTEGER RETRANSLATE=( COMMENT BACK TO EBCDIC; "0123","4567","89AB","CDEF","GHIJ","KLMN","OPQR","STUV","WXYZ", ", "); ARRAY 4 INTEGER HEXTBL SYN RETRANSLATE; ARRAY 2 INTEGER FREEDUMPLIM, COMMENT FREE STORAGE CANCEL DUMP LIM; SEGDUMPMASK; COMMENT SEGMENT BIT MAP FOR CANCEL DUMP; ARRAY 8 INTEGER LOGUNITTBL, COMMENT USER LOGICAL UNIT TABLE; LOGUNITSAVE, COMMENT INTRA-JOB DISK ADDRESS SAVE AREA; TAPEDRIVES=( COMMENT TAPE DRIVE TABLE; #02800001,#02810001,#02820001,#02830001); SHORT INTEGER TAPEADDRESS SYN TAPEDRIVES, COMMENT CUU ADDRESS; TAPEDRIVETYPE SYN TAPEDRIVES(2); COMMENT 1 - 9TRK, 2 - 7TRK; ARRAY 32 INTEGER DISKDRIVES=( COMMENT DISK DRIVE TABLE; #01300002,1,0,0,#01310002,1,0,0,#01320002,1,0,0, #01330002,1,0,0); SHORT INTEGER DISKADDRESS SYN DISKDRIVES, COMMENT CUU ADDRESS; DISKDRIVETYPE SYN DISKDRIVES(2); COMMENT DISKTYPE INDEX; INTEGER VTOCLOCK SYN DISKDRIVES(4); COMMENT SEMAPHORE FOR VTOC; ARRAY 8 BYTE DISKLABEL SYN DISKDRIVES(8); COMMENT DISK VOLUME LBL; ARRAY 4 SHORT INTEGER TRKPERCYL=(10,20,19,0), COMMENT TRACKS PER CYLINDER; PADDIV=(9,11,0,0), COMMENT POWER OF 2 FOR CAPACITY FORMULA; TRKCAP=(3625,7294,13165,0), COMMENT TRACK CAPACITY; RECPAD=(61,101,135,0), COMMENT RECORD PADDING FOR CAPACITY; PADMUL=(537,2137,1,0), COMMENT MULTIPLIER FOR CAPACITY FORMULA; DISKTYPE=(#2311,#2314,#3330,0), COMMENT DRIVE MODEL NUMBERS; LOCKOUT=(#03,#0F,#1F,0), COMMENT TRACKS FOR TABLE OF CONTENTS; LOCKLIM=(250,500,950,0), COMMENT BYTES IN TRACK BIT MAP; FIRSTTRK=(8,25,41,0), COMMENT AREA NAMES ON FIRST TRACK; OTHERTRK=(27,42,56,0); COMMENT AREA NAMES PER TRACK; ARRAY 12 SHORT INTEGER MONTHS=( COMMENT DAYS IN MONTHS; 31,29,31,30,31,30,31,31,30,31,30,31); INTEGER ERRMSGLOCK; COMMENT SEMAPHORE FOR USE OF ERRMSG & ERRANS; ARRAY 26 BYTE ERRMSG; COMMENT I/O ERROR MESSAGE EDITING AREA; ARRAY 8 BYTE ERRANS; COMMENT I/O ERROR MESSAGE ANSWER AREA; INTEGER ASKJOB; COMMENT SEMAPHORE FOR USER USE; ARRAY 9 BYTE IOERRTXT=" I/O ERR "; ARRAY 8 BYTE SAMEMSG="**SAME**"; ARRAY 7 BYTE CANCELRPY=#0C0A170C0E1525X; ARRAY 6 BYTE RETRYRPY=#1B0E1D1B2225X; ARRAY 16 BYTE ELAPSED="ELAPSED TIME IS "; ARRAY 11 BYTE ASKRPYMSG="ENTER REPLY"; ARRAY 8 BYTE SPECBLANK=8(#27); ARRAY 8 BYTE REQUESTMSG="REQUEST?"; ARRAY 11 BYTE PAUSEMSG="***PAUSE***"; ARRAY 8 BYTE SPECMOUNT=#16181E171D270025X; INTEGER NOOFASSIGNS=16, COMMENT NUMBER OF ENTRIES IN ASSIGN TABLE; ASSIGNSIZE=96, COMMENT ASSIGN TABLE ENTRY SIZE; FILESPERVOL=128, COMMENT NUMBER OF FILES PER VOLUME; VTOCSIZE=1024, COMMENT SIZE OF TABLE OF CONTENTS IN BYTES; MAPSIZE, COMMENT HOLDS COPY OF SIZE OF TRACK BIT MAP; DRIVETYPE, COMMENT HOLDS COPY OF DISKDRIVETYPE SHLL 1; ASSIGNPTR; COMMENT POINTER TO ACTUAL ASSIGN TABLE; COMMENT LAYOUT OF ASSIGNTBL; SHORT INTEGER DRIVENO SYN 0; COMMENT INDEX INTO DRIVE TABLE; BYTE PROTECTED SYN 2, COMMENT SET INDICATES FILE PROTECTED; JOBREAD SYN 3, COMMENT FILE ACCESSED FOR READING; JOBWRITE SYN 4, COMMENT FILE ACCESSED FOR WRITING; JOBASSIGNED SYN 5, COMMENT ASSIGNED TO CURRENT JOB; EXTENTCNT SYN 6, COMMENT NUMBER OF EXTENTS; DISKUNIT SYN 7, COMMENT IS DISK OR TAPE; TAPEMODE SYN EXTENTCNT; COMMENT TAPE MODE SET COMMAND; INTEGER ASSIGNLOCK SYN 8; COMMENT SEMAPHORE FOR EXTENT CHANGES; ARRAY 8 BYTE ASSIGNNAME SYN 12, COMMENT LOGICAL UNIT NAME; AREANAME SYN 20; COMMENT DISK AREA NAME; ARRAY 16 INTEGER EXTENTS SYN 28; COMMENT DISK EXTENTS (16); SHORT INTEGER STARTTRACK SYN EXTENTS, COMMENT START TRACK NUMBER; NOTRACKS SYN EXTENTS(2); COMMENT NUMBER OF TRACKS IN EXTENT; BYTE SHARED SYN 92; COMMENT NOT TO BE UNASSIGNED AT JOB END; SHORT INTEGER IPLADDRESS SYN 2; COMMENT SET BY HARDWARE AT IPL; INTEGER IPLDRIVETYPE SYN 84; COMMENT "DISK" OR "TAPE" SET BY IPL; ARRAY 8 BYTE IPLAREA SYN 8; COMMENT SET BY IPL TO AREA NAME; BYTE JOBSACTIVE, COMMENT KEEPS JOB SEQUENCER GOING; GOTBEGIN, COMMENT GOT %BEGIN CARD; OPERATORACTIVE; COMMENT KEEPS OPERATOR PROCESS GOING; ARRAY 81 BYTE OPREPLY; COMMENT OPERATOR REPLY AREA; BYTE REPLYOK; COMMENT USED IN OPERATOR REQUEST SCAN; BYTE TYPEMATCH; COMMENT USED IN INITIALIZATION COMMUNICATION; BYTE MAPGOING, COMMENT INDICATES MAP LISTING IN PROGRESS; MAPKILL; COMMENT CAUSES MAP LISTING PROCESS TO STOP; INTEGER OPRLOCK; COMMENT SEMAPHORE FOR OPERATOR REQUEST; INTEGER SMSGLOCK; COMMENT LOCK SMSG AREA FOR PROCESSJOB; LONG REAL CONVRT; COMMENT NAME STORAGE FOR GETNAME; ARRAY 2 INTEGER COMMAND SYN CONVRT; ARRAY 8 BYTE NAMEHOLD SYN CONVRT; INTEGER JOBLOCK; COMMENT USED ON PAUSE AND RESTART COMMANDS; BYTE JOBPAUSE, JOBSTOPPED; ARRAY 22 BYTE DATEMSG="SNAP OP SYS - OCT 1975"; ARRAY 24 BYTE ASKDATETIME="DATE,TIME? MMDDYY,HHMMSS"; ARRAY 15 BYTE ASKRDRMSG="RDR? 2540,00C,2"; ARRAY 15 BYTE ASKPCHMSG="PCH? 2540,00D,2"; ARRAY 10 BYTE ASKPRTMSG="PRT? 00E,2"; ARRAY 24 BYTE ASKTAPES="TAPES? 9,280,281,282,283"; ARRAY 27 BYTE ASKDISKS="DISKS? 2314,130,131,132,133"; ARRAY 14 BYTE ASSIGNCMD="ASSIGN SYSTEM,"; ARRAY 22 BYTE RDRERRMSG="RDR I/O ERR XXXX XXXX"; ARRAY 11 BYTE RDRNOTRDY="RDR NOT RDY"; ARRAY 11 BYTE RDRNOTOPR="RDR NOT OPR"; ARRAY 22 BYTE PCHERRMSG="PCH I/O ERR XXXX XXXX"; ARRAY 11 BYTE PCHNOTRDY="PCH NOT RDY"; ARRAY 11 BYTE PCHNOTOPR="PCH NOT OPR"; ARRAY 22 BYTE PRTERRMSG="PRT I/O ERR XXXX XXXX"; ARRAY 11 BYTE PRTNOTRDY="PRT NOT RDY"; ARRAY 11 BYTE PRTNOTOPR="PRT NOT OPR"; ARRAY 17 BYTE MEMMSG="0000 K USER SPACE"; ARRAY 31 BYTE IPLERR="COULD NOT ASSIGN SYSTEM, RE-IPL"; ARRAY 25 BYTE BUFFERR="BUFFERS TOO LARGE, RE-IPL"; ARRAY 256 INTEGER VTOCWORK; COMMENT AREA FOR PROCESSING VTOC; COMMENT DISK AREA NAME TABLE -- UP TO 128 - 8 BYTE NAMES; ARRAY 8 BYTE VTOCNAME SYN VTOCWORK; COMMENT DISK AREA NAME; COMMENT DISK TRACK AVAILABILITY BIT MAP -- UP TO 8192 BITS; ARRAY 1024 BYTE VTOCTRACKMAP SYN VTOCWORK; COMMENT DETAIL DATA ENTRY FOR DISK AREA; BYTE VTOCPROTECT SYN VTOCWORK, COMMENT PROTECT FLAG FOR AREA; VTOCXTENTCNT SYN VTOCWORK(1); COMMENT EXTENT COUNT FOR AREA; ARRAY 32 SHORT INTEGER VTOCXTENTS SYN VTOCWORK(2); FUNCTION LIT(2,#4100); PROCEDURE SKIP(R4); BEGIN COMMENT SKIP TO NEXT NON-BLANK; R6:=R6+1; R0:=OPREPLY(R6); WHILE R0 = #27 DO BEGIN R6:=R6+1; R0:=OPREPLY(R6); END; END; PROCEDURE GETHEX(R5); BEGIN COMMENT GET HEX NUMBER FROM OPERATOR REQUEST; R1:=0; SKIP; IF R0 > #0F THEN R0:=#26; WHILE R0 < #10 DO BEGIN IF R1 >= #1000000 THEN R0:=#26 ELSE BEGIN R1:=R1 SHLL 4 OR R0; R6:=R6+1; R0:=OPREPLY(R6); END; END; END; PROCEDURE GETDEC(R5); BEGIN COMMENT GET DECIMAL NUMBER FROM OPERATOR REQUEST; R1:=0; SKIP; IF R0 > 9 THEN R0:=#26; WHILE R0 < 10 DO BEGIN IF R1 >= 100000000 THEN R0:=#26 ELSE BEGIN R1:=R1*10S+R0; R6:=R6+1; R0:=OPREPLY(R6); END; END; END; PROCEDURE GETNAME(R5); BEGIN COMMENT GET UP TO 8 BYTES OF TEXT FROM OPERATOR REQUEST; MVC(7,NAMEHOLD,SPECBLANK); R1:=0; SKIP; IF R0 > #23 OR R0 < #0A THEN R0:=#26 ELSE BEGIN WHILE R0 < #24 DO BEGIN IF R1 < 8 THEN BEGIN NAMEHOLD(R1):=R0; R1:=R1+1; END; R6:=R6+1; R0:=OPREPLY(R6); END; END; TR(7,NAMEHOLD,RETRANSLATE); END; PROCEDURE ASKOPR(R5); BEGIN COMMENT SET UP AND ASK FOR OPERATOR REQUEST; R0:=@OPREPLY; R1:=R1 SHLL 16+80; READTYPE; R0:=21; OPREPLY(R1):=R0; TR(80,OPREPLY,CONSOLETRT); R6:=_1; R0:=OPREPLY; END; GLOBAL 73 PROCEDURE DOREQUEST(R5); BEGIN COMMENT PROCESS OPERATOR REPLY; LONG REAL CONVRT; INTEGER SAVER5, NUMBER, MAXSPACE, NAMEPTR; ARRAY 2 INTEGER SAVER2R3; SHORT INTEGER CYLSIZE; COMMENT TRACKS PER CYLINDER; BYTE DENSITY, PARITY, PUBLIC; ARRAY 12 BYTE MODE=(2,6,2,7,8,4,8,5,2,6,2,7); ARRAY 8 BYTE NAME1, NAME2, SAVENAME; ARRAY 8 BYTE BIT1=(#80,#40,#20,#10,#08,#04,#02,#01), BIT0=(#7F,#BF,#DF,#EF,#F7,#FB,#FD,#FE); FUNCTION SETCC(0,#1200); PROCEDURE NORMALX(R5); BEGIN COMMENT EXIT NORMALLY; R0:=0; SETCC; R5:=SAVER5; END; PROCEDURE ERRORX(R5); BEGIN COMMENT ERROR EXIT; WRITETYPE; R0:=_1; SETCC; R5:=SAVER5; END; PROCEDURE SYNERR(R4); BEGIN COMMENT GENERAL COMMAND ERROR; LIT(R0,"COMMAND ERROR"); R1:=13; ERRORX; END; PROCEDURE WRONGVOL(R4); BEGIN COMMENT DISK NOT THAT IN MOUNT COMMAND; LIT(R0,"WRONG DISK ON DRIVE"); R1:=19; ERRORX; END; PROCEDURE DISKERR(R4); BEGIN COMMENT I/O ERROR ON DISK OR TAPE COMMAND; LIT(R0,"I/O ERROR ON COMMAND"); R1:=20; ERRORX; END; PROCEDURE TAPEERR(R4); BEGIN COMMENT I/O ERROR, REWIND SYSTEM TAPE FIRST; R2:=ASSIGNPTR; REWIND; DISKERR; END; PROCEDURE NODEVICE(R4); BEGIN COMMENT I/O DEVICE NOT DEFINED; LIT(R0,"NO SUCH DISK OR TAPE DRIVE"); R1:=26; ERRORX; END; PROCEDURE DENERR(R4); BEGIN COMMENT TAPE DRIVE TYPE NO CAPABLE OF DENSITY OR MODE; LIT(R0,"ILLEGAL MODE FOR TAPE DRIVE"); R1:=27; ERRORX; END; PROCEDURE FINDASSIGN(R4); BEGIN COMMENT FIND FREE ASSIGN ENTRY, NOT NAME1; R1:=ASSIGNPTR; R2:=0; FOR R0:=1 STEP 1 UNTIL NOOFASSIGNS DO BEGIN CLI(0,ASSIGNNAME(R1)); IF = THEN BEGIN IF R2 = 0 THEN R2:=R1; END ELSE BEGIN CLC(7,ASSIGNNAME(R1),NAME1); IF = THEN BEGIN LIT(R0,"NAME ALREADY ASSIGNED"); R1:=21; ERRORX; END; END; R1:=R1+ASSIGNSIZE; END; IF R2 = 0 THEN BEGIN LIT(R0,"TOO MANY ASSIGNMENTS"); R1:=20; ERRORX; END; END; PROCEDURE FINDVOLUME(R4); BEGIN COMMENT FIND VOLUME NAME2 AND VERIFY; R0:=_1; FOR R1:=0 STEP 16 UNTIL 112 DO BEGIN R3:=@DISKLABEL(R1); CLC(7,B3,NAME2); IF = THEN R0:=R1 SHRL 4; END; IF R0 < 0 THEN BEGIN LIT(R0,"VOLUME NOT MOUNTED"); R1:=18; ERRORX; END; DRIVENO(R2):=R0; SET(DISKUNIT(R2)); RESET(JOBREAD(R2)); RESET(JOBWRITE(R2)); MVC(7,AREANAME(R2)," "); R1:=R0 SHLL 4; R1:=DISKDRIVETYPE(R1) SHLL 1; DRIVETYPE:=R1; R0:=LOCKLIM(R1-2); MAPSIZE:=R0; MVC(3,EXTENTS(R2),#00000006); RESET(SHARED(R2)); R0:=1; ASSIGNLOCK(R2):=R0; RESET(PROTECTED(R2)); RESET(JOBASSIGNED(R2)); MVI(1,EXTENTCNT(R2)); MVC(3,EXTENTS(R2),#00000003); RESET(SHARED(R2)); R0:=@VTOCWORK; R1:=14; R3:=3; READDISK; IF ~= OR OVERFLOW THEN DISKERR; CLC(5,VTOCWORK,"SNAPOS"); IF ~= THEN WRONGVOL; CLC(7,VTOCWORK(6),NAME2); IF ~= THEN WRONGVOL; END; PROCEDURE GETAREAADR(R5); BEGIN COMMENT FIND DISK ADDRESS OF AREA ENTRY; IF R3 <= FIRSTTRK(R1-2) THEN R3:=R3+5 ELSE BEGIN R3:=R3-FIRSTTRK(R1-2); R0:=256; WHILE R3 > OTHERTRK(R1-2) DO BEGIN R3:=R3-OTHERTRK(R1-2); R0:=R0+256; END; R3:=R3+R0; END; END; PROCEDURE FINDAREA(R4); BEGIN COMMENT LOOKUP AREA NAMEHOLD; R0:=@VTOCWORK; R1:=VTOCSIZE;R3:=5; READDISK; IF ~= OR OVERFLOW THEN DISKERR; R1:=@VTOCNAME; R3:=0; FOR R0:=1 STEP 1 UNTIL FILESPERVOL DO BEGIN CLC(7,B1,NAMEHOLD); IF = THEN BEGIN R3:=R0; NAMEPTR:=R1; END; R1:=R1+8; END; IF R3 = 0 THEN BEGIN LIT(R0,"AREA NOT ON VOLUME"); R1:=18; ERRORX; END; R1:=DRIVETYPE; GETAREAADR; R0:=@VTOCWORK; R1:=66; READDISK; IF ~= OR OVERFLOW THEN DISKERR; END; PROCEDURE DUPAREA(R4); BEGIN COMMENT CHECK AREA ALREADY IN USE; R1:=ASSIGNPTR; FOR R0:=1 STEP 1 UNTIL NOOFASSIGNS DO BEGIN CLI(0,ASSIGNNAME(R1)); IF ~= AND DISKUNIT(R1) THEN BEGIN CLC(1,DRIVENO(R1),DRIVENO(R2)); IF = THEN BEGIN CLC(7,AREANAME(R1),NAMEHOLD); IF = THEN BEGIN LIT(R0,"AREA CURRENTLY ASSIGNED"); R1:=23; ERRORX; END; END; END; R1:=R1+ASSIGNSIZE; END; END; PROCEDURE SETTRACK(R4); BEGIN COMMENT SET BITS IN TRACK MAP FOR EXTENT; ARRAY 2 SHORT INTEGER X=(#9600,@B1); COMMENT OI; STM(R2,R3,SAVER2R3); R1:=R0 SHRL 19 AND #1FFF; R1:=@VTOCTRACKMAP(R1); R2:=R0 SHRL 16 AND 7; FOR R0:=R0 AND #FFFF STEP _1 UNTIL 1 DO BEGIN IC(R3,BIT1(R2)); EX(R3,X); R2:=R2+1; IF R2 > 7 THEN BEGIN R2:=0; R1:=R1+1; END; END; LM(R2,R3,SAVER2R3); END; PROCEDURE RESETTRACK(R4); BEGIN COMMENT RESET BITS IN TRACK MAP FOR EXTENT; ARRAY 2 SHORT INTEGER X=(#9400,@B1); COMMENT NI; STM(R2,R3,SAVER2R3); R1:=R0 SHRL 19 AND #1FFF; R1:=@VTOCTRACKMAP(R1); R2:=R0 SHRL 16 AND 7; FOR R0:=R0 AND #FFFF STEP _1 UNTIL 1 DO BEGIN IC(R3,BIT0(R2)); EX(R3,X); R2:=R2+1; IF R2 > 7 THEN BEGIN R2:=0; R1:=R1+1; END; END; LM(R2,R3,SAVER2R3); END; PROCEDURE FINDSPACE(R4); BEGIN COMMENT FIND DISK SPACE IN NUMBER, RETURN EXTENT IN R0; ARRAY 2 SHORT INTEGER X=(#9100,@B1); COMMENT TM; STM(R2,R3,SAVER2R3); R1:=@VTOCTRACKMAP; R2:=0; R0:=0; MAXSPACE:=R0; R3:=R1+MAPSIZE; WHILE R1 < R3 DO BEGIN IC(R3,BIT1(R2)); R2:=R2+1; EX(R3,X); IF = THEN BEGIN COMMENT TRACK NOT AVAILABLE; IF R2 > 7 THEN BEGIN R2:=0; R1:=R1+1; END; R3:=R0 AND #FFFF; IF R3 > 0 THEN BEGIN COMMENT END OF EXTENT; IF R3 > MAXSPACE THEN MAXSPACE:=R3; R3:=R3 SHLL 16; R0:=R0 AND #FFFF0000+R3+#10000; END ELSE R0:=R0+#10000; COMMENT JUST SKIP IT; END ELSE BEGIN COMMENT TRACK AVAILABLE, COUNT IT; IF R2 > 7 THEN BEGIN R2:=0; R1:=R1+1; END; R0:=R0+1; R3:=R0 AND #FFFF; IF R3>= NUMBER THEN R1:=@VTOCTRACKMAP+MAPSIZE; END; R3:=@VTOCTRACKMAP+MAPSIZE; END; R3:=R0 AND #FFFF; IF R3 < NUMBER THEN BEGIN R1:=MAXSPACE; CVD(R1,CONVRT); MVC(32,VTOCWORK,"LARGEST EXTENT ONLY 0000 TRACK(S)"); UNPK(3,7,VTOCWORK(20),CONVRT); OI("0",VTOCWORK(23)); R0:=@VTOCWORK; R1:=33; ERRORX; END; NUMBER:=R0; LM(R2,R3,SAVER2R3); END; GLOBAL 77 PROCEDURE OTHERS(R5); BEGIN COMMENT PROCESS OTHER THAN ASSIGN, UNASSIGN, MOUNT, ETC; INTEGER SAVEPTR; BYTE TEMPPROTECT, TEMPXTENTCNT; ARRAY 32 SHORT INTEGER TEMPXTENTS; FUNCTION XC(5,#D700); IF R0 = #27 AND R1 = "PROT" AND R2 = "ECT " THEN BEGIN GETNAME; IF R0 ~= #24 THEN SYNERR; MVC(7,NAME2,NAMEHOLD); GETNAME; IF R0 ~= #25 THEN SYNERR; MVC(7,NAME1,#FFL); FINDASSIGN; FINDVOLUME; DUPAREA; FINDAREA; SET(VTOCPROTECT); R1:=66; WRITEDISK; IF ~= OR OVERFLOW THEN DISKERR; NORMALX; END; IF R0 = #27 AND R1 = "UNPR" AND R2 = "OTEC" THEN BEGIN GETNAME; IF R0 ~= #24 THEN SYNERR; MVC(7,NAME2,NAMEHOLD); GETNAME; IF R0 ~= #25 THEN SYNERR; MVC(7,NAME1,#FFL); FINDASSIGN; FINDVOLUME; DUPAREA; FINDAREA; RESET(VTOCPROTECT); R1:=66; WRITEDISK; IF ~= OR OVERFLOW THEN DISKERR; NORMALX; END; IF R0 = #27 AND R1 = "CREA" AND R2 = "TE " THEN BEGIN GETNAME; IF R0 ~= #24 THEN SYNERR; MVC(7,NAME2,NAMEHOLD); GETNAME; IF R0 ~= #24 THEN SYNERR; MVC(7,NAME1,#FFL); GETDEC; IF R0 ~= #25 OR R1 = 0 THEN SYNERR; NUMBER:=R1; FINDASSIGN; FINDVOLUME; DUPAREA; R0:=@VTOCWORK; R1:=512; R3:=5; READDISK; IF ~= OR OVERFLOW THEN DISKERR; R1:=@VTOCNAME; R3:=0; FOR R0:=1 STEP 1 UNTIL FILESPERVOL DO BEGIN CLC(7,B1,NAMEHOLD); IF = THEN BEGIN LIT(R0,"AREA ALREADY EXISTS"); R1:=19; ERRORX; END; CLI(0,B1); IF = AND R3 = 0 THEN BEGIN R3:=R0; NAMEPTR:=R1; END; R1:=R1+8; END; IF R3 = 0 THEN BEGIN LIT(R0,"DIRECTORY FULL"); R1:=14; ERRORX; END; R1:=DRIVETYPE; GETAREAADR; SAVEPTR:=R3; R0:=@VTOCWORK; R1:=MAPSIZE; R3:=4; READDISK; IF ~= OR OVERFLOW THEN DISKERR; FINDSPACE; RESETTRACK; R0:=@VTOCWORK; R1:=MAPSIZE; R3:=4; WRITEDISK; IF ~= OR OVERFLOW THEN DISKERR; RESET(VTOCPROTECT); MVI(1,VTOCXTENTCNT); MVC(3,VTOCXTENTS,NUMBER); XC(59,VTOCXTENTS(4),VTOCXTENTS(4)); R1:=66; R3:=SAVEPTR; WRITEDISK; IF ~= OR OVERFLOW THEN DISKERR; R1:=VTOCSIZE; R3:=5; READDISK; IF ~= OR OVERFLOW THEN DISKERR; R1:=NAMEPTR; MVC(7,B1,NAMEHOLD); R1:=VTOCSIZE; WRITEDISK; IF ~= OR OVERFLOW THEN DISKERR; NORMALX; END; IF R0 = #27 AND R1 = "DELE" AND R2 = "TE " THEN BEGIN GETNAME; IF R0 ~= #24 THEN SYNERR; MVC(7,NAME2,NAMEHOLD); GETNAME; IF R0 ~= #25 THEN SYNERR; MVC(7,NAME1,#FFL); FINDASSIGN; FINDVOLUME; DUPAREA; FINDAREA; MVC(65,TEMPPROTECT,VTOCPROTECT); IF TEMPPROTECT THEN BEGIN LIT(R0,"AREA PROTECTED"); R1:=14; ERRORX; END; R0:=@VTOCWORK; R1:=VTOCSIZE; R3:=5; READDISK; IF ~= OR OVERFLOW THEN DISKERR; R1:=NAMEPTR; MVI(0,B1); R1:=VTOCSIZE; WRITEDISK; IF ~= OR OVERFLOW THEN DISKERR; R0:=@VTOCWORK; R1:=MAPSIZE; R3:=4; READDISK; IF ~= OR OVERFLOW THEN DISKERR; R3:=0; R0:=TEMPXTENTCNT; WHILE R0 > 0 DO BEGIN R0:=TEMPXTENTS(R3) SHLL 16+TEMPXTENTS(R3+2); SETTRACK; R0:=TEMPXTENTCNT-1; TEMPXTENTCNT:=R0; R3:=R3+4; END; R0:=@VTOCWORK; R1:=MAPSIZE; R3:=4; WRITEDISK; IF ~= OR OVERFLOW THEN DISKERR; NORMALX; END; IF R0 = #27 AND R1 = "EXTE" AND R2 = "ND " THEN BEGIN GETNAME; IF R0 ~= #24 THEN SYNERR; MVC(7,NAME2,NAMEHOLD); GETNAME; IF R0 ~= #24 THEN SYNERR; MVC(7,NAME1,#FFL); GETDEC; IF R0 ~= #25 OR R1 = 0 THEN SYNERR; NUMBER:=R1; FINDASSIGN; FINDVOLUME; FINDAREA; SAVEPTR:=R3; MVC(65,TEMPPROTECT,VTOCPROTECT); IF TEMPPROTECT THEN BEGIN LIT(R0,"AREA PROTECTED"); R1:=14; ERRORX; END; CLI(16,TEMPXTENTCNT); IF = THEN BEGIN LIT(R0,"TOO MANY EXTENTS"); R1:=16; ERRORX; END; R0:=@VTOCWORK; R1:=MAPSIZE; R3:=4; READDISK; IF ~= OR OVERFLOW THEN DISKERR; FINDSPACE; RESETTRACK; R0:=@VTOCWORK; R1:=MAPSIZE; R3:=4; WRITEDISK; IF ~= OR OVERFLOW THEN DISKERR; R1:=TEMPXTENTCNT+1; TEMPXTENTCNT:=R1; R1:=R1 SHLL 2; R1:=@TEMPXTENTS(R1-4); MVC(3,B1,NUMBER); R0:=@TEMPPROTECT; R1:=66; R3:=SAVEPTR; WRITEDISK; IF ~= OR OVERFLOW THEN DISKERR; R1:=ASSIGNPTR; FOR R3:=1 STEP 1 UNTIL NOOFASSIGNS DO BEGIN CLI(0,ASSIGNNAME(R1)); IF ~= THEN BEGIN CLC(1,DRIVENO(R1),DRIVENO(R2)); IF = AND DISKUNIT(R1) THEN BEGIN CLC(7,AREANAME(R1),NAMEHOLD); IF = THEN BEGIN R0:=@ASSIGNLOCK(R1); P; MVC(63,EXTENTS(R1),TEMPXTENTS); MVC(0,EXTENTCNT(R1),TEMPXTENTCNT); R0:=@ASSIGNLOCK(R1); V; END; END; END; R1:=R1+ASSIGNSIZE; END; NORMALX; END; IF R0 = #27 AND R1 = "MAP " THEN BEGIN PROCEDURE DOMAP(R1); BEGIN COMMENT PROCESS TO DO MAP LISTING; LONG REAL CONVRT; ARRAY 18 BYTE MAPMSG; BYTE LOCKED; PROCEDURE READDISKX(R5); BEGIN COMMENT READ DISK AND TEST FOR ERROR; READDISK; IF ~= OR OVERFLOW THEN BEGIN R0:=@OPRLOCK; V; MVI(0,ASSIGNNAME(R2)); LIT(R0,"I/O ERROR ON MAP"); R1:=16; WRITETYPE; RESET(MAPGOING); STOP; END; END; START; MVI(" ",MAPMSG); MVC(16,MAPMSG(1),MAPMSG); RESET(LOCKED); FOR R6:=1 STEP 1 UNTIL FILESPERVOL DO BEGIN IF ~LOCKED THEN BEGIN R0:=@OPRLOCK; P; R0:=@VTOCWORK; R1:=VTOCSIZE; R3:=5; READDISKX; SET(LOCKED); END; R1:=R6-1 SHLL 3; R1:=@VTOCNAME(R1); CLI(0,B1); IF ~= THEN BEGIN MVC(7,MAPMSG,B1); R1:=DRIVENO(R2) SHLL 4; R1:=DISKDRIVETYPE(R1) SHLL 1; R3:=R6; GETAREAADR; R0:=@VTOCWORK; R1:=66; READDISKX; MVI(" ",MAPMSG(9)); IF VTOCPROTECT THEN MVI("P",MAPMSG(9)); R0:=VTOCXTENTCNT; CVD(R0,CONVRT); UNPK(1,7,MAPMSG(11),CONVRT); OI("0",MAPMSG(12)); R1:=0; R3:=0; WHILE R0 > 0 DO BEGIN R3:=R3+VTOCXTENTS(R1+2); R1:=R1+4; R0:=R0-1; END; CVD(R3,CONVRT); UNPK(3,7,MAPMSG(14),CONVRT); OI("0",MAPMSG(17)); R0:=@OPRLOCK; V; IF MAPKILL THEN BEGIN MVI(0,ASSIGNNAME(R2)); RESET(MAPGOING); STOP; END; R0:=@MAPMSG; R1:=18; WRITETYPE; RESET(LOCKED); END; END; IF ~LOCKED THEN BEGIN R0:=@OPRLOCK; P; END; R0:=@VTOCWORK; R1:=MAPSIZE; R3:=4; READDISKX; R3:=0; R4:=0; R5:=0; FOR R1:=4 STEP 4 UNTIL MAPSIZE DO BEGIN R0:=VTOCWORK(R1-4); FOR R6:=1 STEP 1 UNTIL 32 DO BEGIN IF R0 < 0 THEN BEGIN R3:=R3+1; R4:=R4+1; END ELSE BEGIN IF R4 > R5 THEN R5:=R4; R4:=0; END; R0:=R0 SHLL 1; END; END; IF R4 > R5 THEN R5:=R4; R0:=@OPRLOCK; V; MVI(0,ASSIGNNAME(R2)); CVD(R3,CONVRT); UNPK(3,7,MAPMSG,CONVRT); OI("0",MAPMSG(3)); MVC(12,MAPMSG(4)," TRK(S) AVAIL"); R0:=@MAPMSG; R1:=17; WRITETYPE; CVD(R5,CONVRT); UNPK(3,7,MAPMSG,CONVRT); OI("0",MAPMSG(3)); MVC(13,MAPMSG(4)," LARGEST XTENT"); R1:=18; WRITETYPE; RESET(MAPGOING); STOP; END; GETNAME; IF R0 ~= #25 THEN SYNERR; MVC(7,NAME2,NAMEHOLD); IF MAPGOING THEN BEGIN LIT(R0,"MAP IN PROGRESS"); R1:=15; ERRORX; END; MVC(7,NAME1," MAP "); FINDASSIGN; FINDVOLUME; MVC(7,ASSIGNNAME(R2),NAME1); SET(MAPGOING); RESET(MAPKILL); DOMAP; IF ~= THEN BEGIN MVI(0,ASSIGNNAME(R2)); LIT(R0,"CAN'T START MAP, RETRY LATER"); R1:=28; ERRORX; END; NORMALX; END; IF R0 = #25 AND R1 = "STOP" AND R2 = "MAP " THEN BEGIN IF MAPGOING THEN SET(MAPKILL) ELSE BEGIN LIT(R0,"NO MAP GOING"); R1:=12; ERRORX; END; NORMALX; END; IF R0 = #25 AND R1 = "SKIP" AND R2 = "PCH " THEN BEGIN SET(PCHFLUSH); NORMALX; END; IF R0 = #25 AND R1 = "SKIP" AND R2 = "PRT " THEN BEGIN SET(PRTFLUSH); NORMALX; END; IF R0 = #25 AND R1 = "PROG" AND R2 = "RAM " THEN BEGIN R0:=@ASKJOB; V; NORMALX; COMMENT WAKE UP USER; END; IF R0 = #25 AND R1 = "LIST" AND R2 = "ASSI" THEN BEGIN R2:=ASSIGNPTR; FOR R3:=1 STEP 1 UNTIL NOOFASSIGNS DO BEGIN CLI(0,ASSIGNNAME(R2)); IF ~= THEN BEGIN MVI(" ",OPREPLY); MVC(26,OPREPLY(1),OPREPLY); MVC(7,OPREPLY,ASSIGNNAME(R2)); IF SHARED(R2) THEN MVI("P",OPREPLY(9)); IF DISKUNIT(R2) THEN BEGIN MVC(7,OPREPLY(20),AREANAME(R2)); R1:=DRIVENO(R2) SHLL 4; R1:=@DISKLABEL(R1); MVC(7,OPREPLY(11),B1); R1:=28; END ELSE BEGIN R0:=DRIVENO(R2)+#F1; OPREPLY(11):=R0; R1:=12; END; R0:=@OPREPLY; WRITETYPE; END; R2:=R2+ASSIGNSIZE; END; NORMALX; END; IF R0 = #25 AND R1 = "PAUS" AND R2 = "E " THEN BEGIN IF JOBPAUSE THEN BEGIN LIT(R0,"PAUSE ALREADY REQUESTED"); R1:=23; ERRORX; END; SET(JOBPAUSE); RESET(JOBSTOPPED); NORMALX; END; IF R0 = #25 AND R1 = "REST" AND R2 = "ART " THEN BEGIN IF ~JOBPAUSE THEN BEGIN LIT(R0,"PAUSE NOT REQUESTED"); R1:=19; ERRORX; END; RESET(JOBPAUSE); IF JOBSTOPPED THEN BEGIN RESET(JOBSTOPPED); R0:=@JOBLOCK; V; END; NORMALX; END; SYNERR; END; PROCEDURE UNLOADUNIT(R1); BEGIN COMMENT PROCESS TO UNLOAD TAPES; START; UNLOAD; MVI(0,ASSIGNNAME(R2)); STOP; END; SAVER5:=R5; CLI(#25,OPREPLY); IF = THEN NORMALX; GETNAME; IF R0 = #26 THEN SYNERR; LM(R1,R2,COMMAND); IF R0 = #25 AND R1 = "CANC" AND R2 = "EL " THEN BEGIN R0:=4; CANCEL; NORMALX; END; IF R0 = #27 AND R1 = "ASSI" AND R2 = "GN " THEN BEGIN RESET(PUBLIC); GETNAME; IF R0 ~= #24 THEN SYNERR; MVC(7,NAME1,NAMEHOLD); R3:=R6; GETDEC; IF R0 ~= #26 THEN BEGIN COMMENT TAPE ASSIGN; IF R1 < 1 OR R1 > 8 THEN SYNERR; NUMBER:=R1; MVI(3,DENSITY); MVI(0,PARITY); R6:=@OPREPLY(R6+1); IF R0 = #24 THEN BEGIN COMMENT DENSITY, ETC. FOLLOWS; CLC(2,B6,#02000000); IF = THEN BEGIN MVI(1,DENSITY); R6:=R6+3; COMMENT 200 BPI; END ELSE BEGIN CLC(2,B6,#05050600); IF = THEN BEGIN MVI(2,DENSITY); R6:=R6+3; COMMENT 556 BPI; END ELSE BEGIN CLC(2,B6,#08000000); IF = THEN BEGIN R6:=R6+3; COMMENT 800 BPI, DEFAULT; END ELSE BEGIN CLC(3,B6,#01060000); IF = THEN BEGIN MVI(4,DENSITY); R6:=R6+4; COMMENT 1600 BPI; END; END; END; END; CLI(#0E,B6); IF = THEN BEGIN OI(4,PARITY); R6:=R6+1; COMMENT EVEN PARITY; END ELSE BEGIN CLI(#18,B6); IF = THEN BEGIN OI(8,PARITY); R6:=R6+1; COMMENT ODD PARITY, DEFAULT; END; END; CLI(#17,B6); IF = THEN BEGIN OI(1,PARITY); R6:=R6+1; COMMENT NO CONVERSION, NO TRANSLATE; END ELSE BEGIN CLI(#0C,B6); IF = THEN BEGIN OI(2,PARITY); R6:=R6+1; COMMENT CONVERSION; END ELSE BEGIN CLI(#1D,B6); IF = THEN BEGIN OI(3,PARITY); R6:=R6+1; COMMENT TRANSLATE; END; END; END; R0:=@OPREPLY; R6:=R6-R0; R0:=OPREPLY(R6); END; IF R0 = #24 THEN BEGIN COMMENT IS PUBLIC; GETNAME; CLC(7,NAMEHOLD,"PUBLIC "); IF ~= THEN SYNERR; SET(PUBLIC); END; IF R0 ~= #25 THEN SYNERR; R1:=ASSIGNPTR; R2:=NUMBER-1; FOR R0:=1 STEP 1 UNTIL NOOFASSIGNS DO BEGIN CLI(0,ASSIGNNAME(R1)); IF ~= AND ~DISKUNIT(R1) AND R2 = DRIVENO(R1) THEN BEGIN LIT(R0,"TAPE DRIVE ALREADY ASSIGNED"); R1:=27; ERRORX; END; R1:=R1+ASSIGNSIZE; END; R1:=NUMBER SHLL 2; R2:=TAPEDRIVETYPE(R1-4); IF R2 = 0 THEN NODEVICE; R0:=DENSITY; R1:=PARITY; IF R2 = 1 THEN BEGIN COMMENT 9 TRACK; IF R0 < 3 OR R1 > 0 THEN DENERR; IF R0 = 3 THEN MVI(#CB,DENSITY) ELSE MVI(#C3,DENSITY); END ELSE BEGIN COMMENT 7 TRACK; R1:=MODE(R1); COMMENT TRANSLATE DENSITY AND PARITY; IF R0 > 3 OR R1 = 8 THEN DENERR; R0:=R0-1 SHLL 3 OR R1 SHLL 3 OR 3; DENSITY:=R0; END; FINDASSIGN; MVC(7,ASSIGNNAME(R2),NAME1); R0:=NUMBER-1; DRIVENO(R2):=R0; MVC(0,TAPEMODE(R2),DENSITY); MVC(0,SHARED(R2),PUBLIC); RESET(PROTECTED(R2)); RESET(JOBREAD(R2)); RESET(JOBWRITE(R2)); RESET(JOBASSIGNED(R2)); RESET(DISKUNIT(R2)); R0:=1; ASSIGNLOCK(R2):=R0; NORMALX; END; R6:=R3; GETNAME; IF R0 ~= #24 THEN SYNERR; MVC(7,NAME2,NAMEHOLD); GETNAME; IF R0 = #24 THEN BEGIN MVC(7,SAVENAME,NAMEHOLD); GETNAME; CLC(7,NAMEHOLD,"PUBLIC "); IF ~= THEN SYNERR; SET(PUBLIC); MVC(7,NAMEHOLD,SAVENAME); END; IF R0 ~= #25 THEN SYNERR; FINDASSIGN; FINDVOLUME; DUPAREA; FINDAREA; MVC(0,SHARED(R2),PUBLIC); MVC(7,AREANAME(R2),NAMEHOLD); MVC(0,PROTECTED(R2),VTOCPROTECT); MVC(0,EXTENTCNT(R2),VTOCXTENTCNT); MVC(63,EXTENTS(R2),VTOCXTENTS); MVC(7,ASSIGNNAME(R2),NAME1); NORMALX; END; IF R0 = #27 AND R1 = "UNAS" AND R2 = "SIGN" THEN BEGIN GETNAME; IF R0 ~= #25 THEN SYNERR; CLC(7,NAMEHOLD,"SYSTEM "); IF = THEN BEGIN LIT(R0,"CAN'T UNASSIGN SYSTEM"); R1:=21; ERRORX; END; R1:=ASSIGNPTR; R2:=0; FOR R0:=1 STEP 1 UNTIL NOOFASSIGNS DO BEGIN CLC(7,ASSIGNNAME(R1),NAMEHOLD); IF = THEN R2:=R1; R1:=R1+ASSIGNSIZE; END; IF R2 = 0 THEN BEGIN LIT(R0,"NOT ASSIGNED"); R1:=12; ERRORX; END; IF JOBASSIGNED(R2) THEN BEGIN LIT(R0,"JOB USING ASSIGNMENT"); R1:=20; ERRORX; END; IF DISKUNIT(R2) THEN MVI(0,ASSIGNNAME(R2)) ELSE BEGIN MVI(1,ASSIGNNAME(R2)); UNLOADUNIT; IF ~= THEN BEGIN UNLOAD; MVI(0,ASSIGNNAME(R2)); END; END; NORMALX; END; IF R0 = #27 AND R1 = "MOUN" AND R2 = "T " THEN BEGIN GETDEC; IF R0 ~= #25 OR R1 < 1 OR R1 > 8 THEN SYNERR; R1:=R1 SHLL 4; R0:=DISKDRIVETYPE(R1-16); IF R0 = 0 THEN NODEVICE; R1:=R1 SHRL 4-1; NUMBER:=R1; MVC(7,NAME1,#FFL); R2:=ASSIGNPTR; FOR R0:=1 STEP 1 UNTIL NOOFASSIGNS DO BEGIN CLI(0,ASSIGNNAME(R2)); IF ~= AND R1 = DRIVENO(R2) AND DISKUNIT(R2) THEN BEGIN LIT(R0,"ASSIGNED VOLUME ON DRIVE"); R1:=24; ERRORX; END; R2:=R2+ASSIGNSIZE; END; R2:=R1 SHLL 4; R2:=@DISKLABEL(R2); MVC(7,B2,#0L); FINDASSIGN; R0:=NUMBER; DRIVENO(R2):=R0; SET(DISKUNIT(R2)); RESET(JOBREAD(R2)); RESET(SHARED(R2)); RESET(JOBWRITE(R2)); RESET(PROTECTED(R2)); RESET(JOBASSIGNED(R2)); R0:=1; ASSIGNLOCK(R2):=R0; MVC(3,EXTENTS(R2),#00000006); MVI(1,EXTENTCNT(R2)); R0:=@VTOCWORK; R1:=14; R3:=3; READDISK; IF OVERFLOW THEN DISKERR; IF = THEN BEGIN CLC(5,VTOCWORK,"SNAPOS"); IF = THEN BEGIN R1:=DRIVENO(R2) SHLL 4; R1:=@DISKLABEL(R1); MVC(7,B1,VTOCWORK(6)); MVC(7,VTOCWORK(14)," MOUNTED"); R0:=@VTOCWORK(6); R1:=16; WRITETYPE; NORMALX; END; END; LIT(R0,"DISK NOT FORMATTED PROPERLY"); R1:=27; WRITETYPE; R1:=DRIVENO(R2) SHLL 4; R1:=DISKDRIVETYPE(R1) SHLL 1; DRIVETYPE:=R1; R0:=LOCKLIM(R1-2); MAPSIZE:=R0; R0:=TRKPERCYL(R1-2); CYLSIZE:=R0; NUMBER:=R2; RESET(REPLYOK); WHILE ~REPLYOK DO BEGIN R0:=@OPREPLY; R1:=#150050; LIT(R2,"REFORMAT? (YES OR NO)"); READTYPE; R0:=21; OPREPLY(R1):=R0; TR(80,OPREPLY,CONSOLETRT); R6:=_1; GETNAME; IF R0 = #25 THEN BEGIN R0:=COMMAND; IF R0 = "NO " THEN BEGIN LIT(R0,"NOT REFORMATTED"); R1:=15; ERRORX; END; IF R0 = "YES " THEN SET(REPLYOK); END; END; RESET(REPLYOK); WHILE ~REPLYOK DO BEGIN R0:=@OPREPLY; R1:=#110050; LIT(R2,"NEW VOLUME LABEL?"); READTYPE; R0:=21; OPREPLY(R1):=R0; TR(80,OPREPLY,CONSOLETRT); R6:=_1; CLI(#25,OPREPLY); IF = THEN BEGIN LIT(R0,"NOT REFORMATTED"); R1:=15; ERRORX; END; GETNAME; IF R0 = #25 THEN SET(REPLYOK); END; R4:=NUMBER; R2:=ASSIGNPTR; COMMENT COPY IPL ROUTINE; IF JOBASSIGNED(R2) AND ~DISKUNIT(R2) THEN BEGIN LIT(R0,"SYSTEM ASSIGNED TO JOB, RETRY LATER"); R1:=35; ERRORX; END; IF DISKUNIT(R2) THEN BEGIN COMMENT COPY IPL FROM DISK; R0:=@VTOCWORK; R1:=24; R3:=3; READDISK; IF ~= OR OVERFLOW THEN DISKERR; R2:=R4; R1:=24; R3:=1; FORMATDISK; IF ~= OR OVERFLOW THEN DISKERR; R2:=ASSIGNPTR; R1:=512; R3:=4; READDISK; IF ~= OR OVERFLOW THEN DISKERR; R2:=R4; R1:=512; R3:=2; FORMATDISK; IF ~= OR OVERFLOW THEN DISKERR; R2:=ASSIGNPTR; R1:=256; R3:=5; R0:=@VTOCWORK(16); READDISK; IF ~= OR OVERFLOW THEN DISKERR; END ELSE BEGIN COMMENT COPY IPL FROM TAPE; REWIND; FSPREC; FSPREC; R0:=@VTOCWORK; R1:=24; READTAPE; IF ~= OR OVERFLOW THEN TAPEERR; R2:=R4; R1:=24; R3:=1; FORMATDISK; IF ~= OR OVERFLOW THEN TAPEERR; R2:=ASSIGNPTR; R1:=512; READTAPE; IF ~= OR OVERFLOW THEN TAPEERR; R2:=R4; R1:=512; R3:=2; FORMATDISK; IF ~= OR OVERFLOW THEN TAPEERR; R2:=ASSIGNPTR; R0:=@VTOCWORK(16); R1:=256; READTAPE; IF ~= OR OVERFLOW THEN TAPEERR; REWIND; END; MVC(13,VTOCWORK," ****** "); MVC(1,VTOCWORK(14),CYLSIZE); R2:=R4; R0:=@VTOCWORK; R1:=272; R3:=3; FORMATDISK; IF ~= OR OVERFLOW THEN DISKERR; R6:=DRIVETYPE; R0:=LOCKOUT(R6-2); STC(R0,VTOCTRACKMAP); R0:=#FF; FOR R3:=2 STEP 1 UNTIL MAPSIZE DO STC(R0,VTOCTRACKMAP(R3-1)); R0:=@VTOCWORK; R1:=MAPSIZE; R3:=4; FORMATDISK; IF ~= OR OVERFLOW THEN DISKERR; R0:=0; FOR R1:=1 STEP 1 UNTIL VTOCSIZE DO STC(R0,VTOCTRACKMAP(R1-1)); R0:=@VTOCWORK; R1:=VTOCSIZE; R3:=5; FORMATDISK; IF ~= OR OVERFLOW THEN DISKERR; R4:=0; FOR R5:=1 STEP 1 UNTIL FIRSTTRK(R6-2) DO BEGIN R1:=66; R3:=R3+1; FORMATDISK; IF ~= OR OVERFLOW THEN DISKERR; R4:=R4+1; END; WHILE R4 < FILESPERVOL DO BEGIN R3:=R3 AND _256+256; FOR R5:=1 STEP 1 UNTIL OTHERTRK(R6-2) DO BEGIN R1:=66; R3:=R3+1; FORMATDISK; IF ~= OR OVERFLOW THEN DISKERR; R4:=R4+1; END; END; R1:=272; R3:=3; READDISK; IF ~= OR OVERFLOW THEN DISKERR; MVC(5,VTOCWORK,"SNAPOS"); MVC(7,VTOCWORK(6),NAMEHOLD); R1:=272; WRITEDISK; IF ~= OR OVERFLOW THEN DISKERR; R1:=DRIVENO(R2) SHLL 4; R1:=@DISKLABEL(R1); MVC(7,B1,VTOCWORK(6)); NORMALX; END; OTHERS; COMMENT PROCESS SOME OTHER COMMAND; END; GLOBAL 76 PROCEDURE PROCESSJOB(R6); BEGIN COMMENT PROCESS ONE JOB COMPLETELY; LONG REAL CONVRT; COMMENT CONVERSION WORK AREA; ARRAY 2 INTEGER CONVRTI SYN CONVRT; INTEGER SAVER6; COMMENT SAVE RETURN ADDRESS; INTEGER SAVER1, TIMELIM; COMMENT SAVE USER TIME LIMIT; INTEGER DISKLOADPT; COMMENT DISK ADDRESS FOR LOADING; INTEGER REALDISKADR; COMMENT ADDRESS OF FIRST RECORD IN GROUP; BYTE EXECUTEFLAG; COMMENT INDICATES JOB IN EXECUTION; BYTE FLUSH, KILLREASON; BYTE LOOKING, JOBGOING; ARRAY 100 BYTE SMSG; ARRAY 3 SHORT INTEGER IDMOVE=(#D200,@SMSG(29),@B1); ARRAY 132 BYTE LINE; COMMENT PRINT BUFFER; BYTE DUMPFLG; COMMENT DUMP CORE IF ANY PROCESSES CANCELLED; ARRAY 21 INTEGER HEADER; COMMENT AREA FOR PROGRAM ID RECORD; ARRAY 17 BYTE MSG; ARRAY 8 BYTE NAME; ARRAY 112 BYTE PRGMSG=( COMMENT PROGRAM CHECK REASON; "I/O ", "ILL OP ", "PRIV OP", "EXECUTE", "PROT ", "ADDR ", "SPEC ", "DATA ", "FIX OVF", "FIX DIV", "DEC OVF", "DEC DIV", "EXP OVF", "EXP UND", "SIGNIF ", "FPT DIV"); ARRAY 100 BYTE ERRMSG=( COMMENT REASON FOR CANCEL; "USER CALL ", "ILL SVC ", "TIME LIMIT", "OPERATOR ", "I/O ERROR ", "UNDEF I/O ", "WRONG I/O ", "WRITE PROT", "READ EOF ", "OVERLAY "); ARRAY 19 BYTE NOTONFILE="PROGRAM NOT IN FILE"; ARRAY 20 BYTE MISSCARD="MISSING CONTROL CARD"; ARRAY 21 BYTE ERRORCARD="ERROR IN CONTROL CARD"; ARRAY 12 BYTE NOTASSIGNED="NOT ASSIGNED"; PROCEDURE PUTLINE(R1); BEGIN COMMENT PRINT BUFFER AND CLEAR IT TO BLANK; R0:=@LINE; WRITE; MVI(" ",LINE); MVC(130,LINE(1),LINE); END; PROCEDURE EDITTIME(R5); BEGIN COMMENT EDIT TIME OF DAY INTO SPECIFIED FIELD; LONG REAL CONVRT SYN B3; ARRAY 11 BYTE FIELD SYN B4; GETTIME; R1:=R0; R0:=0; R1:=R1/216000; CVD(R1,CONVRT); UNPK(1,7,FIELD,CONVRT); OI("0",FIELD(1)); MVI(":",FIELD(2)); R1:=R0; R0:=0; R1:=R1/3600; CVD(R1,CONVRT); UNPK(1,7,FIELD(3),CONVRT); OI("0",FIELD(4)); MVI(":",FIELD(5)); R1:=R0; R0:=0; R1:=R1/60; CVD(R1,CONVRT); UNPK(1,7,FIELD(6),CONVRT); OI("0",FIELD(7)); MVI(".",FIELD(8)); R1:=R0; R0:=0; R1:=R1*100S/60; CVD(R1,CONVRT); UNPK(1,7,FIELD(9),CONVRT); OI("0",FIELD(10)); END; PROCEDURE PUTTD(R2); BEGIN COMMENT PRINT BUFFER WITH TIME AND DATE; R0:=@LINE(110); GETDATE; R3:=@CONVRT; R4:=@LINE(121); EDITTIME; PUTLINE; PUTLINE; END; PROCEDURE EDIT(R1); BEGIN COMMENT CONVERT ONE WORD FROM HEX TO EBCDIC; UNPK(8,4,B4,B3); MVI(" ",B4(8)); TR(7,B4,HEXTBL(_240)); R3:=R3+4; R4:=R4+11; END; PROCEDURE DOSTART(R1); BEGIN COMMENT TYPE START MESSAGE; START; R0:=@SMSG; R1:=100; R2:=SMSG(R1-1); WHILE R2 = " " DO BEGIN R1:=R1-1; R2:=SMSG(R1-1); END; WRITETYPE; R0:=@SMSGLOCK; V; STOP; END; PROCEDURE ENDJOB(R6); BEGIN COMMENT END OF JOB PROCESSING; IF PCHJOBPUNCH THEN BEGIN COMMENT FLUSH CARD; MVI(#FF,EXECUTECARD); SET(PCHJOBSTART); MVC(78,EXECUTECARD(1),EXECUTECARD); R0:=@EXECUTECARD; PUNCH; END; FOR R1:=1 STEP 1 UNTIL NOOFASSIGNS DO BEGIN SHORT INTEGER SIZE SYN ASSIGNSIZE(2); R2:=R1-1*SIZE+ASSIGNPTR; CLI(0,ASSIGNNAME(R2)); IF ~= AND JOBASSIGNED(R2) THEN BEGIN R0:=@OPRLOCK; P; RESET(JOBASSIGNED(R2)); IF ~SHARED(R2) THEN BEGIN COMMENT UNASSIGN FILE; MVC(8,OPREPLY,"UNASSIGN "); MVC(7,OPREPLY(9),ASSIGNNAME(R2)); R2:=@OPREPLY(16); CLI(" ",B2); WHILE = DO BEGIN R2:=R2-1; CLI(" ",B2); END; MVI(21,B2(1)); TR(17,OPREPLY,CONSOLETRT); SAVER1:=R1; R6:=_1; DOREQUEST; R1:=SAVER1; END; R0:=@OPRLOCK; V; END; END; R0:=@SMSGLOCK; P; MVC(6,SMSG," ENDED"); R0:=@SMSG(8); GETDATE; R4:=@SMSG(17); R3:=@CONVRT; EDITTIME; R0:=@SMSG; R1:=28; WRITETYPE; R0:=@SMSGLOCK; V; SET(RDRREADCTRL); WHILE FLUSH AND ~GOTBEGIN DO BEGIN R0:=@BEGINCARD; READ; CLC(4,BEGINCARD,"%END "); IF = THEN RESET(FLUSH); CLC(6,BEGINCARD,"%BEGIN "); IF = THEN BEGIN SET(GOTBEGIN); RESET(FLUSH); END; END; R6:=SAVER6; END; PROCEDURE CTRLERR(R6); BEGIN COMMENT ANY JOB ERROR COMES HERE; PUTLINE; IF ~EXECUTEFLAG THEN PUTLINE; WRITETIME; PUTLINE; MVC(9,LINE,"END OF JOB"); PUTTD; R1:=14; LIT(R0,"JOB TERMINATED"); WRITETYPE; SET(FLUSH); ENDJOB; END; PROCEDURE SYNERR(R6); BEGIN COMMENT GENERAL CONTROL CARD ERROR; CLC(6,EXECUTECARD,"%BEGIN "); IF = THEN BEGIN DOSTART; WHILE ~= DO BEGIN R0:=1; WAIT; DOSTART; END; PUTTD; END; MVC(20,LINE,ERRORCARD); CTRLERR; END; PROCEDURE CSKIP(R5); BEGIN COMMENT SKIP TO NEXT NON-BLANK; R0:=EXECUTECARD(R6); WHILE R0 = " " DO BEGIN R6:=R6+1; IF R6 = 80 THEN SYNERR; R0:=EXECUTECARD(R6); END; END; PROCEDURE CDEC(R5); BEGIN COMMENT GET DECIMAL NUMBER FROM CONTROL CARD; R1:=0; R0:=EXECUTECARD(R6); IF R0 < "0" OR R0 > "9" THEN SYNERR; WHILE R0 >= "0" AND R0 <= "9" DO BEGIN IF R1 >= 10000000 THEN SYNERR; R1:=R1*10S-#F0+R0; R6:=R6+1; IF R6 = 80 THEN SYNERR; R0:=EXECUTECARD(R6); END; END; PROCEDURE CNAME(R5); BEGIN COMMENT SCAN CONTROL CARD FOR NAME; ARRAY 40 BYTE BACK SYN RETRANSLATE; R1:=0; R2:=EXECUTECARD(R6); MVC(7,NAME," "); IC(R2,CONSOLETRT(R2)); R2:=R2 AND #FF; R0:=BACK(R2); IF R2 < #0A OR R2 > #23 THEN SYNERR; WHILE R2 < #24 DO BEGIN IF R1 < 8 THEN NAME(R1):=R0; R1:=R1+1; R6:=R6+1; IF R6 = 80 THEN SYNERR; R2:=EXECUTECARD(R6); IC(R2,CONSOLETRT(R2)); R2:=R2 AND #FF; R0:=BACK(R2); END; END; PROCEDURE REWINDPROCESS(R1); BEGIN COMMENT PROCESS TO REWIND SYSTEM OR SCRATCH TAPE; START; REWIND; STOP; END; PROCEDURE CHKCANCEL(R6); IF CANCELFLAG THEN BEGIN COMMENT CHECK JOB CANCELLED; R0:=JOBTIME; IF R0 > TIMELIM THEN MVC(9,LINE(11),ERRMSG(20)) ELSE MVC(9,LINE(11),ERRMSG(30)); MVC(8,LINE,"CANCELLED"); CTRLERR; END; PROCEDURE LOADERR(R1); BEGIN COMMENT GENERAL LOADING ERROR; IF ~DISKUNIT(R2) THEN BEGIN REWINDPROCESS; IF ~= THEN REWIND; END; MVC(28,LINE,"ERROR OCCURRED DURING LOADING"); CTRLERR; END; PROCEDURE REWINDX(R5); IF ~DISKUNIT(R2) THEN REWIND ELSE BEGIN R0:=1; DISKLOADPT:=R0; COMMENT FAKE FOR DISK; END; PROCEDURE FSPTMX(R5); BEGIN COMMENT FORWARD SPACE TAPE OR DISK; IF ~DISKUNIT(R2) THEN FSPTM ELSE BEGIN R3:=HEADER(80); IF R3 = 0 THEN BEGIN R3:=DISKLOADPT; R0:=@HEADER; R1:=24; READDISK; WHILE > OR = DO BEGIN COMMENT OK OR NOT THERE; IF > THEN BEGIN R3:=R3 AND _256+257; READDISK; IF > THEN LOADERR; END ELSE BEGIN R3:=R3+1; R1:=24; READDISK; END; END; R3:=R3+1; END; DISKLOADPT:=R3; END; IF OVERFLOW THEN LOADERR; END; PROCEDURE READTAPEX(R5); BEGIN COMMENT READ DISK OR TAPE; ARRAY 2 INTEGER SAVE; BYTE EOF; IF ~DISKUNIT(R2) THEN READTAPE ELSE BEGIN SAVE:=R1; SAVE(4):=R3; R3:=0; REALDISKADR:=R3; R3:=DISKLOADPT; SET(EOF); WHILE R1 > 0 AND EOF DO BEGIN READDISK; IF > THEN BEGIN R3:=R3 AND _256+257; READDISK; IF > THEN LOADERR; END; IF OVERFLOW THEN LOADERR; IF < THEN RESET(EOF); CLC(3,REALDISKADR,0); IF = THEN REALDISKADR:=R3; R3:=R3+1; R0:=R0+R1; R1:=NEG R1+SAVE; SAVE:=R1; END; DISKLOADPT:=R3; R3:=SAVE(4); TEST(EOF); END; END; GLOBAL 79 PROCEDURE LOADER(R5); BEGIN COMMENT LOAD PROGRAM FROM R2 ASSIGNED TAPE OR DISK; ARRAY 6 INTEGER WORK, SPECREAD; BYTE TYPE SYN WORK(2), COMMENT SEGMENT TYPE CODE; SEGNO SYN WORK(3); COMMENT SEGMENT NUMBER; INTEGER SEGLEN SYN WORK(4); COMMENT ACTUAL SEGMENT SIZE; SHORT INTEGER RECLEN SYN WORK(8); COMMENT RECORD LENGTH; INTEGER SAVER5, COMMENT SAVE RETURN ADDRESS; SEGSTART, COMMENT SEGMENT STARTING ADDRESS; READLEN; COMMENT ACTUAL RECORD LENGTH USED; ARRAY 3 SHORT INTEGER MOVE=(#D200,#5000,@SPECREAD); ARRAY 3 SHORT INTEGER CLEAR=(#D700,@B5,@B5); FUNCTION XC(13,#D700); FUNCTION SSK(1,#0800); PROCEDURE TOOBIG(R1); BEGIN COMMENT PROGRAM TOO LARGE FOR MEMORY; IF ~DISKUNIT(R2) THEN BEGIN REWINDPROCESS; IF ~= THEN REWIND; END; MVC(16,LINE,"PROGRAM TOO LARGE"); CTRLERR; END; SAVER5:=R5; REWINDX; R0:=0; HEADER(80):=R0; R0:=@HEADER; R1:=84; READTAPEX; IF ~= THEN LOADERR; SET(LOOKING); WHILE LOOKING DO BEGIN COMMENT FIND PROGRAM; FSPTMX; CHKCANCEL; R0:=0; HEADER(80):=R0; R0:=@HEADER; R1:=84; READTAPEX; IF ~= THEN BEGIN IF ~DISKUNIT(R2) THEN BEGIN REWINDPROCESS; IF ~= THEN REWIND; END; MVC(18,LINE,NOTONFILE); CTRLERR; END; CLC(7,NAME,HEADER(1)); IF = THEN RESET(LOOKING); END; R3:=USERMEMORY; R4:=ENDMEMORY+1; R0:=0; FOR R1:=0 STEP 4 UNTIL 252 DO BEGIN REFTABLE(R1):=R0; SEGLENGTHTBL(R1):=R0; OVERLAYADR(R1):=R0; END; FOR R1:=ENDMEMORY-256 STEP _256 UNTIL USERMEMORY DO XC(255,B1,B1); R1:=R1-USERMEMORY+255; R5:=USERMEMORY; IF R1 >= 0 THEN EX(R1,CLEAR); OVERLAYDEV:=R0; R0:=1; OVERLAYLOCK:=R0; R0:=_1; FOR R1:=0 STEP 2 UNTIL 30 DO OVERLAYSEG(R1):=R0; R0:=@WORK(2); R1:=22; READTAPEX; IF ~= THEN LOADERR; WHILE = DO BEGIN COMMENT LOAD A SEGMENT; R0:=SEGLEN; R1:=RECLEN; IF R0 < 0 OR R1 < 0 OR R0 > #FFFFFF OR R1 > #7FFF THEN LOADERR; R0:=TYPE; IF R0 = "S" THEN BEGIN COMMENT CODE; SEGSTART:=R3; R3:=R3+SEGLEN+7 AND _8; END ELSE IF R0 = "D" THEN BEGIN COMMENT DATA; R4:=R4-SEGLEN AND _8; SEGSTART:=R4; END ELSE IF R0 > 0 AND R0 < 16 THEN BEGIN SEGSTART:=R3; R3:=R3+SEGLEN+7 AND _8; END ELSE LOADERR; IF R3 > R4 THEN TOOBIG; R0:=SEGSTART; R1:=SEGLEN; R5:=SEGNO SHLL 2; CLI("D",TYPE); IF = THEN R0:=R0 OR #FF000000; IF R5 > 252 THEN LOADERR; REFTABLE(R5):=R0; SEGLENGTHTBL(R5):=R1; IF R1 > RECLEN THEN R1:=RECLEN; READLEN:=R1; IF R1 < 24 THEN BEGIN COMMENT SHORT RECORD; R0:=@SPECREAD; R1:=24; READTAPEX; IF ~= THEN LOADERR; R1:=SEGSTART; R5:=READLEN-1; IF R5 >= 0 THEN EX(R5,MOVE); END ELSE BEGIN COMMENT NORMAL RECORD; READTAPEX; IF ~= THEN LOADERR; END; R1:=TYPE; IF R1 < 16 AND DISKUNIT(R2) THEN BEGIN R3:=SEGSTART; R1:=R1 SHLL 1; R5:=SEGNO SHLL 2; R0:=REALDISKADR; OVERLAYADR(R5):=R0; R0:=OVERLAYSEG(R1); OVERLAYSEG(R1):=R5; REFTABLE(R5):=R0; OVERLAYDEV:=R2; END; R0:=@WORK(2); R1:=22; READTAPEX; END; FOR R5:=0 STEP 2 UNTIL 30 DO BEGIN R1:=OVERLAYSEG(R5); R0:=0; COMMENT FIND MAX SIZE SEG; WHILE R1 >= 0 DO BEGIN IF R0 < SEGLENGTHTBL(R1) THEN R0:=SEGLENGTHTBL(R1); R1:=REFTABLE(R1); END; SEGSTART:=R3; R3:=R3+R0+7 AND _8; IF R3 > R4 THEN TOOBIG; R1:=OVERLAYSEG(R5); WHILE R1 >= 0 DO BEGIN R0:=REFTABLE(R1); MVC(3,REFTABLE(R1),SEGSTART); R1:=@SEGLENGTHTBL(R1); SET(B1); R1:=R0; END; R0:=_1; OVERLAYSEG(R5):=R0; END; LM(R0,R1,REFTABLE); IF R0 = 0 OR R1 = 0 THEN LOADERR; IF ~PROTECTION THEN STM(R3,R4,FREESPACE) ELSE BEGIN R3:=R3+2047 AND _2048; IF R3 > R4 THEN TOOBIG; STM(R3,R4,FREESPACE); R0:=#00; FOR R1:=R3-2048 STEP _2048 UNTIL USERMEMORY DO SSK(R0,R1); R0:=#10; FOR R1:=ENDMEMORY-2047 STEP _2048 UNTIL FREESPACE DO SSK(R0,R1); END; IF ~DISKUNIT(R2) THEN BEGIN REWINDPROCESS; IF ~= THEN REWIND; END; R5:=SAVER5; END; PROCEDURE STARTUSER(R1); BEGIN COMMENT START USER PROGRAM AS PROCESS; FUNCTION GO(0,#052F); SET(EXECUTEFLAG); START; R5:=R0; R0:=0; WAIT; R6:=#7FFF; RESET(RDRREADCTRL); LM(R3,R4,FREESPACE); R0:=0; ASKJOB:=R0; COMMENT USER CAN WAIT FOR OPERATOR; LM(R14,R15,REFTABLE); USERMODE; GO; RETURN; END; PROCEDURE DUMPSTUFF(R1); BEGIN COMMENT PROCESS TO DUMP USER AREA; START; R1:=FREEDUMPLIM(4); IF R1 > 0 THEN BEGIN MVC(9,LINE,"FREE SPACE"); PUTLINE; PUTLINE; LM(R0,R1,FREEDUMPLIM); DUMP; END; LM(R2,R3,SEGDUMPMASK); FOR R4:=0 STEP 4 UNTIL 252 DO IF R2 < 0 THEN BEGIN COMMENT BIT SET IN MASK; SLDL(R2,1); R0:=REFTABLE(R4); R1:=SEGLENGTHTBL(R4); IF R0 < 0 AND R1 > 0 THEN BEGIN PUTLINE; MVC(6,LINE,"SEGMENT"); R0:=R4 SHRL 2; CVD(R0,CONVRT); UNPK(1,7,LINE(8),CONVRT); OI("0",LINE(9)); PUTLINE; PUTLINE; R0:=REFTABLE(R4); R1:=SEGLENGTHTBL(R4); DUMP; END; END ELSE SLDL(R2,1); SET(DUMPFLG); STOP; END; PROCEDURE FINDASSIGN(R3); BEGIN COMMENT FIND ASSIGN NAME OR ASK FOR IT; ARRAY 2 INTEGER SAVER3R4; BYTE ASSIGNED; STM(R3,R4,SAVER3R4); R0:=@OPRLOCK; P; RESET(ASSIGNED); WHILE ~ASSIGNED DO BEGIN R1:=ASSIGNPTR; R2:=0; FOR R0:=1 STEP 1 UNTIL NOOFASSIGNS DO BEGIN CLC(7,ASSIGNNAME(R1),NAME); IF = THEN R2:=R1; R1:=R1+ASSIGNSIZE; END; IF R2 ~= 0 THEN SET(ASSIGNED) ELSE BEGIN MVI(" ",MSG(15)); MVC(7,MSG(7),NAME); MVC(6,MSG,"ASSIGN "); R1:=17; R0:=MSG(14); WHILE R0 = " " DO BEGIN R1:=R1-1; R0:=MSG(R1-3); END; R2:=@MSG(R1-1); MVI("?",B2); R2:=@MSG; ASKOPR; DOREQUEST; IF CANCELFLAG THEN BEGIN R0:=@OPRLOCK; V; CHKCANCEL; END; END; END; SET(JOBASSIGNED(R2)); R0:=@OPRLOCK; V; LM(R3,R4,SAVER3R4); END; PROCEDURE GETUNITNUM(R4); BEGIN COMMENT GET AND CHECK LOGICAL UNIT NUMBER; CSKIP; CDEC; IF R1 < 1 OR R1 > 8 THEN SYNERR; R1:=R1 SHLL 2; R2:=LOGUNITTBL(R1-4); IF R2 = 0 THEN BEGIN MVC(11,LINE,NOTASSIGNED); CTRLERR; END; END; MVI(" ",LINE); MVC(130,LINE(1),LINE); SAVER6:=R6; WHILE ~GOTBEGIN DO BEGIN R0:=@BEGINCARD; READ; CLC(6,BEGINCARD,"%BEGIN "); IF = THEN SET(GOTBEGIN); END; SET(PRTJOBSTART); SET(PCHJOBSTART); RESET(CANCELFLAG); RESET(EXECUTEFLAG); RESET(GOTBEGIN); RESET(PCHJOBPUNCH); R0:=0; JOBTIME:=R0; R1:=1; FOR R2:=0 STEP 4 UNTIL 28 DO BEGIN LOGUNITTBL(R2):=R0; LOGUNITSAVE(R2):=R1; END; PAGE; MVC(79,LINE,BEGINCARD); MVC(21,LINE(84),DATEMSG); MVC(79,EXECUTECARD,BEGINCARD); R0:=@SMSGLOCK; P; MVC(7,SMSG,"STARTED "); R0:=@SMSG(8); GETDATE; R3:=@CONVRT; R4:=@SMSG(17); EDITTIME; MVI(" ",SMSG(16)); MVI(" ",SMSG(28)); MVC(70,SMSG(29),SMSG(28)); R6:=7; R2:=0; CSKIP; IF R0 >= "0" AND R0 <= "9" THEN BEGIN CDEC; IF R1 > 99999 THEN SYNERR; R2:=R1*60S; END; IF R0 = ":" THEN BEGIN R6:=R6+1; IF R6 = 80 THEN SYNERR; R0:=EXECUTECARD(R6); IF R0 >= "0" AND R0 <= "9" THEN BEGIN CDEC; IF R1 > 59 THEN SYNERR; R2:=R2+R1; END; END; IF R0 ~= " " OR R2 = 0 THEN SYNERR; CSKIP; MAXTIME:=R2; TIMELIM:=R2; R1:=@EXECUTECARD(R6); R2:=79-R6; EX(R2,IDMOVE); DOSTART; IF ~= THEN BEGIN R0:=1; WAIT; DOSTART; END; PUTTD; R0:=@EXECUTECARD; READ; SET(JOBGOING); WHILE JOBGOING DO BEGIN WHILE ~EXECUTEFLAG DO BEGIN CLC(6,EXECUTECARD,"%BEGIN "); IF = THEN BEGIN SET(GOTBEGIN); MVC(79,BEGINCARD,EXECUTECARD); PUTLINE; MVC(11,LINE,"NO %END CARD"); CTRLERR; END; CLC(4,EXECUTECARD,"%END "); IF = THEN BEGIN RESET(FLUSH); PUTLINE; MVC(9,LINE,"END OF JOB"); PUTTD; ENDJOB; END; MVC(79,LINE,EXECUTECARD); PUTTD; R0:=0; R1:=0; STM(R0,R1,FREEDUMPLIM); STM(R0,R1,SEGDUMPMASK); CHKCANCEL; CLI("%",EXECUTECARD); IF ~= THEN BEGIN MVC(19,LINE,MISSCARD); CTRLERR; END; CLC(4,EXECUTECARD,"%EOF "); IF = THEN BEGIN MVC(19,LINE,MISSCARD); CTRLERR; END; CLC(7,EXECUTECARD,"%ASSIGN "); IF = THEN BEGIN R6:=8; CSKIP; CDEC; IF R0 ~= "," THEN SYNERR; R4:=R1-1 SHLL 2; R6:=R6+1; IF R6 = 80 THEN SYNERR; CSKIP; CNAME; IF R0 ~= " " THEN SYNERR; IF R4 < 0 OR R4 > 28 THEN SYNERR; FINDASSIGN; R0:=0; FOR R1:=0 STEP 4 UNTIL 28 DO IF R2 = LOGUNITTBL(R1) THEN LOGUNITTBL(R1):=R0; LOGUNITTBL(R4):=R2; R0:=1; LOGUNITSAVE(R4):=R0; R0:=@EXECUTECARD; READ; CLC(4,EXECUTECARD,"%END "); IF = THEN WRITETIME; END ELSE BEGIN CLC(8,EXECUTECARD,"%EXECUTE "); IF = THEN BEGIN R6:=9; GETUNITNUM; IF R0 = " " THEN MVC(7,NAME,"********") ELSE BEGIN IF R0 ~= "," THEN SYNERR; R6:=R6+1; R3:=R2; CSKIP; CNAME; IF R0 ~= " " THEN SYNERR; R2:=R3; END; LOADER; FOR R2:=0 STEP 4 UNTIL 252 DO BEGIN R0:=REFTABLE(R2); IF R0 ~= 0 THEN BEGIN CONVRTI:=R0; MVC(6,LINE,"SEGMENT"); MVC(8,LINE(11),"STARTS AT"); R0:=R2 SHRL 2; UNPK(6,3,LINE(21),CONVRT(1)); TR(5,LINE(21),HEXTBL(_240)); MVI(" ",LINE(27)); CVD(R0,CONVRT); UNPK(1,1,LINE(8),CONVRT(6)); OI("0",LINE(9)); PUTLINE; END; END; PUTLINE; CHKCANCEL; STARTUSER; WHILE ~= DO BEGIN R0:=1; WAIT; CHKCANCEL; STARTUSER; END; END ELSE BEGIN CLC(9,EXECUTECARD,"%UNASSIGN "); IF = THEN BEGIN R6:=10; GETUNITNUM; IF R0 ~= " " THEN SYNERR; R0:=0; LOGUNITTBL(R1-4):=R0; R0:=@OPRLOCK; P; RESET(JOBASSIGNED(R2)); IF ~SHARED(R2) THEN BEGIN MVC(8,OPREPLY,"UNASSIGN "); MVC(7,OPREPLY(9),ASSIGNNAME(R2)); R2:=@OPREPLY(16); CLI(" ",B2); WHILE = DO BEGIN R2:=R2-1; CLI(" ",B2); END; MVI(21,B2(1)); TR(17,OPREPLY,CONSOLETRT); R6:=_1; DOREQUEST; END; R0:=@OPRLOCK; V; R0:=@EXECUTECARD; READ; CLC(4,EXECUTECARD,"%END "); IF = THEN WRITETIME; END ELSE BEGIN R6:=1; CNAME; IF R0 ~= " " THEN SYNERR; R2:=ASSIGNPTR; R0:=@OPRLOCK; P; SET(JOBASSIGNED(R2)); R0:=@OPRLOCK; V; LOADER; CHKCANCEL; STARTUSER; WHILE ~= DO BEGIN R0:=1; WAIT; CHKCANCEL; STARTUSER; END; END; END; END; END; R0:=@ENDJOBCOUNT; P; COMMENT WAIT FOR END OF EXECUTION; IF CANCELFLAG THEN RESET(JOBGOING) ELSE BEGIN SET(RDRREADCTRL); RESET(EXECUTEFLAG); PUTLINE; WRITETIME; SET(FLUSH); WHILE FLUSH DO BEGIN R0:=@EXECUTECARD; READ; IF = OR < THEN RESET(FLUSH); END; CLC(6,EXECUTECARD,"%BEGIN "); IF ~= THEN BEGIN CLC(4,EXECUTECARD,"%END "); IF ~= THEN PAGE; END; END; END; RESET(DUMPFLG); RESET(KILLREASON); FINDCANCEL; R12:=R1; WHILE = DO BEGIN IF ~DUMPFLG THEN PAGE; SET(DUMPFLG); R5:=PSWSUSPEND; IF SVCGOING THEN BEGIN MVC(7,PSWSUSPEND,PSWSVC); MVC(3,REGSUSPEND(60),REGSVC); MVC(27,REGSUSPEND,REGSVC(4)); END; MVC(4,LINE,"REG0 "); R3:=@REGSUSPEND; R4:=@LINE(11); FOR R0:=1 STEP 1 UNTIL 8 DO EDIT; PUTLINE; MVC(4,LINE,"REG8 "); R4:=@LINE(11); FOR R0:=1 STEP 1 UNTIL 8 DO EDIT; PUTLINE; MVC(4,LINE," PSW "); R3:=@PSWSUSPEND; R4:=@LINE(11); EDIT; EDIT; CLI(#84,STATUS); IF = THEN BEGIN SET(KILLREASON); R1:=CANCELCODE*10S; R1:=@ERRMSG(R1-10); MVC(8,LINE(44),"CANCELLED"); MVC(9,LINE(55),B1); END ELSE BEGIN CLI(#86,STATUS); IF = THEN BEGIN SET(KILLREASON); R5:=R5 AND #F*7S; R1:=@PRGMSG(R5); MVC(6,LINE(44),"PRG CHK"); MVC(6,LINE(53),B1); END ELSE MVC(8,LINE(44),"SUSPENDED"); END; R0:=PSWSUSPEND(4) AND #FFFFFF; FOR R1:=0 STEP 4 UNTIL 252 DO BEGIN R2:=REFTABLE(R1)+SEGLENGTHTBL(R1); IF R0 >= REFTABLE(R1) AND R0 < R2 AND R0 ~= 0 THEN BEGIN MVI("(",LINE(33)); R3:=R1 SHRL 2; CVD(R3,CONVRT); UNPK(1,7,LINE(34),CONVRT); OI("0",LINE(35)); R3:=R0-REFTABLE(R1); CONVRTI:=R3; UNPK(4,2,LINE(37),CONVRT(2)); TR(3,LINE(37),HEXTBL(_240)); MVI(")",LINE(41)); END; END; MVC(9,LINE(77),"PROCESS ID"); UNPK(8,4,LINE(88),PCBNUMBER); TR(7,LINE(88),HEXTBL(_240)); MVI(" ",LINE(96)); PUTLINE; PUTLINE; R0:=PCBNUMBER; KILLPROCESS; FINDCANCEL; R12:=R1; END; R12:=CURRENTPCB; IF FLOATINGPOINT THEN BEGIN MVC(5,LINE,"FPTREG"); CONVRT:=F01; UNPK(8,4,LINE(11),CONVRT); UNPK(8,4,LINE(19),CONVRT(4)); TR(15,LINE(11),HEXTBL(_240)); MVI(" ",LINE(27)); CONVRT:=F23; UNPK(8,4,LINE(30),CONVRT); UNPK(8,4,LINE(38),CONVRT(4)); TR(15,LINE(30),HEXTBL(_240)); MVI(" ",LINE(46)); CONVRT:=F45; UNPK(8,4,LINE(49),CONVRT); UNPK(8,4,LINE(57),CONVRT(4)); TR(15,LINE(49),HEXTBL(_240)); MVI(" ",LINE(65)); CONVRT:=F67; UNPK(8,4,LINE(68),CONVRT); UNPK(8,4,LINE(76),CONVRT(4)); TR(15,LINE(68),HEXTBL(_240)); MVI(" ",LINE(84)); PUTLINE; PUTLINE; END; FOR R2:=0 STEP 2 UNTIL 30 DO BEGIN R3:=OVERLAYSEG(R2); IF R3 >= 0 THEN BEGIN MVC(6,LINE,"OVERLAY"); R0:=R2 SHRL 1; CVD(R0,CONVRT); UNPK(1,7,LINE(8),CONVRT); OI("0",LINE(9)); MVC(6,LINE(12),"SEGMENT"); R3:=R3 SHRL 2; CVD(R3,CONVRT); UNPK(1,7,LINE(20),CONVRT); OI("0",LINE(21)); MVC(8,LINE(23),"IN MEMORY"); PUTLINE; END; END; PUTLINE; IF ~KILLREASON THEN BEGIN R0:=JOBTIME; IF R0 > TIMELIM THEN MVC(9,LINE(11),ERRMSG(20)) ELSE MVC(9,LINE(11),ERRMSG(30)); MVC(8,LINE,"CANCELLED"); PUTLINE; PUTLINE; END; RESET(CANCELFLAG); RESET(DUMPFLG); DUMPSTUFF; WHILE ~= AND ~CANCELFLAG DO BEGIN R0:=1; WAIT; DUMPSTUFF; END; R2:=R0; WHILE ~DUMPFLG AND ~CANCELFLAG DO BEGIN R0:=1; WAIT; END; IF R2 ~= 0 AND CANCELFLAG THEN BEGIN R0:=R2; KILLPROCESS; END; SET(CANCELFLAG); CTRLERR; END; PROCEDURE OPERATOR(R1); BEGIN COMMENT PROCESS TO HANDLE OPERATOR REQUESTS; START; R12:=CURRENTPCB; SET(OPERATORACTIVE); WHILE OPERATORACTIVE DO BEGIN R0:=@OPERATORCOUNT; P; R2:=@REQUESTMSG; R1:=8; R0:=@OPRLOCK; P; ASKOPR; DOREQUEST; R0:=@OPRLOCK; V; END; STOP; END; PROCEDURE READER(R1); BEGIN COMMENT CARD READER BUFFERING PROCESS; START; R12:=CURRENTPCB; SET(RDRACTIVE); WHILE RDRACTIVE DO BEGIN R0:=@RDREMPTY; P; R6:=0; R4:=RDRPUTPTR OR #02000000; R5:=#20000050; IF RDRTYPE THEN R4:=R4 OR #40000000; STM(R4,R5,CCWS); R0:=RDRADDRESS; DOIO; WHILE < DO BEGIN COMMENT UNIT CHECK; TM(#40,SENSE); IF OVERFLOW THEN BEGIN IF RDRENDFILE OR R6 < 120 THEN BEGIN R6:=R6+1; R0:=1; WAIT; END ELSE BEGIN R1:=#B0007; R2:=@RDRNOTRDY; R0:=@RDRREPLY; READTYPE; R6:=0; END; END ELSE BEGIN UNPK(4,2,RDRERRMSG(12),CSW(4)); TR(3,RDRERRMSG(12),HEXTBL(_240)); UNPK(4,2,RDRERRMSG(17),SENSE); TR(3,RDRERRMSG(17),HEXTBL(_240)); MVI(" ",RDRERRMSG(16)); R0:=@RDRREPLY; R1:=#150007; R6:=0; R2:=@RDRERRMSG; READTYPE; END; STM(R4,R5,CCWS); R0:=RDRADDRESS; DOIO; END; IF OVERFLOW THEN BEGIN R0:=@RDRNOTOPR; R1:=11; WRITETYPE; RESET(RDRACTIVE); R0:=@RDREMPTY; V; END ELSE BEGIN IF > THEN BEGIN COMMENT END FILE; SET(RDRENDFILE); R0:=@RDREMPTY; V; END ELSE BEGIN RESET(RDRENDFILE); R0:=RDRPUTPTR+80; IF R0 = RDRENDB THEN R0:=RDRSTARTB; RDRPUTPTR:=R0; R0:=@RDRFULL; V; END; END; END; STOP; END; PROCEDURE PUNCH(R1); BEGIN COMMENT CARD PUNCH BUFFERING PROCESS; START; R12:=CURRENTPCB; SET(PCHACTIVE); WHILE PCHACTIVE DO BEGIN IF PCHERRFLG THEN RESET(PCHERRFLG) ELSE BEGIN R0:=@PCHFULL; P; END; R6:=0; R4:=PCHGETPTR; WHILE PCHFLUSH DO BEGIN IF PCHJOBFLAG(R4) THEN RESET(PCHFLUSH) ELSE BEGIN R4:=R4+81; IF R4 = PCHENDB THEN R4:=PCHSTARTB; PCHGETPTR:=R4; R0:=@PCHEMPTY; V; R0:=@PCHFULL; P; END; END; R4:=R4+1; R5:=#20000050; STM(R4,R5,CCWS); IF PCHTYPE THEN MVI(#41,CCWS) ELSE MVI(#81,CCWS); R0:=PCHADDRESS; DOIO; WHILE < DO BEGIN COMMENT UNIT CHECK; TM(#40,SENSE); IF OVERFLOW THEN BEGIN IF R6 < 120 THEN BEGIN R6:=R6+1; R0:=1; WAIT; END ELSE BEGIN R1:=#B0007; R2:=@PCHNOTRDY; R0:=@PCHREPLY; READTYPE; R6:=0; END; END ELSE BEGIN UNPK(4,2,PCHERRMSG(12),CSW(4)); TR(3,PCHERRMSG(12),HEXTBL(_240)); UNPK(4,2,PCHERRMSG(17),SENSE); TR(3,PCHERRMSG(17),HEXTBL(_240)); MVI(" ",PCHERRMSG(16)); R0:=@PCHREPLY; R1:=#150007; R6:=0; R2:=@PCHERRMSG; READTYPE; IF PCHTYPE THEN SET(PCHERRFLG); END; IF PCHERRFLG THEN R4:=@PCHRETRY ELSE R4:=PCHGETPTR+1; STM(R4,R5,CCWS); IF PCHTYPE THEN MVI(#41,CCWS) ELSE MVI(#81,CCWS); R0:=PCHADDRESS; DOIO; END; IF OVERFLOW THEN BEGIN R0:=@PCHNOTOPR; R1:=11; WRITETYPE; RESET(PCHACTIVE); R0:=@PCHEMPTY; V; RESET(PCHERRFLG); END ELSE IF ~PCHERRFLG THEN BEGIN R1:=PCHGETPTR; MVC(79,PCHRETRY,B1(1)); R1:=R1+81; IF R1 = PCHENDB THEN R1:=PCHSTARTB; PCHGETPTR:=R1; R0:=@PCHEMPTY; V; END; END; STOP; END; PROCEDURE PRINTER(R1); BEGIN COMMENT LINE PRINTER BUFFERING PROCESS; START; R12:=CURRENTPCB; SET(PRTACTIVE); WHILE PRTACTIVE DO BEGIN R0:=@PRTFULL; P; R6:=0; R1:=PRTGETPTR; WHILE PRTFLUSH DO BEGIN TM(3,PAGEFLG(R1)); IF = THEN RESET(PRTFLUSH) ELSE BEGIN R1:=R1+133; IF R1 = PRTENDB THEN R1:=PRTSTARTB; PRTGETPTR:=R1; R0:=@PRTEMPTY; V; R0:=@PRTFULL; P; END; END; OI(3,PAGEFLG(R1)); R4:=R1+1 OR #09000000; R5:=#20000084; CLI(3,PAGEFLG(R1)); IF = THEN STM(R4,R5,CCWS) ELSE BEGIN STM(R4,R5,CCWS(8)); IC(R0,PAGEFLG(R1)); R0:=R0 SHLL 24; R1:=#60000001; STM(R0,R1,CCWS); END; R0:=PRTADDRESS; DOIO; WHILE < DO BEGIN COMMENT UNIT CHECK; TM(#40,SENSE); IF OVERFLOW THEN BEGIN IF R6 < 120 THEN BEGIN R6:=R6+1; R0:=1; WAIT; END ELSE BEGIN R1:=#B0007; R2:=@PRTNOTRDY; R0:=@PRTREPLY; READTYPE; R6:=0; END; END ELSE BEGIN UNPK(4,2,PRTERRMSG(12),CSW(4)); TR(3,PRTERRMSG(12),HEXTBL(_240)); UNPK(4,2,PRTERRMSG(17),SENSE); TR(3,PRTERRMSG(17),HEXTBL(_240)); MVI(" ",PRTERRMSG(16)); R0:=@PRTREPLY; R1:=#150007; R6:=0; R2:=@PRTERRMSG; READTYPE; END; R1:=PRTGETPTR; CLI(3,PAGEFLG(R1)); IF = THEN STM(R4,R5,CCWS) ELSE BEGIN STM(R4,R5,CCWS(8)); IC(R0,PAGEFLG(R1)); R0:=R0 SHLL 24; R1:=#60000001; STM(R0,R1,CCWS); END; R0:=PRTADDRESS; DOIO; END; IF OVERFLOW THEN BEGIN R0:=@PRTNOTOPR; R1:=11; WRITETYPE; RESET(PRTACTIVE); R0:=@PRTFULL; V; END ELSE BEGIN R0:=PRTGETPTR+133; IF R0 = PRTENDB THEN R0:=PRTSTARTB; PRTGETPTR:=R0; R0:=@PRTEMPTY; V; END; END; STOP; END; ARRAY 384 INTEGER ASSIGNTBL; COMMENT ACTUAL ASSIGN STORAGE. USE (ASSIGNSIZE/4)*NOOFASSIGNS AS DIMENSION; R0:=@ASSIGNTBL; ASSIGNPTR:=R0; R0:=@DATEMSG; R1:=22; WRITETYPE; RESET(REPLYOK); WHILE ~REPLYOK DO BEGIN R2:=@ASKDATETIME; R1:=24; ASKOPR; GETDEC; IF R0 = #24 THEN BEGIN R0:=0; R1:=R1/100; R2:=R0+1900; YEAR:=R2; R0:=0; R1:=R1/100; IF R1 > 0 AND R1 < 13 AND R2 >= 1970 THEN BEGIN R1:=R1 SHLL 1; IF R0 > 0 AND R0 <= MONTHS(R1-2) THEN BEGIN WHILE R1 > 2 DO BEGIN R0:=R0+MONTHS(R1-4); R1:=R1-2; END; R1:=YEAR AND 3; IF R1 ~= 0 AND R0 > 59 THEN R0:=R0-1; DAY:=R0; GETDEC; IF R0 = #25 THEN BEGIN R0:=0; R1:=R1/100; R2:=R0; R0:=0; R1:=R1/100; IF R0 < 60 AND R1 < 24 AND R2 < 60 THEN BEGIN R1:=R1*60S+R0*60S+R2; SECOND:=R1; SET(REPLYOK); END; END; END; END; END; END; RESET(REPLYOK); WHILE ~REPLYOK DO BEGIN SET(RDRTYPE); R0:=#00C; RDRADDRESS:=R0; R0:=2; RDRNOBUFF:=R0; R2:=@ASKRDRMSG; R1:=15; ASKOPR; IF R0 = #25 THEN SET(REPLYOK) ELSE BEGIN GETDEC; IF R1 = 2540 OR R1 = 2501 OR R1 = 1442 THEN BEGIN IF R0 = #24 THEN BEGIN RESET(RDRTYPE); IF R1 = 2540 THEN SET(RDRTYPE); GETHEX; IF R0 = #24 AND R1 < #1000 THEN BEGIN RDRADDRESS:=R1; GETDEC; IF R0 = #25 AND R1 > 1 THEN BEGIN RDRNOBUFF:=R1; SET(REPLYOK); END; END; END; END; END; END; RESET(REPLYOK); WHILE ~ REPLYOK DO BEGIN SET(PCHTYPE); R0:=#00D; PCHADDRESS:=R0; R0:=2; PCHNOBUFF:=R0; R2:=@ASKPCHMSG; R1:=15; ASKOPR; IF R0 = #25 THEN SET(REPLYOK) ELSE BEGIN GETDEC; IF R1 = 2540 OR R1 = 1442 THEN BEGIN IF R0 = #24 THEN BEGIN RESET(PCHTYPE); IF R1 = 2540 THEN SET(PCHTYPE); GETHEX; IF R0 = #24 AND R1 < #1000 THEN BEGIN PCHADDRESS:=R1; GETDEC; IF R0 = #25 AND R1 > 1 THEN BEGIN PCHNOBUFF:=R1; SET(REPLYOK); END; END; END; END; END; END; RESET(REPLYOK); WHILE ~REPLYOK DO BEGIN R0:=#00E; PRTADDRESS:=R0; R0:=2; PRTNOBUFF:=R0; R2:=@ASKPRTMSG; R1:=10; ASKOPR; IF R0 = #25 THEN SET(REPLYOK) ELSE BEGIN GETHEX; IF R0 = #24 AND R1 < #1000 THEN BEGIN PRTADDRESS:=R1; GETDEC; IF R0 = #25 AND R1 > 1 THEN BEGIN PRTNOBUFF:=R1; SET(REPLYOK); END; END; END; END; R4:=RDRNOBUFF*80S; R5:=PCHNOBUFF*81S; R6:=PRTNOBUFF*133S; R3:=R4+R5+R6; R1:=USERMEMORY; R0:=R1+R3+7 AND _8; USERMEMORY:=R0; IF R0 > ENDMEMORY THEN BEGIN R0:=@BUFFERR; R1:=25; WRITETYPE; R0:=#3FFFFFFF; WAIT; END; RDRSTARTB:=R1; R1:=R1+R4; RDRENDB:=R1; PCHSTARTB:=R1; R1:=R1+R5; PCHENDB:=R1; PRTSTARTB:=R1; R1:=R1+R6; PRTENDB:=R1; RESET(REPLYOK); WHILE ~REPLYOK DO BEGIN R0:=#02800001; FOR R1:=0 STEP 4 UNTIL 28 DO BEGIN TAPEDRIVES(R1):=R0; IF R1 > 12 THEN R0:=0 ELSE R0:=R0+#10000; END; R2:=@ASKTAPES; R1:=24; ASKOPR; IF R0 = #25 THEN SET(REPLYOK) ELSE BEGIN GETHEX; R2:=0; R3:=0; WHILE R0 = #24 DO BEGIN IF R1 = 7 THEN R3:=2 ELSE IF R1 = 9 THEN R3:=1 ELSE IF R1 >= #1000 OR R2 >= 32 OR R3 = 0 THEN R0:=#26 ELSE BEGIN TAPEADDRESS(R2):=R1; TAPEDRIVETYPE(R2):=R3; R2:=R2+4; END; IF R0 ~= #26 THEN GETHEX; END; IF R0 = #25 AND R1 < #1000 AND R2 < 32 AND R3 ~= 0 THEN BEGIN TAPEADDRESS(R2):=R1; TAPEDRIVETYPE(R2):=R3; SET(REPLYOK); END; END; R0:=0; R2:=R2+4; WHILE R2 < 32 DO BEGIN TAPEADDRESS(R2):=R0; TAPEDRIVETYPE(R2):=R0; R2:=R2+4; END; END; RESET(REPLYOK); WHILE ~REPLYOK DO BEGIN R0:=#01300002; R1:=1; R2:=0; R3:=0; FOR R4:=0 STEP 16 UNTIL 112 DO BEGIN R5:=@DISKDRIVES(R4); STM(R0,R3,B5); IF R4 > 16 THEN R0:=0 ELSE R0:=R0+#10000; END; R2:=@ASKDISKS; R1:=27; ASKOPR; IF R0 = #25 THEN SET(REPLYOK) ELSE BEGIN GETHEX; R2:=0; R3:=0; WHILE R0 = #24 DO BEGIN RESET(TYPEMATCH); FOR R4:=0 STEP 2 UNTIL 6 DO IF R1 ~= 0 AND R1 = DISKTYPE(R4) THEN BEGIN R3:=R4 SHRL 1+1; SET(TYPEMATCH); END; IF ~TYPEMATCH THEN BEGIN IF R1 >= #1000 OR R2 >=128 OR R3 = 0 THEN R0:=#26 ELSE BEGIN DISKADDRESS(R2):=R1; DISKDRIVETYPE(R2):=R3; R2:=R2+16; END; END; IF R0 ~= #26 THEN GETHEX; END; IF R0 = #25 AND R1 < #1000 AND R2 < 128 AND R3 ~= 0 THEN BEGIN DISKADDRESS(R2):=R1; DISKDRIVETYPE(R2):=R3; SET(REPLYOK); END; END; R0:=0; R2:=R2+16; WHILE R2 < 128 DO BEGIN DISKADDRESS(R2):=R0; DISKDRIVETYPE(R2):=R0; R2:=R2+16; END; END; R1:=0; R3:=0; FOR R0:=1 STEP 1 UNTIL NOOFASSIGNS DO FOR R2:=4 STEP 4 UNTIL ASSIGNSIZE DO BEGIN ASSIGNTBL(R1):=R3; R1:=R1+4; END; R0:=IPLADDRESS; R1:=IPLDRIVETYPE; R2:=0; R3:=@ASSIGNTBL; IF R1 = "TAPE" THEN BEGIN COMMENT FORCE ASSIGN OF IPL DRIVE; WHILE R2 < 32 AND R0 ~= TAPEADDRESS(R2) DO R2:=R2+4; IF R2 = 32 THEN R2:=_1 ELSE BEGIN COMMENT SET UP TABLE; R2:=R2 SHRL 2+1; OPREPLY(14):=R2; MVC(13,OPREPLY,ASSIGNCMD); TR(13,OPREPLY,CONSOLETRT); MVI(#25,OPREPLY(15)); R6:=_1; DOREQUEST; IF ~= THEN R2:=_1 ELSE R2:=0; END; END ELSE BEGIN COMMENT FORCE MOUNT AND ASSIGN COMMANDS FOR DISK; WHILE R2 < 128 AND R0 ~= DISKADDRESS(R2) DO R2:=R2+16; IF R2 = 128 THEN R2:=_1 ELSE BEGIN COMMENT FORCE COMMANDS; MVC(7,OPREPLY,SPECMOUNT); R2:=R2 SHRL 4+1; OPREPLY(6):=R2; R6:=_1; DOREQUEST; IF ~= THEN R2:=_1 ELSE BEGIN COMMENT COMMAND SUCCESSFUL; R2:=OPREPLY(6) SHLL 4; R2:=@DISKLABEL(R2-16); MVC(13,OPREPLY,ASSIGNCMD); MVC(7,OPREPLY(14),B2); COMMENT MOUNTED VOLUME LABEL; R6:=21; R0:=OPREPLY(21); WHILE R0 = " " DO BEGIN COMMENT SQUEEZE OUT BLANKS; R6:=R6-1; R0:=OPREPLY(R6); END; R6:=@OPREPLY(R6+1); MVI(",",B6); MVC(7,B6(1),IPLAREA); CLI(" ",B6(8)); WHILE = DO BEGIN R6:=R6-1; CLI(" ",B6(8)); END; MVI(21,B6(9)); TR(31,OPREPLY,CONSOLETRT); R6:=_1; DOREQUEST; COMMENT DO ASSIGN COMMAND; IF ~= THEN R2:=_1 ELSE R2:=0; END; END; END; IF R2 < 0 THEN BEGIN COMMENT CAN'T GET TO SYSTEM; R0:=@IPLERR; R1:=31; WRITETYPE; R0:=#3FFFFFFF; WAIT; END; R3:=ASSIGNPTR; SET(PROTECTED(R3)); SET(SHARED(R3)); R1:=ENDMEMORY-USERMEMORY+1 SHRL 10; CVD(R1,CONVRT); UNPK(3,7,MEMMSG,CONVRT); OI("0",MEMMSG(3)); R0:=@MEMMSG; R1:=17; WRITETYPE; RESET(PCHFLUSH); RESET(PRTFLUSH); R0:=0; JOBLOCK:=R0; RESET(JOBSTOPPED); SET(JOBPAUSE); R0:=1; ERRMSGLOCK:=R0; OPRLOCK:=R0; RESET(MAPGOING); OPERATOR; R0:=RDRSTARTB; RDRGETPTR:=R0; RDRPUTPTR:=R0; R0:=1; RDRLOCK:=R0; R0:=0; RDRFULL:=R0; R0:=RDRNOBUFF; RDREMPTY:=R0; SET(RDRENDFILE); RESET(RDRCTRLCARD); RESET(RDREOFFOUND); SET(RDRREADCTRL); READER; R0:=PCHSTARTB; PCHGETPTR:=R0; PCHPUTPTR:=R0; R0:=1; PCHLOCK:=R0; R0:=0; PCHFULL:=R0; R0:=PCHNOBUFF; PCHEMPTY:=R0; RESET(PCHJOBPUNCH); RESET(PCHERRFLG); MVI(" ",PCHRETRY); MVC(78,PCHRETRY(1),PCHRETRY); PUNCH; R0:=PRTSTARTB; PRTGETPTR:=R0; PRTPUTPTR:=R0; R0:=1; PRTLOCK:=R0; R0:=0; PRTLINENO:=R0; PRTFULL:=R0; R0:=PRTNOBUFF; PRTEMPTY:=R0; PRINTER; SET(JOBSACTIVE); RESET(GOTBEGIN); R0:=1; SMSGLOCK:=R0; WHILE JOBSACTIVE DO BEGIN R0:=@OPRLOCK; P; IF JOBPAUSE THEN BEGIN SET(JOBSTOPPED); R0:=@PAUSEMSG; R1:=11; WRITETYPE; R0:=@OPRLOCK; V; R0:=@JOBLOCK; P; END ELSE BEGIN R0:=@OPRLOCK; V; END; PROCESSJOB; END; STOP; END; LEVEL0; COMMENT THIS WAKES UP THE WORLD; END.