TITLE 'Sample Operating System Version 2.00' 00010002 *********************************************************************** 00020000 * * 00030000 * ***************************************************************** * 00040000 * * * * 00050000 * * Sample Operating System * * 00060002 * * Version 2.00 * * 00067002 * * Developed at MIT 1973 * * 00074002 * * * * 00090000 * ***************************************************************** * 00100000 * * 00100602 * Update 2015/10/31 Juergen Winkelmann, e-mail winkelmann@id.ethz.ch * 00101202 * * 00101802 * - change storage protection alignments to 4K \ * 00102402 * - replace SSK/ISK instructions with SSKE/ISKE > 4K support * 00103002 * - minor changes in storage protection logic / * 00103602 * - change number of parallel processing streams to 4 * 00104202 * - change core size to 16M * 00104802 * - replace table of valid $JOB card core requests with general * 00105402 * logic rounding up any none full page request entered to next * 00106002 * full page * 00106602 * - add IPL card and two card loader for one stop creation of an * 00107202 * IPLable card deck * 00107802 * - ignore external interrupts during initialization to avoid * 00108402 * IPLRTN getting interrupted by the interval timer * 00109002 * * 00109103 * Update 2015/11/05 Juergen Winkelmann, e-mail winkelmann@id.ethz.ch * 00109203 * * 00109303 * - allow reloading card readers without needing to re-IPL the * 00109403 * system. This functionality relies on Hercules' card reader * 00109503 * behavior with the EOF initialization in place. It will not * 00109603 * work in INTR mode. * 00109703 * * 00109744 * Update 2015/11/13 Juergen Winkelmann, e-mail winkelmann@id.ethz.ch * 00109784 * * 00109824 * - add UCB to support a console at 009 using the EXCP device * 00109864 * handler. * 00109904 * * 00110000 *********************************************************************** 00120000 SPACE 3 00130000 PRINT ON,NODATA,GEN 00140000 PROGRAM CSECT , sample operating system starts at zero 00150002 CARDLDR CSECT , two card loader follows at the end 00150102 *** 00150202 *** IPL card 00150302 *** 00150402 IPLCARD CSECT , IPLable deck must begin with this card 00150502 PSWD DC F'0',X'00' initial program status word, disabled 00150602 DC AL3(LOADER) start execution at load address 00150702 CCW1 DC X'02',AL3(LOADER) read 1st card to load address 00150802 DC XL4'40000050' chain, read length = 80 00150902 CCW2 DC X'02',AL3(LOADER+80) read 2nd card to load addr + 80 00151002 DC XL4'00000050' read length = 80 00151102 DC C'Sample Operating System Version 2.00' eye catcher 00151202 DC 16X'00' pad to card length 00151302 *** 00151402 *** loader 00151502 *** 00151602 * 00151702 * Initialize 00151802 * 00151902 CARDLDR CSECT , two card loader must follow IPL card 00152002 BALR R12,0 establish .. 00152102 LA R2,2 .. base .. 00152202 SR R12,R2 .. register 00152302 USING CARDLDR,R12 tell assembler 00152402 LA R11,0 addressability of .. 00152502 USING PROGRAM,R11 .. sample operating system 00152602 LA R2,0 I/O .. 00152702 LA R3,IOINTRPT .. new PSWD 00152802 STM R2,R3,IONEW store I/O new PSWD 00152902 SSM ENBLECH0 enable interrupts from channel 0 00153002 LA R5,CCWCHAIN address of card reader CCW chain 00153102 ST R5,CAW store address in CAW 00153202 L R3,NUMCARDS number of cards to read 00153302 L R4,LOADADDR target address of loaded code 00153402 * 00153502 * create CCW chain 00153602 * 00153702 NEXTCARD LR R2,R4 load next card here 00153802 ICM R2,B'1000',READ insert write command 00153902 ST R2,0(,R5) store CCW 00154002 LA R2,80 length of card 00154102 ST R2,4(,R5) store length in CCW, zero all flags 00154202 OI 4(R5),X'40' indicate command chaining 00154302 LA R4,80(,R4) increment target address 00154402 LA R5,8(,R5) point to next CCW 00154502 BCT R3,NEXTCARD read next card 00154602 S R5,EIGHT point to previous CCW 00154702 NI 4(R5),X'BF' clear command chaining flag 00154802 * 00154902 * read cards and wait for completion 00155002 * 00155102 SIO 12(0) read cards 00155202 LA R2,*+12 continue here after I/O completion 00155302 ST R2,CONTINUE store continue address in PSWD skeleton 00155402 LPSW WAITPSWD wait for I/O completion 00155502 * 00155602 * "IPL" the Sample Operating System 00155702 * 00155802 LPSW 0 transfer control 00155902 * 00156002 * I/O interrupt handler 00156102 * 00156202 IOINTRPT EQU * 00156302 TM CSW+4,X'04' device end received? 00156402 BNO IOINTRTN -> no, keep waiting 00156502 NI IOOLD+1,X'FD' -> yes, terminate wait state and .. 00156602 NI IOOLD,X'7F' .. and disable channel 0 interrupts 00156702 IOINTRTN LPSW IOOLD return to mainline 00156802 DROP R11,R12 no longer needed 00156902 * 00157002 * Data area 00157102 * 00157202 ENBLECH0 DC C'80' mask to enable channel 0 interrupts 00157302 READ DC X'02' read a card 00157402 DS 0D align 00157502 WAITPSWD DC X'80020000' wait with channel 0 interrupts enabled 00157602 CONTINUE DS F continue here after wait 00157702 LOADADDR DC F'0' code is to be loaded here 00157802 NUMCARDS DC F'75' number of cards to read 00157904 EIGHT DC F'8' CCW length 00158002 CCWCHAIN DS 0D start of card reader CCW chain 00158102 *** 00158202 *** Sample Operating System code begins here 00158302 *** 00158402 PROGRAM CSECT , sample OS must follow loader cards 00158502 SPACE 1 00160000 CORESIZE EQU 16777216 bytes of core in object machine 00170002 SPACE 1 00180000 USING *,0 COMMUNICATIONS AREA 00190000 SPACE 1 00200000 IPLPSW DC B'00000000',B'00000000',X'0000',X'00',AL3(IPLRTN) 00210000 IPLCCW1 DS D . IPL CCW #1 00220000 IPLCCW2 DS D . IPL CCW #2 00230000 EXTOLD DS D . EXTERNAL OLD PSW 00240000 SVCOLD DS D . SVC OLD PSW 00250000 PGMOLD DS D . PROGRAM INTERRUPT OLD PSW 00260000 MCHKOLD DS D . MACHINE CHECK OLD PSW 00270000 IOOLD DS D . I/O INTERRUPT OLD PSW 00280000 CSW DS D . CHANNEL STATUS WORD 00290000 CAW DS F . CHANNEL ADDRESS WORD 00300000 UNUSED0 DS F . 00310000 TIMER DC F'-1' . TIMER 00320000 UNUSED1 DC F'0' . 00330000 EXTNEW DC B'00000000',B'00000000',X'0000',X'00',AL3(EXTHANDL) 00340000 SVCNEW DC B'00000000',B'00000000',X'0000',X'00',AL3(SVCHANDL) 00350000 PGMNEW DC B'00000000',B'00000000',X'0000',X'00',AL3(PGMHANDL) 00360000 MCHKNEW DC B'00000000',B'00000010',X'0000',X'00',AL3(0) 00370000 IONEW DC B'00000000',B'00000000',X'0000',X'00',AL3(IOINTRPT) <-+ 00380002 *** | 00382002 *** IOINTRPT will be replaced with IOHANDL after IPL by IPLRTN -----+ 00384002 *** 00386002 ORG *+X'100' SPACE OVER STAND ALONE DUMP AREA 00390000 FSBPTR DC A(VERYEND) . FSB POINTER 00400000 FSBSEM DC F'1,0' . FSB SEMAPHORE 00410000 MEMORY DC F'0,0' . MEMORY SEMAPHORE 00420000 CAWSEM DC F'1,0' . CAW SEMAPHORE 00430000 SPACE 1 00440000 TRAPSAVE DS 16F . STORAGE FOR EXTERNAL INTERRUPTS 00450000 IOHSAVE DS 16F . STORAGE FOR I/O INTERRUPTS 00460000 SPACE 1 00470000 SYSSEMSA DS CL84 . SYSTEM SEMAPHORE SAVE AREA 00480000 SPACE 1 00490000 RUNNING DS A . RUNNING 00500000 NEXTTRY DS A . NEXTTRY 00510000 NEXTTRYM DS C,0H . NEXTTRY MODIFIED 00520000 EJECT 00530000 *********************************************************************** 00540000 * * 00550000 * EXTERNAL, PROGRAM, AND SVC INTERRUPT HANDLERS * 00560000 * * 00570000 *********************************************************************** 00580000 SPACE 1 00590000 EXTHANDL EQU * . EXTERNAL INTERRUPT HANDLER 00600000 STM 0,15,TRAPSAVE . SAVE REGISTERS 00610000 BALR 1,0 . ESTABLISH ADDRESSING 00620000 USING *,1 00630000 CLI EXTOLD+3,X'80' . SEE IF TIMER TRAP 00640000 BNE EXTHRET . IF NOT, IGNORE 00650000 L 15,RUNNING . SET UP REGISTERS FOR TRAFFIC 00660000 USING PCB,15 . CONTROLLER (XPER) 00670000 CLI PCBBLOKT,X'FF' . IF BLOCKED, NO PROCESS IS 00680000 BE EXTHRET . RUNNABLE, SO RETURN 00690000 LA 14,PCBISA . GET SAVE AREA 00700000 USING SA,14 00710000 MVC SAPSW,EXTOLD . AND STORE OLD STUFF INTO IT 00720000 MVC SAREGS,TRAPSAVE 00730000 B XPER . THEN GO TO TRAFFIC SCHEDULER 00740000 DROP 14,15 00750000 EXTHRET LM 0,15,TRAPSAVE . TO IGNORE AN INTERRUPT, RELOAD 00760000 LPSW EXTOLD . AND TRANSFER BACK 00770000 SPACE 1 00780000 PGMHANDL EQU * . PROGRAM INTERRUPT HANDLER 00790000 SVC C'?' . IN ANY CASE, AN ERROR 00800000 EJECT 00810000 *********************************************************************** 00820000 * * 00830000 * SVC INTERRUPT HANDLER * 00840000 * * 00850000 * FOR ALL ROUTINES ENTERED BY SVC INTERRUPT, THE * 00860000 * FOLLOWING REGISTERS CONTAIN THIS INFORMATION: * 00870000 * * 00880000 * REGISTER 1 - BASE REGISTER FOR ROUTINE * 00890000 * REGISTER 2 - POINTER TO ARGUMENT LIST (IF ANY) * 00900000 * REGISTER 14 - POINTER TO SAVEAREA USED FOR THIS SVC * 00910000 * REGISTER 15 - POINTER TO PCB PRESENTLY RUNNING * 00920000 * * 00930000 *********************************************************************** 00940000 SPACE 1 00950000 SVCHANDL EQU * . SVC HANDLER 00960000 STM 0,15,TRAPSAVE . SAVE REGISTERS 00970000 BALR 9,0 . ESTABLISH ADDRESSING 00980000 USING *,9 00990000 LM 10,14,SVCCONST . INITIALIZE REGISTERS 01000000 IC 10,SVCOLD+3 . GET SVC CODE 01010000 IC 10,SVCHTABL(10) . TRANSLATE INTO TABLE OFFSET 01020000 LA 10,SVCRTN(10) . REG 10 -> THE CORRECT PSW 01030000 CLI 2(10),X'00' . IS THIS CALL PROTECTED? 01040000 BE SVCHPROT . THEN SEE IF WE CAN CALL IT 01050000 SVCOK L 15,RUNNING . GET PCB POINTER 01060000 USING PCB,15 01070000 CLI 3(10),X'00' . IS IT A SYSTEM SAVEAREA? 01080000 BE SYSSEM . DON'T USE REG 14 AS PCB POINTER 01090000 LR 14,15 . ELSE, SET UP PCB POINTER 01100000 SYSSEM IC 11,3(10) . GET POINTER TO SAVE AREA OFFSET 01110000 A 14,SVCSAVE(11) . REG 14 -> SAVE AREA 01120000 CLI SVCOLD+3,C'.' . ARE WE CALLING XPER? 01130000 BE SVCXPER . IF SO, DON'T SAVE RETURN STATUS 01140000 USING SA,14 01150000 MVC SAPSW,SVCOLD . SAVE PSW 01160000 MVC SAREGS,TRAPSAVE . SAVE REGISTERS 01170000 SVCXPER L 1,4(10) . MAKE ADDRESSING EASY WITHIN 01180000 LPSW 0(10) . ROUTINE, AND GO THERE 01190000 SVCHPROT L 12,SVCOLD . GET PROTECTION KEY 01200000 NR 12,13 . IS IT A USER? 01210000 BZ SVCOK . IF NO, THAT'S FINE 01220000 LA 10,SVCRTN+136 . ELSE SET UP CALL TO XQUE 01230000 B SVCOK . 01240000 DROP 9 01250000 SVCCONST DC 3F'0',X'00F00000',F'0' 01260000 SPACE 1 01270000 SVCHTABL DC 256X'84' . TABLE OF PSW OFFSETS 01280000 ORG SVCHTABL+C'P' 01290000 DC AL1(0) 01300000 ORG SVCHTABL+C'V' 01310000 DC AL1(8) 01320000 ORG SVCHTABL+C'!' 01330000 DC AL1(16) 01340000 ORG SVCHTABL+C',' 01350000 DC AL1(24) 01360000 ORG SVCHTABL+C'B' 01370000 DC AL1(32) 01380000 ORG SVCHTABL+C'A' 01390000 DC AL1(40) 01400000 ORG SVCHTABL+C'F' 01410000 DC AL1(48) 01420000 ORG SVCHTABL+C'I' 01430000 DC AL1(56) 01440000 ORG SVCHTABL+C'J' 01450000 DC AL1(64) 01460000 ORG SVCHTABL+C'.' 01470000 DC AL1(72) 01480000 ORG SVCHTABL+C'R' 01490000 DC AL1(80) 01500000 ORG SVCHTABL+C'S' 01510000 DC AL1(88) 01520000 ORG SVCHTABL+C'C' 01530000 DC AL1(96) 01540000 ORG SVCHTABL+C'N' 01550000 DC AL1(104) 01560000 ORG SVCHTABL+C'Y' 01570000 DC AL1(112) 01580000 ORG SVCHTABL+C'Z' 01590000 DC AL1(120) 01600000 ORG SVCHTABL+C'D' 01610000 DC AL1(128) 01620000 ORG SVCHTABL+C'?' 01630000 DC AL1(136) 01640000 ORG SVCHTABL+C'H' 01650000 DC AL1(144) 01660000 ORG SVCHTABL+C'E' 01670000 DC AL1(152) 01680000 ORG SVCHTABL+256 01690000 SPACE 1 01700000 SVCRTN DS 0D . THE PSWS 01710000 * IN THE FOLLOWING PSWS, THE THIRD BYTE INDICATES * 01720000 * WHETHER THE SVC IS RESTRICTED: * 01730000 * X'00' -> OPERATING SYSTEM ONLY * 01740000 * X'FF' -> AVAILABLE TO USER ALSO * 01750000 * * 01760000 * THE FOURTH BYTE INDICATES WHICH SAVE AREA TO USE; * 01770000 * SVCSAVE BELOW SHOWS THE CODE VALUES. * 01780000 DC B'00000000',B'00000000',X'0000',X'00',AL3(XP) 01790000 DC B'00000000',B'00000000',X'0000',X'00',AL3(XV) 01800000 DC B'00000000',B'00000000',X'0004',X'00',AL3(XEXC) 01810000 DC B'00000000',B'00000000',X'0004',X'00',AL3(XCOM) 01820000 DC B'00000000',B'00000000',X'0004',X'00',AL3(XB) 01830000 DC B'11111111',B'00000000',X'000C',X'00',AL3(XA) 01840000 DC B'11111111',B'00000000',X'000C',X'00',AL3(XF) 01850000 DC B'00000000',B'00000000',X'0004',X'00',AL3(XI) 01860000 DC B'00000000',B'00000000',X'0004',X'00',AL3(XJ) 01870000 DC B'00000000',B'00000000',X'0004',X'00',AL3(XPER) 01880000 DC B'11111111',B'00000000',X'FF08',X'00',AL3(XR) 01890000 DC B'11111111',B'00000000',X'FF08',X'00',AL3(XS) 01900000 DC B'11111111',B'00000000',X'FF08',X'00',AL3(XC) 01910000 DC B'00000000',B'00000000',X'FF04',X'00',AL3(XN) 01920000 DC B'00000000',B'00000000',X'FF08',X'00',AL3(XY) 01930000 DC B'11111111',B'00000000',X'FF08',X'00',AL3(XZ) 01940000 DC B'11111111',B'00000000',X'FF08',X'00',AL3(XD) 01950000 DC B'00000000',B'00000000',X'FF04',X'00',AL3(XQUE) 01960000 DC B'11111111',B'00000000',X'FF08',X'00',AL3(XH) 01970000 DC B'11111111',B'00000000',X'000C',X'00',AL3(XAUTO) 01980000 SPACE 1 01990000 SVCSAVE DS 0F . THE SAVE AREA OFFSETS 02000000 DC A(SYSSEMSA) . CODE 00 -> SYSSEMSA 02010000 DC A(PCBISA-PCB) . CODE 04 -> INTERRUPT SAVE AREA 02020000 DC A(PCBFSA-PCB) . CODE 08 -> FAULT SAVE AREA 02030000 DC A(PCBMSA-PCB) . CODE 0C -> MEMORY SAVE AREA 02040000 SPACE 3 02050000 *********************************************************************** 02060000 * * 02070000 * RETURN SEQUENCE FOR REQUEST DRIVEN ROUTINES AND TRAFFIC CONTROLLER * 02080000 * * 02090000 *********************************************************************** 02100000 SPACE 1 02110000 DS 0D 02120000 RETURN DC B'00000000',B'00000000',X'0000',X'00',AL3(RETURNR) 02130000 SPACE 1 02140000 RETURNR EQU * . RETURN ROUTINE FOR SVC'S AND XPER 02150000 MVC SVCOLD,SAPSW . SAVE PSW IN A SAFE PLACE 02160000 LM 0,15,SAREGS . RELOAD REGISTERS 02170000 LPSW SVCOLD . AND RETURN 02180000 EJECT 02190000 *********************************************************************** 02200000 * * 02210000 * REQUEST DRIVEN ROUTINES * 02220000 * * 02230000 *********************************************************************** 02240000 SPACE 3 02250000 *********************************************************************** 02260000 * * 02270000 * XP ROUTINE * 02280000 * * 02290000 * FUNCTION: TO IMPLEMENT "P" PRIMITIVE FOR SEMAPHORES * 02300000 * DATABASES: UPON ENTRY, REGISTER 2 CONTAINS ADDRESS SM * 02310000 * SM DS 0D SEMAPHORE DEFINITION * 02320000 * SMVAL DS F VALUE * 02330000 * SMPTR DS A POINTER TO FIRST WAITER * 02340000 * ROUTINES USED: XPER * 02350000 * PROCEDURE: SUBTRACT ONE FROM SMVAL; IF NON-NEGATIVE, RETURN. * 02360000 * IF NEGATIVE, PLACE RUNNING PROCESS AT END OF LIST * 02370000 * OF PRECESSES WAITING ON SM. BLOCK CALLING PROCESS; * 02380000 * ENTER TRAFFIC CONTROLLER. * 02390000 * ERROR CHECKS: NONE * 02400000 * INTERRUPTS: OFF * 02410000 * USER ACCESS: NO * 02420000 * * 02430000 *********************************************************************** 02440000 SPACE 1 02450000 XP EQU * . THE XP ROUTINE 02460000 USING *,1 02470000 USING SM,2 . ARGUMENT IS A SEMAPHORE 02480000 L 3,SMVAL . GET THE VALUE 02490000 BCTR 3,0 . SUBTRACT ONE 02500000 ST 3,SMVAL . AND STORE IT BACK 02510000 LTR 3,3 . SET CONDITION CODE 02520000 BM XPWAIT . IF IT'S NEGATIVE, MUST WAIT 02530000 LPSW RETURN . ELSE RETURN NOW 02540000 XPWAIT LA 4,SMPTR . START GOING DOWN 02550000 L 5,SMPTR . CHAIN OF POINTERS 02560000 DROP 15 02570000 USING PCB,5 02580000 XPLOOP LTR 5,5 . IF REACHED END 02590000 BZ XPTHEN . ADD OUR PCB ON. ELSE, 02600000 LA 4,PCBNSW . INCREMENT POINTERS 02610000 L 5,PCBNSW 02620000 B XPLOOP . AND TRY AGAIN 02630000 DROP 5 02640000 USING PCB,15 02650000 XPTHEN MVC 0(4,4),RUNNING . WE'RE AT THE END 02660000 ST 5,PCBNSW . STORE NULL POINTER 02670000 MVI PCBBLOKT,X'FF' . AND WE'RE BLOCKED 02680000 MVC PCBISA,SYSSEMSA . SWITCH SAVE AREAS 02690000 B XPER . SO RUN SOMEONE ELSE 02700000 DROP 2 02710000 EJECT 02720000 *********************************************************************** 02730000 * * 02740000 * XV ROUTINE * 02750000 * * 02760000 * FUNCTION: TO IMPLEMENT "V" PRIMITIVE FOR SEMAPHORES * 02770000 * DATABASES: UPON ENTRY, REGISTER 2 CONTAINS ADDRESS SM * 02780000 * SM DS 0D SEMAPHORE DEFINITION * 02790000 * SMVAL DS F VALUE * 02800000 * SMPTR DS A POINTER TO FIRST WAITER * 02810000 * ROUTINES USED: NONE * 02820000 * PROCEDURE: ADD ONE TO SMVAL; IF > ZERO, RETURN. IF ZERO OR * 02830000 * LESS, REMOVE FIRST PROCESS FROM WAITER CHAIN; * 02840000 * UNBLOCK IT; IF NEXTTRYM NOT SET, SET IT AND SET * 02850000 * NEXTTRY TO THAT PROCESS; RETURN; IF NEXTTRYM SET, * 02860000 * RETURN. * 02870000 * ERROR CHECKS: NONE * 02880000 * INTERRUPTS: OFF * 02890000 * USER ACCESS: NO * 02900000 * * 02910000 *********************************************************************** 02920000 SPACE 1 02930000 XV EQU * . THE XV ROUTINE 02940000 USING *,1 02950000 USING SM,2 . ARGUMENT IS A SEMAPHORE 02960000 L 3,SMVAL . GET THE VALUE 02970000 A 3,=F'1' . ADD ONE 02980000 ST 3,SMVAL . AND STORE IT BACK 02990000 BNP XVWAKEUP . IF <=0, SOMEONE'S WAITING 03000000 LPSW RETURN . ELSE RETURN 03010000 XVWAKEUP L 4,SMPTR . GET THE FIRST OF THE GUYS 03020000 DROP 15 03030000 USING PCB,4 03040000 MVC SMPTR,PCBNSW . REMEMBER THE REST 03050000 MVI PCBBLOKT,X'00' . WE'RE NO LONGER BLOCKING HIM 03060000 CLI NEXTTRYM,X'FF' . IS NEXT TRY MODIFIED? 03070000 BE XVRET . IF SO, WELL OK 03080000 ST 4,NEXTTRY ELSE MODIFY NEXTTRY 03090000 MVI NEXTTRYM,X'FF' . AND SAY SO 03100000 XVRET LPSW RETURN . GET BACK 03110000 DROP 2,4 03120000 EJECT 03130000 *********************************************************************** 03140000 * * 03150000 * XPER ROUTINE (TRAFFIC CONTROLLER) * 03160000 * * 03170000 * FUNCTION: TO IMPLEMENT MULTIPROGRAMMING * 03180000 * DATABASES: NONE * 03190000 * ROUTINES USED: NONE * 03200000 * PROCEDURE: STARTING WITH NEXTTRY, SEARCH FOR PROCESS ON ALL * 03210000 * PCB CHAIN NOT BLOCKED OR STOPPED; IF FOUND, USE AS * 03220000 * NEW RUNNING, FOR 50 MS OF TIME AND RETURN. ELSE, * 03230000 * ENTER WAIT STATE WITH INTERRUPTS ON, AND TRY TO * 03240000 * SCHEDULE AGAIN AFTER INTERRUPT; RETURN. * 03250000 * ERROR CHECKS: NONE * 03260000 * INTERRUPTS: OFF * 03270000 * USER ACCESS: NO * 03280000 * * 03290000 *********************************************************************** 03300000 SPACE 1 03310000 XPER EQU * . ROUTINE XPER: TRAFFIC SCHEDULER 03320000 SSM IONEW . MASK OFF INTERRUPTS 03330000 BALR 1,0 03340000 USING *,1 03350000 L 10,NEXTTRY . START LOOKING AT NEXTTRY 03360000 LR 11,10 . REMEMBER WHICH THAT WAS 03370000 USING PCB,10 03380000 GWLOOP CLI PCBBLOKT,X'FF' . IF IT'S BLOCKED 03390000 BE GWINC . IGNORE 03400000 CLI PCBSTOPT,X'FF' . ELSE, IF IT'S NOT STOPPED 03410000 BNE GWRUN . WE CAN RUN IT 03420000 GWINC L 10,PCBNPALL . ELSE, GO TO THE NEXT 03430000 CR 10,11 . IF WE'VE SEEN ALL, QUIT 03440000 BNE GWLOOP . ELSE TRY AGAIN 03450000 LPSW IDLE . SIT AND WAIT 03460000 DS 0D 03470000 IDLE DC B'11111110',B'00000010',X'0000',X'00',AL3(XPER) 03480000 SPACE 1 03490000 GWRUN MVC NEXTTRY,PCBNPALL . GET A NEW NEXTTRY 03500000 MVI NEXTTRYM,X'00' . NOT MODIFIED 03510000 ST 10,RUNNING . GET A NEW RUNNING 03520000 LA 14,PCBISA 03530000 MVC TIMER,QUANTUM . INTERRUPT AFTER 50 MS 03540000 LPSW RETURN . AND GO TO RETURNR 03550000 QUANTUM DC X'00000F00' . QUANTUM OF TIME 03560000 DROP 10 03570000 USING PCB,15 03580000 EJECT 03590000 *********************************************************************** 03600000 * * 03610000 * XEXC ROUTINE * 03620000 * * 03630000 * FUNCTION: TO ENTER SMC SECTION * 03640000 * DATABASES: NONE * 03650000 * ROUTINES USED: NONE * 03660000 * PROCEDURE: INCREMENT SMC BYTE IN PCB BY ONE; RETURN. * 03670000 * ERROR CHECKS: NONE * 03680000 * INTERRUPTS: OFF * 03690000 * USER ACCESS: NO * 03700000 * * 03710000 *********************************************************************** 03720000 SPACE 1 03730000 XEXC EQU * . ROUTINE XEXC: ENTER SMC SECTION 03740000 USING *,1 03750000 SR 8,8 03760000 IC 8,PCBINSMC 03770000 LA 8,1(8) . ADD ONE TO SMC BYTE 03780000 STC 8,PCBINSMC 03790000 LPSW RETURN . AND LEAVE 03800000 SPACE 1 03810000 *********************************************************************** 03820000 * * 03830000 * XCOM ROUTINE * 03840000 * * 03850000 * FUNCTION: TO LEAVE SMC SECTION * 03860000 * DATABASES: NONE * 03870000 * ROUTINES USED: XP, XV * 03880000 * PROCEDURE: DECREMENT SMC BYTE IN PCB BY ONE; IF NOT ZERO, * 03890000 * RETURN. ELSE, CHECK FOR STOP WAITING; IF STOP * 03900000 * WAITING, ALLOW STOP AND BLOCK SELF; RETURN. IF NO * 03910000 * STOP WAITING, RETURN. * 03920000 * ERROR CHECKS: NONE * 03930000 * INTERRUPTS: OFF * 03940000 * USER ACCESS: NO * 03950000 * * 03960000 *********************************************************************** 03970000 SPACE 1 03980000 XCOM EQU * . ROUTINE XCOM: LEAVE SMC 03990000 USING *,1 04000000 SR 8,8 04010000 IC 8,PCBINSMC 04020000 BCTR 8,0 . SUBTRACT ONE FROM IN SMC BYTE 04030000 STC 8,PCBINSMC 04040000 LTR 8,8 . IS IT ZERO? 04050000 BNZ XCOMRET . NO, THEN GET BACK, OTHERWISE 04060000 CLI PCBSW,X'00' . IS STOP WAITING? 04070000 BE XCOMRET . IF NOT, RETURN 04080000 MVI PCBSW,X'00' . STOPS NOT WAITING AFTER THIS 04090000 LA 2,PCBSRS . WE'LL "V" THE STOPPER, 04100000 SVC C'V' 04110000 LA 2,PCBSES . AND "P" THE STOPPEE. 04120000 SVC C'P' 04130000 XCOMRET LPSW RETURN . AND HERE (IF EVER) WE RETURN 04140000 EJECT 04150000 *********************************************************************** 04160000 * * 04170000 * XA ROUTINE * 04180000 * XAUTO ROUTINE * 04190000 * * 04200000 * FUNCTION: TO ALLOCATE MEMORY * 04210000 * DATABASES: UPON ENTRY, REGISTER 2 CONTAINS ADDRESS XAX: * 04220000 * XAX DS 0D * 04230000 * XAXSIZE DS F SIZE OF BLOCK TO BE ALLOCATED * 04240000 * XAXADDR DS A ADDRESS OF FIRST BYTE OF BLOCK* 04250000 * XAXALGN DS F ALIGNMENT OF BLOCK * 04260000 * ROUTINES USED: XEXC, XCOM, XP, XV, XB * 04270000 * PROCEDURE: LOCK FSB SEMAPHORE; SEARCH FREE STORAGE FOR LARGE * 04280000 * ENOUGH MEMORY BLOCK; ALIGN BOUNDARY; USE XB TO * 04290000 * CHAIN ANY LEFTOVER BLOCKS TO FREE STORAGE LIST; * 04300000 * PLACE ADDRESS OF ALLOCATED BLOCK IN XAXADDR; UNLOCK* 04310000 * FSB SEMAPHORE; RETURN. IF CAN'T SATISFY REQUEST, * 04320000 * UNLOCK FSB SEMAPHORE, APPLY XP ROUTINE TO MEMORY * 04330000 * SEMAPHORE, BLOCKING PROCESS RUNNING UNTIL MEMORY * 04340000 * FREED; THEN UNBLOCK; TRY TO SATISFY REQUEST AGAIN. * 04350000 * ERROR CHECKS: NONE * 04360000 * INTERRUPTS: ON * 04370000 * USER ACCESS: NO * 04380000 * * 04390000 *********************************************************************** 04400000 SPACE 1 04410000 XA EQU * . THE XA ROUTINE, TO ALLOCATE 04420000 USING *,1 04430000 LA 0,1 . SET REGISTER ZERO TO ONE TO 04440000 B XACOM . INDICATE C'A' CALL 04450000 XAUTO EQU * . AUTO STORAGE ENTRY POINT 04460000 USING *,1 04470000 SR 0,0 . REG0=0 INDICATES C'E' CALL 04480000 L 1,=A(XA) . RESET BASE REGISTER PROPERLY 04490000 USING XA,1 04500000 XACOM SVC C'!' . ENTER SMC 04510000 LR 7,2 04520000 USING XAX,7 . ARGUMENT LIST 04530000 L 6,XAXSIZE . GET THE SIZE REQUESTED 04540000 XATOP LA 2,FSBSEM . LOCK THE FSB SEMAPHORE 04550000 SVC C'P' . 04560000 LA 5,FSBPTR . START LOOKING DOWN 04570000 L 4,FSBPTR . THE FREE STORAGE LIST 04580000 L 8,XAXALGN . WE WOULD HAVE TO START AT WITH 04590000 BCTR 8,0 . THIS CONSTANT TO FIND ALIGNMENT 04600000 USING FSB,4 04610000 XALOOP LTR 4,4 . IF AT THE END 04620000 BZ XAWAIT . WAIT UNTIL A "FREE" OP 04630000 LR 13,4 . FIND THE LOCATION 04640000 BCTR 13,0 . IN THIS BLOCK WITH THIS 04650000 OR 13,8 . ALIGNMENT 04660000 LA 13,1(13) . THAT'S IT 04670000 LR 9,13 . AND NOW GET IN REG 9 04680000 SR 9,4 . WHAT IS WASTED AT THE FRONT 04690000 L 3,FSBSIZE . GET SIZE MINUS WASTE AT 04700000 SR 3,9 . FRONT, LEAVING EFFECTIVE SIZE 04710000 CR 6,3 . IS IT ENOUGH? 04720000 BNP XAFOUND . EUREKA! 04730000 LA 5,FSBNEXT . OH WELL, GET THE NEXT FREE 04740000 L 4,FSBNEXT . STORAGE BLOCK ON THE CHAIN 04750000 B XALOOP . BETTER LUCK NEXT TIME 04760000 XAWAIT SVC C'V' . NEED TO WAIT 04770000 LA 2,MEMORY . SO WE LET OTHER PEOPLE GET IN 04780000 SVC C'P' . SO THEY'LL WAKE US UP 04790000 B XATOP . AND THEN WE'LL TRY AGAIN 04800000 XAFOUND ST 13,XAXADDR . WE'VE NOW GOT THE ADDRESS 04810000 MVC 0(4,5),FSBNEXT . UNLINK THE BLOCK OUT 04820000 L 12,FSBSIZE . GET THE WHOLE BLOCK SIZE 04830000 LA 2,SATEMP . START MAKING UP ARG LISTS 04840000 USING XBX,2 . FOR THE XB ROUTINE 04850000 LR 10,13 . THE STARTING LOCATION 04860000 SR 10,4 . MINUS THE START OF THE BLOCK 04870000 BZ XANF . IF NONE WASTED AT THE FRONT, SKIP 04880000 ST 4,XBXADDR . ELSE FREE, STARTING THERE 04890000 ST 10,XBXSIZE . UP TO THE BEGINNING OF THE 04900000 SVC C'B' . ALLOCATION; INSERT IT IN THE CHAIN 04910000 XANF LR 11,13 . THE STARTING ADDR PLUS THE SIZE 04920000 AR 11,6 . GIVES THE FIRST UNUSED ADDR 04930000 SR 12,10 . MINUS THE WASTE AT FRONT, 04940000 SR 12,6 . MINUS THE PART ALLOCATED. IF 04950000 BZ XARETURN . NONE LEFT OVER, GOOD 04960000 ST 11,XBXADDR . ELSE STORE ADDRESS AND 04970000 ST 12,XBXSIZE . SIZE, AND LINK ONTO 04980000 SVC C'B' . FREE STORAGE LIST 04990000 DROP 2 05000000 XARETURN LA 2,FSBSEM . WE ARE DONE, SO NOW SOMEONE 05010000 SVC C'V' . ELSE CAN COME IN 05020000 LTR 0,0 . IS THIS FOR AUTOMATIC STORAGE? 05030000 BNZ XABACK . IF NOT, RETURN NOW 05040000 ST 6,PCBASIZE . OTHERWISE STORE SIZE AND 05050000 ST 13,PCBAADDR . ADDRESS OF AUTOMATIC STORAGE 05060000 XABACK SVC C',' . LEAVE SMC SECTION 05070000 LPSW RETURN . GET BACK JOJO 05080000 DROP 4,7 05090000 EJECT 05100000 *********************************************************************** 05110000 * * 05120000 * XF ROUTINE * 05130000 * * 05140000 * FUNCTION: TO FREE MEMORY * 05150000 * DATABASES: UPON ENTRY, REGISTER 2 CONTAINS ADDRESS XFX: * 05160000 * XFX DS 0D * 05170000 * XFXSIZE DS F SIZE OF BLOCK TO BE FREED * 05180000 * XFXADDR DS A ADDRESS OF FIRST BYTE OF BLOCK* 05190000 * ROUTINES USED: XEXC, XP, XV, XB, XCOM * 05200000 * PROCEDURE: LOCK FSB SEMAPHORE; SEARCH FREE STORAGE LIST TO * 05210000 * FIND IF ANY FREE BLOCK CONTIGUOUSLY FOLLOWS OR * 05220000 * PRECEDES BLOCK TO BE FREED; IF THERE IS ANY, * 05230000 * COMPACT THEM INTO A SINGLE BLOCK OF COMBINED SIZE; * 05240000 * USE XB TO CHAIN COMPACTED BLOCK ONTO FREE STORAGE * 05250000 * LIST; WAKEUP ALL PROCESSES WAITING ON MEMORY * 05260000 * SEMAPHORE; UNLOCK FSB SEMAPHORE; RETURN * 05270000 * ERROR CHECKS: NONE * 05280000 * INTERRUPTS: ON * 05290000 * USER ACCESS: NO * 05300000 * * 05310000 *********************************************************************** 05320000 SPACE 1 05330000 XF EQU * . THE XF ROUTINE, TO FREE STORAGE 05340000 USING *,1 05350000 SVC C'!' . ENTER SMC SECTION 05360000 LR 7,2 05370000 USING XFX,7 . THE ARGUMENT LIST 05380000 L 3,XFXSIZE . GET THE SIZE 05390000 L 4,XFXADDR . AND THE ADDRESS 05400000 LR 5,3 . GET THE ADDRESS OF THE END OF THE 05410000 AR 5,4 . BLOCK TO BE FREED 05420000 LA 2,FSBSEM . LOCK FSBSEM 05430000 SVC C'P' 05440000 LA 8,FSBPTR . START LOOKING DOWN THE FREE 05450000 L 6,FSBPTR . STORAGE LIST, FOR COMPACTION 05460000 USING FSB,6 05470000 XFLOOP LTR 6,6 . ARE WE THROUGH? 05480000 BZ XFLINK . IF SO, JUST ADD IT ON 05490000 L 9,FSBNEXT . IF NOT. GET THE NEXT PTR 05500000 CR 6,5 . IS THIS BLOCK RIGHT AFTER OURS? 05510000 BNE XFTHEN . IF NOT, OK. BUT IF IT IS, 05520000 ST 9,0(8) . WE CAN COMPACT, SO UNCHAIN IT 05530000 A 3,FSBSIZE . AND REMEMBER THE NEW SIZE 05540000 B XFBACKUP . AND ON TO THE NEXT 05550000 XFTHEN LR 10,6 . MAYBE IT'S RIGHT BEFORE OURS 05560000 A 10,FSBSIZE . GET ENDING ADDRESS OF FREE BLOCK 05570000 CR 10,4 . IS IT RIGHT BEFORE OURS? 05580000 BNE XFINC . OH FUDGE! NO! 05590000 ST 9,0(8) . IF SO, UNLINK IT 05600000 LR 4,6 . GET THE NEW BEGINNING LOCATION 05610000 A 3,FSBSIZE . AND NEW SIZE OF FREE BLOCK 05620000 XFBACKUP LR 6,8 . BACK UP ONE FSB 05630000 XFINC LA 8,FSBNEXT . ON TO THE NEXT FSB 05640000 L 6,FSBNEXT 05650000 B XFLOOP . TRY, TRY AGAIN 05660000 XFLINK LA 2,SATEMP . START TO CALL XB 05670000 USING XBX,2 05680000 ST 3,XBXSIZE . STORE SIZE 05690000 ST 4,XBXADDR . AND ADDRESS 05700000 SVC C'B' . LINK IT ONTO THE FSB CHAIN 05710000 USING SM,2 05720000 LA 2,MEMORY . GET VALUE OF MEMORY SEMAPHORE 05730000 LA 11,1(0,0) . SUBTRACT FROM ONE, IT'S A HANDLE 05740000 S 11,SMVAL . ON THE # OF PEOPLE WAITING 05750000 DROP 2 05760000 XFVLOOP BCT 11,XFVDO . LOOP IF ANYONE ELSE IS WAITING 05770000 LA 2,FSBSEM . WE'RE THROUGH, SO 05780000 SVC C'V' . UNBLOCK FSBSEM 05790000 SVC C',' . LEAVE SMC 05800000 LPSW RETURN . RETURN 05810000 XFVDO SVC C'V' . WAKE SOMEONE UP 05820000 B XFVLOOP . TRY AGAIN FOR ANOTHER 05830000 DROP 6,7 05840000 EJECT 05850000 *********************************************************************** 05860000 * * 05870000 * XB ROUTINE * 05880000 * * 05890000 * FUNCTION: TO CHAIN A STORAGE BLOCK ONTO FREE STORAGE LIST * 05900000 * DATABASES: UPON ENTRY, REGISTER 2 CONTAINS ADDRESS XBX: * 05910000 * XBX DS 0D * 05920000 * XBXSIZE DS F SIZE OF BLOCK * 05930000 * XBXADDR DS A ADDRESS OF FIRST BYTE OF BLOCK* 05940000 * ROUTINES USED: NONE * 05950000 * PROCEDURE: SEARCH FREE STORAGE LIST TO FIND WHERE TO INSERT * 05960000 * FREE BLOCK IN ORDER OF INCREASING SIZE; FORMAT * 05970000 * BLOCK LIKE AN FSB; INSERT; RETURN. * 05980000 * ERROR CHECKS: NONE * 05990000 * INTERRUPTS: OFF * 06000000 * USER ACCESS: NO * 06010000 * COMMENTS: SINCE XB ROUTINE ONLY CALLED BY XA AND XF, FSB * 06020000 * SEMAPHORE IS ALREADY LOCKED. * 06030000 * * 06040000 *********************************************************************** 06050000 SPACE 1 06060000 XB EQU * 06070000 USING *,1 06080000 USING XBX,2 . ARGUMENT LIST 06090000 L 3,XBXSIZE . GET THE SIZE 06100000 L 4,XBXADDR . AND THE ADDRESS 06110000 LA 8,FSBPTR . START LOOKING DOWN THE CHAIN 06120000 L 6,FSBPTR 06130000 LTR 6,6 . IF ZERO POINTER, WE ARE AT 06140000 BZ XBINSERT . END OF CHAIN ALREADY 06150000 USING FSB,6 06160000 XBLOOP C 3,FSBSIZE . IF THE SIZE OF OURS IS LESS, 06170000 BNP XBINSERT . TIME TO INSERT 06180000 LA 8,FSBNEXT . ELSE GO ON TO THE NEXT 06190000 L 6,FSBNEXT 06200000 LTR 6,6 . IF NOT ALREADY THROUGH 06210000 BNZ XBLOOP . BRANCH BACK 06220000 XBINSERT ST 4,0(8) . NOW, LINK OURS ON 06230000 DROP 6 06240000 USING FSB,4 06250000 ST 6,FSBNEXT . MAKE OURS POINT TO THE NEXT 06260000 ST 3,FSBSIZE . WITH THE RIGHT SIZE 06270000 LPSW RETURN . AND RETURN 06280000 DROP 2,4 06290000 EJECT 06300000 *********************************************************************** 06310000 * * 06320000 * XC ROUTINE * 06330000 * * 06340000 * FUNCTION: TO CREATE A PROCESS * 06350000 * DATABASES: UPON ENTRY, REGISTER 2 CONTAINS ADDRESS XCX: * 06360000 * XCX DS 0D * 06370000 * XCXNAME DS CL8 NAME OF PROCESS TO BE CREATED * 06380000 * ROUTINES USED: XEXC, XCOM, XN, XA, XI, XQUE * 06390000 * PROCEDURE: USE XA TO ALLOCATE NEW PCB; PLACE XCXNAME IN PCB; * 06400000 * INITIALIZE SEMAPHORES; STOP; BLOCK; OUT OF SMC; * 06410000 * CALL XI TO LINK PCB ONTO PCB CHAINS; RETURN. * 06420000 * ERROR CHECKS: IF NAME ALREADY USED IN THIS GROUP, XQUE ENTERED. * 06430000 * INTERRUPTS: ON * 06440000 * USER ACCESS: YES * 06450000 * * 06460000 *********************************************************************** 06470000 SPACE 1 06480000 XC EQU * . THE XC ROUTINE: CREATE A PROCESS 06490000 USING *,1 06500000 LR 7,2 06510000 USING XCX,7 . ARGUMENT LIST 06520000 LA 2,SATEMP . READY TO MAKE CALLS OUT 06530000 USING XNX,2 . A XN-LIKE ARGUMENT LIST 06540000 MVC XNXNAME,XCXNAME . GET THE NAME 06550000 SVC C'N' . AND CALL TO FIND THE PCB 06560000 CLC XNXADDR,=A(0) . SEE IF THERE 06570000 BNE XCERR . IF ALREADY EXISTS, BAD 06580000 SVC C'!' . ENTER SMC SECTION 06590000 DROP 2 06600000 USING XAX,2 . READY TO CALL XA 06610000 MVC XAXSIZE,=A(LENPCB) . WE KNOW THE SIZE 06620000 MVC XAXALGN,=F'8' . AND THE ALIGNMENT 06630000 SVC C'A' . SO CALL 06640000 L 2,XAXADDR . FIND THE ADDRESS 06650000 DROP 2,15 06660000 USING PCB,2 . FILL IN THE PCB 06670000 MVC PCBNAME,XCXNAME . GIVE IT A NAME 06680000 MVI PCBSTOPT,X'FF' . IT'S STOPPED 06690000 MVC PCBBLOKT(PCBISA-PCBBLOKT),TEMPLATE+1 INITIALIZE PCB 06700000 SVC C'I' . THREAD IT ON 06710000 SVC C',' . LEAVE SMC SECTION 06720000 LPSW RETURN . AND RETURN 06730000 XCERR SVC C'?' . IF ALREADY EXISTS,KERROR 06740000 DROP 2,7 06750000 EJECT 06760000 *********************************************************************** 06770000 * * 06780000 * XD ROUTINE * 06790000 * * 06800000 * FUNCTION: TO DESTROY A PROCESS * 06810000 * DATABASES: UPON ENTRY, REGISTER 2 CONTAINS ADDRESS XDX: * 06820000 * XDX DS 0D * 06830000 * XDXNAME DS CL8 NAME OF PROCESS TO BE DESTROYED* 06840000 * ROUTINES USED: XEXC, XJ, XS, XN, XF, XCOM, XQUE * 06850000 * PROCEDURE: USE XN TO FIND PCB FOR PROCESS TO BE DESTROYED; * 06860000 * USE XJ TO UNLOCK PCB FROM PROCESS CHAINS; IF ANY * 06870000 * MESSAGES FOR THIS PROCESS, FREE STORAGE FOR THEM; * 06880000 * IF THERE IS ANY AUTOMATIC STORAGE, FREE IT; * 06890000 * FREE STORAGE FOR PCB; RETURN. * 06900000 * ERROR CHECKS: IF NAME DOESN'T EXIST OR PROCESS NOT STOPPED, * 06910000 * XQUE ENTERED. * 06920000 * INTERRUPTS: ON * 06930000 * USER ACCESS: YES * 06940000 * * 06950000 *********************************************************************** 06960000 SPACE 1 06970000 XD EQU * . XD ROUTINE: DESTROY A PROCESS 06980000 USING *,1 06990000 LR 7,2 07000000 USING XDX,7 . ARG LIST 07010000 LA 2,SATEMP . READY TO CALL OUT 07020000 USING XNX,2 . WILL CALL XN 07030000 MVC XNXNAME,XDXNAME . GET NAME 07040000 SVC C'N' . AND CALL 07050000 L 2,XNXADDR . GET ADDRESS 07060000 DROP 2 07070000 LTR 2,2 . IF ADDRESS IS NULL, 07080000 BZ XDERR . IT'S AN ERROR 07090000 USING PCB,2 07100000 CLI PCBSTOPT,X'FF' . IF NOT STOPPED 07110000 BNE XDERR . IT'S AN ERROR 07120000 SVC C'!' . ENTER SMC SECTION 07130000 DROP 2 07140000 USING PCB,15 07150000 SVC C'J' . ELSE UNTHREAD THE ENTRY 07160000 LR 8,2 . REMEMBER THE PCB POINTER 07170000 LA 2,SATEMP . READY TO CALL OUT AGAIN 07180000 USING PCB,8 07190000 DROP 15 07200000 L 9,PCBFM . GET FIRST MESSAGE 07210000 XDLOOP LTR 9,9 . ANY MORE MESSAGES? 07220000 BZ XDCHECK . IF NOT, FINISH UP 07230000 USING MSG,9 07240000 L 10,MSGNEXT . ELSE REMEMBER NEXT 07250000 L 11,MSGSIZE . GET THE SIZE 07260000 LA 11,15(11) . AND MAKE IT SOME NUMBER 07270000 N 11,=F'-8' . OF DOUBLEWORDS 07280000 USING XFX,2 07290000 ST 9,XFXADDR . FREE THE LOCATION 07300000 ST 11,XFXSIZE . THE NUMBER OF WORDS 07310000 SVC C'F' . DO IT 07320000 LR 9,10 . ON TO THE NEXT 07330000 B XDLOOP . GET THE NEXT MESSAGE 07340000 XDCHECK CLC PCBAADDR(4),=A(0) . HAS AUTOMATIC STORAGE BEEN 07350000 BE XDTHEN . ALLOCATED? IF NOT, GO FINISH UP 07360000 LA 2,PCBASIZE . SET UP THE ARGUMENT LIST 07370000 SVC C'F' . FREE IT 07380000 LA 2,SATEMP . RESET REGISTER 2 07390000 XDTHEN ST 8,XFXADDR . READY TO FREE THE PCB 07400000 MVC XFXSIZE,=A(LENPCB) . THE SIZE 07410000 SVC C'F' . FREE IT 07420000 SVC C',' . LEAVE SMC 07430000 LPSW RETURN . AND RETURN 07440000 XDERR SVC C'?' . IF PROCESS DOES NOT EXIST 07450000 DROP 2,7,8,9 07460000 USING PCB,15 07470000 SPACE 3 07480000 *********************************************************************** 07490000 * * 07500000 * XH ROUTINE * 07510000 * * 07520000 * FUNCTION: TO HALT A JOB * 07530000 * DATABASES: NONE * 07540000 * ROUTINES USED: XS, XR * 07550000 * PROCEDURE: SEND MESSAGE TO SUPERVISOR PROCESS FOR THIS JOB * 07560000 * INDICATING NORMAL TERMINATION; TRIES TO READ * 07570000 * MESSAGES FOREVER LOOPING; BLOCKS ITSELF, THEREBY * 07580000 * NEVER RETURNING. * 07590000 * ERROR CHECKS: NONE * 07600000 * INTERRUPTS: ON * 07610000 * USER ACCESS: YES * 07620000 * COMMENTS: USER NORMALLY USES THIS ROUTINE TO END A JOB. * 07630000 * * 07640000 *********************************************************************** 07650000 SPACE 1 07660000 XH EQU * . THE XH ROUTINE: HALT A JOB 07670000 USING *,1 07680000 LA 2,XHMSG1 . SEND A MESSAGE TO *IBSUP 07690000 SVC C'S' . SEND IT 07700000 XHLOOP LA 2,XHMSG2 . READY TO READ A REPLY 07710000 SVC C'R' . WHICH NEVER COMES 07720000 B XHLOOP . BUT IF IT DOES WERE READY 07730000 DS 0F 07740000 XHMSG1 DC CL8'*IBSUP' . SAY TO *IBSUP 07750000 DC F'12' . TWELVE CHARACTERS 07760000 DC C'PROGRAM HALT' . SAYING WERE OK 07770000 XHMSG2 DS CL8 . WHO SENDS US A MESSAGE 07780000 DC F'1' . ONE CHARACTER 07790000 DS CL1,0H . WHICH GOES HERE 07800000 EJECT 07810000 *********************************************************************** 07820000 * * 07830000 * XI ROUTINE * 07840000 * * 07850000 * FUNCTION: TO CHAIN A PCB ONTO PROCESS CHAINS * 07860000 * DATABASES: UPON ENTRY, REGISTER 2 CONTAINS ADDRESS OF A PCB * 07870000 * ROUTINES USED: NONE * 07880000 * PROCEDURE: POINTER USED TO CHAIN PCB INTO ALL PCB CHAIN AND * 07890000 * THIS GROUP CHAIN RIGHT AFTER RUNNING PCB; RETURN. * 07900000 * ERROR CHECKS: NONE * 07910000 * INTERRUPTS: OFF * 07920000 * USER ACCESS: NO * 07930000 * * 07940000 *********************************************************************** 07950000 SPACE 1 07960000 XI EQU * . THE XI ROUTINE: THREAD IN A PCB 07970000 USING *,1 07980000 L 10,PCBNPALL . GET THE NEXT 'ALL' PCB 07990000 ST 2,PCBNPALL . STORE THIS PCB RIGNT AFTER MINE 08000000 DROP 15 08010000 USING PCB,10 08020000 ST 2,PCBLPALL . THE NEXT ONE DOWN POINTS BACK 08030000 DROP 10 08040000 USING PCB,2 08050000 ST 15,PCBLPALL . THIS PCB POINTS BACK 08060000 ST 10,PCBNPALL . AND FORWARD 08070000 DROP 2 08080000 USING PCB,15 08090000 L 10,PCBNPTG . GET NEXT "THIS GROUP" PCB 08100000 ST 2,PCBNPTG . RUNNING PCB POINTS TO NEW MEMBER 08110000 DROP 15 . OF PROCESS GROUP 08120000 USING PCB,10 08130000 ST 2,PCBLPTG . NEXT PCB DOWN POINTS BACK 08140000 DROP 10 08150000 USING PCB,2 08160000 ST 15,PCBLPTG . AND WE POINT BACKWARD 08170000 ST 10,PCBNPTG . AND FORWARD 08180000 DROP 2 08190000 LPSW RETURN . RETURN 08200000 USING PCB,15 08210000 EJECT 08220000 *********************************************************************** 08230000 * * 08240000 * XJ ROUTINE * 08250000 * * 08260000 * FUNCTION: TO UNCHAIN A PCB FROM PROCESS CHAINS * 08270000 * DATABASES: UPON ENTRY, REGISTER 2 CONTAINS ADDRESS OF A PCB * 08280000 * ROUTINES USED: NONE * 08290000 * PROCEDURE: POINTERS TO PCB IN ALL PCB CHAIN AND THIS GROUP * 08300000 * CHAIN MODIFIED WITHOUT FREEING STORAGE; RETURN. * 08310000 * ERROR CHECKS: NONE * 08320000 * INTERRUPTS: OFF * 08330000 * USER ACCESS: NO * 08340000 * * 08350000 *********************************************************************** 08360000 SPACE 1 08370000 XJ EQU * . THE XJ ROUTINE: UNTHREAD A PCB 08380000 USING *,1 08390000 DROP 15 08400000 USING PCB,2 08410000 L 11,PCBLPALL . GET PRECEDING PCB 08420000 L 10,PCBNPALL . AND FOLLOWING ONE IN "ALL" 08430000 DROP 2 . CHAIN 08440000 USING PCB,11 08450000 ST 10,PCBNPALL . LAST POINTS TO NEXT 08460000 DROP 11 08470000 USING PCB,10 08480000 ST 11,PCBLPALL . NEXT POINTS TO LAST 08490000 DROP 10 08500000 USING PCB,2 08510000 L 11,PCBLPTG . REDO FOR THIS GROUP PCB CHAIN 08520000 L 10,PCBNPTG 08530000 DROP 2 08540000 USING PCB,11 08550000 ST 10,PCBNPTG . LAST POINTS TO NEXT 08560000 DROP 11 08570000 USING PCB,10 08580000 ST 11,PCBLPTG . NEXT POINTS TO LAST 08590000 DROP 10 08600000 LPSW RETURN . AND RETURN 08610000 USING PCB,15 08620000 EJECT 08630000 *********************************************************************** 08640000 * * 08650000 * XN ROUTINE * 08660000 * * 08670000 * FUNCTION: TO FIND THE PCB FOR A PROCESS GIVEN ITS NAME ONLY * 08680000 * DATABASES: UPON ENTRY, REGISTER 2 CONTAINS ADDRESS XNX * 08690000 * XNX DS 0D * 08700000 * XNXNAME DS CL8 NAME OF PROCESS * 08710000 * XNXADDR DS A ADDRESS OF PCB * 08720000 * ROUTINES USED: NONE * 08730000 * PROCEDURE: SEARCH THIS GROUP PCB CHAIN FOR NAME; IF FOUND, * 08740000 * STORE POINTER IN XNXADDR. IF NOT FOUND, STORE * 08750000 * ZERO IN XNXADDR; RETURN. * 08760000 * ERROR CHECKS: NONE * 08770000 * INTERRUPTS: OFF * 08780000 * USER ACCESS: YES * 08790000 * * 08800000 *********************************************************************** 08810000 SPACE 1 08820000 XN EQU * . THE XN ROUTINE: FIND A NAMED PCB 08830000 USING *,1 08840000 USING XNX,2 . THE ARG LIST 08850000 LR 10,15 . FIRST PCB TO LOOK AT IS OURS 08860000 DROP 15 08870000 USING PCB,10 08880000 XNXLOOP L 10,PCBNPTG . LOOK AT NEXT PCB 08890000 CLC PCBNAME,XNXNAME . HAS IT THE RIGHT NAME? 08900000 BE XNXFOUND . IF YES, OH JOY. 08910000 CR 10,15 . IF NOT, ARE WE THROUGH? 08920000 BNE XNXLOOP . IF NOT, TRY THE NEXT PCB 08930000 LA 10,0 . ELSE, IT'S NOT HERE 08940000 XNXFOUND ST 10,XNXADDR . FOUND IT. SAY WHERE. 08950000 LPSW RETURN . AND RETURN 08960000 DROP 2,10 08970000 USING PCB,15 08980000 EJECT 08990000 *********************************************************************** 09000000 * * 09010000 * XR ROUTINE * 09020000 * * 09030000 * FUNCTION: TO READ A MESSAGE * 09040000 * DATABASES: UPON ENTRY, REGISTER 2 CONTAINS ADDRESS XRX * 09050000 * XRX DS 0D * 09060000 * XRXNAME DS CL8 NAME OF SENDER PROCESS * 09070000 * XRXSIZE DS F SIZE OF MESSAGE TEXT * 09080000 * XRXTEXT DS C TEXT OF MESSAGE * 09090000 * ROUTINES USED: XP, XEXC, XN, XCOM, XF * 09100000 * PROCEDURE: USE XP ON MESSAGE SEMAPHORE RECEIVER TO SEE IF ANY * 09110000 * MESSAGES WAITING; IF NONE, PROCESS BLOCKED UNTIL * 09120000 * THERE IS ONE; LOCK MESSAGE CHAIN; REMOVE A MESSAGE * 09130000 * FROM CHAIN AND UNLOCK IT; MOVE TEXT OF MESSAGE, * 09140000 * PADDING WITH BLANKS OR TRUNCATING AS NECESSARY; * 09150000 * INDICATE CORRECT MESSAGE LENGTH AND NAME OF * 09160000 * MESSAGE SENDER; FREE STORAGE USED TO HOLD MESSAGE, * 09170000 * AND RETURN. * 09180000 * ERROR CHECKS: NONE * 09190000 * INTERRUPTS: ON * 09200000 * USER ACCESS: YES * 09210000 * * 09220000 *********************************************************************** 09230000 SPACE 1 09240000 XR EQU * . THE XR ROUTINE: READ A MESSAGE 09250000 USING *,1 09260000 LR 7,2 09270000 USING XRX,7 . ARG LIST 09280000 LA 2,PCBMSR . SEE IF MESSAGES WAITING 09290000 SVC C'P' 09300000 SVC C'!' . ENTER SMC SECTION 09310000 LA 2,PCBMSC . THEN LOCK THE MESSAGE CHAIN 09320000 SVC C'P' 09330000 L 5,PCBFM . GET THE FIRST MESSAGE 09340000 USING MSG,5 09350000 MVC PCBFM,MSGNEXT . REMEMBER THE NEXT 09360000 SVC C'V' . UNLOCK THE MESSAGE CHAIN 09370000 L 6,XRXSIZE . GET THE BUFFER CAPACITY 09380000 S 6,=F'2' . MINUS 1, MINUS 1 09390000 MVI XRXTEXT,C' ' . MOVE IN A BLANK 09400000 BM XRNOB 09410000 EX 6,XRFILL . THEN FILL THE REST WITH BLANKS 09420000 XRNOB LA 6,1(6) . THEN GET PROPER BUFFER COUNT 09430000 C 6,MSGSIZE . COMPARE WITH MESSAGE LENGTH 09440000 BL XRTHEN . IF LESS, HANDLE ACCORDINGLY 09450000 L 6,MSGSIZE . ELSE COUNT FOR MVC IS MESSAGE 09460000 BCTR 6,0 . SIZE MINUS ONE 09470000 XRTHEN LTR 6,6 . ANY CHARACTERS TO MOVE? 09480000 BM XRAFT . IF NOT, DON'T 09490000 EX 6,XRMOVE . ELSE MOVE THEM 09500000 XRAFT LA 6,1(6) . THEN GET LENGTH 09510000 ST 6,XRXSIZE . STORE IT 09520000 L 10,MSGSENDR . GET SENDER'S PCB 09530000 DROP 15 09540000 USING PCB,10 09550000 MVC XRXNAME,PCBNAME . AND STORE SENDER'S NAME 09560000 L 6,MSGSIZE . GET SIZE OF MESSAGE TEXT 09570000 LA 6,LENMSG(6) . ADD SIZE OF MESSAGE BLOCK 09580000 LA 6,7(6) . AND TRUNCATE 09590000 N 6,=F'-8' . UP 09600000 LR 2,5 . SET UP POINTER TO XFX 09610000 USING XFX,2 09620000 ST 5,XFXADDR . STORE ADDRESS 09630000 ST 6,XFXSIZE . STORE SIZE 09640000 SVC C'F' . AND FREE THE MESSAGE BLOCK 09650000 SVC C',' . LEAVE SMC 09660000 LPSW RETURN . AND RETURN 09670000 XRFILL MVC XRXTEXT+1,XRXTEXT . FILL WITH BLANKS 09680000 XRMOVE MVC XRXTEXT,MSGTEXT . MOVE TEXT 09690000 DROP 2,5,7,10 09700000 USING PCB,15 09710000 SPACE 3 09720000 *********************************************************************** 09730000 * * 09740000 * XS ROUTINE * 09750000 * * 09760000 * FUNCTION: TO SEND A MESSAGE * 09770000 * DATABASES: UPON ENTRY, REGISTER 2 CONTAINS ADDRESS XSX * 09780000 * XSX DS 0D * 09790000 * XSXNAME DS CL8 NAME OF TARGET PROCESS * 09800000 * XSXSIZE DS F SIZE OF TEXT * 09810000 * XSXTEXT DS C TEXT OF MESSAGE * 09820000 * ROUTINES USED: XP, XV, XEXC, XCOM, XA, XQUE * 09830000 * PROCEDURE: USE XN TO GET POINTER TO PCB OF TARGET PROCESS; * 09840000 * USE LENGTH OF MESSAGE AND XA TO ALLOCATE BLOCK FOR * 09850000 * MESSAGE; LOCK MESSAGE CHAIN OF TARGET PROCESS; * 09860000 * PUT MESSAGE BLOCK AT END OF CHAIN; STORE SENDER * 09870000 * NAME, SIZE, AND TEXT OF MESSAGE; UNLOCK CHAIN; * 09880000 * INDICATE MESSAGE CHAIN IS ONE LONGER; RETURN. * 09890000 * ERROR CHECKS: IF NO PROCESS BY GIVEN NAME, ENTER XQUE. * 09900000 * INTERRUPTS: ON * 09910000 * USER ACCESS: YES * 09920000 * * 09930000 *********************************************************************** 09940000 SPACE 1 09950000 XS EQU * . THE XS ROUTINE: SEND MESSAGES 09960000 USING *,1 09970000 LR 7,2 09980000 USING XSX,7 . ARG LIST 09990000 LA 2,SATEMP . READY TO CALL OUT 10000000 USING XNX,2 . ABOUT TO CALL XN 10010000 MVC XNXNAME,XSXNAME . GIVE NAME OF TARGET PROCESS 10020000 SVC C'N' . SEE WHERE IT IS 10030000 L 4,XNXADDR . GET THE POINTER 10040000 LTR 4,4 . IS THERE INDEED ONE? 10050000 BZ XSERR . IF NOT, ERROR 10060000 USING PCB,4 10070000 DROP 2,15 10080000 USING XAX,2 . READY TO CALL XA 10090000 SVC C'!' . ENTERING SMC SECTION 10100000 L 3,XSXSIZE . GET THE STATED SIZE 10110000 LA 3,LENMSG(3) . PLUS THE AMOUNT OF OVERHEAD 10120000 LA 3,7(3) . AND TRUNCATE 10130000 N 3,=F'-8' . UP 10140000 ST 3,XAXSIZE . THAT'S THE SIZE OF THE REGION TO 10150000 MVC XAXALGN,=F'8' . ALLOCATE, ON A DOUBLEWORD BOUND 10160000 SVC C'A' . SO ALLOCATE ALREADY 10170000 L 5,XAXADDR . GET THE ADDRESS 10180000 DROP 2 10190000 LA 2,PCBMSC . GET THE MESSAGE CHAIN SEMAPHORE 10200000 SVC C'P' . AND LOCK IT 10210000 LA 8,PCBFM . THEN START DOWN THE MESSAGE 10220000 L 9,PCBFM . CHAIN 10230000 USING MSG,9 10240000 XSLOOP LTR 9,9 . ARE WE THROUGH? 10250000 BZ XSADD . IF SO ADD IT ON 10260000 LA 8,MSGNEXT . IF NOT, ON TO THE NEXT 10270000 L 9,MSGNEXT 10280000 B XSLOOP . AND TRY AGAIN 10290000 XSADD ST 5,0(8) . CHAIN OURS ON THE END 10300000 DROP 9 10310000 USING MSG,5 10320000 MVC MSGNEXT,=A(0) . SET NEXT POINTER NULL 10330000 ST 15,MSGSENDR . STORE THE SENDER 10340000 L 6,XSXSIZE . GET THE TEXT LENGTH 10350000 ST 6,MSGSIZE . AND STORE IT 10360000 BCTR 6,0 . ONE LESS 10370000 LTR 6,6 . TEST LENGTH 10380000 BM XSAFT . IF ZERO, NOTHING TO MOVE 10390000 EX 6,XSMOVE . ELSE, MOVE IT 10400000 XSAFT SVC C'V' . UNLOCK THE MESSAGE CHAIN 10410000 LA 2,PCBMSR . THEN SAY THERE'S 10420000 SVC C'V' . ONE MORE MESSAGE 10430000 SVC C',' . LEAVE SMC SECTION 10440000 LPSW RETURN . AND RETURN 10450000 XSERR SVC C'?' 10460000 XSMOVE MVC MSGTEXT,XSXTEXT . THE MOVE FOR THE TEXT 10470000 DROP 4,5,7 10480000 USING PCB,15 10490000 EJECT 10500000 *********************************************************************** 10510000 * * 10520000 * XY ROUTINE * 10530000 * * 10540000 * FUNCTION: TO START A PROCESS * 10550000 * DATABASES: UPON ENTRY, REGISTER 2 CONTAINS ADDRESS XYX * 10560000 * XYX DS 0D * 10570000 * XYXNAME DS CL8 NAME OF PROCESS TO BE STARTED * 10580000 * XYXADDR DS A STARTING ADDRESS OF PROCESS * 10590000 * ROUTINES USED: XN, XEXC, XCOM, XQUE * 10600000 * PROCEDURE: USE XN TO GET POINTER TO THE PCB OF PROCESS TO BE * 10610000 * STARTED; STORE IN PCB INTERRUPT SAVE AREA REGISTERS* 10620000 * AND PSW WITH STARTING ADDRESS AS SENT FROM STARTING* 10630000 * PROCESS; STOPPED BIT TURNED OFF; RETURN. * 10640000 * ERROR CHECKS: IF NO PROCESS BY GIVEN NAME, XQUE ENTERED. * 10650000 * INTERRUPTS: OFF * 10660000 * USER ACCESS: YES * 10670000 * * 10680000 *********************************************************************** 10690000 SPACE 1 10700000 XY EQU * . THE XY ROUTINE: START A PROCESS 10710000 USING *,1 10720000 LR 7,2 10730000 USING XYX,7 . THE ARG LIST 10740000 LA 2,SATEMP . READY TO CALL OUT 10750000 USING XNX,2 10760000 MVC XNXNAME,XYXNAME . GIVE XN A NAME 10770000 SVC C'N' . CALL XN 10780000 L 10,XNXADDR . WHERE IS THE PCB? 10790000 LTR 10,10 . OR IS THERE ONE? 10800000 BZ XYERR . IF NOT, OH HISS BOO 10810000 DROP 2,14,15 10820000 USING PCB,10 10830000 LA 13,PCBISA . GET INTO THAT PCB'S ISA 10840000 USING SA,13 10850000 MVC SAPSW,(SAPSW-SA)(14) . GIVE IT THE CALLER'S PSW 10860000 MVC SAPSW+5(3),XYXADDR+1 . BUT AT THE REQUESTED ADDRESS 10870000 MVC SAREGS,(SAREGS-SA)(14) .GIVE IT HIS REGISTERS 10880000 MVI PCBSTOPT,X'00' . IT'S NO LONGER STOPPED 10890000 LPSW RETURN . AND RETURN 10900000 XYERR SVC C'?' . WE DONE BAD 10910000 DROP 7,10,13 10920000 USING SA,14 10930000 USING PCB,15 10940000 EJECT 10950000 *********************************************************************** 10960000 * * 10970000 * XZ ROUTINE * 10980000 * * 10990000 * FUNCTION: TO STOP A PROCESS * 11000000 * DATABASES: UPON ENTRY, REGISTER 2 CONTAINS ADDRESS XZX * 11010000 * XZX DS 0D * 11020000 * XZXNAME DS CL8 NAME OF PROCESS TO BE STOPPED * 11030000 * ROUTINES USED: XN, XEXC, XCOM, XQUE, XP * 11040000 * PROCEDURE: CHECK THAT USER PROCESS CAN'T STOP SYSTEM * 11050000 * PROCESS; USE XN TO GET PCB POINTER; IF IN SMC, SET * 11060000 * STOP WAITING BIT AND BLOCK SELF UNTIL STOP * 11070000 * PERFORMED; ELSE SET STOPPED BIT, AND RETURN. * 11080000 * ERROR CHECKS: IF NO PROCESS BY GIVEN NAME OR USER TRIES TO * 11090000 * STOP A SYSTEM PROCESS, XQUE ENTERED. * 11100000 * INTERRUPTS: ON * 11110000 * USER ACCESS: YES * 11120000 * * 11130000 *********************************************************************** 11140000 SPACE 1 11150000 XZ EQU * . THE XZ ROUTINE: STOP A PROCESS 11160000 USING *,1 11170000 LR 7,2 11180000 USING XZX,7 . ARG LIST 11190000 CLI PCBNAME,C'*' . IS STOPPER A * PROCESS 11200000 BE XZFINE . THAT'S OK 11210000 CLI XZXNAME,C'*' . IF NOT, IS STOPPEE A * ? 11220000 BE XZERR . CAN'T DO THAT 11230000 XZFINE LA 2,SATEMP . READY TO CALL OUT 11240000 USING XNX,2 . WILL CALL XN 11250000 MVC XNXNAME,XZXNAME . GIVE IT THE NAME 11260000 SVC C'N' . AND DO THE CALL 11270000 L 10,XNXADDR . GET THE PCB'S ADDRESS 11280000 LTR 10,10 . SEE IF NULL 11290000 BZ XZERR . IF SO, ERROR 11300000 SVC C'!' . ENTER SMC 11310000 DROP 2,15 11320000 USING PCB,10 11330000 XZSTOP CLI PCBINSMC,X'00' . SEE IF IN SMC 11340000 BNE XZINSMC . IF SO, BAD 11350000 MVI PCBSTOPT,X'FF' . ELSE JUST STOP IT 11360000 SVC C',' . LEAVE SMC 11370000 LPSW RETURN . AND RETURN 11380000 XZINSMC MVI PCBSW,X'FF' . IF IN SMC, SAY STOP WAITING 11390000 LA 2,PCBSRS . AND STOP OURSELVES AGAINST 11400000 SVC C'P' . A SEMAPHORE 11410000 B XZSTOP . THEN WE CAN REALLY STOP IT 11420000 XZERR SVC C'?' . AN ERROR 11430000 DROP 10,7 11440000 USING PCB,15 11450000 EJECT 11460000 *********************************************************************** 11470000 * * 11480000 * XQUE ROUTINE * 11490000 * * 11500000 * FUNCTION: TO SIGNAL ERROR CONDITION * 11510000 * DATABASES: NONE * 11520000 * ROUTINES USED: XR, XS * 11530000 * PROCEDURE: SEND MESSAGE TO SUPERVISOR PROCESS FOR THIS JOB * 11540000 * INDICATING ABNORMAL TERMINATION; TRY TO READ * 11550000 * MESSAGES, FOREVER LOOPING; BLOCK ITSELF, THEREBY * 11560000 * NEVER RETURNING. * 11570000 * ERROR CHECKS: NONE * 11580000 * INTERRUPTS: OFF * 11590000 * USER ACCESS: YES * 11600000 * * 11610000 *********************************************************************** 11620000 SPACE 1 11630000 XQUE EQU * . THE XQUE ROUTINE: ERROR! 11640000 USING *,1 11650000 LA 2,XQUEM1 . SEND AN ERROR MESSAGE TO *IBSUP 11660000 SVC C'S' 11670000 XQUELOOP LA 2,XQUEM2 . WAIT FOR REPLY 11680000 SVC C'R' 11690000 B XQUELOOP . BUT IGNORE IT 11700000 DS 0F 11710000 XQUEM1 DC CL8'*IBSUP' 11720000 DC F'12' 11730000 DC CL12'PROGRAM FLOP' 11740000 XQUEM2 DS CL8 11750000 DC F'1' 11760000 DS CL1,0H 11770000 DROP 14,15 11780000 EJECT 11790000 *********************************************************************** 11800000 * * 11810000 * INPUT/OUTPUT ROUTINES * 11820000 * * 11830000 *********************************************************************** 11840000 SPACE 1 11850000 *********************************************************************** 11860000 * * 11870000 * SYSTEM SUPPLIED DEVICE HANDLER FOR READERS * 11880000 * * 11890000 *********************************************************************** 11900000 SPACE 1 11910000 RDRHANDL EQU * . THE READER HANDLER 11920000 USING UCB,3 . STARTED WITH REG3 -> UCB 11930000 BALR 1,0 11940000 USING *,1 . ESTABLISH ADDRESSING 11950000 LA 2,RDRHSEM . LOCK OURSELVES UNTIL WE SET UP 11960000 SVC C'P' . AN AUTOMATIC STORAGE AREA 11970000 LA 2,RDRHAAS . READY TO ALLOCATE 11980000 USING XAX,2 11990000 SVC C'E' . ALLOCATE 12000000 L 12,XAXADDR . GET A PTR 12010000 DROP 2 12020000 LA 2,RDRHSEM . AND UNBLOCK OURSELVES 12030000 SVC C'V' 12040000 SRL 4,16 . SHIFT KEY 12050000 SR 10,10 . CLEAR REG 10 12060000 USING RDRHAS,12 . AUTOMATIC AREA 12070000 MVI JOBBIT,X'00' . INITIALIZE 12080000 LA 6,RDRHCCB . GET PTR TO CCB 12090000 RDRHLOOP LA 2,RDRHMSG . TRY TO READ A MESSAGE 12100000 USING XRX,2 12110000 MVC XRXSIZE,=F'8' . WE CAN TAKE 8 CHARS 12120000 SVC C'R' . READ IT 12130000 CLC =C'READ',XRXTEXT . IF FIRST WORD IS READ, OK 12140000 BNE RDRHLOOP . ELSE IGNORE 12150000 L 5,XRXTEXT+4 . GET 2ND WORD OF TEXT 12160000 DROP 2 12170000 LA 2,UCBUS . LOCK THE UCB AND IT'S UNIT 12180000 SVC C'P' 12190000 LA 2,RDRHMSG . RESET ADDRESSING POINTER 12200000 USING XRX,2 12210000 CLI JOBBIT,X'FF' . HAVE WE JUST READ $JOB CARD? 12220000 BNE RDRHMORE . IF NO, GO CHECK PROTECTION, ELSE 12230000 CLI XRXNAME,C'*' . IS JSP CALLING US? 12240000 BNE RDRHNO . IF NOT, TELL HIM NO. 12250000 MVC 0(80,5),RDRHTEMP . IF IT IS, GIVE JSP THE $JOB CARD 12260000 MVI JOBBIT,X'00' . SAY WE DON'T HAVE $JOB WAITING 12270000 B RDRHSOK . AND SEND MESSAGE BACK 12280000 DROP 2 12290000 RDRHMORE CLI RDRHMSG,C'*' . IS SYSTEM CALLING? 12300000 BE RDRHPOK . THEN PROTECTION OK, ELSE 12310000 LR 11,5 . GET ADDRESS THAT'S TO HOLD CARD, 12320000 N 11,PROTCON1 . get the page boundary 12330002 * ISKE 10,11 . find storage key 12334002 DC X'B22900AB' Assembler (XF) doesn't support ISKE 12338002 N 10,PROTCON2 . ignore low order bits 12342002 CR 10,4 . DOES IT MATCH OURS? 12350000 BNE RDRHNO . IF NOT, TELL HIM NO 12360000 LA 11,79(5) . CHECK LAST BYTE ADDR OF CARD 12370000 N 11,PROTCON1 . get the page boundary 12380002 * ISKE 10,11 . find storage key 12384002 DC X'B22900AB' Assembler (XF) doesn't support ISKE 12388002 N 10,PROTCON2 . ignore low order bits 12392002 CR 10,4 . DOES IT MATCH OURS? 12400000 BNE RDRHNO . IF NOT, TELL HIM NO 12410000 RDRHPOK N 5,CCBCON1 . MAKE ADDRESS INTO 12420000 ST 5,RDRHCCB . A CCW (OR CCB) 12430000 OI RDRHCCB,X'02' 12440000 MVC RDRHCCB+4,=F'80' . WE'LL READ EIGHTY CHARACTERS 12450000 MVC UCBCSW(4),=A(0) . CLEAR THE LAST CSW THERE 12460000 MVC UCBCSW+4(4),=A(0) 12470000 LA 2,CAWSEM . LOCK THE CAW 12480000 SVC C'P' 12490000 ST 6,CAW . THAT'S THE CAW 12500000 L 7,UCBADDR . GET THE UNIT ADDRESS 12510000 SIO 0(7) . START THE I/O 12520000 BNZ RDSTATUS . BRANCH IF SIO UNSUCCESSFUL 12530000 SVC C'V' . THEN UNLOCK THE CAW 12540000 RDRHWAIT LA 2,UCBWS . NOW WAIT FOR AN INTERRUPT 12550000 SVC C'P' 12560000 TM UCBCSW+4,X'85' . CHECK THE STATUS 12570003 BZ RDRHWAIT . IF NOT FINISHED, WAIT 12580000 TM UCBCSW+4,X'01' . CHECK FOR EXCEPTION 12590000 BO RDRHEXC . if yes, ignore this interrupt 12600003 TM UCBCSW+4,X'80' . if no, check for attention 12602003 BO RDRHPOK . if yes, try to restart the I/O 12604003 B RDRHOK . else, all is groovy 12606003 RDRHEXC NI UCBCSW+4,X'FE' . clear exception .. 12608003 B RDRHWAIT . .. and continue waiting 12610003 RDRHNO MVC RDRHM+12(2),=C'NO' . message back is no 12612003 B RDRHSEND . GET READY TO SEND 12620000 RDRHOK CLI RDRHMSG,C'*' . IS THE SYSTEM CALLING? 12630000 BE RDRHSOK . THAT'S FINE. OTHERWISE, 12640000 CLC =C'$JOB,',0(5) . WAS IT A $JOB CARD? 12650000 BE ENDADATA . OOPS! WE HIT END OF DATA STREAM 12660000 RDRHSOK MVC RDRHM+12(2),=C'OK' .GROOVINESS MESSAGE 12670000 RDRHSEND MVC RDRHM+8(4),=F'2' . SAY THERE ARE 2 CHARACTERS 12680000 MVC RDRHM+0(8),RDRHMSG+0 . SEND BACK TO SAME GUY 12690000 LA 2,UCBUS . NOW UNLOCK UCB AND UNIT 12700000 SVC C'V' 12710000 LA 2,RDRHM . SET UP MESSAGE 12720000 SVC C'S' . AND SEND IT 12730000 B RDRHLOOP 12740000 ENDADATA MVC RDRHM+12(2),=C'NO' . TELL USER NO MORE CARDS 12750000 MVC RDRHTEMP(80),0(5) . SAVE THE $JOB CARD 12760000 MVI 0(5),C' ' . BLANK OUT THE USER'S COPY 12770000 MVC 1(79,5),0(5) 12780000 MVI JOBBIT,X'FF' . INDICATE WE HAVE A NEW $JOB CARD 12790000 B RDRHSEND . AND SEND THE MESSAGE BACK 12800000 RDSTATUS SVC C'V' . UNLOCK THE CAW 12810000 LA 2,UCBWS . AND WAIT FOR AN INTERRUPT 12820000 SVC C'P' 12830000 B RDRHPOK . AND TRY TO RESTART THE I/O 12840000 DROP 3,12 12850000 SPACE 1 12860000 RDRHSEM DC F'1,0' 12870000 CCBCON1 DC X'00FFFFFF' MASK 12880000 PROTCON1 DC X'00FFF000' page alignment 12890002 PROTCON2 DC X'FFFFFFF0' ignore low order bits 12893002 RDRHAAS DC A(LENRDRHA) ALLOCATE ARGLIST FOR STORAGE 12900000 DC F'0' 12910000 DC F'8' 12920000 SPACE 3 12930000 *********************************************************************** 12940000 * * 12950000 * SYSTEM SUPPLIED DEVICE HANDLER FOR PRINTERS * 12960000 * * 12970000 *********************************************************************** 12980000 SPACE 1 12990000 PRTHANDL EQU * . THE PRINTER HANDLER 13000000 USING UCB,3 . ENTERED WITH REG3 -> THE UCB 13010000 BALR 1,0 13020000 USING *,1 . ESTABLISH ADDRESSING 13030000 LA 2,PRTHSEM . LOCK UNTIL ALLOCATE STORAGE 13040000 SVC C'P' . 13050000 LA 2,PRTHAAS . READY TO ALLOCATE 13060000 USING XAX,2 13070000 SVC C'E' . ALLOCATE 13080000 L 12,XAXADDR . GET THE ADDRESS 13090000 DROP 2 13100000 LA 2,PRTHSEM . 13110000 SVC C'V' UNLOCK TO ROUTINE 13120000 SRL 4,16 . SHIFT KEY 13130000 SR 10,10 . CLEAR REG 10 13140000 USING PRTHAS,12 . ADDRESSING IN THE AUTO AREA 13150000 LA 6,PRTHCCB . MAKE A CAW 13160000 PRTHLOOP LA 2,PRTHMSG . READY TO READ A MESSAGE 13170000 USING XRX,2 13180000 MVC XRXSIZE,=F'8' . WE CAN TAKE 8 CHARACTERS 13190000 SVC C'R' . READ IT 13200000 L 5,XRXTEXT+4 . LOAD THE ADDRESS 13210000 CLC =C'PRIN',XRXTEXT . IS IT A PRIN REQUEST? 13220000 BE PRTHPRIN 13230000 CLC =C'STC1',XRXTEXT . OR A SKIP REQUEST? 13240000 BE PRTHSTC1 13250000 B PRTHLOOP . IF NEITHER, IGNORE 13260000 DROP 2 13270000 PRTHPRIN LA 2,UCBUS 13280000 SVC C'P' . LOCK THE UCB AND UNIT 13290000 CLI PRTHMSG,C'*' . IS SYSTEM CALLING? 13300000 BE PRTHPOK . THEN PROTECTION OK. ELSE 13310000 LR 11,5 . GET ADDRESS THAT'S TO HOLD MSG, 13320000 N 11,PROTCON1 . get the page boundary 13330002 * ISKE 10,11 . find storage key 13334002 DC X'B22900AB' Assembler (XF) doesn't support ISKE 13338002 N 10,PROTCON2 . ignore low order bits 13342002 CR 10,4 . DOES IT MATCH OURS? 13350000 BNE PRTHNO . IF NOT, TELL HIM NO 13360000 LA 11,131(5) . CHECK LAST BYTE ADDRESS OF LINE 13370000 N 11,PROTCON1 . get the page boundary 13380002 * ISKE 10,11 . find storage key 13384002 DC X'B22900AB' Assembler (XF) doesn't support ISKE 13388002 N 10,PROTCON2 . ignore low order bits 13392002 CR 10,4 . DOES IT MATCH OURS? 13400000 BNE PRTHNO . IF NOT, TELL HIM NO 13410000 PRTHPOK N 5,CCBCON1 . MAKE A WRITE REQUEST 13420000 ST 5,PRTHCCB . FOR THE CCB 13430000 OI PRTHCCB,X'09' . PRINT COMMAND CODE 13440000 MVC PRTHCCB+4,=F'132' . WE'LL PRINT 132 CHARACTERS 13450000 B PRTHCOMM . BRANCH TO COMMON SECTION 13460000 PRTHSTC1 MVC PRTHCCB(8),=X'8900000020000001' SKIP TO TOP OF PAGE 13470000 LA 2,UCBUS 13480000 SVC C'P' . LOCK THE UCB AND UNIT 13490000 PRTHCOMM LA 2,CAWSEM . LOCK THE CAW 13500000 SVC C'P' 13510000 ST 6,CAW . STORE OUR CAW 13520000 MVC UCBCSW(4),=A(0) . CLEAR THE LAST CSW THERE 13530000 MVC UCBCSW+4(4),=A(0) 13540000 L 7,UCBADDR . GET THE ADDRESS 13550000 SIO 0(7) . START THE I/O 13560000 BNZ PTSTATUS . BRANCH IF SIO UNSUCCESSFUL 13570000 SVC C'V' . AND UNLOCK THE CAW 13580000 PRTHWAIT LA 2,UCBWS . START TO WAIT 13590000 SVC C'P' 13600000 TM UCBCSW+4,X'05' . IS THE UNIT READY? 13610000 BZ PRTHWAIT . IF NOT, ITS STILL ON. WAIT 13620000 TM UCBCSW+4,X'01' . WAS THERE AN EXCEPTION? 13630000 BZ PRTHOK . IF NOT, GOOD 13640000 PRTHNO MVC PRTHM+12(2),=C'NO' .THERE WAS, SO SAY SO 13650000 B PRTHSEND 13660000 PRTHOK MVC PRTHM+12(2),=C'OK' .NO ERRORS 13670000 PRTHSEND MVC PRTHM+8(4),=F'2' . SENDING 2 CHARACTERS 13680000 MVC PRTHM+0(8),PRTHMSG+0 . SEND TO OUR SENDER 13690000 LA 2,UCBUS 13700000 SVC C'V' . UNLOCK THE UCB 13710000 LA 2,PRTHM 13720000 SVC C'S' . SEND IT 13730000 B PRTHLOOP . AND READ ANOTHER MESSAGE 13740000 PTSTATUS SVC C'V' . UNLOCK THE CAW 13750000 LA 2,UCBWS . AND WAIT FOR THE INTERRUPT 13760000 SVC C'P' 13770000 B PRTHCOMM . AND TRY TO RESTART THE I/O 13780000 DROP 3,12 13790000 SPACE 2 13800000 PRTHSEM DC F'1,0' LOCK 13810000 PRTHAAS DC A(LENPRTHA) XA ARG LIST FOR AUTO STORAGE 13820000 DC F'0' 13830000 DC F'8' 13840000 EJECT 13850000 *********************************************************************** 13860000 * * 13870000 * SYSTEM ROUTINE FOR USER SUPPLIED DEVICE HANDLER * 13880000 * * 13890000 *********************************************************************** 13900000 SPACE 1 13910000 EXCPHNDL EQU * . EXCP DEVICE HANDLER 13920000 USING UCB,3 . WILL HAVE REG3 -> UCB 13930000 BALR 1,0 13940000 USING *,1 . ESTABLISH ADDRESSING 13950000 LA 2,EXCPHSEM . LOCK OURSELVES UNTIL WE HAVE 13960000 SVC C'P' . SET UP AUTOMATIC STORAGE 13970000 LA 2,EXCPHAAS . READY TO ALLOCATE 13980000 USING XAX,2 13990000 SVC C'E' . ALLOCATE 14000000 L 12,XAXADDR . GET POINTER TO AUTO STORAGE 14010000 DROP 2 14020000 LA 2,EXCPHSEM . AND UNLOCK OURSELVES 14030000 SVC C'V' UNLOCK TO ROUTINE 14040000 LR 4,11 14050000 SLL 4,8 . SHIFT KEY FOR CAW 14060000 USING EXCPHAS,12 . FOR ADDRESSING AUTO AREA 14070000 EXCPLOOP LA 2,EXCPHMSG . TRY TO READ A MESSAGE 14080000 USING XRX,2 14090000 MVC XRXSIZE,=F'12' . WE'LL TAKE 12 CHARACTERS 14100000 SVC C'R' 14110000 CLC =C'EXCP',XRXTEXT . IS IT AN EXCP MESSAGE? 14120000 BNE EXCPLOOP . IF NOT, IGNORE IT 14130000 L 5,XRXTEXT+4 . REG 5 CONTAINS CHAN AND DEV 14140000 L 6,XRXTEXT+8 . REG 6 CONTAINS ADDR OF CCWS 14150000 DROP 2 14160000 LA 7,UCBTABLE . GET PTR TO UCB TABLE 14170000 EXCPCOMP C 5,0(7) . COMPARE UNIT ADDRESS 14180000 BE EXCPFIND . THAT'S THE UCB WE WANT 14190000 LA 7,UCBLENG(7) . GET PTR TO NEXT UCB 14200000 C 7,=A(UCBTBEND) . ARE WE THROUGH WITH TABLE? 14210000 BNE EXCPCOMP . IF NOT, LOOK SOME MORE 14220000 SVC C'?' . ELSE ERROR 14230000 EXCPFIND LR 3,7 . SET REG 3 TO UCB PTR 14240000 LA 2,UCBUS 14250000 SVC C'P' . LOCK THE UCB 14260000 OR 6,4 . OR IN THE USER'S KEY 14270000 MVC UCBCSW(4),=A(0) . CLEAR THE LAST CSW THERE 14280000 MVC UCBCSW+4(4),=A(0) 14290000 LA 2,CAWSEM 14300000 SVC C'P' . LOCK CAW 14310000 ST 6,CAW . STORE OUR CAW 14320000 SIO 0(5) . START THE I/O 14330000 SVC C'V' . UNLOCK THE CAW 14340000 EXCPWAIT LA 2,UCBWS . NOW WAIT FOR AN INTERRUPT 14350000 SVC C'P' 14360000 MVC EXCPHM+12(8),UCBCSW . GIVE USER HIS CSW 14370000 MVC EXCPHM+8(4),=F'12' 14380000 MVC EXCPHM(8),EXCPHMSG 14390000 LA 2,EXCPHM 14400000 SVC C'S' . AND SENT THE MESSAGE 14410000 LA 2,EXCPHMSG . AND WAIT FOR A REPLY 14420000 USING XRX,2 14430000 MVC XRXSIZE(4),=F'8' . FROM THE USER 14440000 SVC C'R' 14450000 CLC =C'OK',XRXTEXT . AM I DONE? 14460000 BE EXCPDONE 14470000 CLC =C'AGAIN',XRXTEXT . DOES HE WANT ANOTHER CSW? 14480000 BE EXCPWAIT 14490000 SVC C'?' . WRONG MESSAGE 14500000 DROP 2 14510000 EXCPDONE LA 2,UCBUS . UNLOCK UNIT 14520000 SVC C'V' 14530000 B EXCPLOOP . AND GET ANOTHER MESSAGE 14540000 DROP 3,12 14550000 EXCPHSEM DC F'1,0' 14560000 EXCPHAAS DC A(LENEXCPA) . ALLOCATION OF AUTO STORAGE 14570000 DC F'0' 14580000 DC F'8' 14590000 SPACE 3 14600000 LTORG 14610000 EJECT 14620000 *********************************************************************** 14630000 * * 14640000 * UNIT CONTROL BLOCKS * 14650000 * * 14660000 *********************************************************************** 14670000 SPACE 1 14680000 UCBTABLE DS 0F . TABLE OF UNIT CONTROL BLOCKS 14690000 * UCB FOR READER 1 14700000 UCBRDR1 DC X'00000012' . DEVICE ADDRESS, 14710000 DC F'1,0' . USER SEMAPHORE, 14720000 DC F'0,0' . WAIT SEMAPHORE, 14730000 DC F'0,0' . CHANNEL STATUS WORD 14740000 DC X'00' 14750000 DS 0F 14760000 * UCB FOR PRINTER 1 14770000 UCBPRT1 DC X'00000010' . DEVICE ADDRESS, 14780000 DC F'1,0' . USER SEMAPHORE, 14790000 DC F'0,0' . WAIT SEMAPHORE, 14800000 DC F'0,0' . CHANNEL STATUS WORD 14810000 DC X'00' 14820000 DS 0F 14830000 * UCB FOR READER 2 14840000 UCBRDR2 DC X'0000000C' . DEVICE ADDRESS, 14850000 DC F'1,0' . USER SEMAPHORE, 14860000 DC F'0,0' . WAIT SEMAPHORE, 14870000 DC F'0,0' . CHANNEL STATUS WORD 14880000 DC X'00' 14890000 DS 0F 14900000 * UCB FOR PRINTER 2 14910000 UCBPRT2 DC X'0000000E' . DEVICE ADDRESS, 14920000 DC F'1,0' . USER SEMAPHORE, 14930000 DC F'0,0' . WAIT SEMAPHORE, 14940000 DC F'0,0' . CHANNEL STATUS WORD 14950000 DC X'00' 14960000 DS 0F 14970000 * UCB for READER 3 14970302 UCBRDR3 DC X'00000112' . device address, 14970602 DC F'1,0' . user semaphore, 14970902 DC F'0,0' . wait semaphore, 14971202 DC F'0,0' . channel status word 14971502 DC X'00' 14971802 DS 0F 14972102 * UCB for PRINTER 3 14972402 UCBPRT3 DC X'00000110' . device address, 14972702 DC F'1,0' . user semaphore, 14973002 DC F'0,0' . wait semaphore, 14973302 DC F'0,0' . channel status word 14973602 DC X'00' 14973902 DS 0F 14974202 * UCB for READER 4 14974502 UCBRDR4 DC X'0000010C' . device address, 14974802 DC F'1,0' . user semaphore, 14975102 DC F'0,0' . wait semaphore, 14975402 DC F'0,0' . channel status word 14975702 DC X'00' 14976002 DS 0F 14976302 * UCB for PRINTER 4 14976602 UCBPRT4 DC X'0000010E' . device address, 14976902 DC F'1,0' . user semaphore, 14977202 DC F'0,0' . wait semaphore, 14977502 DC F'0,0' . channel status word 14977802 DC X'00' 14978102 DS 0F 14978402 * UCB for CONSOLE 1 14978504 UCBCONS1 DC X'00000009' . device address, 14978604 DC F'1,0' . user semaphore, 14978704 DC F'0,0' . wait semaphore, 14978804 DC F'0,0' . channel status word 14978904 DC X'00' 14979004 DS 0F 14979104 UCBTBEND EQU * 14980000 EJECT 14990000 *********************************************************************** 15000000 * * 15010000 * I/O INTERRUPT HANDLER * 15020000 * * 15030000 *********************************************************************** 15040000 SPACE 1 15050000 IOHANDL EQU * . THE I/O INTERRUPT HANDLER 15060000 STM 0,15,IOHSAVE . SAVE REGISTERS 15070000 BALR 1,0 15080000 USING *,1 . ESTABLISH ADRESSING 15090000 NI IOOLD+1,X'FD' . TURN OFF WAIT BIT 15100000 L 6,=A(UCBTABLE) . GET POINTER TO UCB TABLE 15110000 IOCOMP CLC 2(2,6),IOOLD+2 . COMPARE DEVICE AND CHANNEL 15120000 BE IODEVFND . IF EQUAL, REG 6 INDICATES PTR 15130000 LA 6,UCBLENG(6) . INCREMENT TO NEXT ENTRY 15140000 C 6,=A(UCBTBEND) . ARE WE AT END OF TABLE? 15150000 BNE IOCOMP . IF NOT DONE, TRY NEXT UCB 15160000 B IOBACK . ELSE, IGNORE IT 15170000 USING UCB,6 . IT'S A UCB PTR 15180000 IODEVFND MVC UCBCSW(4),CSW . MOVE IN THE NEW CSW 15190000 L 7,CSW+4 . GET STATUS BYTE 15200000 O 7,UCBCSW+4 . OR IN NEW STATUS INFORMATION 15210000 ST 7,UCBCSW+4 . AND STORE IT BACK 15220000 MVC UCBCSW+6(2),CSW+6 . MOVE IN BYTE COUNT 15230000 LA 2,UCBWS 15240000 CLI UCBFPR,X'00' . IS FAST PROCESSING 15250000 BE IONOFPR . REQUIRED? IF NOT, RETURN 15260000 L 15,RUNNING . IF SO, STOP GUY NOW RUNNING 15270000 USING PCB,15 15280000 CLI PCBBLOKT,X'FF' . IS ANYONE REALLY RUNNING? 15290000 BE IOWAIT . IF NOT, START UP SLEEPER 15300000 LA 13,PCBISA . IF SO, STOP RUNNING PROCESS 15310000 USING SA,13 15320000 MVC SAPSW,IOOLD . SAVE PROCESS WHICH WAS 15330000 MVC SAREGS,IOHSAVE . INTERRUPTED 15340000 DROP 13,15 15350000 IOWAIT MVI NEXTTRYM,X'00' . MAKE NEXTTRY NOT MODIFIED 15360000 SVC C'V' . SO CAN FAST PROCESS SLEEPER 15370000 SVC C'.' . GO PROCESS IT RIGHT AWAY 15380000 IONOFPR SVC C'V' . AND WAKE UP THE SLEEPER 15390000 IOBACK LM 0,15,IOHSAVE . RELOAD OUR REGISTERS 15400000 LPSW IOOLD . AND STEALTHILY RETURN 15410000 DROP 1,6 15420000 EJECT 15430000 *********************************************************************** 15440000 * * 15450000 * IPL ENTERED ROUTINE * 15460000 * * 15470000 * FUNCTION: TO INITIALIZE SYSTEM PARAMETERS, SET STORAGE KEYS, * 15480000 * AND CREATE MULTIPLE JOB STREAMS. * 15490000 * * 15500000 *********************************************************************** 15510000 SPACE 1 15520000 IPLRTN EQU * . THE IPL-ENTERED ROUTINE 15530000 BALR 1,0 15540000 USING *,1 . ESTABLISH ADDRESSING 15550000 MVC IONEW+5(3),SOSIONEW activate IO handler 15553002 MVC EXTNEW+5(3),IPLEXNEW ignore external interrupts for now 15556002 LA 15,IPLPCB . I'M RUNNING 15560000 ST 15,RUNNING . INITIALIZE 'RUNNING' 15570000 ST 15,NEXTTRY . INITIALIZE 'NEXTTRY' 15580000 MVC VERYEND,=A(0,CORESIZE-(VERYEND-PROGRAM)) FREE CORE 15590000 LA 3,8 . SET ZERO KEY AND FETCH PROTECT 15600000 L 2,CORESIZ . START PAST THE LAST BLOCK 15610000 IPLCL S 2,PAGESIZE . get the previous block, page aligned 15620002 BM IPLTH . IF NEGATIVE, WE'RE THROUGH HERE 15630000 * SSKE 3,2 . else set the storage key to 15640002 DC X'B22B0032' Assembler (XF) doesn't support SSKE 15643002 B IPLCL . ZERO, AND WORK BACKWARDS 15650000 IPLTH SR 4,4 . INDEX IN TABLES FOR INPUT STREAM 15660000 L 5,STREAMS . HOW MANY STREAMS? 15670000 IPLLOOP LA 2,IPLAPCBS . READY TO ALLOCATE A PCB 15680000 USING XAX,2 15690000 SVC C'A' . ALLOCATE 15700000 L 2,XAXADDR . GET THE ADDRESS 15710000 MVC 0(TYPLEN,2),TYPPCB .MAKE IT LOOK LIKE A PCB 15720000 SVC C'I' . CHAIN IT ON 15730000 USING PCB,2 15740000 ST 2,PCBNPTG . BUT PUT IT IN A GROUP BY ITSELF 15750000 ST 2,PCBLPTG 15760000 DROP 2 15770000 USING PCB,15 15780000 ST 15,PCBLPTG . LIKEWISE FOR THE IPL PCB 15790000 ST 15,PCBNPTG 15800000 DROP 15 15810000 USING PCB,2 15820000 LA 8,PCBISA . GET THE NEW PCB'S ISA 15830000 USING SA,8 15840000 LA 9,SAREGS . ABOUT TO FIX INIT REGS 15850000 USING REGS,9 15860000 LA 10,UCBTAB 15870000 AR 10,4 15880000 MVC REG3,0(10) . REG3 -> (RDRUCB,PRTUCB) 15890000 MVC REG4,KEYTAB-UCBTAB(10) . REG4 = KEY 15900000 DROP 9 15910000 LA 4,4(4) . GO TO NEXT JOB STREAM 15920000 BCT 5,IPLLOOP . DO FOR EACH STREAM 15930000 MVC EXTNEW+5(3),SOSEXNEW reactivate ext interrupt handler 15935002 SVC C'.' . THEN ENTER TRAFFIC CONTROLLER 15940000 SPACE 1 15950000 STREAMS DC F'4' . NUMBER OF STREAMS 15960002 SPACE 1 15970000 UCBTAB EQU * . TABLE OF PTRS TO UCB BLOCKS 15980000 DC A(UCBLP1) 15990000 DC A(UCBLP2) 16000000 DC A(UCBLP3) 16003002 DC A(UCBLP4) 16006002 SPACE 1 16010000 KEYTAB EQU * . TABLE OF PROTECTION KEYS 16020000 DC X'00100000' storage key for stream 1 region 16030002 DC X'00200000' storage key for stream 2 region 16034002 DC X'00300000' storage key for stream 3 region 16038002 DC X'00400000' storage key for stream 4 region 16042002 SPACE 1 16050000 UCBLP1 DC A(UCBRDR1,UCBPRT1) 16060000 UCBLP2 DC A(UCBRDR2,UCBPRT2) 16070000 UCBLP3 DC A(UCBRDR3,UCBPRT3) 16073002 UCBLP4 DC A(UCBRDR4,UCBPRT4) 16076002 SPACE 1 16080000 DS 0D 16090000 IPLPCB DC CL8' ' . IPL ROUTINE PCB 16100000 DC 4A(IPLPCB) 16110000 DC X'FF000000' . INITIALIZED FLAGS 16120000 DC F'1,0' 16130000 DC 5F'0,0' 16140000 DC X'0002000000000000' 16150000 DS CL76 16160000 DS CL84 16170000 DS CL84 16180000 SPACE 1 16190000 IPLAPCBS DC A(LENPCB) . ALLOC LIST FOR PCB'S 16200000 DC A(0) 16210000 DC F'8' 16220000 CORESIZ DC A(CORESIZE) . BYTES OF CORE IN OBJECT MACHINE 16230000 SPACE 1 16240000 DS 0D 16250000 TYPPCB DC CL8'*IBSUP' . A TEMPLATE *IBSUP PCB 16260000 DC 4A(0) 16270000 TEMPLATE DC X'00000000' . INITIALIZED FLAGS 16280000 DC F'1,0' 16290000 DC 5F'0,0' 16300000 DC X'FF00000000',AL3(JSP) 16310000 TYPLEN EQU *-TYPPCB 16320000 EXINTRPT LPSW EXTOLD ignore external interrupts 16321002 DS 0F align 16322002 DC X'00' filler 16323002 SOSIONEW DC AL3(IOHANDL) sample OS IO new PSW instruction addr 16324002 DC X'00' filler 16325002 SOSEXNEW DC AL3(EXTHANDL) sample OS ext new PSW instruction addr 16326002 DC X'00' filler 16327002 IPLEXNEW DC AL3(EXINTRPT) IPLRTN ext new PSW instruction addr 16328002 EJECT 16330000 *********************************************************************** 16340000 * * 16350000 * JOB STREAM PROCESSOR * 16360000 * * 16370000 *********************************************************************** 16380000 SPACE 1 16390000 JSP EQU * . THE JOB STREAM PROCESSOR 16400000 BALR 1,0 . (PROCESS *IBSUP) 16410000 USING *,1 . ESTABLISH ADDRESSING 16420000 LA 2,JSPSUSEM . LOCK OURSELVES UNTIL 16430000 SVC C'P' . WE CAN ALLOCATE STORAGE 16440000 LA 2,JSPAAS . READY TO ALLOCATE 16450000 USING XAX,2 16460000 SVC C'E' . ALLOCATE 16470000 L 12,XAXADDR . PTR TO AUTO AREA 16480000 DROP 2 16490000 USING JSPAS,12 . USE FOR ADDRESSING 16500000 LA 2,JSPSUSEM . UNLOCK OURSELVES 16510000 SVC C'V' 16520000 MVC TREAD+0(8),=CL8'*IN' . INITIALIZE VALUES IN AUTOMATIC 16530000 MVC TREAD+8(4),=F'8' . STORAGE 16540000 MVC TREAD+12(4),=C'READ' 16550000 LA 2,CARD 16560000 ST 2,ACARD 16570000 MVC USERL+0(8),=CL8'USERPROG' 16580000 MVC WRITE(12),SKIP 16590000 MVC WRITE+12(4),=C'PRIN' 16600000 LA 5,LINE 16610000 ST 5,WRITE+16 16620000 MVC CORE+8(4),PAGESIZE align to page boundary 16630002 MVC TALK+0(8),=CL8'USERPROG' 16640000 MVC TALK+8(4),=F'12' 16650000 MVC ANYBACK+8(4),=F'1' 16660000 MVC RLDTEMP,=A(0) 16670000 ST 4,KEY . STORE KEY 16680000 LR 5,3 . GET PTR TO UCB PTR BLOCK 16690000 L 3,0(5) . GET READER POINTER 16700000 LA 2,INSEQ . READY TO CREATE & START *IN 16710000 SVC C'C' . CREATE 16720000 SVC C'Y' . START 16730000 L 3,4(5) . GET PTR TO PRINTER UCB 16740000 LA 2,OUTSEQ . READY TO CREATE & START *OUT 16750000 SVC C'C' . CREATE 16760000 SVC C'Y' . START 16770000 SPACE 1 16780000 LOOP LA 2,TREAD . READT TO READ A CARD 16790000 SVC C'S' . START TO READ 16800000 MVC RREPLY1,=F'132' . 132 CHARS FOR REPLY 16810000 LA 2,RREPLY 16820000 SVC C'R' . LISTEN FOR REPLY 16830000 CLC REPLY(2),=C'OK' . IS REPLY 'OK'? 16840000 BNE STOP . IF NOT, STOP 16850000 CLC =C'$JOB,',CARD . HAVE WE A JOB CARD? 16860000 BE JOB . GOOD! 16870000 B LOOP . ELSE LOOP 16880000 STOP LA 2,JSPNEVER . WAIT FOR A "V" OPERATION 16890000 SVC C'P' . THAT NEVER COMES 16900000 SPACE 1 16910000 JOB MVI LOADED,X'00' . REMEMBER NOT LOADED 16920000 MVC LINE,=CL8' ' . CLEAR A LINE, PUT IN 16930000 MVC LINE+8(124),LINE+7 .ALL BLANKS 16940000 MVC LINE(80),CARD . GET READY TO SEND $JOB CARD 16950000 LA 2,WRITE . TO PRINTER 16960000 SVC C'S' . SEND IT 16970000 LA 2,RREPLY 16980000 SVC C'R' . AND WAIT FOR REPLY 16990000 LA 2,USERL . CREATE USERPROG 17000000 SVC C'C' 17010000 LA 4,CARD+4 . START TO SCAN CARD 17020000 BAL 3,SCAN . GET NEXT TOKEN 17030000 BCTR 5,0 . less one to remove K 17040002 O 5,COREPKLN . length of packed size for execute 17049002 EX 5,COREPACK . pack core digits 17058002 CVB 8,COREPCKD . convert core requested to binary 17067002 SR 9,9 . is core .. 17076002 SRDL 8,2 . .. modulo four .. 17085002 LTR 9,9 . .. equal zero? 17094002 BZ COREOK . -> yes, use it 17103002 LA 8,1(,8) . -> no, up one page 17112002 COREOK SLL 8,12 . core bytes, rounded up to full pages 17121002 ST 8,CORE . remember core requirement 17130002 ASGNUNIT BAL 3,SCAN . GET NEXT TOKEN 17150000 CLI 0(4),C'=' . IS IT AN '='? 17160000 BNE LOAD . IF NOT, LOAD IN THE OBJECT DECK 17170000 CLI 0(9),C'*' . HAS USER NAMED IT STARTING 17180000 BE EXPUNGE . WITH '*'? IF SO, THROW HIM OUT 17190000 LA 2,SEQ . ELSE CREATE A PROCESS 17200000 MVC SEQ,=CL8' ' . BLANK OUT THE NAME 17210000 EX 5,UNAMMOV . THEN MOVE THE RELEVANT 17220000 SVC C'C' . CHARACTERS AND CREATE 17230000 LA 2,SEQ . WE'LL START IT IN A MOMENT 17240000 BAL 3,SCAN . SCAN AGAIN 17250000 EX 5,CMPIN . IS IT 'IN'? 17260000 BE ASIN . IF SO, ASSIGN IT AS IN 17270000 EX 5,CMPOUT . IF IT'S 'OUT' 17280000 BE ASOUT . ASSIGN IT AS OUT 17290000 EX 5,CMPEXCP . IS IT 'EXCP'? 17300000 BE ASEXCP . IF SO, ASSIGN IT AS EXCP 17310000 B EXPUNGE . ERROR: GO ON TO NEXT JOB 17320000 UNAMMOV MVC SEQ(0),0(9) . MOVE THE UNIT'S PROCESS NAME 17330000 CMPIN CLC 0(0,9),=C'IN ' . DOES IT SAY 'IN'? 17340000 CMPOUT CLC 0(0,9),=C'OUT ' . DOES IT SAY 'OUT'? 17350000 CMPEXCP CLC 0(0,9),=C'EXCP ' . DOES IT SAY 'EXCP'? 17360000 SPACE 1 17370000 ASIN LA 11,=CL8'*IN' . POINT TO NAME OF READER HANDLER 17380000 SETDIM MVC UNITRTN,=A(DIM) . USE DIM AS THE INTERFACE 17390000 SVC C'Y' 17400000 B ASGNUNIT 17410000 ASOUT LA 11,=CL8'*OUT' . POINT TO NAME OF PRINTER HANDLER 17420000 B SETDIM 17430000 ASEXCP MVC UNITRTN,=A(EXCPHNDL) . USE FOR USER SUPPLIED 17440000 L 11,KEY 17450000 SVC C'Y' . I/O ROUTINE 17460000 B ASGNUNIT 17470000 SPACE 1 17480000 LOAD LA 2,CORE . READY TO ALLOCATE THE REGION 17490000 SVC C'A' . AND ALLOCATE IT 17500000 MVI LOADED,X'FF' . REMEMBER THAT WE'RE LOADED 17510000 L 9,CORE+4 . GET THE FIRST ADDRESS 17520000 L 4,KEY . GET THE KEY 17530000 SRL 4,16 17540000 O 4,FETCHPRT fetch protected 17545002 LR 3,9 . GET THE BLOCK FOLLOWING OURS 17550000 AR 3,8 17560000 LOADSK S 3,PAGESIZE . get the previous block, page aligned 17570002 CR 3,9 . HAVE WE PASSED THE START? 17580000 BL LOADLOOP . IF SO, START LOADING 17590000 * SSKE 4,3 . else set this block to the key 17600002 DC X'B22B0043' Assembler (XF) doesn't support SSKE 17603002 B LOADSK . AND BRANCH BACK 17610000 LOADLOOP LA 2,TREAD . READ IN OBJECT DECK 17620000 SVC C'S' . GET A CARD A'READING 17630000 MVC RREPLY1,=F'132' 17640000 LA 2,RREPLY 17650000 SVC C'R' . WAIT FOR ANSWER 17660000 CLC CARD+1(3),=C'TXT' . IS IT A TXT CARD? 17670000 BE TXTCARD 17680000 CLC CARD+1(3),=C'RLD' . IS IT A RLD CARD? 17690000 BE RLDCARD 17700000 CLC CARD+1(3),=C'END' . IS IT AN END CARD? 17710000 BE ENDCARD 17720000 B LOADLOOP . IF NONE, IGNORE. 17730000 SPACE 1 17740000 TXTCARD L 10,CARD+4 . GET THE RELATIVE ADDRESS 17750000 AR 10,9 . PLUS THE ABSOLUTE ADDRESS 17760000 LH 11,CARD+10 . GET THE COUNT, 17770000 BCTR 11,0 . DECREMENTED 17780000 EX 11,TXTMOV . AND MOVE THE TEXT 17790000 B LOADLOOP . AND READ ANOTHER CARD! OH WOW! 17800000 TXTMOV MVC 0(0,10),CARD+16 17810000 SPACE 1 17820000 RLDCARD LH 11,CARD+10 . GET THE BYTE COUNT 17830000 LA 13,CARD+20 . AND AN INDEX INTO THE CARD 17840000 RLDLOOP L 10,0(13) . GET THE LOCATION TO BE RLD'D 17850000 AR 10,9 . GET THE ABSOLUTE ADDRESS 17860000 TM 3(13),X'03' . IS IT A FULLWORD? 17870000 BNZ NOTALGND . IF NO, HANDLE AS THREE BYTES 17880000 L 7,0(10) . GET THAT WORD (HAD BETTER BE 17890000 AR 7,9 . ONE); ADD THE RELOCATION 17900000 ST 7,0(10) . ADDRESS, AND STORE IT BACK 17910000 RLDCONT TM 0(13),X'01' . CHECK IF LONG OR SHORT FIELD 17920000 BNZ SHORT . AND BRANCH ACCORDINGLY 17930000 LA 4,8 . SKIP EIGHT BYTES 17940000 B RLDFINI 17950000 SHORT LA 4,4 . SKIP FOUR BYTES 17960000 RLDFINI AR 13,4 . INCREMENT THE CARD INDEX 17970000 SR 11,4 . DECREMENT THE BYTE COUNT 17980000 BP RLDLOOP . AND TRY AGAIN 17990000 B LOADLOOP . OR READ ANOTHER CARD 18000000 NOTALGND MVC RLDTEMP+1(3),0(10) . PUT ADDRESS HERE 18010000 L 7,RLDTEMP . RELOCATE IT 18020000 AR 7,9 18030000 ST 7,RLDTEMP . AND PUT IT BACK TO 18040000 MVC 0(3,10),RLDTEMP+1 . WHERE IT BELONGS 18050000 NI RLDTEMP,X'00' . CLEAR OUT TEMPORARY 18060000 B RLDCONT . AND LOOP BACK 18070000 SPACE 1 18080000 ENDCARD LA 2,USERL . FIND THE PCB FOR USERPROG 18090000 SVC C'N' 18100000 L 4,USERL+8 . GET THE ADDRESS 18110000 USING PCB,4 18120000 MVI PCBBLOKT,X'FF' . TEMPORARILY BLOCK IT 18130000 ST 9,USERL+8 . STORE THE BEGINNING ADDRESS 18140000 SVC C'Y' . THEN START IT 18150000 L 5,KEY . GET THE KEY 18160000 O 5,PCBISA+0 . THEN OR THIS INTO THE 18170000 ST 5,PCBISA+0 . FIRST WORD OF THE PCB 18180000 OI PCBISA+1,X'01' . OR IN A 'PROGRAM STATE' BIT 18190000 MVI PCBBLOKT,X'00' . AND THEN UNBLOCK IT 18200000 DROP 4 18210000 LA 2,TALK . LISTEN TO WHAT IT SAYS 18220000 SVC C'R' 18230000 SPACE 1 18240000 MVC LINE(8),=CL8' ' . IF JOB FINISHED, CLEAR A LINE 18250000 MVC LINE+8(124),LINE+7 18260000 MVC LINE(12),TALK+12 . MOVE THE MESSAGE ONTO THE LINE 18270000 LA 2,WRITE . AND SAY TO WRITE IT 18280000 SVC C'S' 18290000 LA 2,ANYBACK 18300000 SVC C'R' 18310000 LA 2,SKIP . SKIP TO THE TOP OF THE NEXT PAGE 18320000 SVC C'S' 18330000 LA 2,ANYBACK 18340000 SVC C'R' 18350000 SPACE 1 18360000 EXPUNGE L 5,RUNNING . EXPUNGE A JOB: LOOK AT ALL PCBS 18370000 LA 2,SEQ 18380000 USING PCB,5 18390000 EXPLOOP MVC SEQ(8),PCBNAME . GET THE PROCESS NAME 18400000 L 4,PCBNPTG . GET THE NEXT PTR 18410000 CLI SEQ+0,C'*' . IS IT A '*' PROCESS? 18420000 BE EXPNXT . IF SO, SKIP OVER 18430000 SVC C'Z' . ELSE STOP IT 18440000 SVC C'D' . AND DESTROY IT 18450000 EXPNXT LR 5,4 . GO TO THE NEXT PCB 18460000 C 5,RUNNING . ARE WE THROUGH? 18470000 BNE EXPLOOP . IF NOT, LOOP AGAIN 18480000 CLI LOADED,X'00' . WAS CORE ALLOCATED? 18490000 BE LOOP . IF NOT, GO READ THE NEXT $JOB CARD 18500000 LA 4,8 . set zero key and fetch protect 18510002 LR 3,9 . AND A POINTER TO THE NEXT 18520000 AR 3,8 . BLOCK AFTER OURS 18530000 LOADCL S 3,PAGESIZE . get the previous block, page aligned 18540002 CR 3,9 . ARE WE THROUGH? 18550000 BL LOADD . IF SO, GO FREE CORE 18560000 * SSKE 4,3 . else clear storage key 18570002 DC X'B22B0043' Assembler (XF) doesn't support SSKE 18573002 B LOADCL . AND LOOP BACK 18580000 LOADD LA 2,CORE 18590000 SVC C'F' . FREE THE STORAGE 18600000 B LOOP . READ ANOTHER $JOB CARD 18610000 SPACE 1 18620000 SCAN SR 5,5 . START THE TOKEN COUNT AT ZERO 18630000 SCANLOOP LA 4,1(4) . GO TO NEXT CHARACTER 18640000 CLI 0(4),C',' . DO WE HAVE A DELIMITER? IF SO, 18650000 BE TOKSTART 18660000 CLI 0(4),C'=' . DITTO 18670000 BE TOKSTART 18680000 CLI 0(4),C' ' . DITTO 18690000 BE TOKSTART 18700000 LA 5,1(5) . AND UP COUNT 18710000 B SCANLOOP . AND LOOP 18720000 TOKSTART LR 9,4 . SET REG9 TO START 18730000 SR 9,5 . OF THIS TOKEN 18740000 BCTR 5,0 . LESS ONE FOR EXECUTE INSTRUCTION 18750000 BR 3 18760000 SPACE 2 18770000 JSPNEVER DC F'0,0' . A GOOD WAY TO DIE: P(JSPNEVER) 18780000 SKIP DC CL8'*OUT' . MESSAGE BLOCK FOR A NEW PAGE 18790000 DC F'8' 18800000 DC CL4'STC1' 18810000 INSEQ DC CL8'*IN' . SEQ TO CREATE & START *IN 18820000 DC A(RDRHANDL) 18830000 OUTSEQ DC CL8'*OUT' . SEQ TO CREATE & START *OUT 18840000 DC A(PRTHANDL) 18850000 COREPACK PACK COREPCKD(1),0(1,9) . executed to pack core size req'd 18860002 COREPCKD DS D . packed core requirement goes here 18880002 COREPKLN DC X'00000070' . length of packed size for execute 18900002 PAGESIZE DC F'4096' . page size for core computation 18920002 JSPSUSEM DC F'1,0' . SEMAPHORE TO LOCK ROUTINE 18990000 JSPAAS DC A(LENJSPAS) . ALLOCATE LIST FOR AUTO STORAGE 19000000 DS A 19010000 FETCHPRT DC F'8' reused to or in fetch protection 19020002 EJECT 19030000 *********************************************************************** 19040000 * * 19050000 * DEVICE INTERFACE MODULE * 19060000 * * 19070000 * FUNCTION: TO INTERFACE BETWEEN USERPROG AND DEVICE HANDLER * 19080000 * DATABASES: NONE * 19090000 * ROUTINES USED: XA, XP, XV, XR, XS * 19100000 * PROCEDURE: ALLOCATE AUTOMATIC STORAGE; START TO READ MESSAGE * 19110000 * FROM USER; SEND MESSAGE TO DEVICE HANDLER; * 19120000 * CONTINUE LOOPING, SENDING MESSAGES FROM USER TO * 19130000 * DEVICE HANDLER AND BACK. * 19140000 * ERROR CHECKS: NONE * 19150000 * INTERRUPTS: ON * 19160000 * USER ACCESS: YES * 19170000 * * 19180000 *********************************************************************** 19190000 SPACE 1 19200000 DIM EQU * . THE DEVICE INTERFACE MODULE 19210000 BALR 1,0 19220000 USING *,1 . ESTABLISH ADDRESSING 19230000 LA 2,DIMSEM . LOCK UNTIL GET STORAGE 19240000 SVC C'P' 19250000 LA 2,DIMAAS . READY TO ALLOCATE STORAGE 19260000 USING XAX,2 19270000 SVC C'E' . DO IT 19280000 L 12,XAXADDR . GET THE ADDRESS 19290000 DROP 2 19300000 LA 2,DIMSEM . UNLOCK OURSELVES 19310000 SVC C'V' 19320000 USING DIMAS,12 . USE 12 FOR AUTO STORAGE 19330000 MVC DIMLMS,0(11) . MOVE NAME OF RECIEVER 19340000 LA 8,132 . REG 8 = SIZE OF MESSAGE 19350000 DIMLOOP ST 8,DIMMSG+8 . GET READY TO READ A MESSAGE 19360000 LA 2,DIMMSG 19370000 SVC C'R' . READ 19380000 MVC DIMTEMP,DIMMSG . SAVE SENDER NAME 19390000 MVC DIMMSG,DIMLMS . SEND IT BACK TO THE LAST GUY 19400000 SVC C'S' . SEND IT 19410000 MVC DIMLMS,DIMTEMP . AND REMEMBER WHO TO SEND TO NEXT 19420000 B DIMLOOP . RELOOP 19430000 DIMSEM DC F'1,0' . SEMAPHORE FOR ENTRY 19440000 DIMAAS DC A(DIMLEN) . ALLOCATE SEQ FOR AUTO STORAGE 19450000 DC A(0) 19460000 DC F'8' 19470000 DROP 12 19480000 EJECT 19490000 LTORG 19500000 VERYEND DS 6D . beginning of free storage 19510004 LOADER DS 0D IPL loader goes here 19521002 EJECT 19521203 R0 EQU 0 19521502 R1 EQU 1 19522002 R2 EQU 2 19522502 R3 EQU 3 19523002 R4 EQU 4 19523502 R5 EQU 5 19524002 R6 EQU 6 19524502 R7 EQU 7 19525002 R8 EQU 8 19525502 R9 EQU 9 19526002 R10 EQU 10 19526502 R11 EQU 11 19527002 R12 EQU 12 19527502 R13 EQU 13 19528002 R14 EQU 14 19528502 R15 EQU 15 19529002 *********************************************************************** 19530000 * * 19540000 * DATABASE DEFINITIONS * 19550000 * * 19560000 *********************************************************************** 19570000 SPACE 1 19580000 PCB DSECT . PROCESS CONTROL BLOCK DEFINITION 19590000 PCBNAME DS CL8 . NAME 19600000 PCBNPTG DS F . NEXT POINTER THIS GROUP 19610000 PCBLPTG DS F . LAST POINTER THIS GROUP 19620000 PCBNPALL DS F . NEXT POINTER ALL 19630000 PCBLPALL DS F . LAST POINTER ALL 19640000 PCBSTOPT DS C . STOPPED 19650000 PCBBLOKT DS C . BLOCKED 19660000 PCBINSMC DS C . IN SMC 19670000 PCBSW DS C . STOP WAITING 19680000 PCBMSC DS CL8 . MESSAGE SEMAPHORE COMMON 19690000 PCBMSR DS CL8 . MESSAGE SEMAPHORE RECEIVER 19700000 PCBFM DS F . FIRST MESSAGE 19710000 PCBNSW DS F . NEXT SEMAPHORE WAITER 19720000 PCBSRS DS CL8 . STOPPER SEMAPHORE 19730000 PCBSES DS CL8 . STOPPEE SEMAPHORE 19740000 PCBASIZE DS F . AUTOMATIC STORAGE SIZE 19750000 PCBAADDR DS A . AUTOMATIC STORAGE ADDRESS 19760000 PCBISA DS CL84 . INTERRUPT SAVE AREA 19770000 PCBFSA DS CL84 . FAULT SAVE AREA 19780000 PCBMSA DS CL84 . MEMORY SAVE AREA 19790000 DS 0D . (ALIGN) 19800000 LENPCB EQU *-PCB . (LENGTH) 19810000 SPACE 1 19820000 SA DSECT . SAVE AREA DEFINITION 19830000 SAPSW DS D . PROGRAM STATUS WORD 19840000 SAREGS DS CL64 . REGISTERS 19850000 SATEMP DS CL12 . TEMPORARIES 19860000 SPACE 1 19870000 REGS DSECT . REGISTER DEFINITION 19880000 REG0 DS F . REGISTER 0 19890000 REG1 DS F . REGISTER 1 19900000 REG2 DS F . REGISTER 2 19910000 REG3 DS F . REGISTER 3 19920000 REG4 DS F . REGISTER 4 19930000 REG5 DS F . REGISTER 5 19940000 REG6 DS F . REGISTER 6 19950000 REG7 DS F . REGISTER 7 19960000 REG8 DS F . REGISTER 8 19970000 REG9 DS F . REGISTER 9 19980000 REG10 DS F . REGISTER 10 19990000 REG11 DS F . REGISTER 11 20000000 REG12 DS F . REGISTER 12 20010000 REG13 DS F . REGISTER 13 20020000 REG14 DS F . REGISTER 14 20030000 REG15 DS F . REGISTER 15 20040000 SPACE 1 20050000 FSB DSECT . FREE STORAGE BLOCK DEFINITIONS 20060000 FSBNEXT DS A . NEXT 20070000 FSBSIZE DS F . SIZE 20080000 SPACE 1 20090000 SM DSECT . SEMAPHORE DEFINITION 20100000 SMVAL DS F . VALUE 20110000 SMPTR DS F . PTR 20120000 SPACE 1 20130000 MSG DSECT . MESSAGE DEFINITION 20140000 MSGSENDR DS A . POINTER TO SENDER'S PCB 20150000 MSGNEXT DS A . NEXT 20160000 MSGSIZE DS F . SIZE 20170000 MSGTEXT DS 0C . TEXT 20180000 LENMSG EQU *-MSG . (LENGTH) 20190000 SPACE 1 20200000 XAX DSECT . XA ARGUMENT LIST 20210000 XAXSIZE DS F . SIZE 20220000 XAXADDR DS F . ADDRESS 20230000 XAXALGN DS F . ALIGNMENT 20240000 SPACE 1 20250000 XFX DSECT . XF ARGUMENT LIST 20260000 XFXSIZE DS F . SIZE 20270000 XFXADDR DS F . ADDRESS 20280000 SPACE 1 20290000 XBX DSECT . XB ARGUMENT LIST 20300000 XBXSIZE DS F . SIZE 20310000 XBXADDR DS F . ADDRESS 20320000 SPACE 1 20330000 XCX DSECT . XC ARGUMENT LIST 20340000 XCXNAME DS CL8 . NAME 20350000 SPACE 1 20360000 XDX DSECT . AD ARGUMENT LIST 20370000 XDXNAME DS CL8 . NAME 20380000 SPACE 1 20390000 XNX DSECT . XN ARGUMENT LIST 20400000 XNXNAME DS CL8 . NAME 20410000 XNXADDR DS A . ADDRESS 20420000 SPACE 1 20430000 XRX DSECT . XR ARGUMENT LIST 20440000 XRXNAME DS CL8 . NAME 20450000 XRXSIZE DS F . SIZE 20460000 XRXTEXT DS 0C . TEXT 20470000 SPACE 1 20480000 XSX DSECT . XS ARGUMENT LIST 20490000 XSXNAME DS CL8 . NAME 20500000 XSXSIZE DS F . SIZE 20510000 XSXTEXT DS 0C . TEXT 20520000 SPACE 1 20530000 XYX DSECT . XY ARGUMENT LIST 20540000 XYXNAME DS CL8 . NAME 20550000 XYXADDR DS A . ADDR 20560000 SPACE 1 20570000 XZX DSECT . XZ ARGUMENT LIST 20580000 XZXNAME DS CL8 . NAME 20590000 SPACE 1 20600000 RDRHAS DSECT . READER HANDLER AUTOMATIC STORAGE 20610000 RDRHCCB DS 2F . CCB 20620000 RDRHMSG DS CL8 . MESSAGE BLOCK FOR REQUESTS 20630000 DS F'8' 20640000 DS CL8 20650000 RDRHTEMP DS CL80 . AREA FOR $JOB IN DATA STREAM 20660000 RDRHM DS CL8 . MESSAGE BLOCK FOR REPLY 20670000 DS F'2' 20680000 DS CL2 20690000 JOBBIT DS 1C 20700000 DS 0D 20710000 LENRDRHA EQU *-RDRHAS . (LENGTH) 20720000 SPACE 1 20730000 PRTHAS DSECT . PRINTER HANDLER AUTOMATIC STORAGE 20740000 PRTHCCB DS 2F . CCB 20750000 PRTHMSG DS CL8 . MESSAGE BLOCK FOR REQUESTS 20760000 DS F'2' 20770000 DS CL8 20780000 PRTHM DS CL8 . MESSAGE BLOCK FOR REPLY 20790000 DS F'2' 20800000 DS CL2 20810000 DS 0D 20820000 LENPRTHA EQU *-PRTHAS . (LENGTH) 20830000 SPACE 1 20840000 EXCPHAS DSECT . EXCP HANDLER AUTOMATIC STORAGE 20850000 EXCPHMSG DS CL8 . MESSAGE BLOCK FOR REQUESTS 20860000 DS F'12' 20870000 DS CL12 20880000 EXCPHM DS CL8 . MESSAGE BLOCK FOR REPLY 20890000 DS F'12' 20900000 DS CL12 20910000 DS 0D 20920000 LENEXCPA EQU *-EXCPHAS . (LENGTH) 20930000 SPACE 1 20940000 UCB DSECT . UNIT CONTROL BLOCK DEFINITION 20950000 UCBADDR DS F . ADDRESS 20960000 UCBUS DS FL8 . USER SEMAPHORE 20970000 UCBWS DS FL8 . WAITER SEMAPHORE 20980000 UCBCSW DS FL8 . CHANNEL STATUS WORD 20990000 UCBFPR DS CL1 . FAST PROCESSING REQUIRED 21000000 DS 0F 21010000 UCBLENG EQU *-UCB 21020000 SPACE 1 21030000 JSPAS DSECT . JSP AUTOMATIC STORAGE 21040000 LINE DS CL132 . PRINTED LINE 21050000 DS 0F 21060000 CARD DS CL80 . CARD READ 21070000 DS 0F 21080000 RREPLY DS CL8 . MESSAGE BLOCK FOR REPLIES 21090000 RREPLY1 DS F 21100000 REPLY DS CL132 21110000 TREAD DS 0F . MESSAGE BLOCK FOR READING 21120000 DS CL8'*IN' 21130000 DS F'8' 21140000 DS CL4'READ' 21150000 ACARD DS A(0) 21160000 WRITE DS CL8'*OUT' . MESSAGE BLOCK TO PRINT A LINE 21170000 DS F'8' 21180000 DS CL4'PRIN' 21190000 DS A(LINE) 21200000 KEY DS F 21210000 USERL DS CL8'USERPROG' . LIST FOR MANIPULATING USERPROG 21220000 DS F 21230000 SEQ DS CL8' ' . COMMON ARG LIST FOR I/O PROCESS 21240000 UNITRTN DS A 21250000 CORE DS F . MEMORY ALLOCATED AND FREE 21260000 DS F . SEQUENCE 21270000 DS F'4096' align to page boundary 21280002 RLDTEMP DS F 21290000 TALK DS CL8'USERPROG' . MESSAGE BLOCK FOR MESSAGE FROM 21300000 DS F'12' . USERPROG 21310000 DS CL12 21320000 ANYBACK DS CL8 . MESSAGE BLOCK FOR IGNORING MESS 21330000 DS F'1' 21340000 DS CL1 21350000 LOADED DS C . IS CORE ALLOCATED 21360000 DS 0D 21370000 LENJSPAS EQU *-JSPAS . (LENGTH) 21380000 SPACE 1 21390000 DIMAS DSECT . DEVICE INTERFACE MODULE STORAGE 21400000 DIMMSG DS CL8 . MESSAGE BLOCK 21410000 DS F'132' 21420000 DS CL132 21430000 DIMLMS DS CL8 . LAST MESSAGE SENDER 21440000 DIMTEMP DS CL8 . TEMPORARY 21450000 DS 0D 21460000 DIMLEN EQU *-DIMAS . (LENGTH) 21470000 END 21480000