github.com/retro-software.B5500-software
1
0
Fork 0
mirror of https://github.com/retro-software/B5500-software.git synced 2026-04-28 20:57:48 +00:00
Code Issues Releases Wiki Activity
Files
63725f2ca78a3f8a3fd67ff11593282853ccff5a
retro-software.B5500-software/B6500-Simulator/B65MCP-MARK00.esp_m

14334 lines
1.2 MiB
Raw Blame History

BEGIN 00000000
COMMENT MCP LISTING DIRECTORY 00001000
010000000 INDEPENDENT RUNNER FORWARD DECLARATION 00002000
020000000 FORWARD PROCEDURE DECLARATION 00003000
08000000 INITIAL VALUE TABLES 00004000
08000000 BCL TO EBCEDIC 00005000
08018000 EBCEDIC TO BCL 00006000
08084000 TRUTH SETS 00007000
08106000 POWER OF TEN TABLES 00007100
08247000 CONTROL CARD 00007200
09000000 STANDARD QUEUE DECLARATION 00008000
10000000 GLOBALS 00009000
10017000 INTERRUPT - EVENT HANDLING GLOBALS 00010000
10055000 TAG DEFINITION 00011000
10075000 CONTROL WORD LAYOUTS 00012000
10252000 REGISTERS DEFINITIONS 00013000
11000000 STORAGE ALLOCATION GLOBALS 00014000
12000000 INITIALIZE GLOBALS 00015000
13000000 INPUT - OUTPUT GLOBALS 00016000
13056500 VALUE ARRAYS - MCPID,KEYIN GLOSSARIES,ETC. 00016100
13276000 KEYIN - SPOUT GLOBALS 00017000
13318000 IOQUE QUEUE DECLARATION 00018000
13375000 WAITCHANNELQUE QUEUE DECLARATION 00019000
14000000 DISK MANAGEMENT 00020000
15000000 GETAREA - FORGET AREA GLOBALS 00021000
16000000 STANDARD INSERT 00022000
16016000 STANDARD DELINK 00023000
17000000 NAMEQUE QUEUE DECLARATION 00024000
17021000 BLOCKSOFAREAQUE QUEUE DECLARATION 00025000
17035000 KEYING QUEUE DECLARATION 00026000
18007000 FILE MANAGEMENT 00027000
19000000 REPLY MESSAGE 00028000
20000000 INDEPENDENT RUNNER GLOBALS 00029000
21140000 READYQ QUEUE DECLARATION 00030000
21263000 SHEETQ QUEUE DECLARATION 00031000
21357000 TERMINATEQ QUEUE DECLARATION 00032000
23000000 DIRECTORY MANAGEMENT 00034000
24000000 I/0 INTRINSIC DECLARATIONS 00034100
30000000 GETSPACE / FORGETSPACE 00035000
31000000 GETAREA / FORGETAREA 00036000
32000000 INITIALIZE 00037000
33000000 HARDWAREINTERRUPT 00038000
33167000 PRESENCEBIT 00039000
33538000 WHATDOIDO 00040000
33567000 EVENTHANDLER 00041000
33763000 SOFTWAREINTERRUPTDEC 00042000
33855000 HOLD 00043000
33890000 HOLDINITIALIZE 00044000
33961000 GETINDEPENDENTRUNNERSTACK 00045000
33960000 INDEPENDENTRUNNER 00046000
34051000 RUN 00047000
34086000 LOADFIXDIRSTACK 00048000
38000000 CONTROL CARD 00048600
40000000 INPUT - OUTPUT ROUNTINES 00049000
40005000 STARTIO 00050000
40037000 INITIATEIO 00051000
40075000 IOREQUEST 00052000
40089000 WAITIO 00053000
40131000 NEWIO 00054000
40154000 IOFINISH 00055000
40316000 STATUS 00056000
40565000 DISKIO 00057000
40597000 DISKWAIT 00058000
44022000 DISPLAY ROUTINES 00059000
44097000 KEYIN 00060000
44176000 SPOUT 00061000
50000000 ERROR ROUTINES 00062000
50000000 IOERROR 00063000
55000000 DISK MANAGEMENT 00064000
55018000 FORGETESPDISK 00066000
55039000 GETUSERDISK 00067000
55123000 FORGETUSERDISK 00068000
58000000 LIBRARY MAINTENANCE 00068900
59000000 PERIPHERALINITIALIZE 00069000
60000000 PROGRAM INTRINSICS 00070000
65000000 ARRAYDEC 00071000
65174000 BLOCKEXIT 00072000
65228000 GOTOSOLVER 00073000
70000000 PROGRAM INPUT- OUTPUT INTRINSICS 00074000
80000000 SELECTION - PROCESS HANDLING 00075000
80361000 INITIATE 00076000
80519000 SELECTION 00077000
80600000 TERMINATE 00077200
99000000 MONITOR 00078000
99970000 MCP OUTER BLOCK 00079000
; 00999999
COMMENT FOLLOWING ARE FORWARD DECLARATIONS FOR PROCEDURES CAPABLE OF 01000000
RUNNING AS INDEPENDENT RUNNERS. THE FORWARD DECLARATION FOR 01001000
A NEW INDEPENDENT RUNNER MUST APPEAR BEFORE THAT FOR STATUS IF 01001500
IT IS CAPAPABLE OF MULTIPLE REPRESENTATION. AN INDICATOR MAY. 01002000
BE ASSOCIATED WITH AN INDEPENDENT RUNNER (SEE CROSS FEFERENCE 01002500
FOR "TERMINATE" AND "TERMINATEINDICATOR" FOR HOW THIS IS 01003000
EFFECTED). THIS INDICATOR ISNOT NECESSARY TO THE 01003500
IMPLEMENTATION, HOWEVER IT IS NECESSARY IF INDEPENDENTRUNNER IS01004000
01004300
TO RECOGNISE THE NEW RUNNER AS A SPECIAL CASE 01004500
01004600
; 01005000
PROCEDURE CONTROLCARD (PARAMETER); 01006000
WORD PARAMETER; FORWARD; 01007100
PROCEDURE READALABEL(LINFO);VALUE LINFO;REAL LINFO;FORWARD; 01007105
PROCEDURE PURGIT(U);VALUE U;REAL U;FORWARD; 01007107
PROCEDURE DIRECTORYCOMPLEMENT(ROW); ARRAY ROW[*]; FORWARD; 01007200
PROCEDURE IRTEST(IND); INTEGER IND; FORWARD; 01008000
PROCEDURE INITIATE (DUMMY); REAL DUMMY; FORWARD; 01008200
PROCEDURE IOERROR(RD); REAL RD; FORWARD; 01008500
01009000
PROCEDURE STATUS (COUNT); INTEGER COUNT; FORWARD; 01009100
PROCEDURE KEYIN(COUNT); REAL COUNT; FORWARD; 01009110
PROCEDURE CONNSOUL(COUNT); REAL COUNT; FORWARD;% 01010000
PROCEDURE TERMINATE (PARAMETER); REAL PARAMETER ; FORWARD; 01011000
COMMENT: FOR THOSE OF YOU WHO DON"T KNOW SO, TERMINATE MUST BE THE 01011100
LAST INDEPENDENTRUNNER DECLARED IN THIS FORWARD LIST. 01011200
ONE WRITES "FORK(<PROCEDURE ID>, <PARAMETER>)" TO START ONE OF 01011300
THESE GUYS UP; 01011400
PROCEDURE WHATDOIDO; FORWARD; 02000000
PROCEDURE INDEPENDENTRUNNER(INDEX,PAR);VALUE INDEX,PAR;REAL INDEX; 02001000
WORD PAR; FORWARD; 02002000
PROCEDURE LOADFIXEDIRSTACK(STACKNO);VALUE STACKNO;INTEGER STACKNO; 02003000
FORWARD; 02004000
SAVE INTEGER PROCEDURE TRACE = (0,19) ( TRACTER ) ; 02005000
VALUE TRACTER; INTEGER TRACTER; FORWARD; 02006000
SAVE REAL PROCEDURE GETSPACE (SIZE, WHOFOR, TYPE, ADDRESS); 02007000
VALUE SIZE, WHOFOR, TYPE, ADDRESS; 02008000
INTEGER SIZE, WHOFOR, TYPE; 02009000
REAL ADDRESS; FORWARD; 02010000
SAVE INTEGER PROCEDURE FORGETSPACE (ADDRESS); 02011000
VALUE ADDRESS; INTEGER ADDRESS; FORWARD; 02012000
SAVE PROCEDURE OVERLAY (ADDRESS); VALUE ADDRESS;INTEGER ADDRESS;FORWARD;02013000
REAL PROCEDURE DIRECTORYSEARCH(POINT, CODE, LLOCK); 02016100
VALUE POINT, CODE, LLOCK; 02016200
POINTER POINT; 02016300
REAL CODE; 02016400
BOOLEAN LLOCK; FORWARD; 02016500
SAVE PROCEDURE IOFINISH(MPXINDEX); VALUE MPXINDEX; 02017000
INTEGER MPXINDEX; FORWARD; 02018000
PROCEDURE FINISHOFFIO(IOCB); VALUE IOCB; REFERENCE IOCB; FORWARD;02019000
PROCEDURE FINISHOFFIO(IOCB); VALUE IOCB; REFERENCE IOCB; ; COMMENT * * ;02020000
SAVE 02020998
PROCEDURE SPOUT(IOCB,U);VALUE IOCB,U;REAL U;REFERENCE IOCB;FORWARD; 02021000
PROCEDURE MESSER(W,INFO);VALUE W,INFO;REAL W;WORD INFO;FORWARD;% 02021100
PROCEDURE MIXPRINT(BUF);ARRAY BUF[*]; FORWARD;% 02022000
BOOLEAN PROCEDURE JULIT(P);POINTER P; FORWARD; 02022300
PROCEDURE DATIT(P); POINTER P; FORWARD;% 02022400
REAL PROCEDURE CURRENTTIME; FORWARD; 02022500
PROCEDURE CHANLOUT(I,BUFF);VALUE I;REAL I;ARRAY BUFF[*];FORWARD; 02022600
SAVE PROCEDURE CONNQUEST(UNIT); VALUE UNIT; REAL UNIT; FORWARD; 02023000
SAVE PROCEDURE UNEXPIOERROR(IOCB,IOERRORMASK); 02024000
VALUE IOCB,IOERRORMASK; 02025000
REFERENCE IOCB; 02026000
REAL IOERRORMASK; ; COMMENT * * * * * * * * ** ; 02027000
SAVE REAL PROCEDURE WAITIO(AREA, USER, IOMASK); 02030000
VALUE USER, IOMASK; 02031000
ARRAY AREA[*]; 02032000
REAL USER, IOMASK; 02033000
FORWARD; 02034000
SAVE PROCEDURE IOREQUEST(IOCB);VALUE IOCB;REFERENCE IOCB;FORWARD; 02034100
SAVE REFERENCE PROCEDURE DISKIO(CORE,INDEX,SIZE,DISK,MASK,DISKIOEVNT); 02035000
VALUE INDEX,SIZE,DISK,MASK; 02036000
INTEGER INDEX,SIZE,DISK,MASK; 02037000
ARRAY CORE [*]; 02038000
EVENT DISKIOEVNT ; FORWARD; 02039000
SAVE PROCEDURE DISKWAIT(CORE,INDEX,SIZE,DISK,MASK); 02040000
VALUE INDEX,SIZE,DISK,MASK; 02041000
INTEGER INDEX,SIZE,DISK,MASK; 02042000
ARRAY CORE[*]; 02043000
FORWARD; 02044000
PROCEDURE HARDWAREINTERRUPT(P1,P2); VALUE P1,P2; 02045000
INTEGER P1; WORD P2; FORWARD; 02046000
WORD HARDWAREINTERRUPTPCW = HARDWAREINTERRUPT; 02046100
WORD D03 = (0, 3); 02046200
SAVE PROCEDURE HOLDINITIALISE; FORWARD; 02047000
SAVE PROCEDURE PERIPHERALINITIALIZE; FORWARD; 02048000
REAL MCPDISKBASE = PERIPHERALINITIALIZE; COMMENT ADDRESS OF MCP DISK; 02049000
SAVE PROCEDURE INITIALIZE(P1, P2); 02050000
VALUE P1; 02051000
INTEGER P1; 02052000
WORD P2; FORWARD; 02053000
REAL MAXCHANNELS = INITIALIZE; COMMENT THE NUMBER OF MULTIPLEXORS; 02054000
BOOLEAN MAXMPX = MAXCHANNELS; 02055000
WORD INITIALIZEPCW = INITIALIZE; 02055100
SAVE INTEGER PROCEDURE GETAREA(SIZE); VALUE SIZE; INTEGER SIZE; FORWARD;02057000
SAVE PROCEDURE FORGETAREA(SIZE,ADDRESS); VALUE SIZE,ADDRESS; 02058000
INTEGER SIZE,ADDRESS; FORWARD; 02059000
PROCEDURE UPDATEUNITBITSTABLE(TABLENAME,U); VALUE U; 02060000
INTEGER U; 02061000
BOOLEAN ARRAY TABLENAME[*]; FORWARD; 02062000
PROCEDURE EVENTHANDLER = (0,15) (THEEVENT,EVENTWORD1,WAITFLAG); 02063000
VALUE EVENTWORD1,WAITFLAG; 02064000
WORD THEEVENT,EVENTWORD1; 02065000
BOOLEAN WAITFLAG; FORWARD; 02066000
WORD PROCEDURE SOFTWAREINTERRUPTDEC = (0,14) (THEEVENT,EVENTWORD1, 02067000
EVENTWORD2,KLUDGE,PCWPOINTER); 02068000
VALUE EVENTWORD1,EVENTWORD2,PCWPOINTER,KLUDGE; 02069000
WORD THEEVENT,EVENTWORD1,EVENTWORD2,PCWPOINTER,KLUDGE; 02070000
FORWARD; 02071000
DEFINE INTERLOCK = EVENT # 02071100
, PROCURE(L0CK) = GAOLER(L0CK, FALSE) # 02071200
, LIBERATE(L0CK) = GAOLER(L0CK, TRUE) # 02071300
; 02071400
PROCEDURE GAOLER = (0,18) (E,U); VALUE U; EVENT E; BOOLEAN U; FORWARD; 02071500
SAVE WORD PROCEDURE DOPEVECTOR(MOM); 02072000
VALUE MOM; 02073000
WORD MOM; FORWARD; 02074000
SAVE PROCEDURE ARRAYDEC =(0,7) (NOOFDIMS,NOOFARRAYS,TYPE); 02075000
VALUE NOOFDIMS,NOOFARRAYS,TYPE; 02076000
INTEGER NOOFDIMS,NOOFARRAYS,TYPE; FORWARD; 02077000
SAVE PROCEDURE DUMMYFORCUTTINGSTACK; ; 02077100
WORD DUMMYFORCUTTINGSTACKPCW=DUMMYFORCUTTINGSTACK; 02077200
SAVE WORD PROCEDURE SIM1TOR(A,V); VALUE A, V; REAL A; WORD V; 02078000
BEGIN 02079000
INTEGER T; 02080000
T ~REGISTERS [63]; 02081000
SIM1TOR ~ V; 02082000
END; 02083000
SAVE PROCEDURE MEMDUMP = (0,20) (I,J);VALUE I,J;REAL I,J;FORWARD; 02083100
WORD PROCEDURE JACKMONITOR (A, V); VALUE A, V; REAL A; WORD V; 02084000
FORWARD; 02085000
WORD PROCEDURE RAJMONITOR (A, V); VALUE A, V; REAL A; WORD V; 02086000
FORWARD; 02087000
WORD PROCEDURE BOBMONITOR (A, V); VALUE A, V; REAL A; WORD V; 02088000
FORWARD; 02089000
WORD PROCEDURE DONMONITOR (A, V); VALUE A, V; REAL A; WORD V; FORWARD; 02090000
WORD PROCEDURE STEVEMONITOR(A,V);VALUE A,V;REAL A;WORD V; FORWARD; 02090100
WORD PROCEDURE MIKEMONITOR(A,V); VALUE A,V; REAL A; WORD V; FORWARD; 02090200
REAL PROCEDURE GETUSERDISK(SEGMENTS, SPEED); 02091000
VALUE SEGMENTS, SPEED; 02092000
REAL SEGMENTS, SPEED; FORWARD; 02093000
PROCEDURE FORGETUSERDISK(DKADDR, SEGMENTS); 02094000
VALUE DKADDR, SEGMENTS; 02095000
REAL DKADDR, SEGMENTS; FORWARD; 02095500
REAL PROCEDURE NOUSERDISK(SEGMENTS, SPEED); 02095600
VALUE SEGMENTS, SPEED; 02095700
REAL SEGMENTS, SPEED; FORWARD; 02095800
SAVE PROCEDURE BLOCKEXIT = (0,10); FORWARD; 02096000
PROCEDURE FORGETDOPEVECTORS(DD); WORD ARRAY DD[*]; FORWARD; 02097000
SAVE PROCEDURE MOMTOVECTOR (MOM, VECTOR, INDEX); 02098000
VALUE COMMENT A COPY OR MOM DESCRIPTOR THAT IS AC- 02098100
CEPTABLE TO PRESENCE BIT; 02098200
COMMENT AN-UNINDEXED DESCRIPTOR THAT IS AC- 02099000
CEPTABLE TO AN NXLN OPERATOR; 02099100
INDEX; COMMENT THE INDEX FOR VECTOR WHERE MOM IS TO 02100000
BE PLACED; 02100100
WORD ARRAY MOM[*], 02100200
VECTOR[*]; 02100300
INTEGER INDEX; FORWARD; 02100400
SAVE REFERENCE PROCEDURE ALLOCATENAMEQ; FORWARD; 02101000
SAVE BOOLEAN PROCEDURE TURNOVERLAYKEY (ADDRESSOFMOM); 02102000
VALUE ADDRESSOFMOM; 02103000
INTEGER ADDRESSOFMOM; FORWARD; 02104000
SAVE PROCEDURE MAKEPRESENTANDSAVE (DATA); 02104100
WORD ARRAY DATA [*]; FORWARD; 02104200
PROCEDURE LIBMAIN(MFID);VALUE MFID;POINTER MFID;FORWARD; 02105000
SAVE INTEGER PROCEDURE CONSOLIDATEANDORDER(ADDRESS); 02109000
VALUE ADDRESS; 02110000
INTEGER ADDRESS; FORWARD; 02111000
PROCEDURE OPEN=(0,31)(FIB,TYPEV);VALUE TYPEV;ARRAY FIB[*];REAL TYPEV; 02111100
FORWARD; 02111200
PROCEDURE GOTOSOLVER = (0,11) (SIRW); VALUE SIRW; REAL SIRW; FORWARD; 02112000
REAL PROCEDURE FINDINPUT(LEB,CODE);VALUE CODE;INTEGER CODE;ARRAY LEB[*];02112010
FORWARD; 02112020
SAVE 02113000
WORD PROCEDURE MON1TOR (A, V); VALUE A, V; REAL A; WORD V; FORWARD; 02114000
INTEGER PROCEDURE VECTORINSERT(READYINDICATOR,NEWENTRY); 02115000
VALUE READYINDICATOR 02116000
, NEWENTRY 02117000
; 02118000
REAL READYINDICATOR 02119000
; 02120000
WORD NEWENTRY 02121000
; FORWARD; 02122000
PROCEDURE STACKQREARRANGE(READYINDICATOR) ; 02123000
VALUE READYINDICATOR 02124000
; 02125000
BOOLEAN READYINDICATOR 02126000
; FORWARD; 02127000
PROCEDURE STACKQREMOVE (PATH,STACKINDICATOR); 02128000
VALUE PATH 02129000
, STACKINDICATOR 02130000
; 02131000
REAL PATH 02132000
; 02133000
INTEGER STACKINDICATOR 02134000
; FORWARD; 02135000
PROCEDURE INSERTINQUEUE (PATH,STACKINDICATOR); 02136000
VALUE PATH 02137000
, STACKINDICATOR 02138000
; 02139000
REAL PATH 02140000
, STACKINDICATOR 02141000
; FORWARD; 02142000
INTEGER PROCEDURE GETINDEPENDENTRUNNERSTACK(STAKADRES);REAL STAKADRES; 02143000
FORWARD; 02144000
02145000
02146000
PROCEDURE NEXTPROCESS; FORWARD; 02147000
INTEGER PROCEDURE NEXTINSCHEDULE; FORWARD; 02148000
02149000
02150000
02151000
PROCEDURE SELECTION; FORWARD; 02152000
PROCEDURE RUN (PARAMETER,PROCEEDURE); 02153000
VALUE PARAMETER 02154000
; 02155000
WORD PARAMETER 02156000
; 02157000
PROCEDURE PROCEEDURE 02158000
; FORWARD; 02159000
WORD RUNPCW = RUN; COMMENT USED BY INDEPENDENTRUNNER MECHANISM; 02160000
PROCEDURE STANDARDINSERT(FIRSTENTRY,LASTENTRY,ENTRY); 02161000
VALUE ENTRY; 02162000
REFERENCE FIRSTENTRY,LASTENTRY,ENTRY; FORWARD; 02163000
PROCEDURE STANDARDDELINK(FIRSTENTRY,LASTENTRY,ENTRY); 02164000
VALUE ENTRY; 02165000
REFERENCE FIRSTENTRY,LASTENTRY,ENTRY; FORWARD; 02166000
SAVE PROCEDURE QUEUEMYSTACK (AUTHORITY, REQUIRED, COUNT, MYEVENT, HEAD);02167000
VALUE AUTHORITY, COMMENT THE SORTKEY FOR THIS QUEUE; 02168000
REQUIRED, COMMENT AN ADDITIONAL INFORMATION WORD FOR THE 02169000
QUEUE ENTRY; 02170000
COUNT; COMMENT A 10 BIT COUNTER IN THE STACK LINK 02171000
WORD FOR THIS QUEUE; 02172000
EVENT MYEVENT; COMMENT THE LOCAL EVENT MY STACK IS TO WAIT ON;02172500
INTEGER COUNT; 02172550
REAL AUTHORITY, 02172600
REQUIRED, 02172700
HEAD ; COMMENT A GLOBAL REAL THAT CONTAINS THE BACK- 02173000
WARD AND FORWARD LINKS FOR THE QUEUE. THE BACK 02174000
WARD LINK POINTS TO THE ENTRY WITH THE HIGHEST 02175000
AUTHORITY; FORWARD; 02176000
PROCEDURE DELINKASTACK (WHOSE, HEAD); 02177000
VALUE WHOSE; 02178000
INTEGER WHOSE; COMMENT THE AUTHORITY TYPE STACK TO DELINK; 02179000
REAL HEAD ; COMMENT THE HEAD OF THE AUTHORITY TYPE STACK; 02180000
FORWARD; 02181000
PROCEDURE PARAMETERINSERT (FIRSTPARAM, LASTPARAM, ENTRY); 02182000
VALUE ENTRY; 02183000
REFERENCE FIRSTPARAM, LASTPARAM, ENTRY; FORWARD; 02184000
BOOLEAN SIMULATING = (0,12); % TRUE FOR SIMULATOR RUN 02560000
VALUE ARRAY BCLTOEBC = (0,33) ~ ( 08000000
4"F0F1F2F3" 08001000
, 4"F4F5F6F7" 08002000
, 4"F8F97B7C" 08003000
, 4"6F7A6E69" 08004000
, 4"4EC1C2C3" 08005000
, 4"C4C5C6C7" 08006000
, 4"C8C94B70" 08007000
, 4"504D4C48" 08008000
, 4"00D1D2D3" 08009000
, 4"D4D5D6D7" 08010000
, 4"D8D95B5C" 08011000
, 4"605D5E49" 08012000
, 4"4061E2E3" 08013000
, 4"E4E5E6E7" 08014000
, 4"E8E96B6C" 08015000
, 4"597E6A7F" 08016000
); 08017000
VALUE ARRAY EBCTOBCL = (0,34) ~ ( 08018000
4"0C0C0C0C" 08019000
, 4"0C0C0C0C" 08020000
, 4"0C0C0C0C" 08021000
, 4"0C0C0C0C" 08022000
, 4"0C0C0C0C" 08023000
, 4"0C0C0C0C" 08024000
, 4"0C0C0C0C" 08025000
, 4"0C0C0C0C" 08026000
, 4"0C0C0C0C" 08027000
, 4"0C0C0C0C" 08028000
, 4"0C0C0C0C" 08029000
, 4"0C0C0C0C" 08030000
, 4"0C0C0C0C" 08031000
, 4"0C0C0C0C" 08032000
, 4"0C0C0C0C" 08033000
, 4"0C0C0C0C" 08034000
, 4"300C0C0C" 08035000
, 4"0C0C0C0C" 08036000
, 4"1F2F0C1A" 08037000
, 4"1E1D100C" 08038000
, 4"1C0C0C0C" 08039000
, 4"0C0C0C0C" 08040000
, 4"0C3C0C2A" 08041000
, 4"2B202E0C" 08042000
, 4"2C310C0C" 08043000
, 4"0C0C0C0C" 08044000
, 4"0C0F3E3A" 08045000
, 4"3B0C0E0C" 08046000
, 4"1B0C0C0C" 08047000
, 4"0C0C0C0C" 08048000
, 4"0C0C0D0A" 08049000
, 4"0B0C3D3F" 08050000
, 4"0C0C0C0C" 08051000
, 4"0C0C0C0C" 08052000
, 4"0C0C0C0C" 08053000
, 4"0C0C0C0C" 08054000
, 4"0C0C0C0C" 08055000
, 4"0C0C0C0C" 08056000
, 4"0C0C0C0C" 08057000
, 4"0C0C0C0C" 08058000
, 4"0C0C0C0C" 08059000
, 4"0C0C0C0C" 08060000
, 4"0C0C0C0C" 08061000
, 4"0C0C0C0C" 08062000
, 4"0C0C0C0C" 08063000
, 4"0C0C0C0C" 08064000
, 4"0C0C0C0C" 08065000
, 4"0C0C0C0C" 08066000
, 4"0C111213" 08067000
, 4"14151617" 08068000
, 4"18190C0C" 08069000
, 4"0C0C0C0C" 08070000
, 4"0C212223" 08071000
, 4"24252627" 08072000
, 4"28290C0C" 08073000
, 4"0C0C0C0C" 08074000
, 4"0C0C3233" 08075000
, 4"34353637" 08076000
, 4"38390C0C" 08077000
, 4"0C0C0C0C" 08078000
, 4"00010203" 08079000
, 4"04050607" 08080000
, 4"08090C0C" 08081000
, 4"0C0C0C0C" 08082000
); 08083000
SAVE VALUE ARRAY FOURBITSTUFF = (0,39) ~ ( 08083100
4"00010203", 4"04050607", 4"08091112", 4"13141516", 08083200
8"0123", 8"4567", 8"89AB", 8"CDEF" ); 08083300
DEFINE HEXTOBCL = FOURBITSTUFF[0]#, 08083400
HEXTOEBC = FOURBITSTUFF[4]#; 08083500
VALUE ARRAY TRUTHSETS = (0,38) ~ ( 08084000
6(0) % EBCDIC ALPHA-NUMERIC 08085000
, 4"7FC07FC0" % EBCDIC ALPHA-NUMERIC 08086000
, 4"3FC0FFC0" % EBCDIC ALPHA-NUMERIC 08087000
, 6(0) % EBCDIC ALPHABETIC 08088000
, 4"7FC07FC0" % EBCDIC ALPHABETIC 08089000
, 4"3FC00000" % EBCDIC ALPHABETIC 08090000
, 7(0) % EBCDIC NUMERIC 08091000
, 4"0000FFC0" % EBCDIC NUMERIC 08092000
, 4"FFC07FC0" % BCL ALPHA NUMERIC 08093000
, 4"7FC03FC0" % BCL ALPHA NUMERIC 08094000
, 4"00007FC0" % BCL ALPHABETIC 08095000
, 4"7FC03FC0" % BCL ALPHABETIC 08096000
, 4"FFC00000" % BCL NUMERIC 08097000
, 0 % BCL NUMERIC 08098000
, 2(0) % EBCDIC SPECIAL CHARACTERS 08098100
, 4"803F803F" % EBCDIC SPECIAL CHARACTERS 08098200
, 4"C03F007F" % EBCDIC SPECIAL CHARACTERS 08098300
, 0 % EBCDIC SPECIAL CHARACTERS 08098400
, 4"40000000" % EBCDIC SPECIAL CHARACTERS 08098500
, 4"80008000" % EBCDIC SPECIAL CHARACTERS 08098600
, 4"C0000000" % EBCDIC SPECIAL CHARACTERS 08098700
); 08099000
DEFINE EBCDICALPHANUMERIC = TRUTHSETS[00] #, 08100000
EBCDICALPHABETIC = TRUTHSETS[08] #, 08101000
EBCDICNUMERIC = TRUTHSETS[16] #, 08102000
BCLALPHANUMERIC = TRUTHSETS[24] #, 08103000
BCLALPHABETIC = TRUTHSETS[26] #, 08104000
BCLNUMERIC = TRUTHSETS[28]#, 08105000
EBCDICSPECIALS = TRUTHSETS[30]#, 08105100
ENDTRUTHSETS=0#;% 08105990
COMMENT THESE ARE THE 6500 POWERS OF TEN TABLES. 08106000
10*I=POTL[I.[05:06]]|POTM[I.[11:06])|POTH[I.[14:03]]. 08106500
THE VALUES ARE ALL DOUBLE PRECISION AND ARE ALL --TRUNCATED--. THE 08107000
FLAG-BIT OF THE MOST-SIGNIFICANT WORD IS THE FIRST BIT DROPPED 08107500
(FIRST BIT AFTER THE PERCENT). ALL VALUES WERE CALCULATED TO FULL 08108000
SIGNIFICANCE (I.E., AS INTEGERS), THEN CHOPPED TO 78 BITS.; 08108500
08109000
DOUBLE VALUE ARRAY POTL 08109500
08110000
~(3"1141000000000000",3"0000000000000000", % =@0000008110500
3"1131200000000000",3"0000000000000000", % =@0000108111000
3"1121440000000000",3"0000000000000000", % =@0000208111500
3"1111750000000000",3"0000000000000000", % =@0000308112000
3"1102342000000000",3"0000000000000000", % =@0000408112500
3"1073032400000000",3"0000000000000000", % =@0000508113000
3"1063641100000000",3"0000000000000000", % =@0000608113500
3"1054611320000000",3"0000000000000000", % =@0000708114000
3"1045753604000000",3"0000000000000000", % =@0000808114500
3"1037346545000000",3"0000000000000000", % =@0000908115000
3"1011124027620000",3"0000000000000000", % =@0001008115500
3"0001351035564000",3"0000000000000000", % =@0001108116000
3"0011643245121000",3"0000000000000000", % =@0001208116500
3"0022214116345200",3"0000000000000000", % =@0001308117000
3"0032657142036440",3"0000000000000000", % =@0001408117500
3"0043432772446150",3"0000000000000000", % =@0001308118000
3"0054341571157602",3"0000000000000000", % =@0001608118500
3"0065432127413542",3"0004000000000000", % =@0001708119000
3"0076740555316473",3"0001000000000000", % =@0001808119500
3"0111053071060221",3"0001720000000000", % =@0001908120000
3"0121265707274265",3"0004304000000000", % =@0002008120500
3"0131543271153342",3"0007365000000000", % =@0002108121000
3"0142074147406233",3"0005262200000000", % =@0002208121500
3"0152513201307702",3"0004536640000000", % =@0002308122000
3"0163236041571663",3"0001666410000000", %0 =@0002408122500
3"0174105452130240",3"0000244112000000", %00 =@0002508123000
3"0205126764556310",3"0000315134400000", %000 =@0002608123500
3"0216354561711772",3"0000400363500000", %0000 =@0002708124000
3"0231004771627437",3"0000450046042000", %000000 =@0002808124500
3"0241206170175346",3"0006562057453400", %0000000 =@0002908125000
3"0251447626234640",3"0004316473365100", %00000000 =@0003008125500
3"0261761573704010",3"0005402212262320", %000000000 =@0003108126000
3"0272356132665012",3"0006702654737004", %0000000000 =@0003208126500
3"0303051561442215",3"0004463430126605", %00000000000 =@0003308127000
3"0313664115752660",3"0007600336154346", %200000000000 =@0003408127500
3"4324641141345435",3"0001540425607437", %6400000000000 =@0003508128000
3"4336011371636744",3"0004070533151347", %6100000000000 =@0003608128500
3"4347413670206535",3"0005106662003641", %5520000000000 =@0003708129000
3"0361131664625026",3"0005033043640461", %2104400000000 =@0003808129500
3"4371360241772234",3"0002241654610575", %4525500000000 =@0003908130000
3"4401654312370703",3"0002712227752734", %7653020000000 =@0004008130500
3"0412227375067064",3"0001474675745524", %1625624000000 =@0004108131000
3"0422675274304701",3"0002014055337051", %2173171000000 =@0004208131500
3"4433454553366061",3"0004417070626663", %4632027200000 =@0004308132000
3"4444367706263475",3"0007522706774440", %4000435040000 =@0004408132500
3"4455465667740415",3"0003347470573550", %5000544250000 =@0004508133000
3"4467003245730520",3"0006361406732502", %6200675322000 =@0004608133500
3"0501060411731664",3"0005005571052122", %3364105460640 =@0004708134000
3"0511274514320241",3"0006207127264547", %0261126775010 =@0004808134500
3"4521553637404312",3"0001650755141700", %6335354574212 =@0004908135000
3"0532106607305374",3"0006223150372261", %0024647733254 =@0005008135500
3"0542530351166673",3"0007670002470735", %2032021722127 =@0005108136000
3"4553256443424452",3"0007646003207124", %4440426306555 =@0005208136500
3"4564132154331565",3"0005617404050751", %5550533770310 =@0005308137000
3"0575160607420123",3"0001163305063144", %1102662766373 =@0005408137500
3"0606414751324147",3"0007420166277775", %1323437564071 =@0005508138000
3"4621012014361120",3"0001732422375777", %4361034752111 =@0005608138500
3"0631214417455344",3"0002321127075377", %3455244144533 =@0005708139000
3"0641457523370635",3"0003005354714677", %2370515175662 =@0005808139500
3"0651773450267004",3"0005606650100057", %1066640435236 =@0005908140000
3"4662372362344605",3"0007150422120072", %7304410544506 =@0006008140500
3"4673071057035747",3"0003002526544111", %5165512675627 =@0006108141000
3"0703707272645341",3"0001603254275134", %0423035455175 =@0006208141500
3"0714671151416631",3"0004144127354363");%0527644770435 =@0006308142000
DOUBLE VALUE ARRAY POTM 08142500
08143000
~(3"1141000000000000",3"0000000000000000", % =@0000008143500
3"4726047403722377",3"0007175154247457", %6655616166544 =@0006408144000
3"4014473510762300",3"0023514315770633", %6315541553040 =@0012808144500
3"0103403417361516",3"0032235253250267", %3704517643661 =@0019208145000
3"0172523756577347",3"0043747364335667", %3440156307756 =@0025608145500
3"0262014102745174",3"0055463433536324", %1053014006506 =@0032008146000
3"0351423057061025",3"0066761250270402", %3777752636047 =@0038408146500
3"4441125722256075",3"0073757717235176", %5234420343164 =@0044808147000
3"0527061464053523",3"0100164434331431", %2561245705013 =@0051208147500
3"4615310177342265",3"0115474537630672", %7473770141554 =@0057608148000
3"0704060636744362",3"0125124721622671", %1262127057024 =@0064008148500
3"4773070652155207",3"0137074016271665", %5207710607022 =@0070408149000
3"4062271771625063",3"0152002464306621", %5177450026246 =@0076808149500
3"0151627122640561",3"0165346774161061", %0506313263060 =@0083208150000
3"4241272171262634",3"0173653557514160", %5215416216354 =@0089608150500
3"0331022323162501",3"0205135477216203", %1245320571711 =@0096008151000
3"0416227316541500",3"0215650301354503", %2364507430552 =@0102408151500
3"0504620511515514",3"0225724603203653", %0555750424133 =@0108808152000
3"0573504063603007",3"0230356777015603", %0655471421103 =@0115208152500
3"0662605010657142",3"0245363441540115", %3421137501315 =@0121608153000
3"0752061310601672",3"0257025566260413", %3631527002756 =@0128008153500
3"0041457313355310",3"0276331702015753", %3773670162764 =@0134408154000
3"4131153323315222",3"0306736070051361", %5040437573377 =@0140808154500
3"4217264213744524",3"0311675660467444", %4154541753113 =@0147208155000
3"4305453406516634",3"0326235176210225", %7260732301656 =@0153608155500
3"0374174156441746",3"0333645413752311", %0303470002531 =@0160008156000
3"4463162072241271",3"0341737734347416", %7422224407341 =@0166408156500
3"0552345400577533",3"0356011231622714", %1525032050036 =@0172808157000
3"0641670156730222",3"0362225342141324", %0160746354415 =@0179208157500
3"4731323261527331",3"0372522515457463", %6343655705733 =@0185608158000
3"4021045371360351",3"0413414001145703", %5702156731116 =@0192008158500
3"4106413245605716",3"0426047563137443", %5242020310123 =@0198408159000
3"0174750547327342",3"0434752736224723", %2243161451531 =@0204808159500
3"4263606774750311",3"0446764211226705", %4547637466166 =@0211208160000
3"4352667652055261",3"0454023267541401", %7377467717610 =@0217608160500
3"4442127774503364",3"0463742052221706", %4122154367526 =@0224008161000
3"0531514561003110",3"0471751001571765", %0310004020172 =@0230408161500
3"4621201540275231",3"0506473330776521", %5366506221123 =@0236808162000
3"0707473511634104",3"0517004116002775", %1152751023607 =@0243208162500
3"4775622261444010",3"0521205705141406", %7655434075660 =@0249608163000
3"4064312252460020",3"0542417412313577", %5502311046401 =@0256008163500
3"0153255351072377",3"0556751574341722", %1215026472552 =@0262408164000
3"4242422450716472",3"0565704017717023", %6360057144043 =@0268808164500
3"4331732353517622",3"0577535625522740", %5134162537656 =@0275208165000
3"0421355270251523",3"0603662737142310", %0207247354427 =@0281608165500
3"0511071176733572",3"0613704412666424", %2133176163115 =@0288008166000
3"0576603323156425",3"0623433740626150", %0550153112134 =@0294408166500
3"0665103732441040",3"0630015131727227", %3211033421651 =@0300808167000
3"0753714225644566",3"0641055324257642", %0430466411545 =@0307208167500
3"4042754362757206",3"0667221753325314", %7312430336457 =@0313608168000
3"4132177767210373",3"0670275217323337", %7025527435203 =@0320008168500
3"0221553062356341",3"0707214653450062", %3447603463570 =@0326408169000
3"0311230607367652",3"0716463771052416", %1546004325010 =@0332808169500
3"0377707704136465",3"0723164760756106", %3250540305734 =@0339208170000
3"4465774701726534",3"0732463541673204", %4732427535727 =@0345608170500
3"0554433204752653",3"0746747152676716", %3707123370534 =@0352008171000
3"0643352734424257",3"0756237637571265", %2043073016410 =@0358408171500
3"0732501217041756",3"0762617070716002", %2726527630323 =@0364808172000
3"0021775736715436",3"1005415273205562", %1025012750314 =@0371208172500
3"4111410235752271",3"1011076017302041", %6734200515373 =@0377608173000
3"0201115560167157",3"1025614475554304", %3513554047640 =@0384008173500
3"4266777643636764",3"1030310431025755", %4146654653371 =@0390408174000
3"0355242335310112",3"1046512350074012", %0066765167472 =@0396808174500
3"4444024052516417",3"1051111675276213");%4500576335227 =@0403208175000
DOUBLE VALUE ARRAY POTH 08175500
08176000
~(3"1141000000000000",3"0000000000000000", % =@0000008176500
3"4533043005100212",3"1064202274654451", %4052376002244 =@0409608177000
3"4431132435035057",3"2157536204320307", %6050444301372 =@0819208177500
3"0323470676540576",3"3242655607106551", %3574104722476 =@1228808178000
3"0221305102507076",3"4331314016653042", %3341046467066 =@1638408178500
3"4114177702444352",3"5423212615565017", %4553563624050 =@2048008179000
3"4011502433123006",3"6513114751647704", %4507464541024 =@2457608179500
3"4705000563145240",3"7575774067453713");%5601112567747 =@2867208180000
08180500
COMMENT SKELETON PARAMETER QUEUE ENTRIES FOR COMPILER 08247000
FILES.; 08248000
SAVE ARRAY COMPILERCODEFILE ~ ( 08249000
4"000003000008", 4"010104C3D6C4C500"), 08250000
COMPILERCARDFILE ~ ( 08251000
4"000003000008", 4"010104C3C1D9C400"), 08252000
COMPILERCARDEXTERNAL ~ ( 08253000
4"000005000015", 4"010112000000", 0, 0, 0); 08254000
QUEUE STANDARDQUEUE (PREVIOUSSTANDARD, NEXTSTANDARD); 09000000
VALUE PREVIOUSSTANDARD, NEXTSTANDARD; 09001000
REFERENCE PREVIOUSSTANDARD, NEXTSTANDARD; 09002000
COMMENT STANDARDQUEUE EXISTS ONLY TO ESTABLISH THE LOCATION OF ITS09003000
ITEMS FOR USE BY QUEUEING ALGORITHMS THAT DEAL WITH QUEUES09004000
THAT ARE ORDERED ON A FIRST IN - FIRST OUT BASIS.; 09005000
USING LOCKED; 09006000
INTEGER PBLOK %PRESENCE BIT LOCK 10000000
, GROSSLOK % LOCK ON INTERRUPTS 10001000
, PROCESSCHANGELOCK 10002000
; 10003000
DEFINE SETOVERFLOWFF = ; # 10004000
; 10005000
REAL MULTIPLEREFERENCELOK %FOR PRESENCE BIT 10006000
; 10007000
REAL MONITORLOCK; % MONITOR 10008000
REAL MONITORVALUE = (0,8), 10009000
MONITORMASK = (0,9); 10010000
FIELD MONMASKF = 19:10, MONVALF =9:10; 10011000
DEFINE JACKBIT =2# 10012000
,RAJBIT =4# 10013000
,DONBIT = 8# 10014000
,BOBBIT =16# 10015000
,STEVEBIT = 32# 10015100
,MIKEBIT = 64# 10015200
,GLOBALSTOP = STOP (PDR, PIR)# 10015990
; 10016000
COMMENT THE FOLLOWING DEFINES SPECIFY VALUES OF 10017000
PARAMETERS TO PROCEDURES SUCH AS KILLME, 10018000
NOTYETCODED AND ARITHMETICFAULT 10019000
; 10020000
DEFINE DZ = 1# )"DIVIDE BY ZERO "(10021000
EO = 2# )"EXPONENT OVERFLOW "(10022000
EU = 3# )"EXPONENT UNDERFLOW "(10023000
II = 4# )"INVALID INDEX "(10024000
IO = 5# )"INTEGER OVERFLOW "(10025000
GCAINTERRUPT = 6# )"FIRST UNASSIGNED MPX INT"(10026000
STACKOVER = 7# )"STACK OVERFLOW "(10027000
SYLLABLEDEPENDENT2 = 8# )"COMPROMISED SYLLABLE DEP"(10028000
BLOWUP = 9# )"BASE FOR ALARM INTERRUPT"(10029000
LOOP = 10# )" "(10030000
MEMPARITY = 11# )" "(10031000
MPXPARITY = 12# )" "(10032000
INVALIDADDRESS = 13# )" "(10033000
STACKUNDER = 14# )"STACK UNDERFLOW "(10034000
INVALIDOPCODE = 15# )"CODE NOT VALID OPERATOR "(10035000
MEMPROTECT = 16# )" "(10036000
INVALIDOP = 17# )"OPERATION ILLEGAL "(10037000
SEQERROR = 18# )"SEQUENCE ERROR "(10038000
ML1 = 19# )"INTERUPT ON MULTI-LINE 1"(10039000
ML2 = 20# )"INTERUPT ON MULTI-LINE 2"(10040000
ML3 = 21# )" "(10041000
ML4 = 22# )" "(10042000
EXTMPX = 23# )"EXTERNAL MPX "(10043000
UA2 = 24# )"SECND UNASSIGNED MPX INT"(10044000
UA3 = 25# )"THIRD UNASSIGNED MPX INT"(10045000
UA4 = 26# )"FORTH UNASSIGNED MPX INT"(10046000
MACHINEERROR = 27# )"HOPEFULLY "(10047000
PRTOPR = 28# )"PROCESSOR TO PROCESSOR "(10048000
STACKBOTTOM = 29# )"BOTTOM OF STACK INT "(10049000
EVENTLISTERR = 30 # %ERROR IN EVENTIST 10050000
, INTERRUPTDEC = 31 # %ERROR IN INTERRUPT DEC 10051000
10052000
, GROSSLOCK = 64 # % TEMPORARY GROSSLOK STOP 10053000
; 10054000
COMMENT FOLLOWING ARE THE VARIOUS VALUES OF THE TAG FIELD; 10055000
DEFINE SINGL = 0 #, 10056000
IRW = 1 #, 10057000
DOUBL = 2 #, 10058000
MEMLINK = 3 #, 10059000
CODE = 3 #, 10060000
SEGDESC = 3 #, 10061000
MSCW = 3 #, 10062000
TOS = 3 #, 10063000
RCW = 3 #, 10064000
DATADESC = 5 #, 10065000
STRINGDESC = 5#, 10066000
UNITAL = 6 #, 10067000
PCW = 7 # 10068000
; 10069000
10070000
DEFINE SINGLE = SINGL# 10071000
; 10072000
FIELD FULLWORD = 47:48 10073000
; 10074000
LAYOUT DATADESCRIPTOR ( TAG ~ DATADESC 10075000
, PBITF = 47:1 %PRESENCE BIT 10076000
, CBITF = 46:1 %COPY BIT 10077000
, IBITF = 45:1 %INDEXED BIT 10078000
, SBITF = 44:1 %SEGMENT BIT 10079000
, RBITF = 43:1 %READ ONLY BIT 10080000
, NUF =42:2:=0 %MUST BE ZERO 10081000
, DBITF = 40:1 %DOUBLE PREC. BIT 10082000
, LENTHINDEXF=39:20 %LENGTH/INDEX FLD 10083000
, ADDRESSF = 19:20 %ADDRESS FIELD 10084000
) 10085000
, REFERENCED ( PBITF 10086000
, IBITF 10086100
, LENTHINDEXF 10087000
, ADDRESSF 10088000
) 10089000
, DESCADDRESS ( ADDRESSF 10090000
) 10091000
, STRINGDESCRIPTOR ( TAG ~ STRINGDESC 10092000
, PBITF 10093000
, CBITF 10094000
, IBITF ~ 0 10095000
, SBITF 10096000
, RBITF 10097000
, SZF = 42:3 %CHARACTER SIZE 10098000
, LENGTHSTF = 39:20 %LENGTH FIELD 10099000
, ADDRESSF 10100000
) 10101000
, INDEXEDSTRINGDESCRIPTOR(TAG ~ STRINGDESC 10102000
, PBITF 10103000
, CBITF 10104000
, IBITF ~ 1 10105000
, SBITF 10106000
, RBITF 10107000
, SZF 10108000
, BYTEF = 39:4 %BYTE FILED 10109000
, INDEXSTF = 35:16 %INDEX FILED 10110000
, ADDRESSF 10111000
) 10112000
, SEGMENTDESCRIPTOR( TAG ~ SEGDESC 10113000
, PBITF 10114000
, CBITF 10115000
, DICTIONARYF = 45:1 10116000
, LOCKBITF = 44:1 10117000
, LENGTHSEGF 10118000
, ADDRESSF 10119000
, SVBITF =19:1 %SAVE BIT FIELD 10120000
) 10121000
, SETTAG ( TAG 10122000
) 10123000
; 10124000
DEFINE LENGTHF = LENTHINDEXF #%)CONVENIENT 10125000
, INDEXF = LENTHINDEXF #%)NOMENCLATUR10126000
, EBCDIC = 4 # %CHARACTER SIZE AS 10127000
, BCL = 3 # %PER SZF FIELD IN 10128000
, DIGIT = 2 # %STRING DESCRIPTOR 10129000
, TAGZOT(X) = (X) & SETTAG(SINGL) # 10130000
, DESCRIPTORLOCK =(MOM.DESCRIPTORLOCKF 10130100
=7 AND KIND = DATADESC) # 10130200
; 10131000
FIELD OLAYTYPEF = 18:1 10132000
10133000
, FILETYPEF = 18:1 10134000
, MCPF = 19:1 10135000
, AITINDICATORF = 17:1 10136000
, ADDRESF = 16:17 10137000
, DESCRIPTORLOCKF = 19:3 10137100
, MCPCODEF =19:2 10138000
; 10139000
LAYOUT NOTPRESENTARRAYDESCL( 10139050
PCBITSF = 47:2 ~0 10139100
, LENGTHF 10139150
, MCPCODEF 10139200
, AITINDICATORF 10139300
, ADDRESF 10139350
), 10139400
ARRAYDESCL ( 10139430
PCBITSF ~ 2 10139450
, LENGTHF 10139500
, ADDRESSF 10139550
); 10139600
COMMENT FOLLOWING IS THE FORMAT OF THE NORMAL AND STUFFED IRWS; 10140000
LAYOUT NORMALIRW ( TAG ~ IRW 10141000
, EBITF = 46:1 ~ 0 % E BIT 10142000
, ADRCPLF = 13:14 10143000
) 10144000
, STUFFEDIRW ( TAG ~ IRW 10145000
, EBITF ~ 1 10146000
, STKNRF = 45:10 10147000
, DISPF = 35:16 %OF MKST10148000
, SIRWDELTAF = 12:13 %DELTA 10149000
) 10150000
, MARKSTACKCW( TAG ~ MSCW 10151000
, DSBITF =47:1 10152000
, EBITF 10153000
, STKNRF 10154000
, VBITF = 19:1 10155000
, LLF = 18:5 10156000
, DFF = 13:14 10157000
) 10158000
, MARKSTACKWD( TAG ~ MSCW 10159000
, DSBITF 10160000
, EBITF 10161000
,STKNRF 10162000
, DISPFMS = 35:16 10163000
, VBITF 10164000
, LLF 10165000
, DFF 10166000
) 10167000
, RETURNCONTROLWORD (TAG ~ RCW 10168000
, STKNRF 10169000
, PSRF =35:3 10170000
, PIRF = 32:13 10171000
, NCSFF= 19:1 10172000
, LLF 10173000
, SDIF = 13:14 10174000
) 10175000
, POINTTOIOCB ( LOCKBITF 10176000
, ADDRESSF 10177000
) 10178000
; 10179000
COMMENT FOLLOWING IS FORMAT OF TOS CONTROL WORD; 10180000
LAYOUT TOSCW ( TAG ~ TOS 10181000
, SGNFFF = 47:1 10182000
, OFFFF = 46:1 10183000
, TFFFF = 45:1 10184000
, FLTFF = 44:1 10185000
, DSF = 39:20 10186000
, NCSFF 10187000
, LLF 10188000
, DF = 13:14 10189000
) 10190000
; 10191000
COMMENT FOLLOWING IS THE FORMAT OF THE FIRST WORD OF AN EVENT; 10192000
LAYOUT FIRSTEVENTWORD(TAG~DOUBL 10193000
,COUNTF = 47:27 10194000
, WAITQHEADF= 18:10 % HEAD WAITQ 10195000
, WAITQTAILF= 22:10 % TAIL WAITQ 10196000
, AVAILABLEBITF= 2:1 10197000
, HAPPENEDBITF = 1:1 10198000
, EVENTLOCKBITF= 0:1 10199000
) 10200000
; 10201000
FIELD EVENTLINKSF = 22:20 10202000
; 10203000
LAYOUT LOKMOM(LOCKBITF,DESCRIPTORLOCKF) 10204000
, FIXDESC(PBITF,LOCKBITF,ADDRESSF) 10205000
, SETCOPYBIT(CBITF) 10206000
; 10207000
SAVE 10208000
REAL ARRAY SOFTWAREINTERRUPTMASK[32]%EACH BIT INDICATES WHETHER 10209000
%THERE ARE ANY SOFTWARE 10210000
%INTERRUPTS FOR THE CORRES- 10211000
%PONDING STACK 10212000
; 10213000
10214000
FIELD ENABLEBITF = 46:1 10215000
, MOD32F = 4:5 10216000
, DIV32F = 9:5 10217000
, MOD64F = 5:6 10217010
, DIV64F = 9:4 10217020
, D0DISPF = 12:13 10217100
, D2DISPF = 11:12 10217200
, D4DISPF = 10:11 10217300
, D8DISPF = 9:10 10217400
, D16DISPF = 8:9 10217500
, D0D1SEGBIT= 13:1 10217600
, REALSDIF = 12:13 10217700
; 10218000
DEFINE MYCOURSEWORD = 20 # 10219000
, CODEFILEDESC=1# 10220000
, OLAYFILEDESC=2# 10221000
; 10222000
10223000
10224000
REAL COUNTFORTIMERINTERRUPTEVENT 10225000
, NUMBEROFPROCESSORS 10226000
; 10227000
BOOLEAN MORETHANONEPROCESSOR 10228000
; 10229000
DEFINE IFTHEREISASOFTWAREINTERRUPT = 10230000
IF BOOLEAN (SOFTWAREINTERRUPTMASK 10231000
[MYSNR.DIV32F].MOD32F)# 10232000
, MYCOURSE = STACK[MYSNR,MYCOURSEWORD] # 10233000
, MYDIVIDEBYZERO(X) = KILLME(WHICH) # 10234000
, MYEXPONENTUNDERFLOW(X) = KILLME(WHICH) # 10235000
, MYEXPONENTOVERFLOW(X) = KILLME(WHICH) # 10236000
, MYINVALIDINDEX(X) = KILLME(WHICH) # 10237000
, MYINTEGEROVERFLOW(X) = KILLME(WHICH) # 10238000
; 10239000
REAL CORESIZE = (0,6) 10240000
, SOFTWAREINTERRUPTLOCK= (0,17) 10241000
, INDEPENDENTRUNNERSTACKS 10242000
; 10243000
SAVE REFERENCE ARRAY 10244000
SHEETVECTOR = (0,16) [* ] 10245000
; 10246000
SAVE WORD ARRAY 10247000
SHEETARRAY = SHEETVECTOR[*,*] 10248000
; 10249000
SAVE REAL ARRAY 10250000
SHEETREALS = SHEETVECTOR[*,*] 10250200
; 10251000
COMMENT THE FOLLOWING ILLUSTRATE THE METHOD OF ACCESSIN REGISTERS; 10252000
DEFINE D = REGISTERS # , 10253000
D0 = D[0] #, 10254000
D1 = D[1] #, 10255000
D2 = D[2] #, 10256000
D3 = D[3] #, 10257000
D4 = D[4] #, 10258000
D5 = D[5] #, 10259000
D6 = D[6] #, 10260000
D7 = D[7] #, 10261000
D8 = D[8] #, 10262000
D9 = D[9] #, 10263000
D10 = D[10]#, 10264000
D11 = D[11]#, 10265000
D12 = D[12]#, 10266000
D13 = D[13]#, 10267000
D14 = D[14]#, 10268000
D15 = D[15]#, 10269000
D16 = D[16]#, 10270000
D17 = D[17]#, 10271000
D18 = D[18]#, 10272000
D19 = D[19]#, 10273000
D20 = D[20]#, 10274000
D21 = D[21]#, 10275000
D22 = D[22]#, 10276000
D23 = D[23]#, 10277000
D24 = D[24]#, 10278000
D25 = D[25]#, 10279000
D26 = D[26]#, 10280000
D27 = D[27]#, 10281000
D28 = D[28]#, 10282000
D29 = D[29]#, 10283000
D30 = D[30]#, 10284000
D31 = D[31]#, 10285000
IRSR(X) = REGISTERS[X+32]#, 10286000
PIR = REGISTERS[32]#, 10287000
SIR = REGISTERS[33]#, 10288000
DIR = REGISTERS[34]#, 10289000
TIR = REGISTERS[35]#, 10290000
LOSR = REGISTERS[36]#, 10291000
BOSR = REGISTERS[37]#, 10292000
F = REGISTERS[38]#, 10293000
BRSR(X) = REGISTERS[X+48] #, 10294000
PBR = REGISTERS[48]#, 10295000
SBR = REGISTERS[49]#, 10296000
DBR = REGISTERS[50]#, 10297000
TBR = REGISTERS[51]#, 10298000
S = REGISTERS[52]#, 10299000
SNR = REGISTERS[53]#, 10300000
PDR = REGISTERS[54]# 10301000
; 10302000
DEFINE OLAYROWLENTH = 180 # 10303000
, CODEROWLENTH = 180 # 10304000
; 10305000
DEFINE UPTOYOU =0# )"THE MCP DOES AS IT PLEASES "(10306000
FINISH =1# )"THE MCP MUST D-ES ME "(10307000
CARRYON =3# )"THE MCP MUST IGNORE INTERRUPT "(10308000
TELLME =4# )"THE MCP MUST SET SOME FLAGS "(10309000
SELECT =5# )"ACCESS PCW APPROPRIATE TO INTERUPT"(10310000
FAULTROUTINE =6# 10311000
; 10312000
DEFINE DISABLEOVERLAY = ;# % DUMMY DECLARATION 10313000
, ENABLEOVERLAY = ;# % DUMMY DECLARATION 10314000
; 10315000
PROCEDURE HANDLETHESOFTWAREINTERRUPT;; 10316000
COMMENT THIS IS A DUMMY PROCEDURE; 10317000
QUEUE SOFTWAREINTERRUPTQ(Y);REAL Y; 10318000
COMMENT THIS IS A DUMMY DECLARATION; 10319000
USING 10320000
TO INSERT,ENTRY ~ENTRY 10321000
; 10322000
DEFINE SETINTERVALTIMER = TIMER(100)#; 10323000
SAVE PROCEDURE KILLME(KILLVALUE); VALUE KILLVALUE; REAL KILLVALUE; 10324000
BEGIN 10325000
MONITOR JACKMONITOR(KILLVALUE); 10326000
LAYOUT KILLLAYOUT (39:16, 19:20); 10326100
KILLVALUE~KILLVALUE; 10327000
STOP (0&KILLLAYOUT (KILLVALUE, PDR), PIR); 10328000
IF NOT SIMULATING THEN MEMDUMP(0,0); 10328100
STOP(4"93C838E049E4",4"038038E491C0"); 10328200
END KILLME; 10329000
PROCEDURE MYFAULT(W); WORD W;; %DUMMY DEC 10330000
LAYOUT FIRSTPOINTERWORDL 10982000
(TOTALINFOWORDSF= 47:16 10983000
,INFOINDEXF = 31: 8 10984000
,INFOLENGTHF = 23: 8 10985000
,INFOTYPEF = 15: 9 10986000
,ALFALENGTHF = 6: 7 10987000
,KEYFIELDF = 15:16 10988000
); 10989000
COMMENT DEFINES FOR INFOTYPEF AS USED IN PARAMETER QUEUE10990000
ALGORITHMS. VALUES SHOULD BE GREATER THAN 128 10991000
AND LESS THAN 511.; 10992000
DEFINE FILETYPEP = 129#, 10993000
ENDOFPTYPE= 511#; 10994000
DEFINE UPDATEWORDCOUNT(NEWWORDS, ENTRY) = 10995000
REPLACE POINTERTOID@(ENTRY) 10996000
BY (REAL(POINTERTOID@(ENTRY) , 6) & 10997000
FIRSTPOINTERWORDL(NEWWORDS)) 10998000
FOR 6 #, 10999000
UPDATEINFOINDEX (INFOI, ENTRY) = 10999900
REPLACE POINTERTOID@(ENTRY) 10999930
BY (REAL(POINTERTOID@(ENTRY), 6) & 10999960
FIRSTPOINTERWORDL(*,*,INFOI))FOR 6 ;#;10999990
COMMENT STORAGE ALLOCATION VARIABLES ***********; 11000000
INTEGER PREVADDR, COMMENT THE ABSOLUTE ADDRESS FOR AVAILA OF THE 11001000
LARGEST AVAILABLE AREA NOT FOLLOWING AN OVER- 11002000
LAYABLE AREA OF MEMORY; 11003000
AVAILI, COMMENT THE ABSOLUTE ADDRESS OF THE FIRST 11004000
AVAILABLE LINK.; 11005000
MINDEX, COMMENT A UTILITY MEMORY INDEX; 11006000
MLENGTH, COMMENT A UTILITY MEMORY LENGTH; 11007000
AVAILABLECORE, COMMENT THE AMOUNT OF PRIMARY MEMORY(FRAGMENTED 11007100
OR OTHERWISE) THAT IS AVAILABLE AT ANY MOMENT; 11007200
SPACEQHEAD, COMMENT THE STACK THAT CONTAINS THE SUPER 11007300
SPACE AUTHORITY AND THE LINK TO THE STACK THAT 11007400
HAS THE SPACE REQUEST WITH THE HIGHEST PRIORITY;11007500
BACKALLOCATED, COMMENT ABSOLUTE ADDRESS LINKA FOR MOST 11008000
RECENTLY ALLOCATED AREA.; 11009000
LEFTOFF, COMMENT ABSOLUTE ADDRESS OF LINKA FOR HEAD OF 11010000
LEFTOFF LIST.; 11011000
STOPPER; COMMENT ABSOLUTE ADDRESS OF AVAILA FOR END OF 11012000
AVAILABLE LIST. BIT 42:1 = 1, I.E. SIZE IS 11013000
LARGER THAN LARGEST MEMORY POSSIBLE AND THE LINK11014000
IS ZERO. AVAILB OF STOPPER IS ADDRESS OF LARG- 11015000
EST AVAILABLE AREA.; 11016000
REAL SPACELOCK; COMMENT SPACELOCK INSURES THAT ONLY ONE PROC- 11017000
CESS AT A TIME HAS ACCESS TO MEMORY LINKS. IT 11018000
IS THEREFORE BUZZED UPON ENTRY TO GETSPACE AND 11019000
FORGETSPACE AND UNLOCKED BEFORE THESE PROCEDURES11020000
ARE EXITED.; 11021000
DEFINE FASTPLACE = BACKWARDLINKF#, 11021100
SLOWPLACE = FORWARDLINKF #, 11021200
RETRYCOUNT = SELFIDENTF #, 11021300
SPACERETRY = 10#; COMMENT THE MAXIMUM NUMBER OF TIMES A 11021400
SPACE "QUEUE" ENTRY CAN BE IGNORED BECAUSE AN 11021500
ORDERED SIZE IS NOT ADEQUATE. THE ENTRY MUST BE11021600
AT THE HEAD OF THE QUEUE BEFORE THE COUNTER IS 11021700
DECREMENTED.; 11021800
LAYOUT LINKA COMMENT THE FIRST LINK WORD OF AN IN-USE AREA; 11022000
(TAG ~ 3, 11023000
INUSEID = 47:10, COMMENT THE USERS ID FOR THIS AREA ; 11024000
INUSELENGTH = 37:17, COMMENT A SELF-RELATIVE INDEX FOR 11025000
FINDING LINKZ FOR THIS AREA. I.E. LENGTH OF 11026000
AREA + NUMBER OF LINK WORDS; 11027000
AVAILABLE = 20:1 ~ 0, 11028000
BACKLINK = 19:20), COMMENT THE LINK TO THE LAST PREVIOUSLY11029000
ALLOCATED AREA FOR THIS USER; 11030000
LINKB COMMENT THE SECOND LINK WORD OF AN IN-USE AREA;11031000
(TAG ~ 3, 11032000
USAGE = 47:7, COMMENT THE USAGE OF THE AREA; 11033000
ADDRTYPE = 40:1, COMMENT IS THE ADDRESS OF MOM ABSOLUTE OR11034000
BOS RELATIVE. 1 IS BOS RELATIVE.; 11035000
ADDRMOM = 39:20, COMMENT THE ADDRESS OF THE MOM DESCRIPT;11036000
DISKADDR = 19:20), COMMENT THE DISK ADDRESS OF THE AREA 11037000
DESCRIBED BY MOM. 19:1 = 1 INDICATES OVERLAY 11038000
DISK.; 11039000
LINKC COMMENT THE THIRD LINK WORD OF AN IN-USE AREA; 11040000
(TAG ~ 3 11041000
), COMMENT THIS WORD IS RESERVED FOR EXPANSION; 11042000
LINKZ COMMENT THE FINAL LINK WORD OF AN IN-USE AREA; 11043000
(TAG ~ 3, 11044000
OLAY = 47:1, COMMENT THE PERMANENT OVERLAYABLE STATE OF 11045000
AN AREA. GETSPACE PLACES THE RESULT OF A 11046000
LOGICAL AND OF THE OERLAY BIT OF ITS TYPE 11047000
AND ADDRESS (OF MOM)! 0 IN THIS BIT; 11048000
DELTAWDS = 46:5, 11049000
FRONTLINK =43:20, COMMENT - CHECK-OUT * * * * * * * 11050000
FRONTLINK = 41:20, COMMENT THE LINK TO THE NEXT ALLOCATED11051000
AREA FOR THIS IN-USE ID.; 11052000
SPACEOLAYLOCK = 21:1, COMMENT IF BIT IS ON AREA IS OVER-11053000
LAYABLE. GETSPACE TURNS THE BIT OFF AND THE 11054000
CALLER HAS THE RESPONSIBILITY OF EXCHANGING THE 11055000
OLAY BIT AND THIS BIT.; 11056000
AVAILABLE ~ 0, 11057000
INUSELENGTHZ = 19:20), COMMENT A SELF-RELATIVE INDEX FOR 11058000
FINDING LINKA OF THIS AREA.; 11059000
AVAILA COMMENT THE FIRST LINK WORD OF AN AVAILABLE AREA.; 11060000
(TAG ~ 3, 11061000
PREOLAY = 41:1, COMMENT THE OLAY BIT OF THE PREVIOUS 11062000
AREA; 11063000
LENGTH = 40:20, COMMENT A SELF-RELATIVE INDEX TO AVAILZ 11064000
OF THIS AREA. LENGTH = WORDS IN AREA + LINKSIZ;11065000
AVAILABLE ~ 1, 11066000
LINK = 19:20), COMMENT THE ABSOLUTE ADDRESS OF THE NEXT 11067000
AVAILABLE AREA; 11068000
AVAILB COMMENT THE SECOND LINK WORD OF AN AVAILABLE AREA.; 11069000
(TAG ~ 0, 11070000
LINKTOPREVIOUSAVAILABLEAREA = 47:48), 11071000
AVAILZ COMMENT THE FINAL LINK WORD OF AN AVAILABLE AREA.; 11072000
(TAG ~ 3, 11073000
AVAILABLE ~ 1, 11074000
LENGTHZ = 19:20), COMMENT A SELF-RELATIVE INDEX TO FIND 11075000
AVAILA FOR THIS AREA.; 11076000
SPACETYPE 11077000
( 11078000
PRINTNOMEM = 4:1, COMMENT 1 = PRINT NO MEM MESSAGE; 11079000
MAKEROOM = 3:1, COMMENT 1 = OVERLAY IF REQUIRED; 11080000
SLEEPY = 2:1, COMMENT 1 = SLEEP IF MEMORY N/A; 11081000
11082000
OERLAY = 0:1), COMMENT 1 = SPACE FOR OVERLAYABLE; 11083000
LLLUARG 11084000
(21:1, COMMENT PREVIOUS OVERLAYABILITY; 11085000
20:20); COMMENT SIZE; 11086000
DEFINE INITIALIZETOZERO (ADDRESS, LENGTH) = 11087000
REPLACE POINTER(M[ADDRESS]) BY 0 FOR LENGTH OVERWRITE#; 11088000
FIELD AVAILKEY = 47:28; COMMENT AVAILA SORT KEY FIELD.; 11089000
DEFINE LINKSIZE = COMMENT NUMBER OF WORDS IN MEMORY LINKS -1; 11090000
3#, 11091000
LINKSIZETIMES2PLUS1 = COMMENT SIZE OF TEMPLINKS ARRAY.; 11092000
8#; 11093000
DEFINE PROCSTACKSIZE = 12000000
512#, 12001000
COMMENT ARBITRARY - F AND S ARE SET TO 12002000
SOME ADDRESS IN THE SECOND HALF OF MOD 0 12003000
UNTIL MORE PERMANENT STACKS CAN BE GOTTEN.;12004000
12005000
12006000
COMMENT THEN NUMBER OF WORDS IN A SHEET ENTRY 12007000
AND THE NUMBER OF WORDS THAT ARE RESERVED AT THE12008000
BOTTOM OF A PROCESSES LOWEST LEVEL STACK. ;12009000
STACKOFLOWSIZE = 12010000
64 #, 12011000
COMMENT THE NUMBER OF WORDS THAT ARE RESERVED 12012000
ABOVE LOSR TO HANDLE STACK OVERFLOWS. ;12013000
STACKSPERMODULE = 12014000
32#; 12015000
COMMENT THE NUMBER OF STACK VECTOR WORDS THAT 12016000
ARE ALLOCATED FOR EACH PRESENT MEMORY MODULE UP 12017000
TO THE MAXIMUM OF 1024 STACKS.; 12018000
INTEGER MAXSTACKS; COMMENT THE MAXIMUM INDEX FOR THE 12019000
STACK VECTOR.; 12020000
SAVE WORD ARRAY TEMPLINKS [LINKSIZETIMES2PLUS1]; 12021000
COMMENT RESERVES SPACE IN LEVEL 0 12022000
STACK FOR FIRST AVAILABLE 12023000
AND STOPPER LINKS; 12024000
ARRAY MEMMODS [64]; COMMENT DURING MEMORY INITIALIZATION EACH12025000
WORD CONTAINS A ONE IF THE CORRESPONDING 12026000
MODULE IS PRESENT. AFTER MISSING MODS ARE 12027000
ACCOUNTED FOR THE ELEMENTS ARE AVAILABLE TO12028000
BE DEFINED AS VARIOUS LOCAL INITIALIZE 12029000
VARIABLES. AFTER INITIALIZE THE AREA IS 12030000
FORGOTTEN AND THE STACK CELL IS AVAILABLE 12031000
FOR A PERMANENT GLOBAL.; 12032000
INTEGER PROCSTACKSTART = MEMMODS; 12033000
WORD PROCSTACKSTARTW= MEMMODS;COMMENT ONLY WAY TO OVERWRITE DESC.;12034000
REAL SLAVEQUARTERS, COMMENT USED TO LOCK ALL PROCESSORS EX- 12035000
CEPT THE ONE THAT LOCKS IT UNTIL INITIAL- 12036000
IZATION HAS THE SITUATION SOMEWHAT UNDER 12037000
CONTROL; 12038000
TIMEOUT, COMMENT CONTAINS SOME VALUE OF THE TIME- 12039000
OF-DAY CLOCK + AN INCREMENT OF TIME THAT IS12040000
SUFFICIENT TO ALLOW ALL EXPECTED PROCESSORS12041000
TO GET THEIR STACKS IN TEMPORARY ORDER.; 12042000
MEMMAX, COMMENT THE MAXIMUM AMOUNT OF AVAILABLE 12043000
MEMORY.; 12044000
SAVE1ADDRESS, COMMENT THE ADDRESS OF MEMORY AREA THAT 12045000
CONTAINS INITIALIZATION CODE AND IS TO BE 12046000
FORGOTTEN AFTER INITIALIZATION. STACK CELL12047000
IS AVAILABLE AFTER INITIALIZATION.; 12048000
PROCMASK = NUMBEROFPROCESSORS; 12049000
COMMENT A ONE BIT IN THIS WORD IDENTIFIES12050000
AN AVAILABLE PROCESSOR, THE BITS POSITION 12051000
IS THE PROCESSOR ID.; 12052000
BOOLEAN INITSWITCH; COMMENT USED TO CHANGE MPX INTERRUPT TO 12053000
PTPI INTERRUPT IN INITIALIZE AND 12054000
TO TELL STORAGE ALLOCATION WHEN A 12054500
PERMANENT LEFTOFF HEAD IS READY.; 12055000
LAYOUT SEGTRACEL (STKNRF~1, PIRF, ADDRESSF); 12055500
SAVE REAL PROCEDURE SEGTRACE(SEGTRACTER);% 12055600
VALUE SEGTRACTER; REAL SEGTRACTER;% 12055610
BEGIN 12055620
IF NOT SIMULATING THEN RETURN(0);% 12055625
SEGTRACE~REGISTERS[60]; 12055630
REGISTERS[60]~SEGTRACTER; 12055640
END SEGTRACE; 12055650
SAVE INTEGER PROCEDURE TRACE (TRACTER); 12056000
VALUE TRACTER; 12057000
INTEGER TRACTER; 12058000
BEGIN 12059000
IF NOT SIMULATING THEN RETURN(0);% 12059100
TRACE ~ REGISTERS [64]; 12060000
REGISTERS [64] ~ TRACTER; 12061000
END TRACE; 12062000
COMMENT THE ARRAYS BETWEEN "UNIT" AND 13000000
"TRANSACTION" ARE INITIALIZED TO MAXI-13001000
MUM NUMBER OF UNITS ON A GIVEN SYSTEM 13002000
BY THE CALL: 13003000
INITIALIZEARRAY(UNIT,TRANSACTION,MAXU)13004000
IN THE INITIALIZE PROCEDURE. THIS 13005000
SERIES OF ARRAY DECLARATIONS SERVES TO13006000
ILLUSTRATE THE METHOD FOR THE DECLAR- 13007000
ATION AND INITIALIZATION OF A NUMBER 13008000
(ONE OR MORE) ARRAYS TO THE SAME SIZE.13009000
ALL ARRAYS INITIALIZED THIS MANNER 13010000
ARE PLACED IN HIGH CONTIGUOUS MEMORY 13011000
AND MARKED AS NON-OVERLAYABLE. TO ADD13012000
ANOTHER ARRAY THAT IS TO HAVE A LENGTH13013000
OF MAXU, IT IS ONLY NECESSARY TO DE- 13014000
CLARE THE ARRAY BETWEEN "UNIT" AND 13015000
"TRANSACTION". (ALSO SEE DECLARATION &13016000
PROCEDURE CALL FOR "OLDSTATUSWORD"). 13017000
13018000
FROM THE FOREGOING IT SHOULD BE 13019000
APPARENT THAT: 13020000
1. ARRAYS THAT ARE TO BE INITIALIZED13021000
TO THE SAME LENGTH SHOULD BE DE- 13022000
CLARED CONTIGUOUSLY. 13023000
2. AT LEAST ONE PROCEDURE CALL IS 13024000
REQUIRED FOR EACH SERIES (ONE OR 13025000
MORE) OF ARRAYS THAT ARE TO BE 13026000
INITIALIZED TO THE SAME LENGTH. 13027000
3. ALL STACKCELLS BETWEEN THE FIRST 13028000
AND LAST ARRAY DECLARATIONS WILL 13029000
BE INITIALIZED TO ARRAY DESCRIP- 13030000
TORS. 13031000
;13032000
INTEGER DIAGNOSTICUNIT;COMMENT THE LOGICAL UNIT NO. OF THE 13033000
DIAGNOSTIC FILE; 13034000
DEFINE DIAGNOSTICIOCW = 40"04004" #, % IOCW FOR PRINTER-BCL SNG SPACE 13037100
DIAGNOSTICUNITTYPE = BUFFPRINTER#; %UNIT TYPE FOR MONITOR UNIT 13037200
SAVE WORD ARRAY DIAGNOSTICARRAY[22]; %BUFFER AND IOCW FOR MONITOR 13037300
ARRAY MONITER[*]; %DESCRIPTOR TO I/O AREA OF ABOVE 13037400
EVENT MONITORFINISH; %MONITOR I/O FINISH EVENT 13037500
REAL DCPSANDGCAS; 13037600
BOOLEAN MULTIPLEXORMASK; % A ONE BIT "N" MEANS THERE IS AN MPX-N 13037700
ARRAY UNIT[ * ]; COMMENT CONTAINS INFORMATION OF EACH UNITS CURRENT 13038000
STATE; 13039000
REFERENCE ARRAY LASTIO [*]; 13040000
ARRAY UINFO[*], % DESCRIPTORS FOR NON-DISK UNITS WHICH ARE 13041000
% READY. THE DESCRIPTORS POINT TO A "LABEL 13042000
% BLOCK" WHICH HAS THE SAME FORM AS A "LABEL- 13043000
% EQUATION BLOCK" (LEB) (SEE 24000000 FOR THE 13044000
% FORMAT OF THE LEB). 13045000
13046000
IOTIME [*], COMMENT ARRAY FOR RECORDING USERS IO TIME; 13047000
TRANSACTION[*], COMMENT FOR RECORDING RECORD TRANSACTIONS; 13048000
DUMMYAREA[1]; % FOR MAKING I/O REQUEST 13050000
WORD ARRAY UINFOW = UINFO[*]; 13050100
ARRAY UINFOP = UINFO[*,*]; 13050200
WORD ARRAY UINFOPW=UINFOW[*,*]; 13050210
BOOLEAN OPTIONS;% OPTIONS BIT WORD 13051000
DEFINE% OPTIONS 13051100
RETTOG = OPTIONS.BIT47#,% 13051200
13052000
ENDOPTDEF=0#;% 13054000
COMMENT 13054990
SCREEN IS INITIALIZED BY PERIPHERALINITIALIZE--SHOULD BE DYNAMIC;13055000
ARRAY SCREEN[*];% 13055010
% GLOBALS FOR OUTPUTMESS AND MESSER 13056000
LAYOUT WHOCALLSL (WHOF=47:24,WHICHF=11:12,WHATF=23:12);% 13056100
DEFINE% FOR OUTPUTMESS AMD MESSER 13057000
BEGFINMSG = 0#,% 13057100
BEGFOUTMSG = BEGFINMSG + FINSZ#,% 13057200
BEGMATHERR = BEGFOUTMSG + FOUTSZ#,% 13057300
BEGSTATMSG = BEGMATHERR + MATHERRSZ#,% 13057400
BEGMCPID = BEGSTATMSG + STATSZ#,% 13057500
BEGIOERR = BEGMCPID + MCPIDSZ#, 13057510
BEGSTDIOERR =BEGIOERR + IOERRSZ#,% 13057520
BEGMISCMSG= BEGSTDIOERR + STDIOERRSZ#,% 13057530
FINSZ = 6#,% 13057600
FOUTSZ = 4#,% 13057700
MATHERRSZ = 30#,% 13057800
STATSZ = 11#,% 13057900
MCPIDSZ = 4#,% 13058000
IOERRSZ = 5#,% 13058010
STDIOERRSZ = 18#,% 13058020
MISCSZ= 2#,% 13058030
FINMSGSEC= 0#,% 13058100
FOUTMSGSEC= 1#,% 13058200
MATHERRMSGSEC= 2#,% 13058300
STATMSGSEC= 3#,% 13058400
MCPIDSEC= 4#,% 13058500
IOERRSEC=5#,% 13058600
STDIOERRSEC=6#,% 13058700
MISCMSGSEC= 7#,% 13058710
OPMINDXR(N) = CASE N OF (% 13059000
BEGFINMSG,BEGFOUTMSG,BEGMATHERR,% 13059010
BEGSTATMSG,% 13059020
BEGMCPID,% 13059030
BEGIOERR,% 13059040
BEGSTDIOERR,% 13059050
1305905513059050
BEGMISCMSG,% 13059060
0)#,% 13059090
IOERRMESSL(A,B,C)=MESSER(0&WHOCALLSL(5,A,B),C)#, 13059800
BOJMESSER(SNR)= MESSER(0&WHOCALLSL(MISCMSGSEC),SNR)#,% 13059810
EOJMESSER(SNR)= MESSER(1&WHOCALLSL(MISCMSGSEC),SNR)#,% 13059820
ENDOPMDEF=0#; % 13059990
ARRAY% **** "SCAN" DOES NOT LIKE READ ONLY ARRAYS 13060000
OUTPUTMESS~(% ALL MESSAGES USED BY MESSER 13065000
8"NO FILE"4"00"% **** FINDINPUT MSG**13066000
8"UNMATCHED GENEALOGY"4"00"% * 13066100
8"DUP FIL"4"00"% * 13067000
,% END FIND-INPUT MSG** 13068000
8"REQUIRED"4"00" 8"NEW PBT ON"4"00"% FIND-OUTPUT MSG### 13069000
,% END FIND-OUTPUT MSG### 13070000
8"ALGAMA"4"00" 8"ALOG"4"00" 8"ALOG10"4"00"%MATH ERRORS*** 13071000
8"ARCOS"4"00" 8"ARSIN"4"00" 8"ATAN"4"00" % * 13072000
8"ATAN2"4"00" 8"COS"4"00" 8"COSH"4"00" 8"COTAN"4"00"% * 13073000
8"ERF"4"00" 8"EXP"4"00" 8"GAMMA"4"00" 8"SIN"4"00"% * 13074000
8"SINH"4"00" 8"SQRT"4"00" 8"TAN"4"00" 8"TANH"4"00"% * 13075000
8"XTOI"4"00"% * 13076000
8"DATAN"4"00" 8"DATAN2"4"00" 8"DCOS"4"00" 8"DEXP"4"00"% * 13077000
8"DLOG"4"00" 8"DLOG10"4"00" 8"DSIN"4"00" 8"DSQRT"4"00"% * 13078000
8"CABS"4"00" 8"CCOS"4"00" 8"CEXP"4"00" 8"CLOG"4"00"% * 13079000
8"CSIN"4"00" 8"CSQRT"4"00",% END MATH ERRORS*** 13080000
8"NOT READY"4"00"% STATUS MESSAGES SSSS 13081000
8"UNIDENTIFIED FLYING UNIT"4"00"% S 13081200
8"PARITY RW/L"4"00"% S 13081300
8"RET"4"00"% S 13081500
8"MCP PBT ON"4"00"% S 13081700
,% END STATUS MESSAGES SSSS 13081990
8"B6500 MCP"% **** BEGINNING MCP ID ******* 13082000
8" LEVEL "% * 13082100
8"0"% LEVEL NUMBER * 13082200
8"."% * 13082300
8"0"% PATCH NUMBER WITHIN LEVEL * 13082400
4"00",% **** END MCPID ******* 13082500
8"FILE OPEN"4"00" % I/O ERRORS 13082600
8"FILE ATTRIBUTE"4"00" 13082700
, % END I/O ERRORS 13082800
8"DESCRIPTOR ERROR"4"00" % STD I/O ERRORS 13082900
8"INVALID MEM ADDRESS"4"00"% 13083000
8"I/O MEMORY PARITY"4"00"% 13083100
8"MEMORY PROTECT ERROR"4"00"% 13083200
8"UNIT READ CHECK"4"00"% 13083300
8"WRITE LOCK-OUT"4"00"% 13083400
, % END STD I/O ERRORS 13084000
8"BOJ"4"00"% BEGIN MISCELLANEOUS MESSAGES MMM 13085000
8"EOJ"4"00"% M 13085100
,% END MISCELLANEOUS MESSAGES MMM 13085900
0),% END MESSAGES USED BY MESSER 13099900
MONTHS ~( 8"JANUARY"4"00",8"FEBRUARY"4"00",8"MARCH"4"0000", 13120000
8"APRIL"4"0000",8"MAY"4"00000000",8"JUNE"4"000000", 13120010
8"JULY"4"000000",8"AUGUST","00",8"SEPTEMBER"4"00", 13120020
8"OCTOBER"4"00",8"NOVEMBER"4"00",8"DECEMBER"4"00"), 13120030
PIE~( 8"3.1415926535897932384626433832795028841971693993751058" 13120100
8"209749445923078164062862089986280348253421170679821480" 13120110
8"865132823066470938446095505822317253594081284811174502" 13120120
8"841027019385211055596446229489549303819644288109756659" 13120130
8"334461284756482337867831652712019091456485669234603486" 13120140
8"104543266482133936072602491412737245870066063155881748" 13120150
8"815209209628292540917153643678925903600113305305488204" 13120160
8"665213841469519415116094330572703657595919530921861173" 13120170
8"819326117931051185480744623799627495673518857527248912" 13120180
8"279381830119491298336733624406566430860213949463952247" 13120190
8"371907021798609437027705392171762931767523846748148676" 13120200
8"694051320005681271452635608277857713427577896091736371" 13120210
8"787214684409012249534301465495853710507922796892589235" 13120220
8"420199561121209219608640344181598136297747713099605187" 13120230
8"072113499999983729780499510597317328160963185950244594" 13120240
8"553469083026425223082533446850352619311881710100031378" 13120250
8"387528865875332083814206171776691473035982534904287554" 13120260
8"6873115956286388235378759375195778185778 5321712268066"), 13120270
DICA~(8"MIXSCHJOB PERPCD DIREXP "),% 13124000
DICB~(% 13125000
8"TISTXSES"% PREFIX, NO SUFFIX 13125100
8"DSRMOKILFMULOUFROFUSAXPR"% PREFIX, NO SUFFIX--VALID REPLIES 13125200
8"OLRYPGPBSVRWCL"% SUFFIX, NO PREFIX 13125300
8"TRDRRDSFSOROTC"% SUFFIX, NO PREFIX 13125400
8"LORNTO"% NO PREFIX, SUFFIX OPTIONAL 13125500
8"TFWTWDWMPIEILE"% NO PREFIX, NO SUFFIX 13125600
),% 13125900
MNEMONIC~(8" DKSCODPRPPLPLP CRCPCP MTMTMT ",% BE SURE THESE13131000
8" MT");% ARE CONTIGUOUS 13132000
ARRAY 13133000
MNEMTOUNIT [*],% USED TO OBTAIN PHYS. UNIT NO. FROM UNIT MNEM. 13134000
TYPEINDX[*];% USED TO OBTAIN INDEX INTO MNEMTOUNIT OF LOWEST 13135000
% NUMBERED UNIT OF TYPE I. 13136000
COMMENT THE ARRAYS DICA THROUGH TYPEINDX WILL BE CONVERTED TO 13137000
EBCDIC STRING DESCRIPTORS IN PERIPHERALINITIALIZE. CARE SHOULD BE 13138000
USED WHEN ADDING DECLARATIONS INBETWEEN AND WHEN USING THE 13139000
DESCRIPTORS, SINCE ALL INDEXING WILL BE BY CHARACTERS; 13140000
ARRAY DATE ~(8"1969182TUESDAY, JULY 1, 1969"4"00",0);% 13140100
REAL TODAYSDATE~69182; 13140110
DEFINE FORMATTEDDATEPOINTER = POINTER(DATE,8) + 7 #; 13140150
ARRAY TIME[1];% 13140200
LAYOUT TIMEL ( 47:16,31:16,15:16);% 13140210
BOOLEAN ARRAY OLDSTATUSWORD[*]; % OLD STATUS 13141000
REAL RDLBLP; % READALABEL PROCESS CONTROL WORD 13142000
DEFINE% FOR STATUS, READALABEL 13143000
MAXRDLBLP = 6#,% MAXIMUM # READALABELS 13143010
STATOPM(N)= N&WHOCALLSL(STATMSGSEC)#,% 13143020
NOTREADYMSG(U)= MESSER(STATOPM(0),U)#,% 13143030
UFUMSG(U)= MESSER(STATOPM(1),U)#,% 13143040
PARITYRWLMSG(U)=MESSER(STATOPM(2),U)#,% 13143050
RETMSG(U)= MESSER(STATOPM(3),U)#,% 13143060
PBTONMSG(U)= MESSER(STATOPM(4),U)#,% 13143070
ENDSTATDEF=0#;% 13143990
FIELD RF = 6:6; % READALABEL CONTROL FIELD (0:1-LOCK)13144000
REAL PRGT; % PURGIT PROCESS CONTROL WORD 13145000
FIELD 13146000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%13147000
% UNIT TABLE %13148000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%13149000
UNITTYPE = 47:5, 13150000
UNITTYPECNTRF =42:8,% ORDINAL # OF UNIT WITHIN TYPE 13150100
UERRORSTATUSBITS = 34:14,COMMENT COMBINED FIELD FOR ERROR 13151000
AND STATUS BITS; 13152000
UNITERRORFIELD = 30:5, % UNIT ERROR COUNT (USED BY IOFINISH) 13154000
UNITSTATUS =25:5 , COMMENT FIELD INDICATING UNIT STATE-AS13155000
UNITREADY,UNITERROR,UNITBUSY ETC; 13156000
UNITNOTREADY=25:1, COMMENT 1- NOT READY 13157000
0- READY; 13158000
UNITERROR=24:1 , COMMENT IF SET(=1),ERROR ON UNIT; 13159000
UCHANWAITORBUSY=23:3, COMMENT UNIT BUSY OR WAITING FOR A 13160000
CHANNEL; 13161000
UCHANWAIT=23:1, COMMENT UNIT WAITING FOR A CHANNEL; 13162000
UNITIOBUSY=22:2, COMMENT I/O IN PROCESS & UNITBUSY; 13163000
% 01 - AWAITING PRINTER FINISH 13164000
IOINPROCESS=22:1, COMMENT I/O IN PROCESS; 13165000
UNITINPROCESS=22:1, COMMENT UNIT IN PROCESS; 13166000
UNITSTATE = 20:15, % STATE OF UNIT 13167000
UNITRETRY =20:1, COMMENT UNIT BEING RETRIED; 13168000
ULOCKED = 19:1, % UNIT LOCKED 13169000
USAVED = 18:1, % UNIT SAVED 13170000
DENSITYF = 17:3, % DISK TYPE 13171000
USCRATCH = 14:1, % UNIT IS SCRATCH 13172000
UNITASSIGNED = 13:1, % UNIT ASSIGNED TO A USER 13173000
ULABELLED = 12:1, % UNIT LABELLED 13174000
UINREWIND = 11:1, % UNIT REWINDING 13175000
UCLOSEDNOREWIND= 10:1, % UNIT CLOSED WITH NO REWIND 13176000
UTOBEPURGED = 9:1, % UNIT CLOSED WITH PURGE 13177000
UWRITERING = 8:1, % WRITE RING 13178000
UNITMPXD =5:4, COMMENT MPXDESIGNATOR FOR THE UNIT; 13179000
UNITMPXI =1:1; COMMENT MPXINDICATOR FOR THE UNIT; 13180000
COMMENT =0:1 RESERVED FOR UNITNOLOCK; 13181000
LAYOUT UNITL(UNITNOTREADY,19:2,14:3,UINREWIND); 13182000
REAL 13183000
MAXUNIT, COMMENT MAXIMUM UNIT NO ON THE SYSTEM. UNIT13187000
NO ASSIGNED TO PSEUDO CARD READER IS 13188000
MAXUNIT + 1; 13189000
MINUNIT ~ - 1; COMMENT MINIMUM UNIT ON SYSTEM; 13190000
INTEGER MAXPSEUDOUNIT, COMMENT MAXIMUM UNIT FOR PSEUDO 13191000
CARD READERS - IT IS EQUAL TO 13192000
MAXUNIT + NO. OF PSEUDO CARD 13193000
READERS; 13194000
UBITSTABLESIZE; COMMENT SIZE = HIGHEST WHOLE NO. 13195000
OF MAXPSEUDOUNITS/48; 13196000
FIELD RDMEMADDR=47:20, COMMENT MEMORY ADDRESS FIELD OR RESULT DESC;13198000
RDCHRCNT =27:3 , COMMENT CHARACTER COUNT FIELD OF R.D.; 13199000
RDUNUMERR=24:25,% BOTH UNIT NUMBER AND ERROR FIELD. 13200000
RDUNITNO =24:8 , COMMENT UNIT NO. FIELD IN RESULT DESC.; 13201000
RDERROR =16:17, COMMENT RESULT DESCRIPTOR ERROR FIELD; 13202000
RDSTNDERROR=6:7, COMMENT STANDARD ERROR FIELD OF R.D.; 13203000
RDATTNEXCP=1:2, % ATTENTION EXCEPTION BITS 13204000
RDEXCEPTION=0:1, % HARDWARE EXCEPTN13205000
RDATTENTION=1:1, % SOFTWARE ATTNTN 13206000
RDBIT432 =4:3, COMMENT UNITUSABLE BITS; 13207000
RDBUSY =2:1, COMMENT BUSY; 13208000
RDNOTREADY =3:1, COMMENT NOT READY; 13209000
RDERRORBIT =4:1, COMMENT DESCRIPTOR ERROR; 13210000
RDMEMADDRBIT =5:1, COMMENT MEMORY ADDRESS ERROR; 13211000
RDMEMPARITY =6:1, COMMENT MEMORY PARITY ERROR; 13212000
RDUNITERROR=15:9, COMMENT UNIT ERROR FIELD OF R. D. ; 13213000
RDMEMACCESS =7:1, COMMENT MEMORY ACCESS ERROR; 13214000
RDENDOFTAPE =8:1, COMMENT END OR BEGINNING OF TAPE; 13215000
RDLOWPAPER= 8:1, % LOW PAPER 13216000
RDWLOOREOF =9:1, COMMENT WRITE LOCK-OUT OR END OF FILE;13217000
RDCNTRLCARD =10:1,COMMENT CONTROL CARD; 13218000
RDINCREC = 10:1, % INCOMPLETE RECORD 13219000
RDDENSITY = 11:2, % DENSITY IN RD AFTER TEST 13220000
RDOVERFLOW =11:1,COMMENT EXCEED WORD COUNT; 13221000
RDCRCCORRECT =12:1,COMMENT CRC CORRECTION; 13222000
RDNONPRESENT =13:1,COMMENT NON-PRESENT; 13223000
RDREWINDING =14:1,COMMENT REWINDING; 13224000
RDBLANKTAPE =15:1,COMMENT BLANK TAPE; 13225000
RDMEMPROTECT =16:1;COMMENT MEMORY PROTECT ERROR; 13225500
FIELD RDDISKFILETYPEF= 11:2; 13226000
COMMENT 1C-5 = 0 13227000
1A-X = 1 13228000
1C-3 = 2 13229000
1C-4 = 3; 13230000
COMMENT 1A-X = 0 ALSO, BUT ONLY ON 101, I HOPE; 13231000
FIELD SLCNTRDY = 15:1; COMMENT SINGLE LINE CONTROL TIMEOUT; 13232000
FIELD CONSOLEIDF = 14:3; 13232100
FIELD COMMENT I/O CONTROL WORD FIELDS; 13233000
IOSTANDARDFIELD =45:10, 13234000
IOATTENTION =45:1, 13235000
IOREADBIT =44:1, 13236000
IOMEMINHIBIT =43:1, 13237000
IOMODE =42:2, 13238000
IOTRANSLATE =42:1, 13239000
IOFRAMESIZE =41:1, 13240000
IOMEMPROTECT =40:1, 13241000
IOBACKWARD =39:1, 13242000
IOTESTBIT =38:1, 13243000
IOTRANSFERTAG =37:1, 13244000
IOFORCETAG =36:1, 13245000
IOUNITFIELD =35:36; 13246000
FIELD ADDRESS =19:20, 13247000
USTATUSVECTORNO=11:3, COMMENT EACH VECTOR NO REPRESENTS 13248000
READY STATUS OF 32 UNITS; 13249000
MPXDESIGNATOR = 4:4, COMMENT MPXA(=1), MPXB(=2), ETC; 13250000
MPXINDICATOR = 0:1, COMMENT 0 MEANS INTERROGATE ALL MPXS 13251000
1 MEANS INTERROGATE THE ONE 13252000
SPECIFIED BY MPXDESIGNATOR; 13253000
UNITNO =16:8, COMMENT NOTE-UNITNO WITH UNIT STATUS 13254000
VECTOR NO PRECEEDING MAKES UNITNOS 13255000
FROM 0 TO 255; 13256000
BUFFERLENGTH =39:20, COMMENT BUFFER LENGTH IN AREA DESC.; 13257000
SIGNBITF=46:1, 13260000
DIV4F = 47:46,% 13260100
MOD4F = 1:2,% 13260200
DIV2F = 47:47,% 13260300
MOD2F = 0:1,% 13260400
FIRSTCHRF =47:6, COMMENT FIELD FOR FIRST CHARACTER; 13261000
CONTROLFIELD =8:4; COMMENT CONTROL FIELD FOR VARIOUS 13262000
SCAN IN FUNCTIONS; 13263000
DEFINE IOCBSIZE =6#, % SIZE OF IOCB 13263100
% INDICES OF ITEMS IN IOCB 13263200
USERINDEX =0#, 13263300
MISCINDEX =1#, 13263400
AREADESCINDEX =2#, 13263500
EVENTINDEX =3#; 13263600
COMMENT FIELDS FOR USER WORD OF IOCB; 13264000
FIELD IDNO =47:10, COMMENT USER IDENTIFICATION NO.; 13265000
PRIORITYF =37:5 , COMMENT CONTAINS PRIORITY; 13266000
UNITNOF =32:9 , COMMENT CONTAINS LOGICAL UNIT NO.; 13267000
IOERRORRECOVERY= 23:1, % I/O RECOVEIQ09N PROCESS FOR THIS I/O13268000
USERIOFIELD =22:10, % FIELD FOR USER I/O ACTION 13269000
USERPARITYBIT =22:1, % PARITY ACTION TO BE TAKEN BY USER 13269200
USEREOFORTBIT =21:1, % END OF FILE OR END OF TAPE ACTION 13269400
USERIOFINISH =20:1, % USER I/O FINISHED 13269600
USERSPECIALIO =19:1 , % SPECIAL ACTION TO BE TAKEN 13269800
USERIOBIT =18:1; % USER I/O 13270000
COMMENT FIELDS FOR MISC WORD OF IOCB; 13270100
FIELD 13270200
WORDCOUNTF =47:20, % WORD COUNT FIELD 13270300
COMMENT RDCHRCNT =27:3, CHARACTER COUNT FIELD; 13270400
COMMENT RDUNITNO =24:8, UNIT NUMBER; 13270500
IOERRORMASKFIELD =16:17; % FOR MASKING I/O ERRORS IN 13270600
% IOFINISH 13270700
COMMENT AFTER SUCCESSFUL IOFIMISH , IOERRORMASKFIELD CONTAINS 13270800
ERROR FIELD (AFTER MASKING) OF RESULT DESCRIPTOR; 13270850
COMMENT ADDITIONAL FIELDS HAVE BEEN ADDED TO USERL. PRESENT REFERENCES13270880
TO USERL WILL NOT BE AFFECTED,FOR USING ADDITIONAL FIELDS 13270900
NEW LAYOUT MAY BE NECESSARY; 13270950
LAYOUT IOPATHWORD(UNITNO,MPXDESIGNATOR,MPXINDICATOR), 13271000
COMMENT WORD USED FOR INTERROGATING I/O PATH; 13272000
USTATUSWORD(USTATUSVECTORNO, 8:4~1,MPXDESIGNATOR,MPXINDICATOR),13273000
COMMENT WORD USED FOR INTERROGATING PERIPHERAL 13274000
STATUS; 13275000
UNITINITIALIZE (UNITTYPE, UNITMPXD, UNITMPXI), 13276000
COMMENT TO INITIALIZE UNIT TABLE; 13277000
BINEL (47:8), 13278000
TYPEINTERROGATE(UNITNO, 13279000
CONTROLFIELD ~6, 13280000
MPXDESIGNATOR, 13281000
MPXINDICATOR), 13282000
COMMENT TO INTERROGATE TYPE (AND PATH) AT 13283000
INITIALIZE TIME.; 13284000
BITL( BIT47=47:1, BIT46=46:1, BIT45=45:1, BIT44=44:1, 13285000
BIT43=43:1, BIT42=42:1, BIT41=41:1, BIT40=40:1, 13286000
BIT39=39:1, BIT38=38:1, BIT37=37:1, BIT36=36:1, 13287000
BIT35=35:1, BIT34=34:1, BIT33=33:1, BIT32=32:1, 13288000
BIT31=31:1, BIT30=30:1, BIT29=29:1, BIT28=28:1, 13289000
BIT27=27:1, BIT26=26:1, BIT25=25:1, BIT24=24:1, 13290000
BIT23=23:1, BIT22=22:1, BIT21=21:1, BIT20=20:1, 13291000
BIT19=19:1, BIT18=18:1, BIT17=17:1, BIT16=16:1, 13292000
BIT15=15:1, BIT14=14:1, BIT13=13:1, BIT12=12:1, 13293000
BIT11=11:1, BIT10=10:1, BIT9 = 9:1, BIT8 = 8:1, 13294000
BIT7 = 7:1, BIT6 = 6:1, BIT5 = 5:1, BIT4 = 4:1, 13295000
BIT3 = 3:1, BIT2 = 2:1, BIT1 = 1:1, BIT0 = 0:1), 13296000
DIVMOML(PCBITSF~0,ADDRESSF~0), 13297010
IOL(BL=39:20,FL=19:20), 13297020
IOLINKL(NUMRECSLNK=47:16,BCKWRDLNK=31:16,FRWRDLNK=15:16), 13297030
SCANINWORD(CONTROLFIELD,MPXDESIGNATOR,MPXINDICATOR), 13298000
COMMENT CONTROL WORD USED FOR VARIOUS SCAN IN FUNCTIONS; 13299000
SCANOUTWORD(CONTROLFIELD,MPXDESIGNATOR,MPXINDICATOR), 13299100
COMMENT SCAN OUT CONTROL WORD; 13299200
RDLBL(PNO=19:8,PTP=11:4,UNO=7:8), % READALABL LAYOUT13300000
IOCWDISKL(REPORTF=35:4,DECADDRF=27:28), 13301000
COMMENT UNIT FIELD OF IOCW FOR DISK; 13302000
IOCWPRINTERL(SKIPF=35:4,SPACEF=31:2), COMMENT FOR MAKING 13303000
UNIT FIELD OF IOCW FOR PRINTER; 13304000
IOCWTAPEL(FUNCTIONF=35:2,BPISPECF=33:1,BPIF=32:2, 13305000
PARITYF=30:1,CRCSPECF=29:1,CRCTRACK=28:3), 13306000
COMMENT FOR MAKING UNIT FIELD OF IOCW FOR TAPE; 13307000
COMMENT TO MAKE UP A DESCRIPTOR; 13308000
IOCWL(IOSTANDARDFIELD,IOUNITFIELD), COMMENT TO FORM IOCW; 13309000
IOCWDETAILL(IOATTENTION,IOREADBIT,IOMODE,IOUNITFIELD), 13310000
COMMENT FOR SETTING UP IOCW FOR DIFF. RECORDING MODE;13311000
IOCWSPACEL(IOSTANDARDFIELD~@600,39:1,23:16) 13312000
, COMMENT TO MAKE UP TAPE SPACE ; 13313000
TAPEIOCWL(IOREADBIT,IOTRANSLATE,IOFRAMESIZE,33:3,PARITYF), 13313010
PRINTIOCWL(IOREADBIT~0,IOTRANSLATE,IOFRAMESIZE,SKIPF,SPACEF), 13313020
PPRTIOCWL(IOREADBIT,IOTRANSLATE,IOFRAMESIZE,IOMEMPROTECT, 13313030
FUNCTIONF), 13313040
MISCL (SIGNBITF~1,IOERRORMASKFIELD), 13314000
IOERRORMASKL(BUFFERLENGTH,ADDRESS), 13315000
COMMENT TO MAKE UP IOERRORMASK FOR WAITIO; 13316000
USERL(IDNO,PRIORITYF,UNITNOF,IOERRORRECOVERY); 13317000
COMMENT TO FORM USER WORD FOR IOCB; 13318000
REAL 13319000
MAXVECTORNO; COMMENT MAXIMUM VECTOR NO; 13321000
DEFINE TIMEOFDAYWORD=96 #; COMMENT CONTROL WORD FOR SETTING & 13324000
READING TIME OF DAY; 13325000
DEFINE BASICCLOCKUNIT = 2.4 # % BASIC UNIT TOD CLOCK 13326000
, ONESECOND = 416667 # % NUMBER OF BASIC UNITS13327000
% IN ONESECOND(ACTUALLY13328000
% IN 1.0000008 SECONDS)13329000
13330000
, REARRANGETIME = 416667 # % NUMBER OF BASIC UNITS13331000
% BETWEEN RE-ARRANGING 13332000
% READYQ 13333000
; 13334000
DEFINE COMMENT DEFINES FOR UNIT TYPES-(REF FIELD UNITTYPE); 13335000
NOUNIT =0#, 13336000
DISKFILE =1#, 13337000
CONN = 2#, 13338000
SPO = CONN#,% SPO IS HOLD-OVER FROM B5500. 13339000
PAPERTAPERDR =4#, COMMENT PAPER TAPE READER; 13340000
PAPERTAPEPNCH =5#, COMMENT PAPER TAPE PUNCH; 13341000
BUFFPRINTER =6#, COMMENT LINE PRINTER I BUFFERED; 13342000
UNBUFFPRINTER =7#, COMMENT LINE PRINTER IIUNBUFFERED; 13343000
CARDREADER =9#, 13344000
CARDPUNCH1 =10#, COMMENT CARD PUNCH I; 13345000
CARDPUNCH2 =11#, COMMENT CARD PUNCH II ; 13346000
MAGTAPE1 =13#, COMMENT MAGNETIC TAPE I(7 TRACK); 13347000
MAGTAPE2 =14#, COMMENT MAGNETIC TAPE II (9 TRACK); 13348000
MAGTAPE3 = 15#, COMMENT MAGNETIC TAPE III (9 TRACK); 13349000
MAGTAPCLUSTER1= 29#,% MAGNETIC TAPE CLUSTER I (7 TRACK) 13350000
MAGTAPCLUSTER2= 30#,% MAGNETIC TAPE CLUSTER II (9 TRACK) 13351000
MAGTAPCLUSTER3= 31#,% MAGNETIC TAPE CLUSTER III (9 TRACK) 13352000
MAGTAPE(TYPE) = (TYPE } 13 AND TYPE { 15 OR TYPE } 29) #; 13353000
DEFINE MAXUNITTYPE = 31 #; 13353100
13354000
DEFINE% FOR KEYIN AND ASSOCIATED PROCEDURES 13355000
POINTTOMSGAREA= POINTER(MSGAREA[1],BYTESZ)#, 13356000
MCP = 0#, 13357000
KEYINQSZ = 2#, 13358000
INVKBDSZ = 2#, 13359000
JFACTOR = INVKBDSZ+3#, 13360000
TI(X) = REAL(POINTER(TYPEINDX[X], *), 1) #, 13361000
UNITBL(U1,U2) = REAL(POINTER(MNEMTOUNIT[U1+U2-1],*),1)#, 13362000
CLEAR(P,B) = REPLACE P BY B" " FOR B WORDS#,% 13363000
ETX = 48"03"#,% 13364000
BLANK = 8" "#,% 13366000
CLEARSCREEN = 48"0C0000" #, 13367000
LINEERASE = 48"00110000"#,% 13368000
REVERSELF = 48"00130000"#,% 13369000
HOME = 48"3C00"#,% 13370000
CARRETURN = 48"0D0000"#,% 13371000
LINEFEED = 48"2500"#,% 13372000
COLON = 8":"#,% 13373000
EQUAAL = 8"="#,% 13374000
AT = 8"@"#,% 13375000
SLASH = 8"/"#,% 13376000
PERIOD = 8"."#,% 13377000
COMMA = 8","#,% 13377100
QUESTION = 48"6F"#,% 13378000
BACKSPACE = 48"1600"#,% 13379000
NUL = 48"00"#,% 13379900
ZERO = 8"0"#,% 13380100
DISPLAYONMIX = DISPLAYONKEYER#, 13381000
DISPLAYONPER = DISPLAYONKEYER#, 13382000
DISPLAYONKEYER= SCREEN[2]#, 13383000
DISPLAYONCON = DISPLAYONKEYER#, 13384000
NOOFSCREENSRQD= 4#, 13385000
MNEMLIM = 14#, 13386000
MNEMSZ = 2#, 13387000
BUFFS = 6#, 13388000
CHRS = 6#, 13389000
BYTESZ = 8#, 13390000
RUSER(U) = 0&USERL(,,U,)#, 13391000
RIOCW = 0&IOCWL(@440)#,% 13392000
RERRMSK = @116001#, 13393000
WIOCW = 0&IOCWL(@40)#,% 13394000
WUSER(U) = 0&USERL(*,*,U,*)#, 13395000
WERRMSK = @110001#, 13396000
RDTIMEOUT = RDBLANKTAPE#, 13397000
DATEIS = 8"DATE IS "#,% 13398100
TIMEIS = 8"TIME IS "#,% 13398200
MAXMSGSZ = 1000#, 13399000
LINESZ = 40#,% 13400000
SCREENSZ = 960#,% 13400100
MAXPGS = 2#,% 13400200
MAXLNS = 20#,% 13401000
DICASZ = 3#, 13402000
MAXDICA = 24#, 13403000
DICBSZ = 2#, 13404000
MAXDICB = 102#, 13405000
MIN(A,B) = (IF A{B THEN A ELSE B)#, 13406000
INPUT(IOCW) = BOOLEAN(IOCW.IOREADBIT)#, 13407000
TIMEDOUT = BOOLEAN(RSDS.RDTIMEOUT)#,% 13407100
INTEVNTARY(S,D,L) = 13408000
REPLACE POINTER(D) BY POINTER(S) FOR 2|(L-1) OVERWRITE#, 13409000
USINGSTACK(S) = NOT STACKVECTOR[S] IS 0&DATADESCRIPTOR()#,% 13410000
MCPNOTUSINGSTACK(S)=STACK[S,FIRSTMSCWPLACE].STKNRF!0#,% 13410100
D2STACKIS(S) = STACK[S,PROCESSNATUREPLACE].PROCESSHISTORYF!0#,13410200
HAVENTSUSPENDED(S)=WORDSTACK[S,REPLYEVENTPLACE].TAG=0 OR% 13410300
BOOLEAN(M[STACK[S,REPLYEVENTPLACE]])#, 13410302
JOBREF(S) = WORDSTACK[S,JOBIDPLACE]#,% 13410400
KFPSCRATCHWORDSZ= 1#,% 13428000
LEAP(Y) = Y.MOD4F=0 AND(Y MOD 100!0 OR(Y MOD 400=0 AND 13428100
Y MOD 4000!0))#, 13428102
DAY = 8"DAY, "#,% 13428200
JULDATESZ = 7#,% 13428300
13428400
STARTYEARPLACE= 0#,% 13428500
STARTDAYPLACE = 4#,% 13428600
YEARSZ = 4#,% 13428700
DAYSZ = 3#,% 13428800
BASEYEAR = 1700#,% 13428900
PERCENTAGE(X) = X DIV 10 FOR 2 DIGITS,PERIOD,% 13431000
X MOD 10 FOR 1 DIGITS#,% 13432000
TIMECORRFACT = 2400#,% ::= (2.4|10@6)/10@3 GIVING SECONDS 13433000
DIV2(X) = REAL(BOOLEAN(X)AND NOT BOOLEAN(3))#,% 13433100
DEFINEND=0#; 13434000
DEFINE 13435000
% FOR READALABEL AND PURGIT 13436000
USAH = 0&USERL(,,U,)#, 13437000
SCHANNEL = UNT.UNITTYPE=13#, 13438000
NCHANNEL = NOT SCHANNEL#, 13439000
ERAH(M,S) = 0&IOERRORMASKL(M,S)#, 13440000
UNEXP = 3"377635"#, 13441000
TAPETEST = 4#, 13442000
TAPEPARITY=BOOLEAN(RSLT.RDMEMACCESS)AND RSLT.RDDENSITY=3#,13444000
GETUNT = WHILE BOOLEAN(UNT~READLOCK(1,UNIT[U])) DO#, 13445000
PUTUNT(A,B,C,D)=GETUNT;UNIT[U]~UNT&UNITL(A,B,C,D)#, 13446000
GETOLDS = OLDSTATUS~OLDSTATUSWORD[VECTORNO]; 13447000
% KLUDGE 13448000
OLDSTATUSWORD[VECTORNO]~OLDSTATUS AND NOT 13449000
BOOLEAN(BITWORD)#, 13450000
RD432 = RDBIT432#, 13451000
PHDR1 = PVOL1#, 13452000
PHDR2 = PVOL1#, 13453000
RCRDFRMT = IF TAPETYPE=1 THEN 13454000
IF URF=6"F"THEN 0 ELSE IF URF=6"D"THEN 1 13455000
ELSE IF URF=6"V"THEN 2 ELSE 13456000
IF URF=6"I"THEN 4 ELSE IF URF=6"L"THEN 5 13457000
ELSE IF URF=6"Z"THEN 6 ELSE 3 13457050
ELSE 13458000
IF URF=8"F"THEN 0 ELSE IF URF=8"D"THEN 1 13459000
ELSE IF URF=8"V"THEN 2 ELSE 13460000
IF URF=8"I"THEN 4 ELSE IF URF=8"L"THEN 5 13461000
ELSE IF URF=8"Z"THEN 6 ELSE 3#, 13461050
WERRORS = BOOLEAN(@260201)#; 13462000
COMMENT DECLARATIONS FOR QUEUES OF I/O REQUESTS WAITING FOR UNIT 13463000
ONE QUEUE FOR EACH UNIT; 13464000
ARRAY DUMMYIOQUE[*]; COMMENT FOR MAKING ENTRY IN IOQUE; 13465000
DEFINE FIRSTIOU=FIRSTIO[INDEX]#, COMMENT INDEX IS QUEUE HEAD INDEX; 13466000
LASTIOU=LASTIO[INDEX]#; 13467000
QUEUE ARRAY IOQUE:FIRSTIO[*](USER,MISC,AREADESC,EVNT: 13468000
PRVSIO,NEXTIO); 13469000
VALUE USER,MISC,AREADESC, 13470000
PRVSIO,NEXTIO; 13471000
REAL USER,MISC; 13472000
EVENT EVNT; 13473000
REFERENCE PRVSIO,NEXTIO,AREADESC; 13474000
USING 13475000
ALLOCATE IS REFERENCE(DUMMYIOQUE & 13476000
ARRAYDESCL(3, 6, GETAREA(6))): 13477000
NEXT IS NEXTIO @ FIRSTIO[INDEX]: 13478000
TO INSERT, COMMENT QUEUE IS ARRANGED ON A FIRST COME FIRST 13479000
BASIS; 13480000
BEGIN 13481000
IF LASTIOU=NULL THEN COMMENT QUEUE IS EMPTY; 13482000
BEGIN 13483000
LASTIOU~FIRSTIOU~ENTRY; COMMENT ENTRY IS THE ADDRESS OF 13484000
DESC. POINTING TO DATA OF NEW 13485000
ENTRY; 13486000
NEXTIO@(FIRSTIOU)~PRVSIO @(FIRSTIOU)~ NULL; 13487000
END ELSE 13488000
BEGIN COMMENT PUT ENTRY AT TAIL OF QUEUE; 13489000
PRVSIO @(ENTRY)~ LASTIOU; 13490000
NEXTIO @(LASTIOU)~ENTRY; 13491000
LASTIOU ~ENTRY; 13492000
NEXTIO @(ENTRY)~NULL; 13493000
END; 13494000
END INSERTION OF ENTRY IN QUEUE: 13495000
TO DELINK, 13496000
BEGIN 13497000
IF ENTRY=FIRSTIOU THEN COMMENT ENTRY IS THE TOP OF QUEUE; 13498000
IF FIRSTIOU=LASTIOU THEN COMMENT ONLY ONE ENTRY IN QUEUE; 13499000
FIRSTIOU ~ LASTIOU ~NULL ELSE 13500000
BEGIN COMMENT REMOVES ENTRY FROM TOP; 13501000
FIRSTIOU ~NEXTIO @ FIRSTIOU; 13502000
PRVSIO @(FIRSTIOU) ~ NULL; 13503000
END ELSE 13504000
IF ENTRY=LASTIOU THEN COMMENT REMOVES LAST ENTRY OF QUEUE; 13505000
BEGIN 13506000
LASTIOU~PRVSIO @ ENTRY; 13507000
NEXTIO @(LASTIOU)~ NULL; 13508000
END ELSE COMMENT REMOVES ANY OTHER ENTRY; 13509000
BEGIN 13510000
COMMENT FIX NEXTIO POINTER IN THE UPPER LINK OF ENTRY; 13511000
NEXTIO @(PRVSIO @ ENTRY)~ NEXTIO @ ENTRY; 13512000
COMMENT FIX PRVSIO POINTER IN THE LOWER LINK OF ENTRY; 13513000
PRVSIO @(NEXTIO @ ENTRY)~ PRVSIO @ ENTRY; 13514000
END; 13515000
END DELINKING OF ENTRY FROM QUEUE; 13516000
COMMENT DECLARATIONS FOR QUEUES OF UNITS WAITING FOR CHANNEL. 13517000
ONE QUEUE FOR EACH MPX; 13518000
ARRAY DUMMYWAITCHANNELQUE[*]; COMMENT FOR MAKING ENTRY IN 13519000
WAITCHANNELQUE; 13520000
REFERENCE ARRAY LASTUNIT[*]; COMMENT POINTS TO LAST ENTRY IN 13521000
WAITCHANNELQUE; 13522000
DEFINE FIRSTUNITI=FIRSTUNIT[INDEX]#, COMMENT INDEX-QUEUE HEAD INDEX; 13523000
LASTUNITI=LASTUNIT[INDEX]#; 13524000
QUEUE ARRAY WAITCHANNELQUE:FIRSTUNIT[1](UNTWORD:PRVSUNIT,NEXTUNIT); 13525000
VALUE UNTWORD,PRVSUNIT,NEXTUNIT; 13526000
REAL UNTWORD; 13527000
REFERENCE PRVSUNIT,NEXTUNIT; 13528000
USING 13529000
ALLOCATE IS REFERENCE(DUMMYWAITCHANNELQUE & 13530000
ARRAYDESCL(,3,GETAREA(3))): 13531000
NEXT IS NEXTUNIT @ FIRSTUNIT[INDEX]: 13532000
TO INSERT, COMMENT QUEUE IS ARRANGED ON A FIRST COME FIRST 13533000
BASIS; 13534000
BEGIN 13535000
IF LASTUNITI=NULL THEN COMMENT QUEUE IS EMPTY; 13536000
BEGIN 13537000
LASTUNITI~FIRSTUNITI~ENTRY; COMMENT ENTRY IS THE ADDRESS 13538000
OF DESC. POINTING TO DATA OF 13539000
NEW ENTRY; 13540000
NEXTUNIT @(FIRSTUNITI)~PRVSUNIT @(FIRSTUNITI) ~NULL; 13541000
END ELSE 13542000
BEGIN COMMENT PUT ENTRY AT TAIL OF QUEUE; 13543000
PRVSUNIT @(ENTRY)~ LASTUNITI; 13544000
NEXTUNIT @(LASTUNITI) ~ ENTRY; 13545000
LASTUNITI ~ ENTRY; 13546000
NEXTUNIT @ (ENTRY) ~NULL; 13547000
END; 13548000
END INSERTION OF ENTRY IN WAITCHANNELQUE: 13549000
TO DELINK, 13550000
BEGIN 13551000
IF ENTRY=FIRSTUNITI THEN COMMENT ENTRY IS THE TOP OF QUEUE; 13552000
IF FIRSTUNITI=LASTUNITI THEN COMMENT ONLY ONE ENTRY IN QUEUE;13553000
FIRSTUNITI~LASTUNITI~NULL ELSE 13554000
BEGIN COMMENT REMOVE ENTRY FROM TOP; 13555000
FIRSTUNITI ~ NEXTUNIT @ FIRSTUNITI; 13556000
PRVSUNIT @ (FIRSTUNITI) ~ NULL; 13557000
END ELSE 13558000
IF ENTRY=LASTUNITI THEN COMMENT REMOVE LAST ENTRY OF QUEUE; 13559000
BEGIN 13560000
LASTUNITI ~ PRVSUNIT @ ENTRY; 13561000
NEXTUNIT @(LASTUNITI)~NULL; 13562000
END ELSE COMMENT REMOVES ANY OTHER ENTRY; 13563000
BEGIN 13564000
COMMENT FIX NEXTUNIT POINTER IN THE UPPER LINK OF ENTRY; 13565000
NEXTUNIT @(PRVSUNIT @ ENTRY) ~ NEXTUNIT @ ENTRY; 13566000
COMMENT FIX PRVSUNIT POINTER IN THE LOWER LINK OF ENTRY; 13567000
PRVSUNIT @(NEXTUNIT @ ENTRY) ~ PRVSUNIT @ ENTRY; 13568000
END; 13569000
FORGETAREA(3,WORD(ENTRY).ADDRESS); 13570000
END DELINKING OF ENTRY FROM QUEUE; 13571000
13572000
EVENT TIMERINTERRUPTEVENT, 13573000
STATUSEVENT, COMMENT EVENT CAUSED AFTER EACH STATUS RUN; 13574000
ERRORFLAGEVENT; 13575000
COMMENT GLOBALS FOR DISK MANAGEMENT; 14000000
REAL MCPTOP; COMMENT THE HIGHEST DISKADDRESS OF THE MCP CODE FILE; 14000100
DEFINE MCPINFOSIZE = 60 #; COMMENT SIZE IN WORDS OF DISK INFO; 14001000
ARRAY MCPINFO[MCPINFOSIZE]; COMMENT WE WILL STUFF THE DISK ADDRESS OF 14002000
THE INFO SEGMETNS IN THE DESCRIPTOR SO THAT14002010
PRESENCEBIT WILL READ IT IN FOR US IF 14002020
IT IS NOT PRESENT; 14002030
REAL NEXTADDR, LASTADDR, NEXTROW, FIRSTADDR, MAXADDR, 14002040
DIRECTORYCOMPLEMENTREPORTBACK; 14002050
BOOLEAN PERIPHERALINVALIDADDRESS = DIRECTORYCOMPLEMENTREPORTBACK; 14002060
COMMENT THE ABOVE ARE USED IN BUILDING THE DISK TABLES AND CAN BE 14003000
RE-USED ONCE PERIPHERALINITIALIZE HAS EXITED; 14004000
BOOLEAN PROCEDURE GIVEBACKDISK(DKADDR, SIZE); 14005000
VALUE DKADDR, SIZE; 14006000
REAL DKADDR, SIZE; FORWARD; 14007000
ARRAY DISKMAPARRAY[*,*]; %USED FOR DISK TABLE BUILDING 14008000
DEFINE LLLROWS = 10 #, %THE NUMBER OF ROWS FOR THE ABOVE 14009000
LLLCHUNK = 100 #; %THE ROW SIZE OF THE ABOVE; 14010000
COMMENT THE CELL FOR DISKMAPARRAY IS AVAILABLE AFTER DISKMAPING; 14011000
COMMENT DECLARATIONS FOR USER DISK MANAGEMENT; 14012000
COMMENT FIELD DEFINES FOR USERDISK TABLE; 14013000
FIELD 14014000
DISKADDRF=19:20, COMMENT DISK ADDRESS; 14020000
EUNOF = 27:8; COMMENT UNIT NUMBER OF EU; 14021000
LAYOUT DISKADDRESSL(EUNOF, DISKADDRF); 14025000
LAYOUT FIRSTMAPWORD ( 14026000
MAPUNITNOF = 47:8 14027000
, MAPADDRESSF = 39:20 14028000
, ADDRESSF 14029000
) 14030000
, FIRSTMAPWORDPRIME( 14031000
MAPAREAF = 47:28 14032000
, ADDRESSF 14033000
) 14034000
; 14035000
SAVE ARRAY NEXTEU[3]; COMMENT ONE WORD FOR EACH DISK DENSITY; 14035100
ARRAY USERDISKLIST[*,*], % ROW SIZE MUST BE EVEN 14036000
USERDISKDOPEVECTOR = USERDISKLIST [*], %DOPE VECTOR OF ABOVE 14036500
GETUSERDISKHEAD[*], % SIZE IS NUMBER OF ROWS IN 14037000
FORGETUSERDISKHEAD[*]; % USERDISKLIST 14038000
INTERLOCK USERDISKLOCK; 14039000
DEFINE DISKRETURNLOCK = HEADERLOCKS[1] #, 14039100
EUFACTOR = 2 #, 14039150
USERDISKLISTROWSIZE = 30 #; 14039160
LAYOUT USERDISKHEADWORD( 14041000
USERDISKINDEXF = 47:20 14042000
, EUNOF 14043000
, ADDRESSF 14044000
) 14045000
, DISKAREAWORDL( 14046000
DISKAREASIZEF = 47:20 14047000
, DISKADDRESSF = 27:28 14048000
) 14049000
; 14050000
VALUE ARRAY DISKFILE1C5 := ( % DISK TYPE MOD SWITCH 14051000
0 % 1C-5 0 0 14052000
, 25200 % 1C-5 0 1 14053000
, 50400 % 1C-5 0 2 14054000
, 75600 % 1C-5 0 3 14055000
, 100800 % 1C-5 1 0 14056000
, 126000 % 1C-5 1 1 14057000
, 151200 % 1C-5 1 2 14058000
, 176400 % 1C-5 1 3 14059000
, 201600 % 1C-5 2 0 14060000
, 226800 % 1C-5 2 1 14061000
, 252000 % 1C-5 2 2 14062000
, 277200 % 1C-5 2 3 14063000
, 302400 % 1C-5 3 0 14064000
, 327600 % 1C-5 3 1 14065000
, 352800 % 1C-5 3 2 14066000
, 378000 % 1C-5 3 3 14067000
, 403200 % 1C-5 4 0 14068000
, 428400 % 1C-5 4 1 14069000
, 453600 % 1C-5 4 2 14070000
, 478800 % 1C-5 4 3 14071000
, 503000 % 1C-5 5 0 14072000
), 14073000
DISKFILE1AX := ( % DISK TYPE MOD SWITCH 14074000
0 % 1A-X 0 0 14075000
, 12500 % 1A-X 0 1 14076000
, 25000 % 1A-X 0 2 14077000
, 37500 % 1A-X 0 3 14078000
, 50000 % 1A-X 1 0 14079000
, 62500 % 1A-X 1 1 14080000
, 75000 % 1A-X 1 2 14081000
, 87500 % 1A-X 1 3 14082000
, 100000 % 1A-X 2 0 14083000
, 112500 % 1A-X 2 1 14084000
, 125000 % 1A-X 2 2 14085000
, 137500 % 1A-X 2 3 14086000
, 150000 % 1A-X 3 0 14087000
, 162500 % 1A-X 3 1 14088000
, 175000 % 1A-X 3 2 14089000
, 187500 % 1A-X 3 3 14090000
, 200000 % 1A-X 4 0 14091000
, 212500 % 1A-X 4 1 14092000
, 225000 % 1A-X 4 2 14093000
, 237500 % 1A-X 4 3 14094000
, 250000 % 1A-X 5 0 14095000
), 14096000
DISKFILESIM := ( % DISK TYPE MOD SWITCH 14097000
0 % SI-M 0 0 14098000
,0,0,0 COMMENT FILLER TO MAKE IT WORK LIKE THE REST OF THEM; 14098100
, 1250 % SI-M 0 1 14099000
), 14100000
DISKFILE1C3 := ( % DISK TYPE MOD SWITCH 14101000
0 % 1C-3 0 0 14102000
, 27600 % 1C-3 0 1 14103000
, 55600 % 1C-3 0 2 14104000
, 83400 % 1C-3 0 3 14105000
, 111200 % 1C-3 1 0 14106000
, 139000 % 1C-3 1 1 14107000
, 166800 % 1C-3 1 2 14108000
, 194600 % 1C-3 1 3 14109000
, 222400 % 1C-3 2 0 14110000
, 250200 % 1C-3 2 1 14111000
, 278000 % 1C-3 2 2 14112000
, 305800 % 1C-3 2 3 14113000
, 333600 % 1C-3 3 0 14114000
, 361400 % 1C-3 3 1 14115000
, 389200 % 1C-3 3 2 14116000
, 417000 % 1C-3 3 3 14117000
, 444800 % 1C-3 4 0 14118000
, 472600 % 1C-3 4 1 14119000
, 500400 % 1C-3 4 2 14120000
, 528200 % 1C-3 4 3 14121000
, 556000 % 1C-3 5 0 14122000
), 14123000
DISKFILE1C4 := ( % DISK TYPE MOD SWITCH 14124000
0 % 1C-4 0 0 14125000
, 31800 % 1C-4 0 1 14126000
, 63600 % 1C-4 0 2 14127000
, 95400 % 1C-4 0 3 14128000
, 127200 % 1C-4 1 0 14129000
, 159000 % 1C-4 1 1 14130000
, 190800 % 1C-4 1 2 14131000
, 222600 % 1C-4 1 3 14132000
, 254400 % 1C-4 2 0 14133000
, 286200 % 1C-4 2 1 14134000
, 318000 % 1C-4 2 2 14135000
, 349800 % 1C-4 2 3 14136000
, 381600 % 1C-4 3 0 14137000
, 413400 % 1C-4 3 1 14138000
, 445200 % 1C-4 3 2 14139000
, 477000 % 1C-4 3 3 14140000
, 508800 % 1C-4 4 0 14141000
, 540600 % 1C-4 4 1 14142000
, 572400 % 1C-4 4 2 14143000
, 604200 % 1C-4 4 3 14144000
, 636000 % 1C-4 5 0 14145000
); 14146000
COMMENT GLOBALS FOR GETAREA/FORGETAREA; 15000000
COMMENT FIELD DECLARATIONS FOR AREASTATUS ITEM OF BLOCKOFAREASQUE;15001000
FIELD BASEADDRF =39:20, COMMENT BASE ADDRESS OF THE BLOCK; 15002000
AREASIZEFF=47:4 , COMMENT SIZE OF AREA IN A BLOCK; 15003000
AREASTATUSBITSF=19:20; COMMENT BITS FOR INDICATING 15004000
AVAILABLITY OF AREAS; 15005000
DEFINE MAXNOOFAREAS =20#; COMMENT KLUDGE UNTIL BOBS PATCH IS IN 15006000
INTEGER MAXNOOFAREAS; COMMENT NO. OF AREAS ALLOWED IN A BLOCK WHICH IS15007000
ALLOCATED AT A TIME. MAXIMUM NO OF AREAS IS 20; 15008000
DEFINE AITDESCRIPTORPLACE=19#; COMMENT TEMP DEFINE FOR AIT; 15009000
COMMENT DECLARATION FOR QUEUE OF BLOCKS OF AREAS OF DIFFERENT SIZE; 15010000
ARRAY DUMMYBLOCKOFAREASQUE[*]; COMMENT FOR MAKING ENTRY IN 15011000
BLOCKOFAREASQUE; 15012000
REFERENCE LASTBLOCK; COMMENT POINTS TO LAST BLOCK IN BLOCKOFAREASQUE;15013000
PROCEDURE STANDARDINSERT (FIRSTENTRY, LASTENTRY, ENTRY); 16000000
VALUE ENTRY; 16001000
REFERENCE FIRSTENTRY, LASTENTRY, ENTRY; 16002000
COMMENT ASSUMES FIRST 2 ITEMS OF QUEUE ARE PREVIOUS ENTRY 16003000
AND NEXT ENTRY, RESPECTIVELY. SEE STANDARDQUEUE.; 16004000
IF LASTENTRY =NULL 16005000
THEN BEGIN COMMENT QUEUE IS EMPTY; 16006000
FIRSTENTRY ~ LASTENTRY ~ ENTRY; 16007000
PREVIOUSSTANDARD @(ENTRY) ~ NEXTSTANDARD @(ENTRY) ~ NULL; 16008000
END 16009000
ELSE BEGIN COMMENT NEW ENTRY TO TAIL OF QUEUE; 16010000
PREVIOUSSTANDARD @(ENTRY) ~ LASTENTRY; 16011000
NEXTSTANDARD @ (LASTENTRY) ~ ENTRY; 16012000
LASTENTRY ~ ENTRY; 16013000
NEXTSTANDARD @ (ENTRY) ~ NULL; 16014000
END OF STANDARD QUEUE INSERTION ALGORITHM; 16015000
PROCEDURE STANDARDDELINK (FIRSTENTRY, LASTENTRY, ENTRY); 16016000
VALUE ENTRY; 16017000
REFERENCE ENTRY, FIRSTENTRY, LASTENTRY; 16018000
COMMENT ASSUMES FIRST 2 ITEMS OF QUEUE ARE PREVIOUS ENTRY 16019000
AND NEXT ENTRY, RESPECTIVELY. SEE STANDARDQUEUE.; 16020000
IF ENTRY =FIRSTENTRY COMMENT ENTRY IS THE TOP OF THE QUEUE; 16021000
THEN IF FIRSTENTRY = LASTENTRY 16022000
THEN FIRSTENTRY ~LASTENTRY ~NULL 16023000
ELSE BEGIN 16024000
FIRSTENTRY ~ NEXTSTANDARD @ FIRSTENTRY; 16025000
PREVIOUSSTANDARD @(FIRSTENTRY) ~NULL; 16026000
END 16027000
ELSE IF ENTRY =LASTENTRY 16028000
THEN BEGIN COMMENT REMOVE LAST ENTRY; 16029000
LASTENTRY ~PREVIOUSSTANDARD @ ENTRY; 16030000
NEXTSTANDARD @ (LASTENTRY) ~NULL; 16031000
END 16032000
ELSE BEGIN COMMENT REMOVE ANY OTHER ENTRY; 16033000
NEXTSTANDARD @(PREVIOUSSTANDARD @ ENTRY) ~ 16034000
NEXTSTANDARD @ ENTRY; 16035000
PREVIOUSSTANDARD @ (NEXTSTANDARD @ ENTRY) ~ 16036000
PREVIOUSSTANDARD @ ENTRY; 16037000
END OF DELINKING STANDARD QUEUE; 16038000
REFERENCE LASTNAME; 17000000
QUEUE NAMEQUEUE:FIRSTNAME(PREVNAME,NEXTNAME,POINTERTONAME,CHARCOUNT); 17001000
VALUE POINTERTONAME, CHARCOUNT, PREVNAME, NEXTNAME; 17002000
REFERENCE PREVNAME, NEXTNAME; 17003000
POINTER POINTERTONAME; 17004000
INTEGER CHARCOUNT; 17005000
COMMENT QUEUE INDIVIDUAL NAMES UNTIL A "DIRECTORYSEARCH" TYPE 17006000
POINTER CAN BE BUILT; 17007000
USING LOCKED: 17008000
ALLOCATE IS ALLOCATENAMEQ: 17009000
TO INSERT, 17010000
STANDARDINSERT (FIRSTNAME, LASTNAME, ENTRY): 17011000
TO DELINK, 17012000
STANDARDDELINK (FIRSTNAME, LASTNAME, ENTRY); 17013000
SAVE REFERENCE PROCEDURE ALLOCATENAMEQ; 17014000
BEGIN 17015000
REFERENCE R; 17016000
ARRAY A [3]; 17017000
ALLOCATENAMEQ ~ R ~ R & DATADESCRIPTOR(,1,*,,,,,,4,GETAREA(4));17018000
POINTERTONAME @(R) ~ POINTER (A); 17019000
RETURN (R); 17019100
END NAMEQUEUE ALLOCATION AND INITIALIZATION; 17020000
QUEUE BLOCKOFAREASQUE :FIRSTBLOCK(PRVSBLOCK, NEXTBLOCK, AREASTATUS); 17021000
VALUE PRVSBLOCK, NEXTBLOCK, AREASTATUS; 17022000
REFERENCE PRVSBLOCK, NEXTBLOCK; 17023000
REAL AREASTATUS; 17024000
USING 17025000
ALLOCATE IS REFERENCE (DUMMYBLOCKOFAREASQUE & 17026000
ARRAYDESCL( ,3,GETSPACE(3,0,4,0))): 17027000
TO INSERT, 17028000
STANDARDINSERT (FIRSTBLOCK, LASTBLOCK, ENTRY): 17029000
TO DELINK, 17030000
BEGIN 17031000
STANDARDDELINK (FIRSTBLOCK, LASTBLOCK, ENTRY); 17032000
FORGETSPACE (WORD(ENTRY).ADDRESS); 17033000
END; 17034000
% GLOBALS FOR KEYINQ 17035000
REAL KEYINLK; 17036000
REFERENCE FIRSTINP, 17037000
NEXTINP, 17038000
LASTINP; 17039000
INTEGER PROCEDURE CENSUS(O,Y);VALUE O,Y;REFERENCE O,Y;FORWARD; 17039100
QUEUE KEYINQ:KEYQHD (KUSER,KRD,KBUF,KEVNT:PREINP,NEXINP); 17040000
VALUE KUSER,KRD,KBUF,KEVNT,PREINP,NEXINP; 17041000
REFERENCE KBUF, PREINP, NEXINP; 17042000
REAL KUSER, KRD, KEVNT; 17043000
USING 17045000
NEXT IS 17046000
(NEXTINP~NEXINP @ NEXTINP): 17047000
LOCKED: 17048000
POPULATION = CENSUS(FIRSTINP,LASTINP):% 17048100
TO DELINK, 17049000
BEGIN 17050000
IF ENTRY=FIRSTINP THEN 17051000
IF ENTRY=LASTINP THEN 17052000
FIRSTINP~LASTINP~NULL 17053000
ELSE BEGIN 17054000
FIRSTINP~NEXINP @ FIRSTINP; 17055000
PREINP @ (FIRSTINP)~NULL; 17056000
END 17057000
ELSE IF ENTRY=LASTINP THEN 17058000
BEGIN 17059000
LASTINP~PREINP @ LASTINP; 17060000
NEXINP @ (LASTINP)~NULL; 17061000
END 17062000
ELSE BEGIN 17063000
NEXINP @ (PREINP @ ENTRY)~NEXINP @ ENTRY; 17064000
PREINP @ (NEXINP @ ENTRY)~PREINP @ ENTRY; 17065000
END; 17066000
END: 17067000
TO INSERT, 17068000
BEGIN 17069000
IF LASTINP=NULL THEN% EMPTY 17070000
BEGIN 17071000
LASTINP~FIRSTINP~ENTRY; 17072000
NEXINP @ (FIRSTINP)~PREINP @ (FIRSTINP)~NULL; 17073000
END 17074000
ELSE BEGIN 17075000
PREINP @ (ENTRY)~LASTINP; 17076000
NEXINP @ (LASTINP)~ ENTRY; 17077000
LASTINP~ENTRY; 17078000
NEXINP @ (ENTRY)~ NULL; 17079000
END; 17080000
END; 17081000
INTEGER PROCEDURE CENSUS(OLDEST,YOUNGEST);VALUE OLDEST,YOUNGEST; 17082000
REFERENCE OLDEST,YOUNGEST; 17082100
BEGIN INTEGER TMP~1;% 17082200
IF OLDEST=NULL THEN RETURN(0) ELSE% 17082400
BEGIN 17082410
NEXTINP~OLDEST;% 17082500
WHILE OLDEST!YOUNGEST DO% 17082600
BEGIN% 17082610
TMP~*+1;% 17082620
OLDEST~NEXT(KEYINQ);% 17082630
END;% 17082690
END;% 17082700
RETURN(TMP);% 17082900
END CENSUS;% 17082990
% GLOBALS FOR SPOUTQ 17090000
REAL SPOUTLK;% 17090100
REFERENCE FIRSTOUTP,% 17090200
NEXTOUTP,% 17090300
LASTOUTP;% 17090400
QUEUE SPOUTQ:SPOQHD(SUSER,SRD,SBUF,SEVNT:PREOUTP,NEXOUTP); 17091000
VALUE SUSER,SRD,SBUF,SEVNT,PREOUTP,NEXOUTP; 17091100
REAL SUSER,SRD;% 17091200
WORD SEVNT;% 17091210
REFERENCE SBUF, PREOUTP,NEXOUTP; 17091300
USING 17091400
NEXT IS 17091500
(NEXTOUTP~NEXOUTP@NEXTOUTP):% 17091600
LOCKED: 17091700
TO INSERT,% 17091800
BEGIN% 17091900
IF LASTOUTP=NULL THEN% EMPTY 17092000
BEGIN% 17092100
LASTOUTP~FIRSTOUTP~ENTRY;% 17092200
NEXOUTP@(FIRSTOUTP)~PREOUTP@(FIRSTOUTP)~NULL;% 17092300
END% 17092400
ELSE BEGIN% 17092500
PREOUTP@(ENTRY)~LASTOUTP;% 17092600
NEXOUTP@(LASTOUTP)~ENTRY;% 17092700
LASTOUTP~ENTRY;% 17092800
NEXOUTP@(ENTRY)~NULL;% 17092900
END;% 17093000
END:% 17093100
TO DELINK,% 17094000
BEGIN% 17094100
IF ENTRY=FIRSTOUTP THEN% 17094200
IF ENTRY=LASTOUTP THEN% ONE AND ONLY ONE ITEM IN QUEUE 17094300
FIRSTOUTP~LASTOUTP~NULL% 17094400
ELSE BEGIN% TOP ITEM IN QUEUE 17094500
FIRSTOUTP~NEXOUTP@FIRSTOUTP;% 17094600
PREOUTP@(FIRSTOUTP)~NULL;% 17094700
END 17094800
ELSE IF ENTRY=LASTOUTP THEN% BOTTOM ITEM IN QUEUE 17094900
BEGIN% 17095000
LASTOUTP~PREOUTP@LASTOUTP;% 17095100
NEXOUTP@(LASTOUTP)~NULL;% 17095200
END% 17095300
ELSE BEGIN% ITEM IS IN THE MIDDLE OF QUEUE 17095400
NEXOUTP@(PREOUTP@ENTRY)~NEXOUTP@ENTRY;% 17095500
PREOUTP@(NEXOUTP@ENTRY)~PREOUTP@ENTRY;% 17095600
END;% 17095700
END;% 17095800
INTERLOCK ARRAY CHANNELLOCKS[*];% 17100000
ARRAY CHANNELGUIDE[*];% 17100100
LAYOUT LNDESCL (FIRF=19:1,LASF=18:1,PGF=17:10,LNF=7:8),% 17100500
GYDEFORM (RATINGSAMPLEF=47:30,SERF=17:8,CUSTF=9:8,0:1~1); 17100590
FIELD LNSTATF = 19:2;% 17100600
PROCEDURE CHANLINSERT(E,I);VALUE E,I;REAL I;REFERENCE E; FORWARD; 17101000
PROCEDURE CHANLREPLACE(E); VALUE E; REFERENCE E; FORWARD;% 17101100
DEFINE% FOR TUNING CHANNELS 17102000
MAXPSUEDOCHANNELS=10#,% 17102100
PICQSZ= 6#,% 17102110
MIXPIC = 0#,% 17102200
PERPIC = 1#,% 17102210
SCHPIC = 2#,% 17102220
DIRPIC = 3#,% 17102230
MIXCHNLLK = CHANNELLOCKS[MIXPIC]#,% 17102300
MIXQ(R) = PICQ,R,MIXPIC#,% 17102310
MIXQHD = CHANLHD[MIXPIC]#,% 17102320
PRINTMIXPIC(A)= CHANLOUT(MIXPIC,A)#,% 17102330
FIRSTLN= CHANLHD[INDEX]#,% 17102340
TOPLINE= 1&LNDESCL(,,1)#,% 17102350
FIRSTIMAGE(L,P)= L&LNDESCL(1,0,P)#,% 17102360
LASTIMAGE(L,P)= L&LNDESCL(0,1,P)#,% 17102370
CURRENTIMAGE(L,P)= L&LNDESCL(1,1,P)#,% 17102380
AVAILABLEIMAGE(L,P)= L&LNDESCL(0,0,P)#,% 17102390
AVAILINE(L)= (L).LNSTATF=0#,% 17102400
STATUSPOSIT= 28#,% 17102500
STATUSSZ= 3#,% 17102600
ENDCHANLQDEF=0#;% 17102990
QUEUE ARRAY PICQ:CHANLHD[*](LNID,LNDESC,LNBUF,INTERPICLNK,PRELN,NEXLN); 17103000
VALUE LNID,LNDESC, INTERPICLNK,PRELN,NEXLN; 17103100
REAL LNID,LNDESC, INTERPICLNK; 17103200
ARRAY LNBUF[*];% 17103210
REFERENCE PRELN,NEXLN; 17103300
USING LOCKED:% 17103400
TO INSERTINTO, CHANLINSERT(ENTRY,INDEX):% 17103500
TO REPLACIT, CHANLREPLACE(ENTRY):% 17103600
TO INSERT,% 17103700
BEGIN% 17103710
IF FIRSTLN=NULL THEN% 17103720
BEGIN% 17103730
FIRSTLN~ENTRY;% 17103740
PRELN@(ENTRY)~ENTRY;% 17103750
NEXLN@(ENTRY)~NULL;% 17103760
END% 17103770
ELSE BEGIN% 17103780
NEXLN@(ENTRY)~FIRSTLN;% 17103790
NEXLN@(PRELN@FIRSTLN)~ENTRY;% 17103800
PRELN@(ENTRY)~PRELN@FIRSTLN;% 17103810
PRELN@(FIRSTLN)~ENTRY; 17103820
END; 17103830
END: 17103890
TO DELINK,% 17104000
BEGIN% 17104010
IF ENTRY=FIRSTLN THEN% 17104020
IF NEXLN@ENTRY=NULL THEN FIRSTLN~NULL% 17104030
ELSE BEGIN% 17104040
FIRSTLN~NEXLN@ENTRY;% 17104050
PRELN@(FIRSTLN)~PRELN@ENTRY;% 17104060
END% 17104070
ELSE IF NEXLN@ENTRY=NULL THEN NEXLN@(PRELN@ENTRY)~NULL% 17104080
ELSE BEGIN% 17104090
NEXLN@(PRELN@ENTRY)~NEXLN@ENTRY;% 17104100
PRELN@(NEXLN@ENTRY)~PRELN@ENTRY;% 17104110
END;% 17104120
FORGETAREA(WORD(ENTRY).LENGTHF,WORD(ENTRY).ADDRESSF); 17104130
END:% 17104190
TO REARRANGE,% 17104200
BEGIN% 17104210
ENTRY~NEXLN@ENTRY; 17104220
WHILE PRELN@ENTRY!PRELN@FIRSTLN DO% 17104230
BEGIN% 17104240
PRELN@(ENTRY)~PRELN@(PRELN@ENTRY);% 17104250
IF AVAILINE(LNDESC@(NEXLN@(PRELN@ENTRY))) THEN% 17104260
FORGETAREA(WORD(NEXLN@(PRELN@ENTRY)).LENGTHF,% 17104270
WORD(NEXLN@(PRELN@ENTRY)).ADDRESSF);% 17104280
END;% 17104290
END;% 17104300
PROCEDURE CHANLINSERT(ENTREE,CHNNO);VALUE ENTREE,CHNNO;% 17110000
REAL CHNNO; REFERENCE ENTREE;% 17110100
BEGIN% 17111000
INTEGER TMPLN, TMPPG~-1;% 17112000
REFERENCE TMPENTRY~CHANLHD[CHNNO];% 17113000
LABEL LOOP;% 17119000
LOOP: TMPLN:=(TMPLN MOD MAXLNS)+1;% 17121000
IF TMPENTRY=NULL THEN% 17122000
BEGIN% 17123000
LNDESC@(ENTREE)~FIRSTIMAGE(TMPLN,TMPPG+REAL(TMPLN=1)); 17124000
PICQ[CHNNO]~ENTREE;% 17125000
END% 17126000
ELSE BEGIN% 17127000
IF AVAILINE(TMPLN~LNDESC@TMPENTRY) THEN% 17128000
BEGIN% 17129000
LNDESC@(ENTREE)~FIRSTIMAGE(TMPLN,TMPLN.PGF);% 17130000
PRELN@(ENTREE)~TMPENTRY;% 17131000
REPLACIT(PICQ,ENTREE,CHNNO);% 17132000
END% 17133000
ELSE BEGIN% 17134000
TMPENTRY~NEXLN@TMPENTRY;% 17135000
GO TO LOOP;% 17136000
END;% 17137000
END;% 17138000
END CHANLINSERT;% 17139900
PROCEDURE CHANLREPLACE(ENTREE);VALUE ENTREE;REFERENCE ENTREE; 17150000
BEGIN% 17150100
REFERENCE PREVLINE~PRELN@ENTREE;% 17150200
PRELN @ (ENTREE) ~ PRELN @ PREVLINE;% 17150300
NEXLN @ (ENTREE) ~ NEXLN @ PREVLINE;% 17150400
NEXLN @ (PRELN @ ENTREE) ~ PRELN @ (NEXLN @ ENTREE) ~ENTREE; 17150500
FORGETAREA(WORD(PREVLINE).LENGTHF,% 17150700
WORD(PREVLINE).ADDRESSF);% 17150702
END CHANLREPLACE;% 17151990
REFERENCE LASTPARAM; 17152000
QUEUE PARAMETERQUEUE:FIRSTPARAM 17153000
(PREVPARAM, NEXTPARAM, POINTERTOID, PARAMETERINFO); 17154000
VALUE PREVPARAM, NEXTPARAM, POINTERTOID, PARAMETERINFO; 17155000
REFERENCE PREVPARAM, NEXTPARAM, PARAMETERINFO; 17156000
POINTER POINTERTOID; 17157000
COMMENT QUEUE PARAMETER NAMES AND THEIR ASSOCIATED INFO 17158000
UNTIL ALL ITEMS CAN BE PLACED IN A SINGLE 17159000
VECTOR.; 17160000
USING LOCKED: 17161000
ALLOCATE IS ALLOCATENAMEQ: 17162000
TO INSERT, 17163000
BEGIN 17164000
PARAMETERINSERT (FIRSTPARAM, LASTPARAM, ENTRY); 17165000
END: 17166000
TO DELINK, 17167000
BEGIN 17168000
STANDARDDELINK (FIRSTPARAM, LASTPARAM, ENTRY); 17169000
FORGETAREA (4, WORD (ENTRY).ADDRESSF); 17170000
END: 17171000
TO INITIALINSERT, 17172000
STANDARDINSERT (FIRSTPARAM, LASTPARAM, ENTRY); 17173000
PROCEDURE PARAMETERINSERT (FIRSTPARAM, LASTPARAM, ENTRY); 17174000
VALUE ENTRY; 17175000
REFERENCE FIRSTPARAM, LASTPARAM, ENTRY; 17176000
BEGIN 17177000
POINTER PT, PE; 17178000
ARRAY PB [*]; 17179000
REFERENCE RT, PBR = PB; 17180000
INTEGER IT, IE, WORDS; 17181000
REAL T; 17182000
LABEL AWAY; 17183000
IF RT ~ FIRSTPARAM ! NULL 17184000
THEN BEGIN 17185000
WORDS~REAL(POINTERTOID@(RT),6).TOTALINFOWORDSF; 17186000
DO IF IT ~ REAL(PT ~POINTERTOID@(RT), 6). 17187000
KEYFIELDF = 17188000
IE ~ REAL(PE ~POINTERTOID@(ENTRY),6). 17189000
KEYFIELDF 17190000
THEN IF PT+6 = PE+6 FOR IT.ALFALENGTHF 17191000
THEN BEGIN 17192000
PBR ~ PARAMETERINFO@(RT); 17193000
WORDS ~ WORDS - REAL(PT,6).INFOINDEXF - 17194000
PB.LENGTHF; 17195000
STANDARDDELINK (FIRSTPARAM, LASTPARAM, RT); 17196000
FORGETSPACE(PT.ADDRESSF); 17197000
FORGETSPACE(PB.ADDRESSF); 17198000
FORGETAREA(4, WORD (RT).ADDRESSF); 17199000
GO AWAY 17200000
END 17201000
UNTIL RT ~ NEXTPARAM@(RT) = NULL; 17202000
END 17203000
ELSE PE ~ POINTERTOID@(ENTRY); 17204000
AWAY: PBR ~ PARAMETERINFO@(ENTRY); 17205000
STANDARDINSERT (FIRSTPARAM, LASTPARAM, ENTRY); 17206000
UPDATEWORDCOUNT 17207000
(WORDS + (REAL(PE,6).INFOINDEXF) + 17208000
(T ~ PB.LENGTHF), FIRSTPARAM); 17209000
UPDATEINFOINDEX (T, ENTRY); 17210000
END; 17211000
% GLOBALS FOR LOGGING 17300000
ARRAY LOGBUF[*],% 17300100
LOGHDR[*];% 17300200
REAL LOGLOCK,% 17300300
LOGRECCNT;% 17300400
DEFINE 17301000
LOGROWSZ= 1000#,% 17301100
SEGMENTSZ= 30#,% 17301200
LOGRECSZ= 15#,% 17301300
LOGHDRSZ= 30#,% 17301400
ENDLOGDEF=0#;% 17301900
COMMENT GLOBALS FOR ARRAYDEC; 18000000
DEFINE MCPAITSIZE=10#, 18000300
AITSIZE=64#; 18000700
ARRAY MCPARRAYINFOT[MCPAITSIZE]; 18001000
LAYOUT SARRAYDESCL(TAG~5,LENGTHF,MCPARRAYBIT=19:1,FILETYPEF, 18002000
AITINDICATORF,AITINDEXF=16:12,ARRAYTYPEF=4:5); 18003000
COMMENT TO MAKE UP A SPECIAL ARRAY 18004000
DESCRIPTOR FOR ARRAY DECLARATIONS; 18005000
FIELD DOUBLEBIT=2:1,LSAVEBIT=0:1; 18006000
COMMENT GLOBALS FOR FILE MANAGEMENT; 18007000
DEFINE STOPFILETIMING=STARTFILETIMING #, COMMENT WHEN 18008000
STOPFILETIMING IS CALLED SECOND PARAMETER IS FALSE; 18009000
SETUNITAVAILABLE=SETUNITINUSE #, COMMENT WHEN 18010000
SETUNITAVAILABLE IS CALLED SECOND PARAMETER IS FALSE;18011000
LEBZERO=LEB[0]#, 18012000
LEBONE=LEB[1]#, 18013000
LEBTWO=LEB[2]#; 18014000
FIELD BYTE1F=47:8, 18015000
BYTE2F=39:8, 18016000
BYTE3F=31:8, 18017000
BYTE4F=23:8, 18018000
BYTE5F=15:8, 18019000
BYTE6F=7:8; 18020000
DEFINE PUTINBITSTABLE(TABLE,U) =TABLE[U DIV 48].[U MOD 48:1]~1#; 18021000
FIELD PTYPEF =4:5, % DEVICE CODE OF PERIPHERAL TYPE 18022000
PTYPECODEF=7:3, % QUALIFYING CODE FOR PERIPHERAL TYPE 18023000
UNOF =U:1; % FOR RESETTING BITS IN UNIT BITS TABLE 18024000
EVENT FINDINPUTEVENT; % NOW YOU CAN CALL FINDINPUT 18024100
REAL MCPDISKUNITNO; % UNIT NO TO BE USED FOR TALKING ABOUT DISK18024200
COMMENT DEFINES FOR CODE VALUE PASSED TO FINDINPUT; 18024300
DEFINE SEARCHONLY=1# % DONOT WAIT IF DISK FILE IS LOCKED 18024400
; 18024800
ARRAY REPLY[*]; COMMENT FOR STORING REPLYCODE FOR CHECKING 19002000
VALID RESPONSES FROM SPO FOR EACH STACK NO.19003000
(SNR).WHEN VALID RESPONSE IS RECEIVED 19004000
REPLY[SNR]>0 AND WILL CONTAIN THE RECEIVED 19005000
MESSAGE; 19006000
% THE ARRAY REPLY[*] IS TEMPORARILY BEING INITIALIZED 19006200
% TO MAXIMUM NO OF STACKS -- EVENTUALLY IT SHOULD BE MADE DYNAMIC, 19006210
% POSSIBLY BY A QUEUE MECHANISM OR BY STANDARD OFFSET FROM BOSR. 19006220
LAYOUT REPWRDL (% 19006500
REPINFOF=23:9,% MISC. INFO 19006510
REPVALF=14:15);% RESPONSE VALUE 19006590
DEFINE% REPLY BIT VALUE REPINFOF 19006900
DSREP = 1#,% NOTHING 19007000
RMREP = 2#,% NOTHING 19007010
OKREP = 4#,% NOTHING 19007020
ILREP = 8#,% UNIT NO. 19007030
FMREP = 16#,% UNIT NO. 19007040
ULREP = 32#,% UNIT NO. 19007050
OUREP = 64#,% UNIT TYPE 19007060
FRREP = 128#,% NOTHING 19007070
OFREP = 256#,% NOTHING 19007080
USREP = 512#,% GEN AND VER NOS. 19007090
AXREP = 1024#,% DONT KNOW YET 19007100
DEFINEREPEND=0#; 19014000
COMMENT DEFINES FOR BIT NO VALUE IN REPLY MASK; 19014010
DEFINE DSV =0# 19014020
,RMV =1# 19014030
,OKV =2# 19014040
,ILV =3# 19014050
,FMV =4# 19014060
,ULV =5# 19014070
,OUV =6# 19014080
,FRV =7# 19014090
,OFV =8# 19014100
,USV =9# 19014110
,AXV =10# 19014120
; 19014300
COMMENT DEFINES FOR FIB; 19015000
20000000
20001000
DEFINE INDEPENDENTRUNNERCORE = 512 # %***STACK CORE 20002000
, IRCORE = 500 # %TOTAL CORE 20003000
, IRPROCTIME = 1000 # 20004000
, IRIOTIME = 500 # 20005000
, D0OFFSET = 0 # 20006000
; 20007000
REAL INDEPENDENTRUNNERLOK 20008000
; 20009000
COMMENT THE FOLLOWING INDICES ARE USED FOR PARTITIONING INDEPENDENT 20009100
RUNNER PROCEDURES 20009200
; 20009300
REAL IRPCWSTARTPLACE~NAME(CONTROLCARD).ADRCPLF 20009400
, ONEONLYINDEX ~ NAME(STATUS).ADRCPLF -IRPCWSTARTPLACE 20009500
, MAXIRINDEX ~ NAME(TERMINATE).ADRCPLF -IRPCWSTARTPLACE20009600
, MAXIRINDEXPLUS1 ~ MAXIRINDEX+1 20009700
; 20009800
COMMENT THE FOLLOWING INDICATORS ARE USED BY INDEPENDENT RUNNER IN 20010000
RECOGNISING THOSE RUNNERS REQUIRING SPECIAL ACTION. FOR 20010200
EXAMPLE INITIALISE WILL PUT PRIORITIES FOR RECOGNISED RUNNERS 20010400
INTO "IRPRIORITIES"(NOTE - THIS HAS TO BE CODED) - NON 20010600
RECOGNISED RUNNERS WILL HAVE DEFAULT PRIORITIES 20010800
; 20011000
20011100
20011200
REAL CONTROLCARDINDICATOR ~ NAME(CONTROLCARD).ADRCPLF 20013000
-IRPCWSTARTPLACE 20013200
, INITIATEINDICATOR ~ NAME(INITIATE).ADRCPLF 20014000
-IRPCWSTARTPLACE 20014200
, TERMINATEINDICATOR ~ NAME(TERMINATE).ADRCPLF 20015000
-IRPCWSTARTPLACE 20015200
, DIRCOMPLEMENTINDICATOR := NAME(DIRECTORYCOMPLEMENT). 20015300
ADRCPLF - IRPCWSTARTPLACE 20015400
; 20016000
DEFINE FORK(PROC,PARAM)=INDEPENDENTRUNNER(NAME(PROC).ADRCPLF20020020
-IRPCWSTARTPLACE,PARAM) # ; 20020040
COMMENT FOLLOWING DEFINE DEFAULT PRIORITY AND PRIORITIES FOR RUNNERS 20020100
WITH WHICH INDICATORS ARE ASSOCIATED; 20020200
DEFINE IRDEFAULTPRIORITY 20020300
= 10 # 20020400
, DIRCOMPLEMENTPRIORITY = 18 # 20020420
, CONTROLCARDPRIORITY 20020500
= 12 # 20020600
, INITIATEPRIORITY 20020620
= 12 # 20020640
, TERMINATEPRIORITY 20020660
= 19 # 20020680
; 20020900
REAL IRSTACKS %~2 20023000
, PIRSTACKS 20024000
; 20025000
ARRAY STACKINUSE[*], 20026000
IRPRIORITIES[*] 20026100
%EACH IR MUST BE INITI-20027000
%ALISED 20028000
; 20029000
ARRAY IRPARAMETERLOK[*] 20030000
; 20031000
BOOLEAN NOTFIRSTWAIT % *** KLUDGE 20032000
; 20033000
INTEGER TERMINATESTACK % STACK NUMBER FOR TERMINATE 20034000
; 20035000
LAYOUT REDYQHEAD( FIRSTREADYF = 12:10 21000000
,LASTREADYF = 22:10 21001000
) 21002000
; 21003000
REAL ARRAY VECTORLOK[2] 21004000
; 21005000
DEFINE SHEETINDICATOR = FALSE # 21006000
, READYINDICATOR = TRUE # 21007000
, SVECTORPLACE = 16 # 21008000
21009000
21010000
, PRIORITYRANGE = 9 # % UPPER LIMIT ON PRIORITIES 21011000
, PRIORITYRANGEPLUS1 = 10 # 21011100
, TIMELOAD = 10# % NO OF RE-ARRANGES OF SHEET21012000
% BEFORE PRIORITY INCREASE 21013000
, ALLOWABLESLACK = 120# % IN SHEET,STACK VECTOR SIZE21014000
, VECTORMODULE = 100# % SHEET AND STACK VECTOR 21015000
; 21016000
REAL LASTNOTAVAILABLEINVECTOR 21017000
, FIRSTAVAILABLEINVECTOR 21018000
; 21019000
21020000
21021000
ARRAY PRIORITYLEVEL[PRIORITYRANGEPLUS1] 21022000
; 21023000
REAL HIGHESTSHEETVECTOR 21024000
, HIGHESTSTACKVECTOR 21025000
; 21026000
DEFINE SHEET = 0 # %NORMAL 21027000
, REDY = 1 # %FROM WAITQ 21028000
, SHEETI = SHEET # 21029000
, WAITI = 2 # 21030000
, OTHERREDY = 3 # 21031000
, OTHER = OTHERREDY # 21032000
, GETIRS = 4 # 21033000
, TERMINATEI = 5 # 21034000
, READYQHEAD = READYQHED # 21034100
; 21035000
21036000
21037000
21038000
COMMENT FOLLOWING ARE FORMATS OF SHEET PSEUDO-STACK,PROCESS STACK, 21039000
D1 STACK AND D2 STACK NOTE CORRESPONDENCE WITH SHEETQ AND READYQ 21040000
DECLARATIONS - IN GENERAL THERE ARE TWO WAYS OF REFERENCING STACK 21041000
OR PSEUDO STACK INFORMATE - THROUGH ITEM REFERENCES OR THROUGH 21042000
DIRECT INDEXING INTO STACK OR SHEET ARRAY 21043000
; 21044000
DEFINE FIRSTPLACE = 0 # 21045000
, LINKPLACE = 1 # 21046000
, COREPLACE = 2 # 21047000
, PRIORITYPLACE = 3 # 21048000
, PROCTIMEPLACE = 4 # 21049000
, IOTIMEPLACE = 5 # 21050000
, FPBDESCPLACE = 6 # 21051000
, COMMONVALUEPLACE = 7 # 21052000
, PROCESSNATUREPLACE= 8 # 21053000
, FIRSTPARAMETERPLACE = 9# 21053200
, LASTPARAMETERPLACE =10# 21053400
, STACKOLAYABLECOREPLACE = 9 # 21054000
, STACKNONOLAYABLECOREPLACE= 10# 21055000
, TARGETTIMEPLACE = 13# 21056000
, IDPLACE = 14# 21057000
, TIMEENTEREDPLACE = 15 # 21058000
, FIRSTXPLACE = 16# 21059000
, CODEFILEDESCPLACE= 17# 21060000
, CODEFILENAMEDESCPLACE= 18# 21061000
, STACKSIZEPLACE = 20# 21062000
, SEPCOMPILEINFOPLACE = 21# 21063000
, EXTERNALINFOPLACE = 22# 21064000
, D1DESCRIPTORPLACE = 23# 21065000
, D2DESCRIPTORPLACE = 24# 21066000
, NEXTPROGRAMPLACE = 26# 21066100
, AUTHORITYLINKPLACE = 32# 21067000
, REQUIREDPLACE = 33 # 21067200
, AUTHORITYPLACE = 34 # 21067400
, AUTHORITYEVENTPLACE = 35# 21067600
, FIRSTMSCWPLACE 21072000
= 36 # 21072050
, FIRSTRCWPLACE 21072100
= 37 # 21072150
, IRPARAMETERPLACE 21072200
= 38 # 21072250
, IRPCWPLACE 21072300
= 39 # 21072350
, SECNDMSCWPLACE 21072400
= 40 # 21072450
, RETURNCONTROLWORDPLACE 21072500
= 41 # 21072550
; 21073000
DEFINE EVENTWAITQLINK = LINKPLACE # ; 21074000
COMMENT FOLLOWING APPLY TO PSEUDO-STACK ONLY; 21075000
DEFINE SCHEDULEIDPLACE= 14# 21076000
, COLLAPSEDNAMEPLACE = 15# 21077000
; 21078000
21079000
COMMENT FOLLOWING APPY TO PROCESS STACK ONLY; 21080000
DEFINE JOBIDPLACE = 14# 21081000
, PROCESSIDPLACE = 16# 21082000
, TRPLACE = 17# 21083000
, TWPLACE = 18# 21084000
, AITDESCPLACE = 19# 21085000
, TPPLACE = 20# 21086000
, CURRENTPRIORITYPLACE= 23# 21087000
, MYCOURSEPLACE = 24# 21088000
, IOTIMEACCUMPLACE = 25# 21089000
21090000
, DATDESCRIPTORPLACE = 26# 21091000
, OLAYFILEDESCRIPTORPLACE= 27# 21092000
, PROCESSFAMILYLINKPLACE = 28# 21093000
, ERRORCOUNTPLACE = 29 # 21094000
, ABORTEVENTPLACE = 30 # 21095000
, REPLYEVENTPLACE = 31 # 21096000
; 21097000
COMMENT FOLLOWING APPLY TO D1 STACK ONLY; 21098000
DEFINE SEGDICTIDENTPLACE = 2 # 21099000
, FIRSTPCWPLACE = 3 # 21100000
, D1CODEFILEDESCPLACE = 4 # 21101000
, D1CODEFILENAMEDESCPLACE =5# 21102000
, USERCOUNTNLINKAGEPLACE =6 # 21103000
, D1MSCWPLACE = 13# 21104000
, D1RCWPLACE = 14# 21105000
, MYCODEFILENAME(D2STKNR)= WORDSTACK[WORDSTACK[D2STKNR,21105100
PROCESSFAMILYLINKPLACE].FATHERF, 21105102
D1CODEFILENAMEDESCPLACE]#% 21105104
; 21106000
DEFINE D1INFO = D1MSCWPLACE # 21107000
; 21108000
LAYOUT READYWAITLINK ( BACKWARDLINKF = 22:10 21109000
, FORWARDLINKF = 12:10 21110000
, SELFIDENTF = 45:10 21111000
, HEYOUINTERRUPTF= 24:1 21112000
) 21113000
; 21114000
FIELD DEDICATEDSTACKF = 25:1 21114200
; 21114400
WORD D2MSCW2 21115000
, SHEETTOSCW 21116000
, D2MSCW1 21117000
, IRMSCW1 21118000
, IRMSCW2 21119000
, D1MSCW 21120000
, D2RCW1 21121000
, IRTOSCW 21122000
, D2TOSCW 21122100
; 21123000
FIELD DYNAMICLINKSF =22:23 21124000
, STATUSINDICATORF = 23:21 21125000
, FULLINDICATORF = 23:1 21126000
; 21127000
DEFINE 21128000
21129000
D1TOSCW = SHEETTOSCW # 21130000
, IRRCW1 = D2RCW1 # 21131000
21131200
, D1RCW = D2RCW1 # 21132000
; 21133000
LAYOUT USERLINK ( LATENTUSERSF = 39:10 21134000
, ACTIVEUSERSF = 29:10 21135000
, FIRSTD2VALUE = 19:20 21136000
) 21137000
; 21138000
FIELD NUMBEROFUSERSF = 39:20 21138010
; 21138020
LAYOUT PROCESSFAMILYLINKAGE 21138100
% *** AT PRESENT ,A D2 STACK CAN HAVE NO FATHER AND 21138110
% *** FATHERPROCESSF HOLDS THE D1 STACK NO. THE 21138120
% *** D1LINKFLAGF(WHICH AT PRESENT IS UNUSED) MAY PROVE 21138130
% *** USEFUL IF THIS SITUATION CHANGES.15 MARCH 1969 21138140
( FATHERF = 9:10 21138200
, D1LINKFLAGF = 10:1 21138300
, ELDESTSONF = 20:10 21138400
, OLDERBROTHERF = 30:10 21138500
, YOUNGERBROTHERF = 40:10 21138600
); 21138900
21139000
QUEUE READYQ :WRONGTYPEREADYQHEAD ( 21140000
READYQBOTTOM 21141000
, READYQLINK 21142000
, READYQCORE 21143000
, DECLAREDPRIORITY 21144000
, PROCESSLIMIT 21145000
, IOLIMIT 21146000
, FPBDESCRIPTOR 21147000
, COMMONVALUE 21148000
, PROCESSCLASS 21149000
, STACKOLAYABLECORE 21149200
, STACKNONOLAYABLECORE 21149400
, DUMMYREDY1 21149600
, DUMMYREDY2 21149800
, TARGETTIME 21150000
, JOBID 21151000
, TIMEENTERED 21152000
, PROCESSID 21153000
, TIMEINREADYQ 21154000
, WAITTIME 21155000
, AITDESCRIPTOR 21155200
, PROCESSTIME 21156000
, SEPCOMPILEINFO 21156200
, EXTERNALINF 21156400
, CURRENTPRIORITY 21157000
, MYCOURSEITEM 21158000
, ACCUMULATEDIOTIME 21159000
21160000
, OATDESCRIPTOR 21161000
, OLAYFILEDESCRIPTOR 21162000
, PROCESSFAMILYLINK 21163000
, ERRORCOUNT 21164000
, ABORTEVENT 21165000
, REPLYEVENT 21166000
, AUTHORITYLINK 21166010
, REQUIRED 21166100
, AUTHORITY 21166200
, AUTHORITYEVENT 21166300
, FIRSTMSCW 21166400
, FIRSTRCW 21166500
, IRPARAMETER 21166600
, IRPCW 21166700
, SECNDMSCW 21166800
, RETURNCONTROLWD 21166900
); 21167000
VALUE READYQBOTTOM 21168000
, READYQLINK 21169000
, READYQCORE 21170000
21171000
, DECLAREDPRIORITY 21172000
, PROCESSLIMIT 21173000
, IOLIMIT 21174000
, FPBDESCRIPTOR 21175000
, COMMONVALUE 21176000
, TARGETTIME 21177000
, JOBID 21178000
, TIMEENTERED 21179000
, PROCESSCLASS 21180000
, PROCESSID 21181000
, TIMEINREADYQ 21182000
, WAITTIME 21183000
, PROCESSTIME 21184000
, CURRENTPRIORITY 21185000
, MYCOURSEITEM 21186000
, ACCUMULATEDIOTIME 21187000
, AITDESCRIPTOR 21188000
, OATDESCRIPTOR 21189000
, OLAYFILEDESCRIPTOR 21190000
, PROCESSFAMILYLINK 21191000
, ERRORCOUNT 21192000
, DUMMYREDY1 21193000
, DUMMYREDY2 21193200
, SEPCOMPILEINFO 21193400
, EXTERNALINF 21193600
, AUTHORITYLINK 21193800
, REQUIRED 21194000
, AUTHORITY 21194200
, IRPARAMETER 21194400
, FIRSTMSCW 21194600
, FIRSTRCW 21194800
, IRPCW 21195000
, SECNDMSCW 21195200
, RETURNCONTROLWD 21195400
, STACKOLAYABLECORE 21195700
, STACKNONOLAYABLECORE 21195800
; 21195900
REAL READYQCORE 21196000
21197000
, DECLAREDPRIORITY 21198000
, PROCESSLIMIT 21199000
, IOLIMIT 21200000
, COMMONVALUE 21201000
, TARGETTIME 21202000
, JOBID 21203000
, TIMEENTERED 21204000
, PROCESSCLASS 21205000
, PROCESSID 21206000
, TIMEINREADYQ 21207000
, WAITTIME 21208000
, PROCESSTIME 21209000
, CURRENTPRIORITY 21210000
, MYCOURSEITEM 21211000
, ACCUMULATEDIOTIME 21212000
, PROCESSFAMILYLINK 21213000
, ERRORCOUNT 21214000
, DUMMYREDY1 21214100
, DUMMYREDY2 21214200
, SEPCOMPILEINFO 21214300
, EXTERNALINF 21214400
, AUTHORITYLINK 21214500
, REQUIRED 21214600
, AUTHORITY 21214700
, IRPARAMETER 21214800
, STACKOLAYABLECORE 21214820
, STACKNONOLAYABLECORE 21214840
; 21215000
WORD READYQBOTTOM 21216000
, READYQLINK 21217000
, FPBDESCRIPTOR 21218000
, AITDESCRIPTOR 21219000
, OATDESCRIPTOR 21220000
, OLAYFILEDESCRIPTOR 21221000
, FIRSTMSCW 21221100
, FIRSTRCW 21221200
, IRPCW 21221300
, SECNDMSCW 21221400
, RETURNCONTROLWD 21221500
; 21222000
EVENT ABORTEVENT 21223000
, REPLYEVENT 21224000
, AUTHORITYEVENT 21224100
; 21225000
USING 21226000
LOCKED 21227000
:TO INSERT, VECTORINSERT(REDY ,ENTRY) 21228000
:TO REARRANGE, STACKQREARRANGE(READYINDICATOR) 21229000
:EMPTY IF REAL(M[NAME(WRONGTYPEREADYQHEAD)])=0 21230000
:TO INSERTINQ, INSERTINQUEUE(REDY ,INDEX) 21231000
: TO MOVETONEXTINREADY ,NEXTPROCESS 21232000
: TO MOVEFROMSHEET, SELECTION 21233000
; 21234000
21235000
21236000
DEFINE FIRSTATLEVEL = FIRSTREADYF # 21237000
, LASTATLEVEL = LASTREADYF # 21238000
; 21239000
FIELD COUNTATLEVEL = 45:20 21240000
; 21241000
LAYOUT LEVELFORMAT ( FIRSTATLEVEL 21241010
, LASTATLEVEL 21241020
,COUNTATLEVEL 21241030
); 21241040
DEFINE DEFAULTPRIORITY= 5 # 21241100
; 21241200
COMMENT FOLLOWING ARE THE CURRENT WEIGHTING COEFFICIENTS OF THE 21242000
SCHEDULING ALGORITHMS. THEY ARE PURELY TEMPORARY FOR THE 21243000
FOLLOWING REASONS : 21244000
A THEIR DERIVATION WAS PURELY ARBITRARY. AS YET THERE HAS 21245000
BEEN NO ATTEMPT TO ARRIVE AT GOOD VALUES. FURTHER ANALYSIS21246000
,SIMULATION AND EXPERIENCE ARE REQUIRED 21247000
B THE VALUES OF THE COEFFICIENTS WILL BE DYNAMIC RATHER 21248000
THAN FIXED AS SHOWN BELOW 21249000
; 21250000
REAL DECLAREDPRIORITYWEIGHT ~ 1.0 21251000
21252000
%)TIMES IN SECS21253000
, READYTIMEWEIGHT ~ 0.0017 %)THUS 1 ADDED 21254000
, WAITTIMEWEIGHT ~ 0.0017 %)EVERY 10 OR 21255000
, ELAPSEDTIMEWEIGHT ~ 0.00017 %)HUNDRED MINS 21256000
%)TO PRIORITY 21257000
21258000
, TARGETTIMEWEIGHT ~ 0.1 21259000
, COREWEIGHT ~ 0.002 21260000
, TIMEINSCHEDULEWEIGHT ~ 0.0017 21261000
; 21262000
QUEUE SHEETQ :WRONGTYPESHEETQHEAD ( 21263000
SHEETBOTTOM 21264000
, SHEETLINK 21265000
, SHEETCORE 21266000
, SHEETPRIORITY 21267000
, PROCESSLIMITINSHEET 21268000
, IOLIMITINSHEET 21269000
, FPBDESCRIPTORINSHEET 21270000
, COMMONVALUEINSHEET 21271000
, PROCESSNATURE 21272000
, FIRSTPARAMETER 21272200
, LASTPARAMETER 21272400
, DUMMYSHEET3 21272600
, DUMMYSHEET4 21272800
, TARGETTIMEINSHEET 21273000
, SCHEDULEID 21274000
, TIMEENTEREDINSHEET 21275000
, FIRSTXINSHEET 21276000
, SHEETCODEFILEDESCRIPTOR 21277000
, SHEETCODEFILENAMEDESCRIPTOR 21278000
, COLLAPSEDNAME 21279000
, STACKSIZEINSHEET 21280000
, SEPARATELYCOMPILEDINFO 21281000
, EXTERNALINFO 21282000
, D1DESCRIPTOR 21283000
, D2DESCRIPTOR 21284000
, PREVIOUSPROGRAM 21285000
, NEXTPROGRAM 21286000
, DUMMYSHEET5 21286020
, DUMMYSHEET6 21286040
, DUMMYSHEET7 21286060
, DUMMYSHEET8 21286080
, DUMMYSHEET9 21286100
, AUTHORITYLINKINSHEET 21286120
, REQUIREDINSHEET 21286140
, AUTHORITYINSHEET 21286160
, AUTHORITYEVENTINSHEET 21286180
, FIRSTMSCWINSHEET 21286200
, FIRSTRCWINSHEET 21286220
, IRPARAMETERINSHEET 21286240
, IRPCWINSHEET 21286260
, SECNDMSCWINSHEET 21286280
, RETURNCONTROLWORDINSHEET 21286300
); 21287000
VALUE SHEETBOTTOM 21288000
, SHEETLINK 21289000
, SHEETCORE 21290000
, SHEETPRIORITY 21291000
, PROCESSLIMITINSHEET 21292000
, IOLIMITINSHEET 21293000
, FPBDESCRIPTORINSHEET 21294000
, COMMONVALUEINSHEET 21295000
, TARGETTIMEINSHEET 21296000
, SCHEDULEID 21297000
, TIMEENTEREDINSHEET 21298000
, PROCESSNATURE 21299000
, FIRSTPARAMETER 21299200
, LASTPARAMETER 21299400
, FIRSTXINSHEET 21300000
, SHEETCODEFILEDESCRIPTOR 21301000
, SHEETCODEFILENAMEDESCRIPTOR 21302000
, COLLAPSEDNAME 21303000
, STACKSIZEINSHEET 21304000
, SEPARATELYCOMPILEDINFO 21305000
, EXTERNALINFO 21306000
, D1DESCRIPTOR 21307000
, D2DESCRIPTOR 21308000
, PREVIOUSPROGRAM 21309000
, NEXTPROGRAM 21310000
, AUTHORITYLINKINSHEET 21310020
, REQUIREDINSHEET 21310040
, AUTHORITYINSHEET 21310060
, FIRSTMSCWINSHEET 21310080
, FIRSTRCWINSHEET 21310100
, IRPARAMETERINSHEET 21310120
, IRPCWINSHEET 21310140
, SECNDMSCWINSHEET 21310160
, RETURNCONTROLWORDINSHEET 21310180
; 21311000
REAL SHEETCORE 21312000
, SHEETPRIORITY 21313000
, PROCESSLIMITINSHEET 21314000
, IOLIMITINSHEET 21315000
, COMMONVALUEINSHEET 21316000
, TARGETTIMEINSHEET 21317000
, SCHEDULEID 21318000
, TIMEENTEREDINSHEET 21319000
, PROCESSNATURE 21320000
, COLLAPSEDNAME 21321000
, STACKSIZEINSHEET 21322000
, SEPARATELYCOMPILEDINFO 21323000
, EXTERNALINFO 21324000
21324020
21324040
, DUMMYSHEET3 21324060
, DUMMYSHEET4 21324080
, DUMMYSHEET5 21324100
, DUMMYSHEET6 21324120
, DUMMYSHEET7 21324140
, DUMMYSHEET8 21324160
, DUMMYSHEET9 21324180
, AUTHORITYLINKINSHEET 21324200
, REQUIREDINSHEET 21324220
, AUTHORITYINSHEET 21324240
; 21325000
WORD SHEETBOTTOM 21326000
, SHEETLINK 21327000
, FPBDESCRIPTORINSHEET 21328000
, SHEETCODEFILEDESCRIPTOR 21329000
, SHEETCODEFILENAMEDESCRIPTOR 21330000
, D1DESCRIPTOR 21331000
, D2DESCRIPTOR 21332000
, FIRSTMSCWINSHEET 21332020
, FIRSTRCWINSHEET 21332040
, IRPARAMETERINSHEET 21332060
, IRPCWINSHEET 21332080
, SECNDMSCWINSHEET 21332100
, RETURNCONTROLWORDINSHEET 21332120
, FIRSTXINSHEET 21333000
; 21334000
REFERENCE PREVIOUSPROGRAM 21335000
, FIRSTPARAMETER 21335200
, LASTPARAMETER 21335400
, NEXTPROGRAM 21336000
; 21337000
EVENT 21337020
AUTHORITYEVENTINSHEET 21337040
; 21337100
USING 21338000
LOCKED 21339000
:TO INSERT, VECTORINSERT(SHEETI ,ENTRY) 21340000
:TO REARRANGE, STACKQREARRANGE(SHEETINDICATOR) 21341000
:EMPTY IF REAL(M[NAME(WRONGTYPESHEETQHEAD)])=0 21342000
: NEXTINDEX = NEXTINSCHEDULE 21343000
; 21344000
DEFINE MOVETONEXTINREADYQ = MOVETONEXTINREADY(READYQ)# 21345000
, MOVETONEXTONEINREADYQ = MOVETONEXTINREADYQ # 21346000
, NEXTSTACKINREADYQ = READYQHED.FIRSTREADYF# 21347000
, NOTHINGTODO = (EMPTY(READYQ) AND EMPTY(SHEETQ))# 21347100
; 21348000
WORD WORDREADYQHEAD = WRONGTYPEREADYQHEAD 21349000
, WORDSHEETQHEAD = WRONGTYPESHEETQHEAD 21350000
; 21351000
DEFINE FILLARRAY(ARAY,VALU ,LENGTH) 21352000
= REPLACE POINTER(ARAY) BY VALU FOR LENGTH 21353000
OVERWRITE # 21354000
; 21355000
21356000
QUEUE TERMINATEQ:WRONGTYPETERMINATEQHEAD(DUMMY); REAL DUMMY; 21357000
USING 21358000
LOCKED 21358200
: TO INSERTINQ , INSERTINQUEUE(TERMINATEI,INDEX) 21358400
: EMPTY IF REAL(M[NAME(WRONGTYPETERMINATEQHEAD)])= 0 21358600
: TO REMOVE, STACKQREMOVE(TERMINATEI,INDEX) 21359000
; 21360000
DEFINE NEXTINTERMINATEQ=TERMINATEQHEAD.FIRSTREADYF # 21361000
; 21361500
WORD WORDTERMINATEQHEAD = WRONGTYPETERMINATEQHEAD ; 21362000
REAL READYQHED =WRONGTYPEREADYQHEAD 21363000
, TERMINATEQHEAD = WRONGTYPETERMINATEQHEAD 21364000
, SHEETQHEAD=WRONGTYPESHEETQHEAD 21365000
; 21366000
21367000
21368000
21369000
DEFINE FORWARDLINKSF = FORWARDLINKF # 21370000
, SELFIDENTSF = SELFIDENTF # 21371000
, BACKWARDLINKSF = BACKWARDLINKF # 21372000
; 21373000
21374000
21375000
REAL FIRSTLOK 21376000
; 21377000
LAYOUT LINKWORD ( FORWARDLINKSF 21378000
, SELFIDENTSF 21379000
, BACKWARDLINKSF 21380000
) 21381000
; 21382000
BOOLEAN MUSTREARRANGE 21383000
; 21384000
DEFINE RUNRETURNCONTROLWORD = RUNPCW&RETURNCONTROLWORD 21385000
(,*,*,*,*,*,*) # 21386000
; 21387000
21388000
DEFINE LOOKFORSOMETHING = 21388200
BEGIN 21388300
UNLOCK(READYQ); 21388320
IF NOTFIRSTWAIT AND NOT BUSY(INDEPENDENTRUNNERLOK) 21388400
THEN FORK(STATUS,0); 21388500
ALLOW; ALLOW; DISALLOW; 21388600
GO LOOKFORNEWPROCESS; 21388700
END # ; 21388800
21389000
21390000
DEFINE TIMEOFDAY = SCANIN(TIMEOFDAYWORD) # 21391000
; 21392000
LAYOUT JOBTIME ( TIMEOFDAYF = 47:36) 21393000
; 21394000
REAL SHEETENTRYSIZE ~ SIZE(SHEETQ)-4; 21394200
DEFINE READYENTRYSIZE=SHEETENTRYSIZE # 21394300
, FIXEDIRSIZE = SHEETENTRYSIZE # 21394400
; 21394500
REFERENCE DUMMYREF; 21395000
REAL NEXTINREADYVECTOR 21395100
, NEXTINSHEETVECTOR 21395200
; 21395300
SAVE EVENT ARRAY HOLEINVECTOR[2] 21395400
; 21395500
DEFINE PUTINJOBIDANDTIME(S,N) 21395600
=S[JOBIDPLACE]~N&JOBTIME(S[TIMEENTEREDPLACE] 21395700
~TIMEOFDAY)# 21395800
; 21395900
COMMENT *** FOLLOWING IS DUMMY UNTIL COREFACTOR DEFINED; 21399000
BOOLEAN COREFACTOR; COMMENT TRUE IF MEMORY USAGE IS SATIS- 21400000
FACTORY FOR NEW PROCESS INITIATION; 21400100
DEFINE FIRSTBITPH = 20 # 21400200
, LENGTHPH = 5 # 21400300
, FIRSTBITPC = 15 # 21401000
, LENGTHPC = 8 # 21401500
; 21402000
LAYOUT NATUREOFPROCESS(PROCESSHISTORYF=FIRSTBITPH:LENGTHPH 21402500
,PROCESSCLASSF= FIRSTBITPC:LENGTHPC ) 21403000
; 21403200
DEFINE AD1STACK 21403500
= 0 # 21404000
, NORMAL 21404500
= 1 # 21405000
, XSED 21405500
= 2 # 21406000
, DSED 21406500
= 3 # 21407000
, DEPENDENT 21407200
= 4 # 21407400
, INDEPENDENT 21407600
= 5 # 21407800
, TERMINATEIR 21408000
= 6 # 21408200
; 21408800
COMMENT THE FOLLOWING ARE VALUES FOR PROCESSCLASS; 21409000
DEFINE GOJOB = 0 # 21410000
, EXECUTEJOB= 1 # 21411000
, COMPILENGOJOB= 10# 21412000
, COMPILENSYNTAXJOB= 11# 21413000
, COMPILETOLIBRARYJOB=12# 21414000
, COMPILETOLIBRARYANDGOJOB = 19 # 21414100
, RUNJOB = 20# 21415000
, LIBRARYNGOJOB = 6# 21415100
, COMPILENSYNTAXOBJECT = 7# 21415200
; 21416000
DEFINE FIRSTCOMPILEROPTION = COMPILENGOJOB # 21416200
, LASTCOMPILEROPTION = COMPILETOLIBRARYJOB # 21416300
; 21416400
FIELD INITIATESTACKF = 21:1 21416500
; 21416600
DEFINE COMPILEFORSYNTAX(P) = 21417000
P.PROCESSCLASSF = COMPILENSYNTAXOBJECT#; 21418000
COMMENT DIRECTORY MANAGEMENT GLOBALS; 23000000
DEFINE DIRECTORYBITE = 90 #, %THE SIZE OF A DIRECTORY RECORD 23001000
SEGMENTSPERDIRECTORYBITE = 3 #, 23002000
SYSTEMDIRECTORYINDEX = 0 # %INDEX INTO DISKFILEHEADERS 23002100
; 23003000
ARRAY DISKFILEHEADERS[*,*]; 23003100
INTERLOCK HEADERLOCK; 23003200
ARRAY DISKFILEHEADERSDOPEVECTOR = DISKFILEHEADERS [*]; 23003250
REAL DISKB;%KLUDGE FOR SIMULATOR"S DIRECTORY SEARCH 23003301
DEFINE DIRECTORYLOCK = HEADERLOCKS[0] # 23003310
, HEADERSTOSTARTWITH = 10 # 23003320
; 23003330
INTERLOCK ARRAY HEADERLOCKS[HEADERSTOSTARTWITH]; 23003335
ARRAY SYSTEMDIRECTORY[*]; 23003340
LAYOUT DIRECTORYSEARCHCODES( 23003355
DCODE1 = 38:15 23003360
,DCODE2 = 23:8 23003370
,DCODE3 = 14:15 23003375
); 23003380
COMMENT DEFINES FOR DCODE3 FIELD VALUE WHEN DIRECTORYSEARCH IS 23003383
UNSUCCESSFUL- (WHEN IT RETURNS NEGATIVE VALUE); 23003387
DEFINE NOSUCHFILE=1#, 23003390
NOTAVALIDFILENAME=2#, % DIRECTORY NAME MISSING 23003393
FILETHEREBUTLOCKED=3#, 23003395
FILEWITHWRONGGENEALOGY=4#; 23003397
LAYOUT STANDARDMASSADDRESSWORD( %STANDARD MASS STORAGE 23004000
%ADDRESS FORMAT 23005000
VOLUMEKIND = 47:3 %VOLUME TYPE 23006000
, VOLUMENOEUNOF = 44:25 %VOLUME OR EU UNIT 23007000
%AS PER ABOVE. 23008000
, BLOCKADDRESSF = 19:20 %BLOCK ADDRESS OR BLOCK23009000
%NUMBER. 23010000
); 23011000
DEFINE VOLUMENOF = VOLUMENOEUNOF # 23012000
; 23013000
COMMENT EUNOF = VOLUMENOEUNOF%UNIT NO. OF EU 23014000
, DISKADDRESS = BLOCKADDRESSF 23015000
; 23016000
DEFINE %THESE DEFINITIONS ARE TO 23017000
%BE USED FOR "VOLUMEKIND" 23018000
%IN STANDARD MASS ADDRESS 23019000
%WORDS 23020000
FIXEDDISK = 0# 23021000
, DISKPACK = 1# 23022000
, TAPE = 2# 23023000
; 23024000
COMMENT: 23024050
THE FOLLOWING ARE THE FIRST FOUR WORDS OF A DIRECTORY RECORD. 23024100
SUCCESSOR RECORD = WORD 0 23024150
PREDICESSOR RECORD = WORD 1 23024200
FIRST AVAILABLE NAME BLOCK INDEX = WORD 2 23024250
RECORD NUMBER OF THIS RECORD = WORD 3 23024300
NOTE: 23024350
THERE IS ALWAYS AT LEAST ONE WORD AT THE END OF A RECORD 23024400
WHICH IS USED AS A STOPPER. IT HAS A VALUE OF EITHER 23024450
THREE OR ONE, AS DESCRIBED BY "ENDER" IN THE NAME BLOCK 23024500
DESCRIPTION. 23024550
; 23024600
COMMENT: 23025000
THE FOLLOWING IS A DESCRIPTION OF THE NAME ENTRY FOR A FILE 23026000
IN A DIRECTORY RECORD. 23027000
; 23028000
LAYOUT DIRECTORYENTRYINFOWORD( %WORD 0 23029000
USEMEDIUMF = 47:5 %STORAGE MEDIUM WHERE 23030000
%FILE IS SUPOSED TO BE 23031000
%WHEN IT IS IN USE. 23032000
%USEMEDIUM=0 MEANS THAT23033000
%IT IS WHERE IT SHOULD 23034000
%BE. 23035000
, FILEKINDF = 36:8 %FILE TYPE FOR THE FILE23038000
%(PROGRAM,DIRECTORY...)23039000
, HEADERSIZEF = 28:10 %SIZE (IN WORDS) OF THE23040000
%HEADER FOR THIS FILE. 23041000
, ENDER = 1:2 %DIRECOTRY END MARKER 23042000
% =3 IS END OF RECORD 23043000
% =1 IS END OF FILE 23044000
%IF THE WORD IS -1 THEN23044100
%IT MARKS THE END OF A 23044200
%SCRAMBLED DIRECTORY. 23044300
) 23045000
COMMENT ADDRESSOFFILEHEADER = STANDARDMASSADDRESSWORD-WORD 1;23046000
, DIRECTORYENTRYFILENAME( %WORD 2 23047000
CHARACTERCOUNTF= 47:8 %CHARACTER COUNT FOR 23048000
%FILE NAME. 23049000
, FIRSTFIVECHRS = 39:40 %FIRST FIVE EBCDIC 23050000
%CHARACTERS OF THE FILE23051000
%NAME. (LEFT JUSTIFIED23052000
%WITH TRAILING ZEROS IF23053000
%NECESSARY. 23054000
) 23055000
; 23056000
COMMENT THE NEXT TWO WORDS CONTAIN THE REST OF THE NAME. THE NAME 23057000
IS LIMITED TO 17 CHARACTERS; 23058000
COMMENT: 23069000
THE FOLLOWING IS A DESCRIPTION OF A FILE HEADER 23070000
; 23071000
COMMENT ADDRESSOFHEADER = STANDARDMASSADDRESSWORD 23072000
THIS WORD IS WORD -1 23073000
OF THE CORE COPY OF THE23074000
HEADER RELATIVE TO THE 23075000
DESCRIPTOR RETURNED BY 23076000
DIRECTORY SEARCH 23077000
IT IS IN THE MEMORY LINK 23078000
; 23079000
LAYOUT COREADDRANDLOCKER( %WORD 0 23080000
COREADDRF = 19:20 %ON DISK THIS FIELD IS 23086000
%THE POINTER TO THE 23087000
%CORE COPY OF THIS 23088000
%HEADER. IF THIS FIELD23089000
%IS ZERO, THERE IS NO 23090000
%COPY IN CORE. 23091000
) 23092000
, HEADERINFOONE( %WORD 1 23093000
UPDATEBITF = 47:1 %TRUE IF FILE UPDATED 23094000
, OPENCOUNTF = 46:10 %NUMBER OF PROCESSES 23095000
%LOOKING AT THE HEADER.23096000
, FILEKINDF %SAME AS IN 23097000
%DIRECTORYENTRYINFOWORD23098000
, HEADERSIZEF %SAME AS IN 23099000
%DIRECTORYENTRYINFOWORD23100000
, SECURITYCODEF = 18:4 %CLASS OF SECURITY ON 23101000
%THIS FILE. 23102000
, SECINFOSIZEF = 14:8 %SIZE (IN WORDS) OF THE23103000
%SECURITY INFORMATION 23104000
%IN THIS HEADER. 23105000
, LOGICALMODEF = 3:4 %EBCDIC, DOUBLE, ETC...23106000
) 23108000
, HEADERINFOTWO( % FILE ORGANIZATION 23109000
PACKEDB = 47:1 % (IF 1 FILE IS PACKED)23110000
, PROTECTIONF = 46:1 % (1 IF FILE PROTECTED)23110100
, PERMANENCYF = 45:1 % (1 IF TEMPORARY FILE)23110200
, RECORDTYPEF = 42:3 % RECORD TYPE 23111000
, FILEORGF = 39:40 % FILE ORGANIZATION 23113000
) 23114000
COMMENT WORD 3 IS FIB TANKDATA2; 23115000
COMMENT ENDOFFILECOUNT WORD 4; 23116000
, ROWINFO( %WORD 5 23117000
NUMROWSF = 29:10 %NUMBER OF ROWS FOR 23120000
%WHICH ROW ADDRESS 23121000
%WORDS ARE ASSIGNED. 23122000
, ROWSIZEF = 19:20 %SIZE (IN SEGMENTS) OF 23123000
%EACH ROW . 23124000
) 23125000
, NAMEQUALIFICATIONINFO( %WORD 6 23126000
SAVEFACTORF = 47:10 %SAVE TIME 23127000
, CREATEDDATEF = 37:18 %WHEN THE FILE WAS MADE23128000
, GENERATIONNOF = 19:15 %USASCI GENERATION NO. 23128100
, MAXGENERATIONSF= 4:5 %PURGE ANY OVER THIS 23128200
, GENERATIONNO = 19:20 %USASCI GENERATION NO. 23129000
) 23130000
, ACCESSINFO( %WORD 7 23131000
LASTACCESSDATEF=17:18 %DATE LAST USED 23132000
) 23133000
COMMENT WORD 8 IS USED FOR VARIOUS PURPOSES DEPENDING ON THE FILE KIND.23134000
FOR DIRECTORIES, IT IS THE SCRAMBLE MODULUS. 23134100
FOR CODE FILES, IT IS THE STACK NUMBER FOR THE D1 STACK WHEN 23134200
A COPY OF THE PROGRAM IS RUNNING. 23134300
; 23134900
COMMENT SPARE (WORD 9) = RESERVED FOR EXPANSION; 23135000
COMMENT ROW ADDRESS WORDS IN STANDARD MASS ADDRESS WORD 23136000
FORMAT. ONE WORD PER ROW FOR 23137000
NUMROWS ROWS; 23138000
COMMENT SECURITYINFO SECINFOSIZE WORDS; 23139000
; 23141000
DEFINE FIRSTROWINDEX = 10 # 23141100
, FIRSTROWADDRESS(HDR) = HDR[FIRSTROWINDEX] # 23141120
, ROWADDRESS(HDR, ROW) = HDR[FIRSTROWINDEX + ROW] # 23141130
, SCRAMBLEMOD(HDR) = HDR[8] # 23141150
, HEADERSIZE(HDR) = HDR[1].HEADERSIZEF # 23141200
, HEADERUPDATED(HDR) = TRUE # % TEMPORARY 23141250
, OPENCOUNT(HDR) = HDR[1].OPENCOUNTF # 23141300
, ROWSIZE(HDR) = HDR[5].ROWSIZEF # 23141350
, CRUNCHED(HDR) = 0 # COMMENT TEMPORARY ONLY; 23141400
, NUMBEROFROWS(HDR) = HDR[5].NUMROWSF # 23141450
, D1STACKNUMBER(HDR) = HDR[8] # 23141500
, UPDATED(HDR) = HDR[1].UPDATEBITF# 23141550
, DISKBLOCKING(HDR) = HDR[3]# 23141600
, FIBINFO(HDR) = HDR[2]# 23141650
; 23141950
DEFINE %THESE DEFINITIONS ARE TO 23142000
%BE USED FOR "FILEKIND" IN 23143000
%FILE HEADERS AND DIRECTORY 23144000
%NAME ENTRIES 23145000
DIRECTORY = 0# 23146000
, DATA = 1# 23147000
; 23148000
COMMENT *** FOLLOWING FIELD AND DEFINE ARE TEMPORARY ; 23177100
FIELD TYPEINFOF = 35: 36 ; 23177200
DEFINE COMPILERS = 0 # ; 23177300
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24000000
% I/O INTRINSIC DECLARATIONS %24001000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24002000
% %24003000
% * WARNING * %24004000
% %24005000
% DO NOT REFER TO FIB WORDS OR FIELDS DIRECTLY. INSERT YOUR FIB %24006000
% REFERENCE INTO THE MASTER-FIB DEFINE LIST. ONLY THIS LIST WILL %24007000
% BE CHECKED WHEN IT IS NECESSARY TO CHANGE THE DEFINITION OF A FIB %24008000
% WORD OR FIELD. %24009000
% (HONI SOIT QUI MAL Y PENSE) %24010000
% %24011000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24012000
24013000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24252000
% FIXED PART OF FILE INFORMATION BLOCK %24253000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24254000
DEFINE 24255000
%%%%% SIMPLE I/O 24256000
FIBSIZE = FIB[0]#, % SIZE OF FILE INFO BLOCK 24257000
RECORDSTATUS = FIB[1]#, 24258000
FILESTATUS = FIB[2]#, 24259000
TANKDATA1 = FIB[3]#, % BLOCK SIZE INFORMATION 24260000
TANKDATA2 = FIB[4]#, % RECORD SIZE INFORMATION 24261000
TANKDATA3 = FIB[5]#, % BUFFER SIZE INFORMATION 24262000
IOINFO = FIB[6]#, % HARDWARE INFORMATION 24263000
IOADESC = FIBW[7]#, % TOP IOAREA 24264000
LBLEQTN = FIBW[8]#, % LABEL EQUATION BLOCK 24265000
%%%%% REGULAR I/O 24266000
BUFDESC = FIBW[9]#, % BUFFER DESCRIPTOR 24267000
UNITSLEFT = FIB[10]#, % WORDS OR CHARACTERS LEFT 24268000
BLOCKCOUNT = FIB[11]#, % BLOCK COUNT OR PAGE COUNT 24269000
RECORDCOUNT = FIB[12]#, % RECORD COUNT OR LINE COUNT24270000
LABELATT = FIB[13]#; % LABEL ATTRIBUTES 24272000
LAYOUT 24273000
FIBSIZEL ( 24274000
FIBFXD = 47:8, % SIZE OF FIXED PART 24275000
FIBOPT = 39:40), % VARIABLE PART MASK 24276000
RECORDSTATUSL ( 24277000
MTBUF = 0:1, % BUFFER NEEDS I/O 24278000
UFEAT = 1:1, % UNIT FEATURE 24279000
DRCDSIZE = 2:1, % RECORD SIZE REQUIRED OR DESIRED24280000
EXCEPTION = 3:1, % EXCEPTION CONDITION 24281000
OPNOUT = 4:1, % OPEN OUTPUT 24282000
OPNIN = 5:1, % OPEN INPUT 24283000
DIO = 6:1, % DIRECTED I/O (DATA COMM) 24284000
SIO = 7:1), % SIMPLE I/O 24285000
FILESTATUSL ( 24286000
% EXCEPTION CONDITIONS 24287100
STATEF = 9:10, % STATE OF FILE 24287200
% 0:1 = EOF (DISCONNECT) 24287300
% 1:1 = PARITY ERROR 24287400
% 2:1 = DATA ERROR 24287500
% 3:1 = LOCKOUT 24287600
% 4:1 = NO INPUT(TIME OUT) 24287700
% 5:1 = BREAK 24287800
% ERROR HANDLING LEVEL 24287900
ERRLEVEL = 12:2, % LEVEL OF ERROR RECOVERY 24288000
% 0 = FULL SYSTEM ACTION 24288100
% 1 = INHIBIT COPY 24288200
EXCEPTIONT= 13:1, % EXCEPTION ACTION TAKEN 24288300
OPT = 14:1, % OPTIONAL 24288400
IMPOPEN = 15:1, % (1 IF IMPLICIT OPEN IS NOT OK) 24288410
% EXCEPTION ACTION 24288500
% CODES ARE: 24288600
% 0 = MARK AND EXIT 24288700
% 1 = EVENT OR IMPLICIT LABEL 24288800
% 2 = RETURN OR USE ROUTINE 24288900
% 3 = TERMINATE 24289000
EOFACTION = 22:3, 24289100
PARACTION = 25:3, 24289200
DATACTION = 28:3, 24289300
LOCACTION = 31:3, 24289400
NOIACTION = 34:3, 24289500
BREACTION = 37:3), 24289600
TANKDATA1L ( 24345000
BLKFUNNY = 47:1, % ALTERNATE AREA IN USE 24346000
BLKD = 46:1, % BLOCKED 24347000
MLTBLK = 45:1, % MULTI-PHYSICAL-RECORD BLOCK 24348000
PNTR = 44:1, % (1 IF POINTER TO BE RETURNED) 24349000
INTMODE = 43:3, % INTERNAL RECORD FORM - 24350000
% RECORD DESCRIPTOR TYPE: 24351000
% 0 = SINGLE DATA 24352000
% 1 = DOUBLE DATA 24353000
% 2 = PACKED-DECIMAL (4) 24354000
% 3 = BCL (6) 24355000
% 4 = EBCDIC (8) 24356000
% 5 = ASCII (8) 24357000
RCDUNTS = 40:2, % RECORD UNITS: 24358000
% 0 = WORDS 24359000
% 1 = CHARACTERS 24360000
RCRDTYPE = 38:4, % RECORD TYPE 24361000
% 0 = "F" - FIXED LENGTH 24362000
% 1 = "D" = VARIABLE, LENGTH24363000
% IN BINARY IN FIRST 2 24363100
% CHARACTERS 24363200
% 2 = "V" - VARIABLE, LENGTH24364000
% IN DECIMAL IN FIRST 424364100
% CHARACTERS 24364200
% 3 = "U" - UNDEFINED, SIZE 24365000
% PROVIDED EXPLICITLY 24365100
% 4 = "I" - VARIABLE, LENGTH24366000
% IN RECORD AT FIXED 24366100
% LOCATION 24366200
% 5 = "L" - LINKS 24367000
% 6 = "Z" - FORTRAN 24367100
% 7 = DEPENDENT SPECIFICATN 24367200
% FIXED UP AT OPEN 24368000
SIZEMODE = 34:3, % SIZE MODE 24369000
SIZEOFF = 31:16, % SIZE OFFSET 24370000
SIZESZ = 15:16), % SIZE SIZE 24371000
TANKDATA2L ( 24372000
BLOCKSIZE = 47:16, % BLOCK SIZE 24373000
MINRECSIZE= 31:16, % MINIMUM RECORD SIZE 24374000
MAXRECSIZE= 15:16), % MAXIMUM RECORD SIZE 24375000
TANKDATA3L ( 24376000
BUFFERD = 47:1, % (1 IF BUFFERED - LEVEL 2&3 I/O)24377000
CNTGS = 44:1, % CONTIGUOUS - BUFFERS ADJACENT 24378000
BFFRLCK = 45:1, % (1 IF BUFFERS NEED LOCKS) 24378100
BUFFPROT = 44:1, % (1 IF MUST PROTECT BUFFERS) 24378200
BEVNT = 43:12, % BUFFER EVENT # 24379000
BFFRSZ = 31:16, % BUFFER SIZE (IOAREA SIZE) 24380000
BUFFREQSTD= 15:8, % BUFFERS REQUESTED 24381000
BUFFASSGND= 7:8), % BUFFERS ASSIGNED 24382000
IOINFOL ( 24383000
%%%%% FOR DATACOM USE THIS WORD FOR LAST STATION 24383100
SKLTNIOCW = 47:27, % SKELETON IOCW 24384000
UNITNUM = 12:8, % UNIT NUMBER 24385000
UNITYPP = 4:5), % UNIT TYPE 24386000
LABELATTL ( 24387000
LABELUSER = 47:1, % LABEL USE ROUTINES 24388000
LABELTYP = 46:3, % LABEL TYPE 24389000
% 0 = B6500 USASI 24390000
% 1 = UNLABELLED 24391000
% 2 = SYSTEM STANDARD 24392000
WRPRND = 17:1, % (1 IF WRAPAROUND SPECIFIED) 24392100
USERSIZE = 16:4, % NUMBER OF USERS LABELS 24393000
LBLEQTD = 12:1, % (1 IF HAVE LOCATED FPB) 24394000
EVNTNO = 11:12); % FILE EVENT # 24395000
FIELD 24396000
%%%%% RECORDSTATUS 24397000
OPENBITS = 9:2, 24398000
%%%%% FILESTATUS 24398010
EOFB = 0:1, % END-OF-FILE (DISCONNECT) 24398020
PARITYB = 1:1, % PARITY ERROR 24398030
DATAERRORB= 2:1, % DATA ERROR 24398040
LOCKOUTB = 3:1, % LOCKOUT 24398050
NOINPUTB = 4:1, % NO INPUT (TIME OUT) 24398060
BREAKB = 5:1, % BREAK 24398070
%%%%% IOINFO 24404000
SIOCWSTANDARD = 45:10; % STANDARD FIELD OF IOCW 24405000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24406000
% OPTIONAL PART OF FILE INFORMATION BLOCK %24407000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24408000
DEFINE 24409000
ALTDESCF = 0#, 24410000
FIBLOCKF = 1#, 24411000
FRMTLOCKF = 2#, 24412000
DISKHDRF = 3#, 24413000
DISKINFOF = 4#, 24414000
LIMITSF = 5#, 24415000
USERSF = 6#, 24416000
RERUNF = 7#, 24417000
EOFF = 8#, 24418000
PARITYP = 9#, 24419000
NOINPUTF = 10#, 24420000
BREAKF = 11#, 24421000
QUEUEFULLF= 12#, 24422000
INQUEUEF = 13#, 24423000
TLISTF = 14#, 24424000
TOWF = 15#, 24425000
TMISCF = 16#, 24426000
OUTQUEUEF = 17#, 24426100
SORTWORDF = 18#, 24426200
% FIBOVERFLOW=39#, % RESERVED FOR EXPANSION 24426900
FIIB(FLD) = FIB[FIB0.FIBFXD 24428000
+ONES(FIB0.[39:FLD])]#, 24429000
FIIBW(FLD)= FIBW[FIB0.FIBFXD 24430000
+ONES(FIB0.[39:FLD])]#, 24431000
FIBB(FLD) = BOOLEAN(FIB0.[39-(FLD):1])#, 24432000
ALTDESC = FIBW[FIB0.FIBFXD]#, % ALTERNATE DESCRIPTOR 24433000
% IF BLOCKEDFUNNY THEN DESCRIPTOR FOR ALTERNATE 24434000
% AREA. IF COPY BLOCKING THEN POINTER TO OTHER 24435000
% FIB. 24436000
LOCKER = FIIB(FIBLOCKF)#, % LOGICALRECORD LOCK 24437000
FLOCK = FIIB(FRMTLOCKF)#, % FORMATTER LOCK 24438000
DISKHEADER= FIIBW(DISKHDRF)#, % DISK HEADER 24439000
FILEACCESS= FIIB(DISKINFOF)#, % FILE ACCESS INFORMATION 24440000
FILELIMITS= FIIB(LIMITSF)#, % FILE LIMITS 24441000
USEROUTINES=FIIBW(USERSF)#, % USE-ROUTINE-INDEX ARRAY 24442000
RERUNATT = FIIB(RERUNF)#, % RERUN ATTRIBUTES 24443000
EOFE = FIIBW(EOFF)#, % END OF FILE EVENT 24444000
PARITYE = FIIBW(PARITYP)#, % PARITY EVENT 24445000
NOINPUTE = FIIBW(NOINPUTF)#, % NO INPUT EVENT 24446000
BREAKE = FIIBW(BREAKF)#, % BREAK EVENT 24447000
QUEUEFULLE= FIIBW(QUEUEFULLF)#,% QUEUE FULL EVENT 24448000
INQUEUE = FIIBW(INQUEUEF)#, % INPUT QUEUE 24449000
TERMINALISTF=FIIBW(TLISTF)#, % TERMINAL LIST 24450000
TOCCURSWORD=FIIB(TOWF)#, % TERMINAL OCCURS WORD 24451000
TMISC = FIIB(TMISCF)#, % TERMINAL MISC WORD 24452000
OUTQUEUE = FIIBW(OUTQUEUEF)#,% OUTPUT QUEUE 24452100
SORTWORD = FIIB(SORTWORDF)#, % SORT INFO 24452200
USERS = FIBB(USERSF)#, 24453000
KLUDGED = 0#; 24454000
LAYOUT 24455000
FILEACCESSL ( 24456000
EXPADRS = 41:1, % (1 IF EXPLICIT ADDRESS IS 24459000
% PERMITTED WITH SEQUENTIAL 24460000
% FILE) 24461000
BEGINO = 40:1, % (1 IF FILE BEGINS AT 1) 24462000
ACSSTYPE = 39:4, % FILE ACCESS TYPE: 24463000
% 0 = SERIAL 24464000
% 1 = RANDOM 24465000
% 2 = LINKED 24466000
% 3 = DIRECTED 24467000
ACSSMODES = 35:1, % (1 IF ACCESS MODE SPECIFIED) 24467100
ACSSMODE = 34:3, % ACCESS MODE (IF LINKED) 24468000
% SAME VALUES AS INTMODES 24469000
ACSSOFF = 31:16, % ACCESS OFFSET 24473000
ACSSZ = 15:16), % ACCESS SIZE 24474000
RERUNATTL ( 24475000
RERUNEOR = 47:2, % RERUN END-OF-REEL 24476000
% 0 = NONE 24477000
% 1 = EOR 24478000
% 2 = RECORDS 24479000
% 3 = CLOCK UNITS 24480000
RERUNHERE = 45:1, % RERUN ON THIS TAPE 24481000
RERUNCOUNT= 31:16, % NUMBER OF RECORDS: ACCUMULATOR 24482000
RERUNNO = 15:16), % NUMBER OF RECORDS: TARGET 24483000
TOCWL ( 24484000
TERMINALSZ= 47:16, % TERMINAL SIZE 24485000
NUMTERMS = 31:16); % NUMBER OF TERMINALS 24486000
DEFINE 24487000
% TERMINAL LIST 24488000
TOUTQUEUE = TLISTW[TSZ]#, % OUTPUT QUEUE (DIRECTED) 24489000
TSTATUS = TLIST[TSZ+1]#, % TERMINAL STATUS 24490000
TFILE = TLISTW[TSZ+2]#, % TERMINAL FILE 24491000
TTIME = TLIST[TSZ+3]#, % TERMINAL TIME DATA 24492000
TINQUEUE = TLISTW[TSZ+4]#, % INPUT QUEUE (TERMINAL) 24493000
TSTAT = TLIST[TSZ+5]#; % TERMINAL STATISTICS 24494000
DEFINE 24494100
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24494110
% LABEL-EQUATION BLOCK (LEB) %24494120
% SAME FORMAT ALSO USED IN LABEL TABLE AND FPB %24494130
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24494140
% FIXED PART LEB 24494150
LEBC = LEB[0]#, % BASIC DATA: SIZE,KIND ... 24494160
GEN1 = LEB[1]#, % REEL, CYCLE, VERSION 24494170
GEN2 = LEB[2]#, % DATE, SAVE FACTOR 24494180
DSKS = LEB[3]#, % DISK INFO AND MYUSE,OTHERUSE...24494190
OPENTIME = LEB[4]#, % TIME FILE OPEN 24494200
% OPTIONAL PART LEB 24494210
% BLK1 = LEB[U]#, % FILE TYPE,BLOCK SIZE,MAX REC SZ24494220
% BLK2 = LEB[U+1]#, % MINIMUM RECORD SIZE 24494230
% TITLE FOLLOWS LAST WORD OF OPTIONAL PART 24494240
% LABEL TABLE 24494250
LCNTRL = UINFOP[U,0]#, 24494260
LGEN1 = UINFOP[U,1]#, 24494270
LGEN2 = UINFOP[U,2]#, 24494280
LMISC = UINFOP[U,3]#, 24494290
USERFIB = UINFOPW[U,4]#,% SIRW TO USERS FIB 24494300
LBLK1 = UINFOP[U,5]#, 24494310
LBLK2 = UINFOP[U,6]#; 24494320
LAYOUT 24495000
% LABEL-EQUATION BLOCK (LEB) 24496000
LEBCNTRL ( 24497000
FXD = 47:4, % NUMBER OF WORDS IN FIXED PART 24498000
OPTMASK = 43:15, % OPTIONAL-PART MASK 24499000
% OPTIONALF = 23:1, % OPTIONAL 24499010
% FPRTCTD = 20:1, % FILE PROTECTED 24499020
LPARITY = 19:1, % PARITY (1 IS ODD) 24500000
DENSITYS = 18:1, % ON IF DENSITY SPECIFIED 24501000
DENSITYL = 17:2, % DENSITY: 0-800, 1-556, 2-200, 24502000
% 3-1600 24503000
LABELTYPES= 15:1, % ON IF LABEL TYPE SPECIFIED 24504000
LABELTYPEL= 14:4, % LABEL TYPE: 24505000
% 0 - B6500 USASI 24506000
% 1 - UNLABELLED 24507000
% 2 - B5500 24508000
% 3 - SYSTEM STANDARD 24509000
% 4 - B3500 USASI 24510000
% 5 - NON-STANDARD USASI 24511000
% 6 - BACKUP TAPE 24512000
% 7 - LIBRARY TAPE 24513000
% 8 - LOAD-CONTROL TAPE 24514000
% 9 - SYSTEM TAPE 24515000
% 10 - B5500 BACKUP 24516000
% 11 - B5500 LIBRARY 24517000
EXTFORML = 10:3, % EXTERNAL FORM 24518000
% PROBLEM WITH UNSPECIFIED Q 24518010
PTYPEL = 7:8), % PERIPHERAL TYPE 24519000
%%%%% FOR CARD READERS HAVE ONLY THIS BLOCK PLUS THE NAMES 24520000
GENEALOGY1 ( 24521000
CYCLE =38:15, % CYCLE (GENERATION NUMBER) 24522000
GENVERSN = 23:8, % GENERATION VERSION 24523000
REELS = 15:1, % ON IF REEL NUMBER SPECIFIED 24524000
REEL = 14:15), % REEL NUMBER 24525000
GENEALOGY2 ( 24526000
% SERIALN = 45:20, % SERIAL # (FOR LABEL TABLE) 24526010
SAVFACTOR = 25:11, % SAVE FACTOR 24527000
CRTNDATE = 14:15), % CREATION DATE 24528000
LMISCL ( % USED IN LABEL TABLE 24529000
BCNTL = 43:20, % BLOCK COUNT 24530000
RCNTL = 23:24), % RECORD COUNT 24531000
DISKSPECL ( 24532000
DIRECTIONF= 47:1, % (1 IF REVERSED) 24533000
REVACTIONF= 46:1, % (1 IF OPEN REVERSE GOES 1 REEL)24533100
DRCTRYF = 43:1, % (1 IF GOES IN DIRECTORY) 24533200
PACKEDF = 42:1, % PACKED 24533300
FLEXIBLEF = 41:1, % FLEXIBLE 24533400
SPEEDF = 40:3, % SPEED 24534000
OTHERUSEF = 37:2, % OTHER USE 24535000
MYUSEF = 35:2, % MY USE 24536000
ACCSSTYPEF= 33:4, % ACCESS TYPE 24537000
NUMAREAS = 29:10, % NUMBER OF AREAS 24538000
AREASIZE = 19:20), % AREA SIZE 24539000
% OPTIONAL PART OF LEB RELATIVE WORD #24540000
%*************************************************************%24540050
% POINTER TO INTERNAL NAME (IF ANY) % 124540100
%*************************************************************%24540110
BLOCKING1 ( % 224541000
FILETYPEL = 41:3, % FILE TYPE 24542000
NONBUFFRDL= 38:1, % NON-BUFFERED 24543000
BUFFERNOL = 37:6, % NUMBER OF BUFFERS 24544000
MAXRECSZL = 31:16, % MAXIMUM RECORD SIZE 24545000
BLOCKSZL = 15:16), % BLOCK SIZE 24546000
BLOCKING2 ( % 324547000
MINRECSZL = 15:16); % MINIMUM RECORD SIZE 24548000
FIELD 24549000
FPRTCTD = 20:1, % FILE PROTECTED 24550000
OPTIONALF =23:1, % ON, IF OPTIONAL FILE 24551000
% GENEALOGY2 24552000
SERIALN = 45:20; % SERIAL # (FOR LABEL TABLE) 24553000
DEFINE 24553100
INTNAME = 0#, 24553110
BLCKNG1 = 1#, 24553120
BLCKNG2 = 2#, 24553130
FRMS = 3#, 24553140
LEEB(FLD) = LEB[LEBC.FXD+ONES(LEBC.[43:FLD])]#, 24553150
LEBB(FLD) = BOOLEAN(LEB[LEBC.FXD+ONES(LEBC.[43-FLD:1])])#,24553160
BLK1 = LEEB(BLCKNG1)#,% FILE TYPE, BLOCKING INFO 24553170
BLK2 = LEEB(BLCKNG2)#,% MINIMUM RECORD SIZE 24553180
KLUDGED1 = 0#; 24553190
DEFINE 24571000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24571100
% FILE LABEL DEFINES %24571200
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24571300
24571400
% B6500 USASI LABELS 24572000
% VOL1 24573000
UVSN = PVOL1+4#, % SERIAL NUMBER 24574000
UMFID = PVOL1+11#, % MULTIPLE FILE ID 24575000
USYSN = PVOL1+28#, % "65" 24576000
USYST = PVOL1+30#, % TAPE TYPE 24577000
% 0 - SCRATCH 24578000
% 1 - USER 24579000
% 2 - LIBRARY 24580000
% 3 - BACK UP 24581000
% 4 = LOAD CONTROL 24582000
ULSL = PVOL1+79#, % 1 IF STANDARD USASI 24583000
% HDR1 24584000
UFID = PHDR1+4#, % FILE ID 24585000
URLNMBR = PHDR1+27#, % FILE SECTION NUMBER (REEL #) 24586000
USQNCNMBR = PHDR1+31#, % FILE SEQUENCE NUMBER (POSITION)24587000
UGNRTN = PHDR1+35#, % GENERATION NUMBER 24588000
UVRSN = PHDR1+39#, % VERSION 24589000
UCDT = PHDR1+42#, % CREATION DATE 24590000
UEDT = PHDR1+48#, % EXPIRATION DATE 24591000
UBCNT = PHDR1+54#, % BLOCK COUNT 24592000
URCNT = PHDR1+60#, % RECORD COUNT 24593000
USYSL = PHDR1+67#, % " B6500" 24594000
% HDR2 24595000
URF = PHDR2+4#, % RECORD FORMAT 24596000
UBL = PHDR2+5#, % BLOCK LENGTH 24597000
URL = PHDR2+10#, % RECORD LENGTH 24598000
UDNSTY = PHDR2+15#, % DENSITY 24599000
USNTNL = PHDR2+16#, % SENTINEL 24600000
UPRTY = PHDR2+17#, % PARITY 24601000
UFORM = PHDR2+18#, % EXTERNAL FORM 24602000
UMRL = PHDR2+19#, % MINIMUM RECORD LENGTH 24603000
UOFS = PHDR2+50#, % OFFSET TO DATA 24604000
% B3500 USASI LABELS 24605000
% VOL1 ALL BLANKS EXCEPT "VOL1",SERIAL NUMBER, AND "1" 24606000
% HDR1 24607000
B35FID = PHDR1+13#, % B3500 FILE ID 24608000
B35MFID = PHDR1+21#, % B3500 MULTIPLE FILE ID 24609000
% NO HDR2 24610000
% B5500 LABELS 24611000
% B5500 LABEL 24612000
LMFID = PVOL1+9#, 24613000
LFID = PVOL1+17#, 24614000
LREEL = PVOL1+24#, 24615000
LCDT = PVOL1+27#, 24616000
LCYCLE = PVOL1+32#, 24617000
LEDT = PVOL1+34#, 24618000
LSNTNL = PVOL1+39#, 24619000
LBCNT = PVOL1+40#, 24620000
LRCNT = PVOL1+45#, 24621000
LMEMDUMP = PVOL1+52#, 24622000
LVSN = PVOL1+53#; 24623000
LAYOUT 24624000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24624100
% UNIT FEATURE WORD (PASSED BY COMPILERS TO LOGICALRECORD) %24624200
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24624300
UFEATL ( % UNIT FEATURE LAYOUT 24625000
MOTIONF = 47:1, % (1 IF PRINT AFTER PAPER MOTION)24626000
DRCTNF = 46:1, % (1 IF REVERSE SPACE) 24627000
SKIPFF = 45:1, % (1 IF SKIP TO CHANNEL) 24628000
ABSLINEF = 44:1, % (1 IF ABSOLUTE LINE NUMBER) 24629000
WRAPF = 43:1, % ( 1 IF WRAPAROUND) 24630000
REUSEF = 42:1, % (1 IF REUSE THIS RECORD) 24631000
FORMATTERF= 41:1, % (1 STILL IN THE FORMATTER) 24632000
MEMINHIBITF=40:1, % (1 NO DATA TRANSFER) 24632010
CVALUEF = 15:16); % CONTROL VALUE: 24633000
% ABSOLUTE LINE NUMBER 24634000
% RELATIVE LINE NUMBER 24635000
% CHANNEL # 24636000
% ABSOLUTE RECORD # 24637000
% RELATIVE RECORD # 24638000
DEFINE 24639000
% USE-ROUTINES-INDEX ARRAY 24640000
% INPUT 24641000
BBRI = PUSE#, % BEFORE BEGINNING REEL INPUT 24642000
ABRI = PUSE+1#, % AFTER BEGINNING REEL INPUT 24643000
BBFI = PUSE+2#, % BEFORE BEGINNING FILE INPUT 24644000
ABFI = PUSE+3#, % AFTER BEGINNING FILE INPUT 24645000
BERI = PUSC+4#, % BEFORE ENDING REEL INPUT 24646000
AERI = PUSE+5#, % AFTER ENDING REEL INPUT 24647000
BEFI = PUSE+6#, % BEFORE ENDING FILE INPUT 24648000
AEFI = PUSE+7#, % AFTER ENDING FILE INPUT 24649000
% OUTPUT 24650000
BBRO = PUSE+8#, % BEFORE BEGINNING REEL OUTPUT 24651000
ABRO = PUSE+9#, % AFTER BEGINNING REEL OUTPUT 24652000
BBFO = PUSE+10#, % BEFORE BEGINNING FILE OUTPUT 24653000
ABFO = PUSE+11#, % AFTER BEGINNING FILE OUTPUT 24654000
BERO = PUSE+12#, % BEFORE ENDING REEL OUTPUT 24655000
AERO = PUSE+13#, % AFTER ENDING REEL OUTPUT 24656000
BEFO = PUSE+14#, % BEFORE ENDING FILE OUTPUT 24657000
AEFO = PUSE+15#, % AFTER ENDING FILE OUTPUT 24658000
% IO 24659000
BBRIO = PUSE+16#, % BEFORE BEGINNING REEL IO 24660000
ABRIO = PUSE+17#, % AFTER BEGINNING REEL IO 24661000
BBPIO = PUSE+18#, % BEFORE BEGINNING FILE IO 24662000
ABFIO = PUSE+19#, % AFTER BEGINNING FILE IO 24663000
BERIO = PUSE+20#, % BEFORE ENDING REEL IO 24664000
AERIO = PUSE+21#, % AFTER ENDING REEL IO 24665000
BEFIO = PUSE+22#, % BEFORE ENDING FILE IO 24666000
AEFIO = PUSE+23#, % AFTER ENDING FILE IO 24667000
% ERROR 24668000
EI = PUSE+24#, % ERROR INPUT 24669000
ERO = PUSE+25#, % ERROR OUTPUT 24670000
EIO = PUSE+26#; % ERROR IO 24671000
DEFINE 24672000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24673000
% IOAREA - NORMAL STATE I/O BUFFER LAYOUT %24674000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24675000
% AT THE FRONT OF THE IOAREA IS THE IOCB - I/O CONTROL BLOCK %24676000
% USER = 0 % USER WORD: 24677000
% PRIORITY, UNIT-NUMBER, 24678000
% WORD-COUNT, I/O-ERROR RECOVERY 24679000
% MISC = 1 % RECEIVES RESULT DESCRIPTOR 24680000
% AREADESC= 2 % POINTS AT BEGINNING OF BUFFER (IOCW)24681000
% EVNT = 3 % POINTS AT THE BUFFER (FILE) EVENT 24682000
% PRVSIO = 4 % FORWARD QUEUE LINK 24683000
% NEXTIO = 5 % BACKWARD QUEUE LINK 24684000
% A FEW WORDS ARE NEEDED FOR BUFFER CONTROL ... %24685000
IOAL = 6#, % FORWARD & REVERSE BUFFER LINKS 24686000
IOAW = 7#, % HOLDS NECESSARY FIELDS 24687000
% REWRITE,BEFORE,PASSED,ACTIVE 24688000
% THE BEGINNING OF THE BUFFER %24689000
IOCWP = 8#, % IOCW - I/O CONTROL WORD 24690000
FRSTDATA = 9#, % FIRST DATA 24691000
IOTANKSZ = 9#; 24692000
FIELD 24693000
% IOAW FIELDS 24694000
RWRT = 47:1, % REWRITE 24695000
BFR = 46:1, % BEFORE 24696000
RCN = 39:20, % RECORD NUMBER 24697000
PSSD = 39:10, % PASSED 24698000
ACTV = 29:10, % ACTIVE 24699000
ACTLKY = 19:20; % ACTUAL KEY 24700000
DEFINE 24701000
% ARGUMENT 24702000
INV = 1#, 24703000
OUTV = 2#, 24704000
IOV = 3#, 24705000
REGOPEN = 0#, 24706000
RLSWTCH = 1#, 24707000
STATUSV = 2#, 24708000
PRESENTV = 3#, 24709000
REGCLOSE = 0#, 24709100
RELEASEV = 1#, 24710000
PURGEV = 2#, 24710100
MOREWINDV = 3#, 24710200
LOCKV = 4#, 24711000
CRUNCHV = 5#, 24711100
HERE = 6#, 24712000
ASTRSK = 7#; 24713000
DEFINE 24714000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24715000
% MASTER LIST OF FIB DEFINES %24716000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24717000
ACCESSMODE = FILEACCESS.ACSSMODE#, %24718000
ACCESSOFF = FILEACCESS.ACSSOFF#, 24719000
ACCESSZ = FILEACCESS.ACSSZ#, 24720000
ACCESSTYPE= FILEACCESS.ACSSTYPE#, 24720100
ACTIONTAKEN=BOOLEAN(ATAKEN)#, 24720150
ACTIVE = IOAREA[IOAW].ACTV#, 24721000
ACTUALKEY = IOAREA[IOAW].ACTLKY#, 24722000
ADD1TOBIT32=4294967296#, 24722100
ADRSF = ADDRESSF#, 24723000
AFTER = BOOLEAN(UNITFEATURE.MOTIONF)#, 24723100
ALREADYOPEN = RECORDSTATUS.OPENBITS!0#, 24724000
ATAKEN = FILESTATUS.EXCEPTIONT#, 24724010
ARRAYROW = BOOLEAN(TANKDATA1.PNTR)#, 24724100
BEFORE = NOT AFTER#, 24724200
BFFRD = TANKDATA3.BUFFERD#, 24726000
BEFOREACTION=BOOLEAN(IOAREA[IOAW].BFR)#, 24727000
BFFRXHSTD = RECORDSTATUS.MTBUF#, 24728000
BLCKDFNNY = TANKDATA1.BLKFUNNY#, 24729000
BFRACTN = IOAREA[IOAW].BFR#, 24730000
BLKDFNNY(P1,P2,SZ) = IF BLOCKEDFUNNY THEN 24731000
REPLACE P1 BY P2 FOR SZ WORDS#, 24732000
BLOCKED = BOOLEAN(TANKDATA1.BLKD)#, 24733000
BLOCKEDFUNNY = BOOLEAN(TANKDATA1.BLKFUNNY)#, 24734000
BLOCKSZ = TANKDATA2.BLOCKSIZE#, 24735000
BUFFERED = BOOLEAN(BFFRD)AND NUMBEROFBUFFERS!0#, 24736000
BUFFEREXHAUSTED = BOOLEAN(RECORDSTATUS.MTBUF)#, 24737000
BUFFERSZ = TANKDATA3.BFFRSZ#, 24738000
BUFFREQ = TANKDATA3.BUFFREQSTD#, 24739000
CARRIAGECONTROL=RECORDSTATUS.UFEAT#, 24740000
CHANNELNO = UNITFEATURE.ADDRESSF#, 24741000
CHANNELSKIP=BOOLEAN(UNITFEATURE.SKIPF)#, 24742000
CHARECORD = BOOLEAN(RECORDUNITS)#, 24742100
CHERE = FILESTATUS.CLSHR#, 24743000
CLOSEHERE = BOOLEAN(FILESTATUS.CLSHR)#, 24744000
CONTGS = TANKDATA3.CNTGS#, 24745000
CONTIGUOUS= BOOLEAN(TANKDATA3.CNTGS)#, 24746000
CRRGCNTRL = BOOLEAN(CARRIAGECONTROL)#, 24747000
DIRECTION = IOINFO.IOBACKWARD#, 24748000
DISC = UNITYP=DISKFILE#, 24749000
DISKREAD = @460#, % MEMORY PROTECT 24749100
DISKWRITE = @040#, 24749200
DIVORCEMOM(A)=A~A&DIVMOML(,)#, 24750000
ENDOF = BOOLEAN(FILESTATUS.EOFB)#, 24751000
ENDOFACTION = FILESTATUS.EOFACTION#, 24752000
ENDOFTAKEN= ENDOF AND ACTIONTAKEN#, 24753000
ENDOV = FILESTATUS.EOFB#, 24754000
ENTERDIR = FILEACCESS.DRCTRYF#, 24755000
EVENTNO = TANKDATA3.BEVNT#, 24756000
EXPLICITADDRESS=BOOLEAN(FILEACCESS.EXPADRS)#, 24757000
FFORTRAN = RECORDTYPE=6#, 24757100
FIB0 = FIBSIZE#, 24757200
FIBUZZ = IF FIBB(FIBLOCKF) THEN BEGIN 24758000
WHILE BOOLEAN(READLOCK(1,LOCKER)) DO 24759000
WAIT(IOEVENT[FILEVENT]); 24760000
RESET(IOEVENT[FILEVENT]) END#, 24761000
FILEDRCDSIZE=BOOLEAN(RECORDSTATUS.DRCDSIZE)#, 24761050
FILEMTBUF = BOOLEAN(RECORDSTATUS.MTBUF)#, 24761100
FILENOTOPEN = RECORDSTATUS.OPENBITS=0#, 24762000
FILEVENT = LABELATT.EVNTNO#, 24763000
FILEXCPTN = BOOLEAN(RECORDSTATUS.EXCEPTION)#, 24764000
FIXEDL = RECORDTYPE=0#, 24764100
FLINKED = RECORDTYPE=5#, 24764200
FORMATD = RECORDTYPE=1#, 24764300
FORMATI = RECORDTYPE=4#, 24764400
FORMATTER = BOOLEAN(TANKDATA1.PNTR)AND PFOCRCSZ#, 24764450
FORMATU = RECORDTYPE=3#, 24764500
FORMATV = RECORDTYPE=2#, 24764600
FORMSMESSAGE=LEBB(FRMS)#, 24764700
GENSZ= 4#,% 24766000
IMPLCTOPN = FILESTATUS.IMPOPEN#, 24767000
IMPLICITOPEN=NOT BOOLEAN(IMPLCTOPN)#, 24768000
INOUTPART = DSKS.MYUSEF#, 24769000
INTERNALMODE = FILESTATUS.INTMODE#, 24770000
IOCOMPLET = USER@(IOCB).USERIOFINISH#, 24771000
IOCOMPLETE= BOOLEAN(WORD(USER@IOCB).USERIOFINISH)#, 24772000
IOCWSKLTN= IOINFO#, 24774000
IOPENDING = NOT IOCOMPLETE#, 24775000
IOTERMINATE=BEGIN TRACE(18);TRACE(21)END#, 24776000
LABELEQTD = BOOLEAN(LABELATT.LBLEQTD)#, 24777000
LABELTYPE = LABELATT.LABELTYP#, 24778000
LASTBUFFER=IOAREA~*&ARRAYDESCL(,*,IOAREA[IOAL].BL)#, 24778100
LASTLENGTH= TANKDATA1.SIZESZ#, 24778200
LBLEQUATED= LABELATT.LBLEQTD#, 24779000
LOCKOUT = FILESTATUS.LOCKOUTB#, 24780000
MAGICNUMBER=150#, 24781000
MAXGENNO= 9999#,% 24781100
MAXNO = 549755813887#, 24782000
MAXRECSZ = TANKDATA2.MAXRECSIZE#, 24783000
MAXVERNO= 99#,% 24783100
MINRECSZ = TANKDATA2.MINRECSIZE#, 24784000
MLTBLCK = TANKDATA1.MLTBLK#, 24785000
MULTIBLOCK= BOOLEAN(TANKDATA1.MLTBLK)#, 24786000
NEXTBUFFER=IOAREA~*&ARRAYDESCL(,*,IOAREA[IOAL].FL)#, 24786100
NOACTION = BOOLEAN(UNITFEATURE.REUSEF)#, 24786200
NOLINES = UNITFEATURE.ADDRESSF#, 24786600
NOMORE = BOOLEAN(WORD(USER@IOCB).USEREOFORTBIT)#, 24789000
NOTOPEN = RECORDSTATUS.OPENBITS=0#, 24791000
NUMBEROFBUFFERS = TANKDATA3.BUFFASSGND#, 24792000
NUMLABELS = LABELATT.USERSIZE#, 24794000
ONEREELREVERSE=BOOLEAN(DSKS.REVACTIONF)#, 24795000
OPENINPUT = BOOLEAN(RECORDSTATUS.OPNIN)#, 24796000
OPENIO = RECORDSTATUS.OPENBITS=3#, 24797000
OPENOUTPUT = BOOLEAN(RECORDSTATUS.OPNOUT)#, 24798000
OPNINPUT = RECORDSTATUS.OPNIN#, 24799000
OPNOUTPUT = RECORDSTATUS.OPNOUT#, 24800000
NOPTIONAL = LEBC.OPTIONALF#, 24801000
OPTSPACE(SYZE)=GETSPACE(SYZE,0,0,0)#, 24802000
PARITYERROR=BOOLEAN(WORD(USER@IOCB).USERPARITYBIT)#, 24802100
PARITYERR = FILESTATUS.PARITYB#, 24802500
PARITYACTION=FILESTATUS.PARACTION#, 24802600
PASSED = IOAREA[IOAW].PSSD#, 24803000
PFOCRCSZ = BOOLEAN(PFOC.DRCDSIZE)#, 24807000
PFOCMTBUF = BOOLEAN(PFOC.MTBUF)#, 24808000
PLMT(UT) = ((UT=CARDREADER OR UT=CARDPUNCH1 OR 24810000
UT=CARDPUNCH2) AND BLOCKSZ>10 OR 24811000
(UT=BUFFPRINTER OR UT=UNBUFFPRINTER) AND 24812000
BLOCKSZ>17 24813000
)#, 24814000
PNCH(UT) = (UT=CARDPUNCH1 OR UT=CARDPUNCH2)#, 24814010
POINTEREQD=ARRAYROW#, 24814050
PRINTSPACE= @200#, 24814100
PRNTR(UT) = (UT=BUFFPRINTER OR UT=UNBUFFPRINTER)#, 24816000
PROPERIOACTION = RECORDSTATUS.OPNIN=PFOC.OPNIN#, 24817000
PROTECTED = LEBC.FPRTCTD#, 24818000
PRTY = BOOLEAN(FILESTATUS.PARITYB)#, 24819000
PRTYACTN = FILESTATUS.PARACTION#, 24820000
RANDOM = ACCESSTYPE=1#, 24821000
RCRDSZ(A,B)=IF FIXEDL THEN MAXRECSZ ELSE IF FLINKED THEN 24821100
IF WORDORIENTED THEN M[A.ADDRESSF].FRWRDLNK 24821200
ELSE REAL(B,WORDSTO).FRWRDLNK ELSE 24821300
CALCRECSZ(A,FIB)#, 24821400
RECINBLK = IOAREA[IOAW].RCN#, 24824000
RECORDMODE = TANKDATA1.SIZEMODE#, 24827000
RECORDOFF = TANKDATA1.SIZEOFF#, 24828000
RECORDSZ = TANKDATA1.SIZESZ#, 24829000
RECORDUNITS=TANKDATA1.RCDUNTS#, 24830000
RECORDTYPE= TANKDATA1.RCRDTYPE#, 24831000
RECSIZE = TANKDATA2.MAXRECSIZE#, 24832000
REQSPACE(SYZE)=GETSPACE(SYZE,0,0&SPACETYPE(0,1,1,0),0)#, 24833000
REVERSED = BOOLEAN(DIRECTION)#, 24834000
REVERSETYPE = UNITYP=DISKFILE OR MAGTAPE(UNITYP)#, 24835000
REWRITE = BOOLEAN(IOAREA[IOAW].RWRT)#, 24836000
REWRT = IOAREA[IOAW].RWRT#, 24837000
ROTATEBUFFERS=IF BUFFERED THEN 24837100
IOCB~REFERENCE(IOAREA~IOADESC~ 24837200
IOAREA&ARRAYDESCL(,*,IOAREA[IOAL].FL))#, 24837300
SIZEPROBLEM=FILESTATUS.DATAERRORB#, 24841000
SKLTN = IOINFO.SKLTNIOCW#, 24843000
SKLTNSTNDRD = IOINFO.SIOCWSTANDARD#, 24844000
TANKEY = IOAREA[IOAW].ACTLKY#, 24845000
TAPEFILE = MAGTAPE(IOINFO.UNITYPP)#, 24846000
TAPEREWIND=@210#, 24847000
TAPESPACE = @600#, 24847100
UNBLOCKED = NOT BOOLEAN(TANKDATA1.BLKD)#, 24848000
UNITNUMBER=IOINFO.UNITNUM#, 24849000
UNITYP=IOINFO.UNITYPP#, 24850000
UNLABELLED= LABELTYPE=1#, 24851000
UNLOCKFIB = IF FIBB(FIBLOCKF) THEN BEGIN 24852000
READLOCK(0,LOCKER); 24853000
CAUSE(IOEVENT[FILEVENT]) END#, 24854000
USASILABEL= LABELTYPE=0#, 24855000
VERSZ= 2#,% 24856000
WORDORIENTED=NOT CHARECORD#, 24856050
WORDSLEFT = UNITSLEFT#, 24856100
WORDSTO = CASE INTERNALMODE OF(1,.5,12,8,6,6)#, 24857000
WORDSTORND= CASE INTERNALMODE OF (0,0,11,7,5,5)#, 24858000
WRAPAROUND= LABELATT.WRPRND#; 24859000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24860000
SAVE PROCEDURE AVAILREMOVE (AVAILZLINK); 30000000
VALUE AVAILZLINK; 30001000
INTEGER AVAILZLINK; 30002000
BEGIN COMMENT REMOVE AN AREA FROM THE AVAILABLE LIST; 30003000
INTEGER MI ~ AVAILZLINK - M[AVAILZLINK].LENGTHZ + 1; 30004000
INTEGER T; 30005000
IF MI-1 = PREVADDR 30006000
THEN BEGIN COMMENT THE AREA TO BE REMOVED IS THE LARGEST 30007000
AREA THAT FOLLOWS A NON-OVERLAYABLE AREA. 30008000
AVAILB CONTAINS THE NEW PREVADDR.; 30009000
PREVADDR ~ M[MI] 30010000
END; 30011000
M[M[MI]].LINK ~ T ~ M[MI-1].LINK; 30012000
COMMENT PREVIOUS POINTS AT NEXT; 30013000
M[T+1] ~ M[MI]; 30014000
COMMENT NEXT POINTS AT PREVIOUS; 30015000
END OF AVAIL REMOVE; 30016000
SAVE PROCEDURE ORDER (ADDRESS); 30017000
VALUE ADDRESS; 30018000
INTEGER ADDRESS; 30019000
BEGIN COMMENT ORDER PLACES THE AREA WITH AVAILA AT ADDRESS IN 30020000
THE AVAILABLE LIST ACCORDING TO THE ARGUMENT IN 30021000
BITS 47:27 OF THE WORD AT ADDRESS.; 30022000
INTEGER T; COMMENT THE LINK THIS LINK WILL POINT AT.; 30023000
REAL RETRIES; 30023100
IF NOT BOOLEAN (M[ADDRESS].PREOLAY) 30024000
THEN BEGIN COMMENT UPDATE PREVADDR IF REQUIRED AND DETER- 30025000
MINE HIGHEST STARTING POINT FOR LLLU OPERATOR.; 30026000
IF M[ADDRESS].LENGTH > M[PREVADDR].LENGTH 30027000
THEN PREVADDR ~ ADDRESS; 30028000
MINDEX ~ AVAILI; 30029000
END 30030000
ELSE MINDEX ~ PREVADDR; 30031000
M[ADDRESS + 1] ~ MINDEX ~ 30032000
LISTLOOKUP (M[ADDRESS].AVAILKEY, M, MINDEX); 30033000
M [ADDRESS].LINK ~ T ~ M[MINDEX].LINK; 30034000
M [MINDEX].LINK ~ ADDRESS; 30035000
M [T + 1] ~ ADDRESS; 30036000
IF SPACEQHEAD !0 THEN 30036050
IF ((RETRIES ~ ( STACK [T~SPACEQHEAD.FASTPLACE, 30036100
AUTHORITYLINKPLACE]).RETRYCOUNT) =0 30036200
OR STACK [T, REQUIREDPLACE] { M [ADDRESS].LENGTH) 30036250
THEN BEGIN 30036300
DELINKASTACK (T, SPACEQHEAD); 30036400
CAUSE (AUTHORITYEVENT @(REFERENCE(STACK[T,*]))); 30036500
END 30036600
ELSE STACK [T, AUTHORITYLINKPLACE].RETRYCOUNT ~ RETRIES - 1; 30036650
END OF ORDERING AVAILABLE LIST; 30037000
DEFINE GETLEFTOFF (ADDRESS) = 30038000
IF ADDRESS = LEFTOFF 30039000
THEN LEFTOFF ~ M[M[ADDRESS].INUSELENGTH + ADDRESS].FRONTLINK; 30040000
#; 30041000
DEFINE CONSOLIDATE (ADDRESS, MINDEX) = 30042000
BEGIN 30043000
MLENGTH ~ M[ADDRESS].INUSELENGTH; 30044000
IF BOOLEAN (M [MINDEX ~ ADDRESS + M[ADDRESS].INUSELENGTH +1] 30045000
.AVAILABLE) 30046000
THEN BEGIN 30047000
MLENGTH ~ * + (T ~ M[MINDEX].LENGTH) + 1; 30048000
AVAILREMOVE (MINDEX + T); 30049000
END; 30050000
IF BOOLEAN (M[ADDRESS - 1].AVAILABLE) 30051000
THEN BEGIN COMMENT PREVIOUS AREA IS AVAILABLE; 30052000
MLENGTH ~ * + (T ~ M[ADDRESS - 1].LENGTHZ)+1; 30053000
MINDEX ~ ADDRESS - T - 1; 30054000
AVAILREMOVE (ADDRESS-1); 30055000
END 30056000
ELSE MINDEX ~ ADDRESS; 30057000
END 30058000
#; 30059000
SAVE BOOLEAN PROCEDURE TURNOVERLAYKEY (ADDRESSOFMOM); 30060000
VALUE ADDRESSOFMOM; 30061000
INTEGER ADDRESSOFMOM; 30062000
BEGIN COMMENT IF THE SPACE POINTED AT BY MOM IS PRESENT AND 30063000
NON-OVERLAYABLE, SET IT TO ITS PERMANENT STATE 30064000
AND RETURN TRUE OTHERWISE RETURN FALSE; 30065000
WORD MOM, ZLINK; 30066000
INTEGER T, TA, I; 30067000
BOOLEAN B; 30067100
LABEL AWAY; 30067200
IF B ~ UNLOCK (SPACELOCK) THEN BUZZCONTROL (SPACELOCK); 30068000
MOM ~ M[ADDRESSOFMOM]; 30069000
IF MOM.PBITF =1 30070000
THEN BEGIN COMMENT MOM HAS SPACE TO CHANGE; 30071000
T ~ (TA ~ MOM.ADDRESSF) - LINKSIZE - 1; 30072000
DO I ~ * + M[TA ~ * -1].TAG UNTIL TA =T; 30072100
IF I ! (LINKSIZE + 1) | MEMLINK 30072200
THEN GO AWAY; 30072300
T ~ * + 1; 30072400
ZLINK ~ M[T ~ T + M[T].INUSELENGTH]; 30073000
IF TURNOVERLAYKEY ~ ZLINK.SPACEOLAYLOCK =0 30074000
THEN M[T].SPACEOLAYLOCK ~ ZLINK.OLAY; 30075000
END; 30076000
AWAY: 30076100
IF B THEN UNLOCK (SPACELOCK); 30077000
END TURNOVERLAYKEY; 30078000
SAVE PROCEDURE MAKEPRESENTANDSAVE (DATA); 30078100
WORD ARRAY DATA [*]; 30078200
BEGIN 30078300
WORD MPS; MONITOR DONMONITOR (MPS); MPS ~ DATA; %%%%%%%% 30078380
DATA [0] ~ *; 30078500
COMMENT * * * * * * FIX IOFINISH TURNOLAYKEY 2/17 30078599
M[DATA.ADDRESSF + DATA.LENGTHF].SPACEOLAYLOCK ~ 0; 30078600
END OF INSURING PRESENCE AND SAVING DATA; 30078800
SAVE INTEGER PROCEDURE CONSOLIDATEANDORDER(ADDRESS); 30156000
VALUE ADDRESS; 30157000
INTEGER ADDRESS; 30158000
BEGIN 30159000
INTEGER MINDEX, T; 30160000
WORD ZLINK; 30161000
CONSOLIDATE (ADDRESS, MINDEX); 30162000
ZLINK ~ M[MINDEX-1]; 30163000
T ~ REAL(ZLINK.OLAY = 1 OR ZLINK.SPACEOLAYLOCK = 1); 30164000
M[MINDEX] ~ 0 & AVAILA (, T,MLENGTH, , *); 30165000
M[MINDEX ~ MLENGTH] ~ 0 & AVAILZ (,, MLENGTH); 30166000
ORDER (MINDEX); 30167000
CONSOLIDATEANDORDER ~ MINDEX; 30168000
END OF CONSOLIDATING RETURNED AREA AND ORDERING IT IN LIST; 30169000
SAVE INTEGER PROCEDURE FORGETSPACE(ADDRESS); 30170000
VALUE ADDRESS; 30171000
INTEGER ADDRESS; 30172000
BEGIN COMMENT RETURN THE SPACE DESCRIBED BY THE IN-USE LINK 30173000
POINTED AT BY ADDRESS TO THE AVAILABLE LIST. 30174000
WHEN "ADDRESS" IS POSITVE CONSOLIDATION WITH 30175000
ADJACENT AVAILABLE AREAS IS PERFORMED AND THE 30176000
LIST IS RE-ORDERED AND THE NEW ADDRESS IS 30177000
RETURNED. WHEN "ADDRESS" IS NEGATIVE CONSOLI- 30178000
DATION AND ORDERING ARE NOT PERFORMED.; 30179000
LABEL AWAY; 30180000
INTEGER TADDR ~ ABS (ADDRESS) - LINKSIZE, 30181000
FRONTLNK, 30182000
30183000
T, COMMENT TEMPORARY; 30184000
TRACTER, 30185000
MINDEX; 30186000
TRACTER~TRACE(0); 30186100
MINDEX ~ TADDR -1; 30187000
DO T ~ *+M[MINDEX].TAG UNTIL MINDEX ~ * +1 = ABS(ADDRESS); 30188000
IF T ! (LINKSIZE +1) | MEMLINK 30189000
THEN BEGIN 30190000
FORGETSPACE ~ -MINDEX; 30191000
GO AWAY; 30192000
END; 30193000
FRONTLNK ~ M[TADDR + M[TADDR].INUSELENGTH].FRONTLINK; 30194000
IF FRONTLNK ! 0 30195000
THEN BEGIN COMMENT REMOVE AREA FROM IN-USE LIST; 30196000
M[FRONTLNK].BACKLINK ~ MINDEX ~ M[TADDR ].BACKLINK; 30197000
M[MINDEX + M[MINDEX].INUSELENGTH].FRONTLINK ~ 30198000
M[TADDR + M[TADDR ].INUSELENGTH].FRONTLINK; 30199000
END 30200000
ELSE BEGIN COMMENT AREA BEING FORGOTTEN WAS LAST ALLOCATED;30201000
BACKALLOCATED ~ M[TADDR ].LINK; 30202000
M[M[BACKALLOCATED].INUSELENGTH + BACKALLOCATED]. 30203000
FRONTLINK ~ 0; 30204000
END; 30205000
GETLEFTOFF (TADDR); 30206000
IF ADDRESS > 0 30207000
THEN BEGIN COMMENT CONSOLIDATE WITH ADJACENT AVAILABLE 30208000
AREAS AND ORDER NEW AREA IN LIST; 30209000
FORGETSPACE ~ CONSOLIDATEANDORDER (TADDR); 30210000
END 30211000
ELSE FORGETSPACE ~ ADDRESS; 30212000
AWAY: 30213000
TRACE(TRACTER); 30214000
UNLOCK (SPACELOCK); 30214100
END OF FORGETSPACE; 30215000
SAVE PROCEDURE OVERLAY (ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; ; 30216000
SAVE REAL PROCEDURE GETSPACE (SIZE, WHOFOR, TYPE, ADDRESS); 30217000
VALUE SIZE, WHOFOR, TYPE, ADDRESS; 30218000
INTEGER SIZE, WHOFOR, TYPE; 30219000
REAL ADDRESS; 30220000
BEGIN COMMENT 30221000
;30222000
LABEL OVERSRCH, STARTSRCH, TRUBLE, AROUND, ALLDONE; 30223000
LABEL RETRY; 30223100
INTEGER S ~ SIZE + LINKSIZE, 30224000
START, 30225000
ARGS; 30226000
INTEGER TRACTER; COMMENT SAVE AND RESTORE TRACE; 30227000
BOOLEAN TRYAGAIN; 30227100
SAVE INTEGER PROCEDURE TROUBLE (REQ); 30228000
VALUE REQ; 30229000
INTEGER REQ; 30230000
BEGIN COMMENT TROUBLE IS RESPONSIBLE FOR CHASING THE LEFT-OFF 30231000
LIST AND RETURNING WITH AN ADDRESS OF AN AREA 30232000
THAT WILL SATISFY THE SIZE REQUIREMENT (REQ). 30233000
IF AN ADEQUATE AREA CANNOT BE FOUND, A NEGATIVE 30234000
VALUE IS RETURNED. 30235000
;30236000
INTEGER LEFTOFFT ~ LEFTOFF, COMMENT THE NEXT ADDRESS IN THE30237000
LEFT-OFF LIST.; 30238000
R, COMMENT TEMPORARY REQ; 30239000
MINDEX, 30240000
INITIAL, COMMENT THE ABSOLUTE ADDRESS OF THE AREA 30241000
BEING MADE AVAILABLE.; 30242000
FINAL; COMMENT THE FINAL ADDRESS OF THE AREA 30243000
BEING MADE AVAILABLE.; 30244000
BOOLEAN FIRST, COMMENT WHEN TRUE THE SUCCEEDING AS 30245000
WELL AS PRECEDING AREAS ARE EXAMINED 30246000
FOR AVAILABILITY.; 30247000
AVAILB; COMMENT TRUE WHEN THE ADDRESS OF AN 30248000
IN-USE AREA HAS BEEN RECORDED FOR 30249000
OVERLAY BECAUSE OF THE AVAILABILITY OF30250000
AN ADJACENT AREA.; 30251000
LABEL NEXT, 30252000
EXIT; 30253000
WORD TLINK; COMMENT TEMPORARY MEMORY LINK.; 30254000
MONITOR DONMONITOR 30254100
(R 30254200
,INITIAL 30254300
,FINAL 30254400
, TLINK); 30254500
IF TYPE.MAKEROOM = 0 30255000
THEN BEGIN 30256000
MINDEX ~ -1; 30257000
GO EXIT; 30258000
END; 30259000
NEXT: COMMENT EXAMINE NEXT AREA IN LEFT=OFF LIST.; 30260000
SETINTERVALTIMER; 30260100
R ~ REQ; 30261000
MINDEX ~ LEFTOFFT; 30262000
FIRST ~ TRUE; 30263000
DO BEGIN COMMENT BY-PASS NON-OVERLAYABLE ITEMS LEFT- 30264000
OFF LIST.; 30265000
IF LEFTOFFT !0 THEN 30266000
IF NOT BOOLEAN ((TLINK ~ M[LEFTOFFT + M[LEFTOFFT] 30267000
.INUSELENGTH]).SPACEOLAYLOCK) 30268000
THEN MINDEX ~ LEFTOFFT ~ TLINK.FRONTLINK; 30269000
END UNTIL BOOLEAN(TLINK.SPACEOLAYLOCK) OR LEFTOFFT = 0; 30270000
IF MINDEX = 0 30271000
THEN BEGIN COMMENT LEFT-OFF LIST HAS BEEN EXHAUSTED.; 30272000
MINDEX ~ -(IF BOOLEAN (TYPE.SLEEPY) THEN 3 ELSE 5) 30273000
+ TYPE.PRINTNOMEM; 30274000
GO EXIT; 30275000
END; 30276000
FINAL ~ M[MINDEX].INUSELENGTH + MINDEX; 30277000
LEFTOFFT ~ TLINK.FRONTLINK; 30278000
WHILE R > 0 30279000
DO BEGIN COMMENT EXAMINE THIS AREA AND ADJACENT AREAS 30280000
IN DESCENDING MEMORY LOCATIONS UNTIL R { 0 OR 30281000
A NON-OVERLAYABLE AREA IS ENCOUNTERED.; 30282000
AVAILB ~ FALSE; 30283000
IF FIRST 30284000
THEN BEGIN COMMENT THE FIRST TIME THE AREA SUC- 30285000
CEEDING THE LEFT-OFF AREA MUST BE EX- 30286000
AMINED FOR AVAILABILITY.; 30287000
IF INITSWITCH 30287100
THEN BEGIN 30287200
LEFTOFF ~ MINDEX; 30287300
INITSWITCH ~ FALSE; 30287400
END; 30287500
INITIAL ~ MINDEX; 30288000
FIRST ~ FALSE; 30289000
IF BOOLEAN ((TLINK ~ M[(FINAL ~ MINDEX + 30290000
M[MINDEX].INUSELENGTH+1)]).AVAILABLE) 30291000
THEN BEGIN 30292000
INITIAL ~ MINDEX; 30293000
FINAL ~ FINAL + TLINK.LENGTH +1; 30294000
AVAILB ~ TRUE; 30295000
R ~ R - TLINK.LENGTH 30296000
- M[MINDEX].INUSELENGTH; 30297000
END; 30298000
END; 30299000
IF BOOLEAN ((TLINK ~ M[MINDEX - 1]).AVAILABLE) 30300000
THEN BEGIN COMMENT ALL AREAS PRECEDING IN-USE 30301000
AREAS ARE EXAMINED FOR AVAILABILITY.; 30302000
INITIAL ~ MINDEX - TLINK.LENGTHZ - 1; 30303000
R ~ R - TLINK.LENGTHZ - 30304000
(IF AVAILB THEN 1 ELSE M[MINDEX] 30305000
.INUSELENGTH); 30306000
AVAILB ~ TRUE; 30307000
END 30308000
ELSE INITIAL ~ MINDEX; 30308100
R ~ R-(IF AVAILB THEN 1 ELSE M[MINDEX].INUSELENGTH); 30309000
IF R > 0 30310000
AND NOT BOOLEAN (M[INITIAL - 1].SPACEOLAYLOCK) 30311000
THEN GO NEXT; 30312000
MINDEX ~ INITIAL -1 - M[INITIAL -1].INUSELENGTHZ; 30313000
END; 30314000
IF BOOLEAN ((TLINK ~ M[INITIAL - 1]).AVAILABLE) 30315000
THEN INITIAL ~ INITIAL - TLINK.LENGTHZ -1; 30316000
MINDEX ~ INITIAL; 30317000
DO IF AVAILB ~ BOOLEAN ( (TLINK ~ M[MINDEX]).AVAILABLE) 30318000
THEN BEGIN 30319000
AVAILREMOVE (MINDEX + TLINK.LENGTH); 30320000
R ~ TLINK.LENGTH; 30321000
END 30322000
ELSE R ~ TLINK.INUSELENGTH 30323000
UNTIL MINDEX ~ * + R + 1 > FINAL; 30324000
MINDEX ~ INITIAL; 30325000
DO IF NOT AVAILB ~ BOOLEAN ((TLINK ~ M[MINDEX]).AVAILABLE) 30326000
THEN BEGIN 30327000
GLOBALSTOP; 30327100
OVERLAY (MINDEX + LINKSIZE); 30328000
FORGETSPACE (-MINDEX - LINKSIZE); 30329000
R ~ TLINK.INUSELENGTH; 30330000
END 30331000
ELSE R ~ TLINK.LENGTH 30332000
UNTIL MINDEX ~ * + R + 1 > FINAL; 30333000
MINDEX ~ INITIAL; 30334000
EXIT: 30335000
IF TROUBLE ~ MINDEX > 0 30336000
THEN BEGIN COMMENT MAKE AREA LOOK AVAILABLE.; 30337000
M[INITIAL] ~ 0 & AVAILA(,*, FINAL-INITIAL,, *); 30338000
M[FINAL] ~ 0 & AVAILZ (,, FINAL - INITIAL); 30339000
END; 30340000
END OF TROUBLE; 30341000
SAVE INTEGER PROCEDURE ALOCATE (SIZE, MINDEX); 30342000
VALUE SIZE, MINDEX; 30343000
INTEGER SIZE, MINDEX; 30344000
BEGIN COMMENT ALOCATE ASSIGNS IN-USE LINKS FOR AN AREA OF SIZE30345000
SOMEWWERE IN THE AREA STARTING AT MINDEX. NON- 30346000
OVERLAYABLE AREAS ARE ASSIGNED AT THE FRONT OF 30347000
AN AREA. THAT PORTION OF AN AREA THAT IS NOT 30348000
USED IS RETURNED TO THE AVAILABLE LIST.; 30349000
INTEGER AVLINK; 30350000
IF (MLENGTH ~ M[MINDEX].LENGTH- SIZE - 1) { LINKSIZE 30351000
THEN SIZE ~ SIZE + MLENGTH + 1; 30352000
IF TYPE.OERLAY = 0 30353000
THEN AVLINK ~ MINDEX + SIZE + 1 30354000
ELSE BEGIN 30355000
AVLINK ~ MINDEX; 30356000
MINDEX ~ M[MINDEX].LENGTH - SIZE + AVLINK; 30357000
IF LEFTOFF { 0 THEN LEFTOFF ~ MINDEX; 30358000
END; 30359000
M[MINDEX + SIZE] ~ 0 & LINKZ(, REAL(TYPE.OERLAY=1 AND 30360000
ADDRESS!0),,,,, SIZE); 30361000
IF MLENGTH > LINKSIZE 30362000
THEN BEGIN 30363000
M[AVLINK] ~ 0 & AVAILA 30364000
(, M[AVLINK-1].OLAY, MLENGTH, ,*); 30365000
COMMENT ORDER WILL SUPPLY LINK; 30366000
M[AVLINK + MLENGTH] ~ 0 & AVAILZ 30367000
(, , MLENGTH); 30368000
ORDER (AVLINK); 30369000
END; 30370000
M[MINDEX] ~ 0 & LINKA (, WHOFOR, SIZE, *, BACKALLOCATED); 30371000
M[MINDEX + 1] ~ 0 & LINKB 30372000
(, % TAG =3 30373000
, % USAGE 30374000
*, % ADDRESS TYPE - ABSOLUTE FOR NOW 30375000
ADDRESS, % OF MOM 30376000
IF ADDRESS ! 0 THEN M[ADDRESS].ADDRESSF ELSE 0); % DISK 30377000
COMMENT NUMEROUS UNANSWERED QUESTIONS.; 30378000
M[MINDEX +2] ~ 0 & LINKC ( ); COMMENT UNUSED; 30379000
M[BACKALLOCATED + M[BACKALLOCATED].INUSELENGTH].FRONTLINK ~ 30380000
MINDEX; 30381000
BACKALLOCATED ~ MINDEX; 30382000
ALOCATE ~ MINDEX + LINKSIZE; 30383000
END OF ALOCATE; 30384000
TRACTER ~ TRACE(0); COMMENT TURN OFF & SAVE TRACE; 30385000
BUZZCONTROL (SPACELOCK); 30385100
RETRY: 30385200
MINDEX ~ M[STOPPER + 1]; 30386000
IF BOOLEAN (TYPE.OERLAY) 30387000
THEN BEGIN COMMENT LOOK FOR AN AREA ADJACENT TO OVERLAY- 30388000
ABLE STORAGE.; 30389000
IF S { M[MINDEX].LENGTH 30390000
AND BOOLEAN (M[MINDEX].PREOLAY) 30391000
THEN BEGIN COMMENT START SEARCH IN OVERLAYABLE 30392000
PORTION OF LIST; 30393000
OVERSRCH: START ~ PREVADDR; 30394000
ARGS ~ 1 & LLLUARG (1, S); 30395000
END 30396000
ELSE IF S > M[PREVADDR].LENGTH 30397000
THEN GO TRUBLE 30398000
ELSE BEGIN 30399000
STARTSRCH: START ~ AVAILI; 30400000
ARGS ~ 1 & LLLUARG (0, S); 30401000
END 30402000
END 30403000
ELSE IF S > M[PREVADDR].LENGTH 30404000
THEN IF S > M[MINDEX].LENGTH THEN GO TRUBLE ELSE GO 30405000
OVERSRCH 30406000
ELSE GO STARTSRCH; 30407000
MINDEX ~ M[LISTLOOKUP(ARGS, M, START)].LINK; 30408000
AVAILREMOVE (MINDEX + M[MINDEX].LENGTH); 30409000
GO AROUND; 30410000
TRUBLE: MINDEX ~ TROUBLE(S); 30411000
IF MINDEX < 1 30412000
THEN BEGIN 30413000
SAVE PROCEDURE DAMMIT; 30413020
BEGIN 30413040
EVENT SPACESHOT; 30413160
TRYAGAIN ~ FALSE; 30413200
QUEUEMYSTACK (STACK[WHOFOR, PRIORITYPLACE], S, SPACERETRY, 30413400
SPACESHOT, SPACEQHEAD); 30413500
UNLOCK (SPACELOCK); 30413760
WAIT (SPACESHOT); 30413780
BUZZ (SPACELOCK); 30413800
TRYAGAIN ~ TRUE; 30413810
END OF QUEUEING UNSATISFIED REQUEST; 30413820
SAVE PROCEDURE SPOUTIT; 30413840
BEGIN 30413860
END OF SPOUTIT; 30413980
CASE ABS (MINDEX) OF 30413990
BEGIN 30414000
; COMMENT - SHOULD NEVER HAPPEN 0;30415000
; COMMENT - NO OVERLAY, SPOUT OR SLEEP 1;30416000
BEGIN 30417000
SPOUTIT; DAMMIT; % 2 30418000
END; 30419000
BEGIN 30420000
DAMMIT; % 3 30421000
END; 30422000
BEGIN 30423000
SPOUTIT; 30424000
END; 30425000
BEGIN 30426000
30427000
END; 30428000
END 30429000
END OF UNSATISFIED REQUESTS; 30429100
IF TRYAGAIN THEN GO RETRY ELSE IF MINDEX < 0 THEN GO ALLDONE; 30430000
AROUND: MINDEX ~ ALOCATE (S, MINDEX); 30431000
ALLDONE: GETSPACE ~ MINDEX; 30436000
UNLOCK (SPACELOCK); 30436100
TRACE (TRACTER); COMMENT RESTORE TRACE; 30437000
END OF GETSPACE; 30438000
SAVE PROCEDURE MOMTOVECTOR (MOM, VECTOR, INDEX); 30439000
VALUE COMMENT A COPY OR MOM DESCRIPTOR THAT IS AC- 30440000
CEPTABLE TO PRESENCE BIT; 30441000
COMMENT AN-UNINDEXED DESCRIPTOR THAT IS AC- 30442000
CEPTABLE TO AN NXLN OPERATOR; 30443000
INDEX; COMMENT THE INDEX FOR VECTOR WHERE MOM IS TO 30444000
BE PLACED; 30445000
WORD ARRAY MOM[*], 30446000
VECTOR[*]; 30447000
INTEGER INDEX; 30448000
BEGIN 30449000
MOM[0] ~ *; 30456000
VECTOR[INDEX] ~ MOM & SETCOPYBIT (0); 30457000
M [MOM.ADDRESSF - LINKSIZE +1].ADDRMOM ~ VECTOR.ADDRESSF+INDEX;30458000
END MOM TO VECTOR OR QUEUE; 30459000
30460000
SAVE PROCEDURE QUEUEMYSTACK (AUTHORITY, REQUIRED, COUNT, MYEVENT, HEAD);30461000
VALUE AUTHORITY, COMMENT THE SORTKEY FOR THIS QUEUE; 30462000
REQUIRED, COMMENT AN ADDITIONAL INFORMATION WORD FOR THE 30463000
QUEUE ENTRY; 30464000
COUNT; COMMENT A 10 BIT COUNTER IN THE STACK LINK 30465000
WORD FOR THIS QUEUE; 30466000
REAL HEAD ; COMMENT A GLOBAL REAL THAT CONTAINS THE BACK- 30467000
WARD AND FORWARD LINKS FOR THE QUEUE. THE BACK 30468000
WARD LINK POINTS TO THE ENTRY WITH THE HIGHEST 30469000
AUTHORITY; 30470000
EVENT MYEVENT; COMMENT THE EVENT THAT IS WAITED UPON AND 30471000
CAUSED BY THE CALLER; 30472000
REAL AUTHORITY, 30473000
REQUIRED; 30474000
INTEGER COUNT; 30475000
BEGIN COMMENT PLACE MYEVENT, REQUIRED AND AUTHORITY IN MY30476000
STACK AND PLACE MY STACK IN THE QUEUE POINTED AT30477000
BY HEAD BASED ON AUTHORITY.; 30478000
INTEGER FASTER, % THAN ME 30479000
SLOWER, % THAN ME 30480000
FASTEST, % ACCORDING TO HEAD 30481000
SLOWEST, % DITTO 30482000
I, % THE NEXT FASTEST ENTRY 30483000
INDEX, % THE ENTRY FASTER THAN MINE 30484000
ME ; % THE CALLERS (AND MY) STACK 30485000
MONITOR DONMONITOR (ME, HEAD, 30485100
SLOWER, 30485200
FASTER, 30485300
I); 30485400
ARRAY MY [*]; 30486000
REFERENCE MYREFERENCE = MY; 30486100
LABEL AHEAD, AROUND; 30487000
DEFINE AUTHORITYLINKL = READYWAITLINK#; 30488000
MY ~ STACK [ME ~ SNR, *]; 30489000
STOREITEM (AUTHORITYEVENT@(MYREFERENCE), MYEVENT); 30490000
MY [AUTHORITYPLACE] ~ AUTHORITY; 30492000
MY [REQUIREDPLACE] ~ REQUIRED; 30493000
SLOWEST ~ HEAD.SLOWPLACE; 30495000
IF I ~ FASTEST ~ HEAD.FASTPLACE = 0 30496000
THEN BEGIN COMMENT AN EMPTY HEAD; 30497000
%FASTER ~ SLOWER ~ 0; 30498000
HEAD ~ 0 & AUTHORITYLINKL(ME, ME); 30499000
GO AROUND; 30500000
END; 30501000
WHILE AUTHORITY { STACK [I, AUTHORITYPLACE] 30502000
DO BEGIN COMMENT I"M HIGHER LOOK FOR LESSER OR LEAST; 30503000
INDEX ~ I; 30504000
IF I ~ STACK[I, AUTHORITYLINKPLACE].SLOWPLACE = 0 30505000
THEN GO AHEAD; 30506000
END; 30507000
IF I = FASTEST 30508000
THEN BEGIN COMMENT I"M FASTER THAN THE FASTEST - TELL EM;30509000
STACK [SLOWER ~ FASTEST, AUTHORITYLINKPLACE]. 30510000
FASTPLACE ~ ME; 30511000
HEAD.FASTPLACE ~ ME; 30512000
% FASTER ~ 0; 30513000
GO AROUND; 30514000
END 30515000
ELSE BEGIN COMMENT THERE ARE HIGHER & LOWER AUTHORITIES; 30516000
FASTER ~ INDEX; 30517000
SLOWER ~ STACK [INDEX, AUTHORITYLINKPLACE].SLOWPLACE;30518000
STACK[FASTER, AUTHORITYLINKPLACE].SLOWPLACE ~ ME; 30519000
STACK[SLOWER,AUTHORITYLINKPLACE].FASTPLACE ~ ME; 30520000
GO AROUND END; 30521000
AHEAD: STACK [FASTER ~ SLOWEST, AUTHORITYLINKPLACE].SLOWPLACE ~ ME; 30522000
HEAD.SLOWPLACE ~ ME; 30523000
% SLOWER ~ 0; NOBODY IS SLOWER THAN ME 30524000
AROUND: MY [AUTHORITYLINKPLACE] ~ 0 & AUTHORITYLINKL 30525000
(FASTER, SLOWER, COUNT); 30526000
END; 30527000
PROCEDURE DELINKASTACK (WHOSE, HEAD); 30528000
VALUE WHOSE; 30529000
INTEGER WHOSE; COMMENT THE AUTHORITY TYPE STACK TO DELINK; 30530000
REAL HEAD ; COMMENT THE HEAD OF THE AUTHORITY TYPE STACK; 30531000
BEGIN COMMENT UNDO ALL THE GOOD WORK OF QUEUEMYSTACK; 30532000
INTEGER SLOWEST, 30533000
FASTEST, 30534000
SLOWER, 30535000
FASTER; 30536000
REAL LINK; 30537000
MONITOR DONMONITOR (HEAD 30537100
); 30537200
ARRAY WHO [*]; 30538000
LABEL AWAY; 30539000
DEFINE ALP = WHO [AUTHORITYLINKPLACE]#; 30540000
WHO ~ STACK [WHOSE, *]; 30541000
SLOWEST ~ HEAD.SLOWPLACE; 30542000
FASTEST ~ HEAD.FASTPLACE; 30543000
IF SLOWEST = FASTEST 30544000
THEN BEGIN COMMENT ONLY ONE ENTRY; 30545000
IF WHOSE!SLOWEST THEN EXIT; % CALLER GOOFED 30546000
HEAD ~ 0; 30547000
END 30548000
ELSE IF WHOSE=FASTEST 30549000
THEN BEGIN COMMENT SLOWER OF WHOSE IS FASTEST; 30550000
HEAD.FASTPLACE~SLOWER~WHO[AUTHORITYLINKPLACE]. 30551000
SLOWPLACE; 30552000
STACK [SLOWER, AUTHORITYLINKPLACE].FASTPLACE ~0;30553000
END 30554000
ELSE IF WHOSE = SLOWER 30555000
THEN BEGIN COMMENT FASTER OF WHOSE IS SLOWEST; 30556000
HEAD.SLOWPLACE ~ FASTER ~ ALP.FASTPLACE; 30557000
STACK [SLOWER, AUTHORITYLINKPLACE]. 30558000
SLOWPLACE ~ 0; 30559000
END 30560000
ELSE BEGIN 30561000
FASTER ~(LINK ~ ALP).FASTPLACE; 30562000
SLOWER ~ LINK.SLOWPLACE; 30563000
STACK[FASTER, AUTHORITYLINKPLACE]. 30564000
SLOWPLACE ~ SLOWER; 30565000
STACK[SLOWER, AUTHORITYLINKPLACE]. 30566000
FASTPLACE ~ FASTER 30567000
END; 30568000
ALP ~ 0; 30569000
END OF DELINKING A QUEUE; 30570000
SAVE INTEGER PROCEDURE GETAREA(SIZE); VALUE SIZE; INTEGER SIZE; 31000000
COMMENT GETAREA SEARCHES BLOCKOFAREASQUE FOR A BLOCK OF A GIVEN SIZE 31001000
AREA. IF BLOCK IS NOT IN THE QUEUE IT CALLS GETSPACE PROCEDURE31002000
AND BUILDS UP AREASTATUS WORD FOR THE OBTAINED BLOCK- IT THEN 31003000
MAKES ENTRY INTO THE QUEUE, IT RESETS BIT REPRESNTING THE 31004000
FIRST AREA OF THE BLOCK AND RETURNS BASE ADDRESS OF THE BLOCK.31005000
IF BLOCK IS IN QUEUE,IT FINDS BITNO REPRESENTING AVAILABLE 31006000
AREA, RESETS THAT BIT IN AREASTATUSBITS FIELD AND RETURNS THE 31007000
ADDRESS AS BASE ADDRESS OF BLOCK INDEXED BY (BITNO-1). 31008000
SIZE -SIZE OF AREA IN NO. OF WORDS; 31009000
BEGIN 31010000
DEFINE AREASIZEF=AREASIZEFF#; 31011000
REFERENCE BLOCKPOINTER; COMMENT CURRENT POINTER OF QUEUE; 31012000
ARRAY QENTRY =BLOCKPOINTER [*]; 31013000
REAL AREASTATUSWORD; COMMENT LOCAL FOR AREASTATUS ITEM; 31014000
INTEGER BITNO; COMMENT BIT NO. FOR AVAILABLE AREA; 31015000
INTEGER COREADDR, COMMENT GETSPACE ADDRESS; 31016000
TRACTER,% MAR USED TO SHUT OFF TRACE IN THIS PROCEDURE 31017000
COREAREASIZE; 31018000
LABEL TRYANOTHER,LOOP; 31019000
LABEL NOQUENTRY; 31020000
FIELD SETFIELD=MAXNOOFAREAS-2:MAXNOOFAREAS-1; 31021000
TRACTER~TRACE(0); 31022000
IF FIRSTBLOCK=NULL THEN GO NOQUENTRY; 31023000
BLOCKPOINTER~ FIRSTBLOCK; 31024000
LOOP: 31025000
AREASTATUSWORD~ AREASTATUS @ BLOCKPOINTER; 31026000
IF SIZE=AREASTATUSWORD.AREASIZEF THEN COMMENT FOUND BLOCK; 31027000
BEGIN 31028000
BITNO~ FIRSTONE(AREASTATUSWORD.AREASTATUSBITSF )-1; 31029000
IF BITNO!-1 THEN AREASTATUS@(BLOCKPOINTER)~ 31030000
RESET(AREASTATUS@BLOCKPOINTER,BITNO) 31031000
ELSE GO TRYANOTHER; 31032000
END ELSE 31033000
BEGIN 31034000
TRYANOTHER: 31035000
BLOCKPOINTER ~ NEXTBLOCK @ BLOCKPOINTER; 31036000
IF BLOCKPOINTER!NULL THEN GO LOOP 31037000
ELSE 31038000
BEGIN 31039000
NOQUENTRY: 31040000
AREASTATUSWORD ~ 0; 31041000
AREASTATUSWORD.SETFIELD ~ @77777777; 31042000
BITNO~MAXNOOFAREAS-1; 31043000
AREASTATUSWORD.AREASIZEF~ SIZE; 31044000
COREAREASIZE~SIZE | MAXNOOFAREAS + 1; 31045000
COREADDR~GETSPACE(COREAREASIZE,0,4,0); 31046000
AREASTATUSWORD.BASEADDRF~COREADDR + 1; 31047000
M [COREADDR] ~ 0; 31047100
BLOCKPOINTER ~ ALLOCATE(BLOCKOFAREASQUE); 31048000
INITIALIZETOZERO(QENTRY.ADDRESSF, 3); 31049000
AREASTATUS@(BLOCKPOINTER)~AREASTATUSWORD; 31050000
BLOCKOFAREASQUE ~ BLOCKPOINTER; 31051000
END; 31052000
END; 31053000
INITIALIZETOZERO(COREADDR ~ AREASTATUSWORD.BASEADDRF + 31054000
BITNO | SIZE, SIZE); 31055000
TRACE(TRACTER); 31055100
RETURN(COREADDR); 31056000
END GETAREA; 31058000
SAVE PROCEDURE FORGETAREA(SIZE,ADDRESS); VALUE SIZE,ADDRESS; 31059000
INTEGER SIZE,ADDRESS; 31060000
COMMENT FORGETAREA SEARCHES BLOCKOFAREASQUE FOR A BLOCK OF A GIVEN 31061000
SIZE AREA. IF NO BLOCK IS FOUND THEN THE SIZE SPECIFIED MUST 31062000
BE WRONG. WHEN THE BLOCK OF GIVEN SIZE IS FOUND IT CHECKS 31063000
WHETHER SPECIFIED ADDRESS FALLS WITHIN THE BLOCK RANGE. WHEN 31064000
THE RIGHT BLOCK IS FOUND,IT FINDS BITNO REPRESENTING AREA TO 31065000
BE FORGOTTEN. IT SETS THAT BIT NO IN AREASTATUS ITEM OF QUEUE.31066000
IF ALL THE AREAS WITHIN BLOCK ARE AVAILABLE IT CALLS 31067000
FORGETSPACE TO FORGET THE BLOCK.NOTE QUEUE IS SEARCHED FROM 31068000
THE END TO DEALLOCATE ADDITIONAL BLOCKS (OF GIVEN SIZE) AS 31069000
SOON AS POSSIBLE: 31070000
SIZE - SIZE OF AREA IN NO OF WORDS 31071000
ADDRESS- BASE ADDRESS OF THE AREA; 31072000
IF SIZE = 0 31073000
THEN FORGETSPACE (ADDRESS) ELSE 31074000
BEGIN 31075000
DEFINE AREASIZEF=AREASIZEFF#; 31076000
REFERENCE BLOCKPOINTER; COMMENT CURRENT POINTER OF QUEUE; 31077000
REAL AREASTATUSWORD; COMMENT LOCAL FOR AREA STATUS ITEM; 31078000
INTEGER BITNO; COMMENT BIT NO FOR AREA TO BE FORGOTTEN; 31079000
LABEL LOOP,QUIT; 31080000
BLOCKPOINTER ~ LASTBLOCK ; 31081000
LOOP: 31082000
AREASTATUSWORD~ AREASTATUS @ BLOCKPOINTER; 31083000
IF SIZE=AREASTATUSWORD.AREASIZEF THEN 31084000
BEGIN COMMENT BLOCK OF RIGHT SIZE; 31085000
IF BITNO~ADDRESS-AREASTATUSWORD.BASEADDRF>0 THEN 31086000
IF BITNO~BITNO DIV SIZE < MAXNOOFAREAS THEN 31087000
BEGIN COMMENT BLOCK OF RIGHT SIZE AND ADDRESS; 31088000
AREASTATUSWORD~ SET(AREASTATUSWORD,BITNO); 31089000
COMMENT COUNT NO. OF BITS ON (NO OF AVAILABLE 31090000
AREAS); 31091000
BITNO~ ONES(AREASTATUSWORD.AREASTATUSBITSF); 31092000
IF BITNO=MAXNOOFAREAS THEN 31093000
BEGIN 31094000
FORGETSPACE(AREASTATUSWORD.BASEADDRF-1); 31095000
DELINK(BLOCKOFAREASQUE,BLOCKPOINTER) 31096000
END ELSE 31097000
AREASTATUS @(BLOCKPOINTER)~AREASTATUSWORD; 31098000
GO QUIT; 31099000
END; 31100000
END; 31101000
BLOCKPOINTER~ PRVSBLOCK @ BLOCKPOINTER; 31102000
IF BLOCKPOINTER=NULL THEN 31103000
BEGIN 31104000
COMMENT BUILD A MESSAGE "WRONG SIZE OR ADDRESS FOR AREA"; 31105000
%SPOUT(MSGAREA,DISPLAYONCON);% MAR 31106000
END ELSE GO LOOP; 31107000
QUIT: 31108000
END FORGETAREA; 31109000
SAVE 1 PROCEDURE INITIALIZEARRAY(FIRSTARRAY, LASTARRAY, LENGTH); 32000000
VALUE LENGTH; 32001000
INTEGER LENGTH; 32002000
WORD ARRAY FIRSTARRAY,LASTARRAY [*]; 32003000
BEGIN COMMENT GET SPACE AND INITIALIZE ALL DESCRIPTORS BETWEEN32004000
FIRSTARRAY AND LASTARRAY (INCLUSIVE). (SEE COM- 32005000
MENT AT "UNIT" ARRAY DECLARATION) "LENGTH" IS 32006000
THE NUMBER OF WORDS GOTTEN FOR EACH ARRAY AND 32007000
THE LENGTH FIELD OF THE ARRAY DESCRIPTOR. ;32008000
INTEGER MOMF ~ NAME(FIRSTARRAY).ADRCPLF, 32009000
MOML ~ NAME(LASTARRAY).ADRCPLF, 32010000
T, 32011000
A; 32012000
MOMF ~ * + D0; 32013000
MOML ~ * + D0; 32014000
T ~ MOML - MOMF + 1; 32015000
LENGTH~*|(FIRSTARRAY.DBITF+1); 32015100
M[MOMF] ~ FIRSTARRAY & DATADESCRIPTOR 32016000
(,1,0,*,*,*,*,*,LENGTH, A ~ 32017000
GETSPACE (T | LENGTH, 0, 1, 0)); 32018000
INITIALIZETOZERO (A, T | LENGTH); 32019000
WHILE MOMF ~ * + 1 { MOML DO 32020000
M[MOMF] ~ 0 & DATADESCRIPTOR 32021000
(,1,0,*,*,*,*,*, LENGTH, A ~ A + LENGTH); 32022000
END INITIALIZE ARRAYS; 32023000
SAVE 1 PROCEDURE INITIALIZEQARRAY (QARRAYW, LENGTH); 32024000
VALUE LENGTH; 32025000
INTEGER LENGTH; 32026000
WORD ARRAY QARRAYW [*]; 32027000
BEGIN COMMENT GET "LENGTH" SPACE AND FILL IT WITH NULL DATA 32028000
DESCRIPTORS; 32029000
WORD DD; 32030000
WORD WT1 = QARRAYW; 32031000
INTEGER MOMQ ~ WT1.ADRCPLF, 32032000
A; 32033000
INTEGER I ~ LENGTH - 1; 32034000
M[MOMQ] ~ 0 & DATADESCRIPTOR 32035000
(,1,*,*,*,*,*,*, LENGTH, 32036000
A ~ GETSPACE (LENGTH, 0, 1, 0)); 32037000
DD ~ 0 & DATADESCRIPTOR (,1,1,*,*,*,*,*,*,*); 32038000
DO QARRAYW[I] ~ DD UNTIL I ~1 - 1 < 0; 32039000
END INITIALIZEQARRAY; 32040000
SAVE 1 PROCEDURE INITIALIZE (P1, P2); 32041000
VALUE P1; 32042000
INTEGER P1; 32043000
WORD P2; 32044000
BEGIN 32045000
DEFINE TIMEINCR = 32048000
1000 COMMENT THE TIME IN MICRO-SECONDS THAT 32049000
SHOULD BE ADEQUATE TO INITIALIZE A PROCES- 32050000
SORS STACK.; 32051000
/BASICCLOCKUNIT 32052000
| 0 COMMENT ************ CHECK-OUT; 32053000
| 8 #, COMMENT MAXIMUM NUMBER OF PROCESSORS.; 32054000
DD = DATADESCRIPTOR#, 32055000
MINDEX = TIMEOUT#, 32056000
MLENGTH = MAXADDR#,% 32057000
T = NEXTADDR #, 32058000
CODE = FIRSTADDR #, 32059000
OLDS = NEXTROW #, 32059100
STOPPIT = GLOBALSTOP#; 32060000
FIELD PROCIDBITS = (MYSELF-1):1, 32061000
MODULE = 19:6, 32062000
SDBITS = 9:10, 32063000
MOD2F = 0:1, 32064000
DIV2F = 47:47; 32065000
LAYOUT MSCW (35:16, 13:14); 32066000
DEFINE TYPEINT = TYPEINTERROGATE#, PATHINT = TYPEINT#; 32067000
DEFINE INITIALIZERARRAY (QARRAY, RARRAY, LENGTH) = 32068000
REPLACE POINTER (RARRAY) BY POINTER (QARRAY) 32069000
FOR LENGTH OVERWRITE;#; 32070000
DEFINE MOVESTACK (NEWF) = 32071000
BEGIN 32072000
D[30] ~ F; COMMENT D[30] IS TEMPORARY FOR WHERE WE 32073000
MOVE FROM; 32074000
F ~ NEWF ~ SHEETENTRYSIZE + 2; 32075000
COMMENT ALL PROCESSORS HAVE AN INITIAL S REG 32076000
SETTING OF 8192. WHEN INITIALIZE IS INVOKED, IT32077000
RUNS WITH A D[1] AND F OF 8193 AND THIS IS IM- 32078000
MEDIATELY CHANGED TO A LOCATION SOME PLACE IN 32079000
THE SECOND HALF OF MOD 0. THE EXACT LOCATION IS32080000
BASED ON THE PROCESSOR ID.; 32081000
D[1] ~ F; 32082000
S ~ S + F - D[30]; 32083000
M[F] ~ 0 & MARKSTACKCW (, 32084000
REAL (SNR ! 0), 1, *, *, 1, 32085000
IF SNR =0 THEN F ELSE SHEETENTRYSIZE +1); 32086000
REPLACE POINTER (M[F+1]) BY POINTER (M[D[30] + 1]) 32087000
FOR S - F OVERWRITE; 32088000
D[30] ~ 0; 32089000
END #; 32090000
DEFINE MISSINGMODS = 32091000
BEGIN COMMENT MISSINGMODS ALLOCATES MISSING MEMORY MODULES AS 32092000
NON-OVERLAYABLE AREAS AND PRESENT MODULES AS 32093000
OVERLAYABLE AREAS. WHEN MISSINGMODS IS INVOKED 32094000
THE SITUATION IS THIS: 32095000
1. THERE ARE "HOLES" IN MEMORY. I.E. THERE ARE32096000
ONE OR MORE INACTIVE MODULES SURROUNDED BY 32097000
ONE OR MORE ACTIVE MODULES. 32098000
2. ACTIVE MODULES INCLUDE 0 AND THE HIGHEST 32099000
AVAILABLE. 32100000
3. ZERO WORDS HAVE BEEN ALLOCATED AT THE HIGH-32101000
EST POSSIBLE MEMORY LOCATION. 32102000
4. MEMMODS ARRAY (INDEXED BY MODULE) HAS BEEN 32103000
INITIALIZED (1 IS ACTIVE MODULE). 32104000
5. THE REMAINDER OF THE HIGHEST MODULE IS A- 32105000
VAILABLE FOR ALLOCATION. WE WILL DO THIS 32106000
IN SUCH A WAY THAT THE ZERO WORD OF THE 32107000
MODULE IS AVAILABLE FOR SOME "Z" LINK. ;32108000
MINDEX ~ GETSPACE(16382-(LINKSIZE+1)|2,0,1,1).MODULE -1; 32109000
MLENGTH ~ 16384; 32110000
WHILE MINDEX } 1 DO 32111000
BEGIN 32112000
IF MEMMODS[MINDEX] = 0 32113000
THEN BEGIN COMMENT THE MOD IS MISSING; 32114000
IF MEMMODS[MINDEX -1] = 1 32115000
THEN BEGIN COMMENT BUT THE ONE BELOW IT IS 32116000
READY SO WE ALLOCATE THE MISSING 32117000
ONE AS NON-OVERLAYABLE.; 32118000
GETSPACE (MLENGTH, 0, 1, 0); 32119000
MLENGTH ~ 16364; 32120000
END OTHERWISE WE INCREASE THE AMOUNT WE 32121000
GET WHEN WE CAN 32122000
ELSE IF (MLENGTH ~ MLENGTH + 16364).MODULE > 7 32123000
THEN STOP COMMENT DONT EXCEDE GETSPACE MAX;32124000
END OTHERWISE ALLOCATE AS OVERLAYABLE SAVING FIRST 32125000
WORD OF MODULE FOR Z LINK 32126000
ELSE GETSPACE (16383 - LINKSIZE, 0, 1, 1); 32127000
MINDEX ~ MINDEX - 1; 32128000
END 32129000
END #; 32130000
DISALLOW; 32131000
CASE FIRSTONE(ABS(P1))-21+REAL(NOT INITSWITCH).MPXINDICATOR OF 32132000
BEGIN 32133000
CASE FIRSTONE (P1.SDBITS) - 1 OF 32134000
BEGIN 32135000
STOPPIT; 32136000
STOPPIT; 32137000
STOPPIT; 32138000
STOPPIT; 32139000
STOPPIT; 32140000
STOPPIT; 32141000
STOPPIT; 32142000
STOPPIT; 32143000
STOPPIT; 32144000
BEGIN 32145000
STOPPIT; 32145050
END IO FINISH; 32145100
; 32146000
; 32147000
; 32148000
; 32149000
; 32150000
; 32151000
END MPX INTERRUPTS CASE; 32153000
BEGIN COMMENT PROCESSOR TO PROCESSOR INTERRUPT; 32154000
MOVESTACK (PROCSTACKSIZE | MYSELF + F); 32155000
PROCMASK.PROCIDBITS ~ 1; COMMENT IDENTIFY MYSELF; 32156000
IF TIMEOUT = 0 32157000
THEN BEGIN COMMENT FIRST PROCESSOR SAYS HOW LONG32158000
IT SHOULD TAKE TO INITIALIZE 32159000
ALL PROCESSORS; 32160000
TIMEOUT ~ SCANIN (TIMEOFDAYWORD)+ TIMEINCR;32161000
INITSWITCH ~ TRUE; 32162000
END; 32163000
HEYOU; COMMENT ALL PROCESSORS HAVE BEEN IDLING OR 32164000
EXECUTING THE CODE IN THIS COMPOUND 32165000
STATEMENT.; 32166000
COMMENT ONLY ONE PROCESSOR CAN SUCCESSFULLY 32167000
COMPLETE THE TWO FOLLOWING STATEMENTS 32168000
AND IT IS THE ONE THAT COMPLETES THE 32169000
INITIALIZATION.; 32170000
DO UNTIL SCANIN (TIMEOFDAYWORD) > TIMEOUT; 32171000
BUZZCONTROL (SLAVEQUARTERS); 32172000
IF LOCK(SLAVEQUARTERS) 32173000
THEN BEGIN COMMENT GET MEMORY 32174000
UNDER CONTROL.; 32175000
MINDEX := INITIALIZEPCW := 0; 32176000
MCPINFO ~ MCPINFO & 32177000
NOTPRESENTARRAYDESCL(,*,3,0,MCPTOP := 32177040
M[2]); 32177050
COMMENT THE MCP LOADERS 32177100
WILL ALWAYS PLACE THIS 32178000
ADDRESS IN MEMORY[2] SO32179000
THAT WE WILL KNOW WHERE32180000
TO FIND THE MCP INFO 32181000
SEGMENTS; 32182000
SIMULATING := BOOLEAN(M[2]).BIT45 ; 32182100
M[2] := 0; 32182200
DO MINDEX ~ M[MINDEX].INUSELENGTH + MINDEX32183000
+ 1 UNTIL BOOLEAN(M[MINDEX].AVAILABLE);32184000
PREVADDR ~ MINDEX; 32185000
AVAILI ~ TEMPLINKS.ADDRESSF; 32186000
COMMENT FIX FIRST AVAILABLE LINK; 32187000
TEMPLINKS[0] ~ 0 & 32188000
AVAILA (,*,LINKSIZE,, PREVADDR); 32189000
TEMPLINKS [LINKSIZE] ~ 0 & 32190000
AVAILZ (,, LINKSIZE); 32191000
COMMENT FIX STOPPER; 32192000
STOPPER ~ LINKSIZE + 1; 32193000
TEMPLINKS [STOPPER] ~ 4"040000000001" & 32194000
AVAILA (,*, LINKSIZE,,*); 32195000
TEMPLINKS[STOPPER+1] ~ PREVADDR; 32196000
TEMPLINKS[STOPPER+LINKSIZE] ~ 32197000
0 & AVAILZ (,, LINKSIZE); 32198000
COMMENT UPDATE AVAILABLE AREA LINK; 32199000
STOPPER ~STOPPER +TEMPLINKS.ADDRESSF; 32200000
M[PREVADDR].LINK ~STOPPER; 32201000
M[PREVADDR+1] ~ AVAILI; 32202000
COMMENT SAVE INITIALIZATION CODE 32203000
ADDRESS FOR LATER FORGETING;32204000
SAVE1ADDRESS ~ PREVADDR - M[PREVADDR -1]. 32205000
INUSELENGTHZ + 2; 32206000
32207000
BACKALLOCATED ~ SAVE1ADDRESS - LINKSIZE; 32208000
MEMMODS ~ MEMMODS&DD 32209000
COMMENT IT SEEMS LIKE A REASONABLE PLACE;32210000
( ,1,0,*,*,*,*,*,*, 12000); 32211000
REPLACE POINTER(MEMMODS) BY 1 FOR 64 32212000
OVERWRITE; 32213000
COMMENT ASSUME ALL POSSIBLE MEMORY IS 32214000
PRESENT AND MARK ABSENT MODS IN INVALID 32215000
ADDRESS.; 32216000
MEMMAX ~ M.LENGTHF; 32217000
COMMENT LET INVALID ADDRESS WORK; 32218000
MINDEX ~ 0; 32219000
DO BEGIN 32220000
M[MINDEX := MINDEX + 16384] := 0; 32220500
IF BOOLEAN(MEMMODS[MINDEX.MODULE]) THEN 32220600
M[MINDEX+1] := 0; %CHECK INTERLACING 32220700
END UNTIL MINDEX = 1032192; 32221000
COREFACTOR ~ TRUE; COMMENT * * * * * * * * * * ; 32221050
AVAILABLECORE ~ MEMMAX - PREVADDR; 32221100
COMMENT FIND HIGHEST POSSIBLE ADDRESS; 32222000
MINDEX~MASKSEARCH(1,1,MEMMODS)|16384+16382;32223000
M.LENGTHF ~MINDEX + 1; 32224000
COMMENT WHEN THERE IS MAXIMUM MEMORY32225000
THE LAST WORD IS NOT INDEXABLE THROUGH32226000
M AND SO WE WASTE IT ALLCASES.; 32227000
M[PREVADDR].LENGTH ~ MINDEX - PREVADDR; 32228000
M[MINDEX] ~ 0 & AVAILZ (,,MINDEX-PREVADDR);32229000
COMMENT NOW ALL MEMORY ABOVE INITIALIZA- 32230000
TION AND INCLUDING MEMMAX LOOKS 32231000
AVAILABLE. THIS MAY NOT BE TRUE 32232000
BECAUSE OF MISSING MODS, BUT ALL 32233000
THE SPACE ROUTINES WILL FUNCTION,32234000
AND TO AVOID REPETITIVE CHECKS AS32235000
TO WHETHER WE ARE AT THE END OF 32236000
MEMORY WE WILL ALLOCATE 0 NON- 32237000
OVERLAYABLE WORDS AT THE END OF 32238000
MEMORY.; 32239000
GETSPACE (0, 0, 1, 0); 32240000
MEMMAX ~ MEMMAX -1; 32241000
IF MINDEX ! MEMMAX 32242000
THEN BEGIN COMMENT THERE ARE MISSING MODS.32243000
REGARDLESS OF THE STATUS OF OTHER32244000
MODS, 16375 WORDS CAN BE GOTTEN 32245000
IN THE FINAL MOD AND THE FIRST 32246000
WORD OF THE MOD WILL BE AVAILABLE32247000
FOR SOME "Z" LINK.; 32248000
MISSINGMODS; 32249000
END; 32250000
MINDEX ~ M.LENGTHF -1; 32251000
DO BEGIN 32252000
IF BOOLEAN(M[MINDEX].OLAY) 32253000
THEN FORGETSPACE(MINDEX +LINKSIZE32254000
-M[MINDEX].INUSELENGTHZ); 32255000
MINDEX ~ MINDEX 32256000
- M[MINDEX].INUSELENGTHZ -1;32257000
END 32258000
UNTIL MINDEX + LINKSIZE +1= SAVE1ADDRESS; 32259000
REPLACE POINTER(MEMMODS) BY 0 FOR 64 WORDS;32260000
T ~ D31; 32261000
MONITORMASK ~ T.MONMASKF; 32262000
D31 := MONITORVALUE := T.MONVALF; 32263000
IF SIMULATING 32265000
THEN BEGIN 32266000
MINDEX ~ NAME(MON1TOR).SDIF; 32267000
M[MINDEX] ~ M[NAME(SIM1TOR)]; 32268000
END ELSE 32269000
LOCK(MONITORLOCK); 32269100
IF MAXSTACKS ~ (MEMMAX.MODULE +1) | 32270000
STACKSPERMODULE > 1024 32271000
THEN MAXSTACKS ~ 1024; 32272000
STACK ~ 32273000
STACK & DD(,1,0,*,*,*,*,*, MAXSTACKS, 32274000
GETSPACE(MAXSTACKS, 0, 1, 0)) ; 32275000
INITIALIZEARRAY(REPLY,REPLY,MAXSTACKS); 32275100
MAXSTACKS ~ * -1; 32276000
COMMENT ******** SOMETHING WILL EVENTUALLY HAVE TO BE DONE 32277000
ABOUT THE FOLLOWING TWO STATEMENTS IN REGARDS 32278000
TO NON-SEOUENTIALLY NUMBERED PROCESSORS 8/16; 32279000
PROCSTACKSTARTW~ WORD(GETSPACE( 32280000
PROCSTACKSIZE|FIRSTONE(PROCMASK),0,1,0)); 32281000
STACKVECTOR [0] ~ 0 & DD(); 32282000
REPLACE POINTER (STACKVECTOR[1]) BY 32283000
POINTER (STACKVECTOR[0]) 32284000
FOR MAXSTACKS - 1 OVERWRITE; 32285000
STACKVECTOR [0] ~ STACKVECTOR [0] 32286000
&DD(,1,0,*,*,*,*,*, 1+ 32287000
M[0].INUSELENGTH, *); 32288000
PERIPHERALINVALIDADDRESS := TRUE; 32288050
MAXCHANNELS := 4"F"; 32288060
FOR CODE := 0 STEP 1 UNTIL 3 DO 32288100
BEGIN % MPX 32288150
OLDS := S; 32288200
SCANIN(0 & SCANINWORD(2, SET(0, CODE),32288250
1)); %MIGHT AS WELL READ R.D. 32288300
S := OLDS; % TO DELETE IN ADDR CRAP 32288350
END; 32288400
MULTIPLEXORMASK := BOOLEAN(2|MAXCHANNELS); 32288420
DCPSANDGCAS := 4"FFFFFFFFFF"; 32288440
FOR CODE := 4 STEP 1 UNTIL 19 DO 32288450
BEGIN % DCP 32288500
OLDS := S; 32288550
SCANOUT(0, 4"C0000" & SCANOUTWORD 32288600
(2, CODE - 4, 0)); % HALT DCP 32288650
S := OLDS; 32288700
END; 32288750
COMMENT DO THE GCA HERE---CODE GEQ 20; 32288800
UNLOCK (SLAVEQUARTERS); 32289000
32290000
COMMENT *** SOME QUEUE HEADS HAVE TO BE SMASHED AT INITIALISATION; 32292000
; 32293000
WORDREADYQHEAD ~ 0; 32294000
WORDSHEETQHEAD ~ 0; 32295000
WORDTERMINATEQHEAD ~ 0; 32296000
COMMENT *** END OF QUEUE HEAD SMASHING; 32297000
INITIALIZEARRAY(STACKINUSE, IRPARAMETERLOK, 32297100
MAXIRINDEXPLUS1); 32297200
INITIALIZEARRAY(PRIORITYLEVEL,PRIORITYLEVEL,PRIORITYRANGE+1); 32297300
32297400
COMMENT *** THE NUMBER OF INDEPENDENT RUNNER STACKS MAY BE A DEFINE OR32298000
IT MAY BE A SYSTEM PARAMETER, FOR THE MOMENT, IT IS AN 32299000
INITIALISED VARIABLE AS DEMONSTRATED BELOW; 32300000
INDEPENDENTRUNNERSTACKS ~ 2; 32301000
COMMENT STACKINUSE GIVES THE STACK NO OF EACH INDEPENDENT RUNNER 32302000
WHICH IS CURRENTLY RUNNING AND WHICH DOES NOT REQUIRE MORE32303000
THAN ONE STACK, IT MUST BE INITIALISED TO ZERO; 32304000
FILLARRAY(STACKINUSE,0,MAXIRINDEX); 32305000
COMMENT IRPRIORITIES GIVES PRIORITY OF EACH INDEPENDENT RUNNER, 32306000
THOSE RUNNERS ASSIGNED INDICATORS MUST HAVE PRIORITIES 32306200
ASSIGNED.OTHER RUNNERS WILL HAVE DEFAULT PRIORITIES 32306400
; 32307000
FILLARRAY(IRPRIORITIES,IRDEFAULTPRIORITY,MAXIRINDEX);32308000
IRPRIORITIES[CONTROLCARDINDICATOR] 32308200
~CONTROLCARDPRIORITY; 32308400
IRPRIORITIES[INITIATEINDICATOR]~INITIATEPRIORITY; 32308600
IRPRIORITIES[TERMINATEINDICATOR]~TERMINATEPRIORITY; 32308800
IRPRIORITIES[DIRCOMPLEMENTINDICATOR] := 32308900
DIRCOMPLEMENTPRIORITY; 32308950
COMMENT FOLLOWING ARE INITIALIZATIONS OF SOME CONTROL WORDS; 32309000
D2MSCW2~0&MARKSTACKWD(,*,1,*,READYENTRYSIZE-2,*,2,4);32310000
IRMSCW2~0&MARKSTACKWD(,*,1,*,FIXEDIRSIZE-2,*,2,4); 32311000
SHEETTOSCW~0&TOSCW(,0,0,0,0,SHEETENTRYSIZE+1,1,1,2); 32312000
D2MSCW1~0&MARKSTACKWD(,1,1,*,D0OFFSET,*,1, 32313000
READYENTRYSIZE-3); 32314000
IRMSCW1~0&MARKSTACKWD(,1,1,*,D0OFFSET,*,1,FIXEDIRSIZE32315000
-3); 32315100
D1MSCW~0&MARKSTACKWD(,1,1,*,D0OFFSET,*,1,D1INFO-1); 32316000
32317000
D2RCW1 ~ 0&RETURNCONTROLWORD(,*,*,*,*,*,*); 32318000
IRTOSCW~0&TOSCW(,,,,,FIXEDIRSIZE+4,1,2,2); 32319000
D2TOSCW~0&TOSCW(,,,,,READYENTRYSIZE+4,1,2,2); 32319100
D03 := HARDWAREINTERRUPTPCW; 32320000
END OF NON PROCESSOR INITIALIZATION; 32321000
SNR ~ MYSELF; 32322000
P1 ~ PROCSTACKSTART.ADDRESSF + (MYSELF-1)| 32323000
PROCSTACKSIZE; 32324000
MOVESTACK (P1); 32324100
INITIALIZETOZERO (P1, SHEETENTRYSIZE); 32324900
STACKVECTOR [MYSELF] ~ 32325000
0 & DD ( ,1,*,*,*,*,*,*, PROCSTACKSIZE, 32326000
F - SHEETENTRYSIZE - 2); 32327000
STACK [SNR, 0]~MYSELF; % PROCESSOR ID TO TOS 32328000
WORDSTACK [MYSELF, 1] ~ 0 & 32329000
MARKSTACKCW (,*,1, SNR, *,*,*); 32330000
BOSR ~ STACKVECTOR[SNR].ADDRESSF; 32331000
LOSR ~ BOSR + PROCSTACKSIZE - STACKOFLOWSIZE; 32332000
MORETHANONEPROCESSOR ~ (NUMBEROFPROCESSORS ~ 32333000
ONES(PROCMASK)) > 1; 32334000
PROCSTACKSTART.LENGTHF ~ PROCSTACKSTART.LENGTHF+1; 32335000
INITIALIZEARRAY(SHEETVECTOR,SHEETVECTOR, 32336000
IF STACKVECTOR.LENGTHF<511 32336100
THEN STACKVECTOR.LENGTHF|2 ELSE 1024); 32336200
COMMENT *** THERE IS NO JUSTIFICATION FOR THIS; 32336400
HOLDINITIALISE; 32337000
END PROCESSOR TO PROCESSOR INTERRUPT; 32338000
BEGIN COMMENT TIMER & STACK OVERFLOW; 32339000
STOPPIT 32340000
END; 32341000
BEGIN COMMENT SYLLABLE DEPENDENT - CLASS 2; 32342000
STOPPIT 32343000
END; 32344000
CASE FIRSTONE (P1.SDBITS) - 1 OF 32345000
BEGIN 32346000
STOPPIT; COMMENT MEMORY PROTECT; 32347000
STOPPIT; COMMENT INVALID OPERATOR; 32348000
STOPPIT; COMMENT DIVIDE BY ZERO; 32349000
STOPPIT; COMMENT EXPONENT OVERFLOW; 32350000
STOPPIT; COMMENT EXPONENT UNDEHFLOW; 32351000
STOPPIT; COMMENT INVALID INDEX; 32352000
STOPPIT; COMMENT INTEGER OVERFLOW; 32353000
STOPPIT; COMMENT BOTTOM OF STACK; 32354000
BEGIN COMMENT PRESENCE BIT - 32355000
AS LONG AS P2 POINTS TO A WELL FORMED DATA 32356000
DESCRIPTOR THAT DOES NOT REQUIRE I-O, WE SHOULD 32357000
BE ABLE TO SATISFY PB INTERRUPTS DURING INITIAL-32358000
IZATION. HOWEVER, IT SHOULD BE REMEMBERED 32359000
THAT MOST ALLOCATION DURING INITIALIZATION IS 32360000
NON-STANDARD. I.E. NON-OVERLAYABLE AND HIGH IN 32361000
MEMORY. THIS PRESENCE BIT WILL CAUSE THE SAME 32362000
TYPE OF ACTION. NOTE - OP NOT CONSIDERED .; 32363000
ALLOW; 32364000
M[P2.ADDRESSF] ~ M[P2.ADDRESSF] & DD 32365000
(*,1,0,*,*,*,*,*,*, GETSPACE( M[P2.ADDRESSF]. 32366000
LENGTHF , 0,1, P2.ADDRESSF)); 32367000
INITIALIZETOZERO(M[P2.ADDRESSF].ADDRESSF, 32368000
M[P2.ADDRESSF].LENGTHF); 32368100
IF P2.TAG ! 1 32369000
THEN P2~P2 & DD (*,1,1,*,*,*,*,*,*, 32370000
M[P2.ADDRESSF].ADDRESSF); 32370100
IF P1 < 0 32371000
THEN RETURN(P2); 32372000
32373000
END INITIALIZE PRESENCE BIT; 32374000
STOPPIT; COMMENT SEQUENCE ERROR; 32375000
END SYLLABLE DEPENDENT; 32376000
CASE FIRSTONE(P1.SDBITS) OF 32377000
BEGIN COMMENT ALARM INTERRUPTS; 32378000
STOPPIT; 32379000
STOPPIT; COMMENT OPERATOR LOOP; 32380000
STOPPIT; COMMENT MEMORY PARITY; 32381000
STOPPIT; COMMENT MPX PARITY; 32382000
IF PERIPHERALINVALIDADDRESS THEN 32383000
BEGIN COMMENT PERIPHERAL TYPE INVALID ADDRESS; 32383100
IF CODE < 4 THEN 32383200
MAXCHANNELS := RESET(MAXCHANNELS,CODE) ELSE 32383300
DCPSANDGCAS := RESET(DCPSANDGCAS, CODE - 4 | 32383400
REAL(CODE < 20)); 32383500
END ELSE 32383600
BEGIN COMMENT MEMORY TYPE INVALID ADDRESS; 32383700
MEMMODS[MINDEX.MODULE] ~ 0; 32384000
MEMMAX ~ MEMMAX - 16384; 32385000
M[F+1] ~ IF M[F+1].PSRF = 0 32386000
THEN M[F+1] & RETURNCONTROLWORD 32387000
(*,*,5,M[F+1].PIRF-1,*,*,*) 32388000
ELSE M[F+1] & RETURNCONTROLWORD 32389000
(*,*,M[F+1].PSRF-1,*,*,*,*); 32390000
M[F-1].INDEXF ~ 16383; 32391000
COMMENT SET BACK PIR & PSR SO THAT THE 32392000
INVOKING OPERATOR IS REPEATED AND32393000
THE STACK IS PROPERLY CUT BACK. 32394000
THE WORD AT 16383 IS AVAILABLE 32395000
AND UNUSED AT THIS TIME.; 32396000
END; 32397000
STOPPIT; COMMENT STACK UNDERFLOW; 32398000
STOPPIT; COMMENT INVALID OPERATOR; 32399000
END ALARM INTERRUPTS; 32400000
END MAJOR INTERRUPT CASE; 32401000
32402000
END INITIALIZE; 32403000
32404000
33000000
SAVE PROCEDURE HARDWAREINTERRUPT (P1,P2); VALUE P1,P2; 33001000
INTEGER P1; COMMENT IDENTIFIES TYPE OF INTERRUPT; 33002000
WORD P2; COMMENT USED BY PRESENCE BIT AND POSSIBLY OTHERS; 33003000
COMMENT FURTHER GLOBALS ARE 33004000
33005000
33006000
33007000
PROCEDURE MYFAULT ) NOTE THAT THESE NAMES 33008000
MYDIVIDEBYZERO ) ACCESS PCWS STUFFED IN 33009000
MYEXPONENTOVERFLOW ) KNOWN STACK LOCATIONS BY 33010000
MYEXPONENTUNDERFLOW ) COMPILES,LINKAGE LOADERS ETC. 33011000
MYINVALIDINDEX ) THEY ARE ASSOCIATED WITH E.G. 33012000
MYINTEGEROVERFLOW ) ALGOL FAULT STATEMENTS THUS 33013000
) PCWS SHOULD HAVE CONTROL BIT ON33014000
) AND ACCESSED STATEMENTS SHOULD 33015000
) NOT INVOKE SYLLABLE DEPENDENT 33016000
) INTERRUPTS 33017000
SIZE IS NUMBER OF WORDS REQUIRED, 33018000
THERE ARE POTENTIALLY 8 TYPES ONLY TWO ARE DISTINGUISHED SO 33019000
FAR(AND MUST BE GLOBALLY DEFINED): 33020000
OVLAYABLE 33021000
NONOVLAYABLE 33022000
GREATESTTYPE MAXIMUM VALUE OF TYPE FOR GETSPACE 33023000
MASSIN(DISKTYPE,DISKADDRESS,EVENT, SOME OTHER PARAMETERS) 33024000
DISKTYPE CODEDISK 33025000
OVERLAYDISK 33026000
EVENT IS SET ON COMPLETION 33027000
FIREUP TRANSFERS PROCESSES FROM EVENT QUEUE 33028000
TO READYQ 33029000
; 33030000
COMMENT THIS PROCEDURE HANDLES ALL INTERRUPTS 33031000
IT USES AS BIBLE :- "INTERRUPT HANDLING AND ACCIDENTAL ENTRY"33032000
, E.A. HAUK, JULY 25 1967 33033000
(1) NOTE THAT THE PROCEDURE MAY EITHER EXIT ON COMPLETION OR 33034000
CHANGE TO ANOTHER PROCESS(JOB). THUS ALL PROCESS INITIATION 33035000
AND RE-ACTIVATION MAY BE HANDLED IN THIS PROCEDURE IF SUCH A 33036000
COURSE PROVES DESIRABLE 33037000
(2) NOTE THAT A SINGLE PROCESSOR USER PAYS A PRICE BECAUSE OF 33038000
POTENTIAL MULTIPROCESSOR USERS. SOME ATTEMPT TO MINIMISE THIS 33039000
PRICE MAY BE WORTHWHILE. SOURCE EDITING AND THE USE OF DEFINES 33040000
MAY BE APPROPRIATE; 33041000
33042000
BEGIN COMMENT MCS 1; 33043000
REAL TRACTER ; 33044000
PROCEDURE NOTYETCODED (X); VALUE X; REAL X; FORWARD; 33045000
LAYOUT P1PARAMETER 33046000
( IOFFIELD = 0:1 % INT MASK FIELD FOR IOFINISH 33047000
, MPXSPECFIELD= 3:4 % SPECIFIES MPXA OR MPXB 33048000
, ALARMFIELD = 5:6 % ALARM TYPE 33049000
, IFFIELD = 7:4 % MPX INTERFACE 33050000
, INTFIELD = 9:10 % SD INTERRUPT TYPE 33051000
, MPXFIELD = 20:1 % MPX INTERRUPT 33052000
, SDFIELD = 24:1 % SYLLABLE DEP INT FLAG 33053000
, RTBITF = 46:1 % RETURN BIT 33054000
) ; 33055000
33056000
33057000
33058000
DEFINE INTERVALTIMERSPEC = @020000001# 33059000
, STACKOVERFLOWSPEC = @020000002# 33060000
, SYLLABLEDEPNDNT2SPEC= @040000000# 33061000
, ALARMSPEC = @200000001# 33062000
, PROCTOPROCSPEC = @010000000# 33063000
, SYLABLEDEPENDENT2 = SYLLABLEDEPNDNT2SPEC# 33064000
; 33065000
DEFINE LITERALFUNCTIONA = @ 743 # 33066000
, LITERALFUNCTIONB = @ 745 # 33067000
; 33068000
INTEGER MYSNR 33069000
, MYF 33070000
33071000
; 33072000
LABEL LOOKAROUND 33073000
, AGAIN 33074000
, FINI 33075000
; 33076000
BOOLEAN FIRST )"TRUE IF FIRST TIME AT LOOKAROUND "(33077000
RTBIT 33078000
; 33079000
MONITOR JACKMONITOR(P1); 33080000
WORD ACTUALCOPY = P2 33081000
; 33082000
FIELD BITONEF = 1:1 33082100
, BITTWOF = 2:1 33082200
; 33082300
COMMENT THE FOLLOWING LOCAL PROCEDURES HANDLE ALL INTERRUPTS OTHER 33083000
THAN INTERVAL TIMER, GCA AND IOFINISH, 33084000
; 33085000
SAVE PROCEDURE PROCTOPROC; 33086000
NOTYETCODED(PRTOPR); 33087000
SAVE PROCEDURE STACKOVERFLOW; 33088000
NOTYETCODED(STACKOVER); 33089000
SAVE PROCEDURE SYLLABLEDEPENDENT2; 33090000
KILLME(SYLABLEDEPENDENT2); 33091000
SAVE PROCEDURE ALARM; 33092000
NOTYETCODED(BLOWUP+P1.ALARMFIELD); 33093000
SAVE PROCEDURE MEMORYPROTECT; 33094000
NOTYETCODED(MEMPROTECT); 33095000
SAVE PROCEDURE INVALIDOPERATOR; 33096000
NOTYETCODED(INVALIDOP); 33097000
SAVE PROCEDURE SEQUENCEERROR; 33098000
NOTYETCODED(SEQERROR); 33099000
SAVE PROCEDURE MLL1; 33100000
NOTYETCODED(ML1); 33101000
SAVE PROCEDURE MLL2; 33102000
NOTYETCODED(ML2); 33103000
SAVE PROCEDURE MLL3; 33104000
NOTYETCODED(ML3); 33105000
SAVE PROCEDURE MLL4; 33106000
NOTYETCODED(ML4); 33107000
SAVE PROCEDURE EXTERNALMPX; 33108000
NOTYETCODED(EXTMPX); 33109000
SAVE PROCEDURE MPXUNASSIGNED(SPEC); VALUE SPEC; INTEGER SPEC; 33110000
NOTYETCODED(SPEC); 33111000
SAVE PROCEDURE BOTTOMOFSTACK; 33112000
NOTYETCODED(STACKBOTTOM); 33113000
SAVE PROCEDURE ARITHMETICFAULT(WHICH); VALUE WHICH; 33114000
INTEGER WHICH; COMMENT SPECIFIES INTERRUPT; 33115000
COMMENT HANDLES DIVIDE BY ZERO,EXPONENT OVERFLOW,EXPONENT UNDERFLOW, 33116000
INVALID INDEX AND INTEGER OVERFLOW 33117000
THE PROCEDURE ACCESSES "MYCOURSE" (A DEFINE OR 33118000
INTRINSIC ACCESSING A STACK LOCATION SET BY THE COMPILER. THE 33119000
LINKAGE LOADER OR SOMETHING) 33120000
MYCOURSE = UPTOYOU THE MCP DOES AS IT PLEASES 33121000
= FINISH THE MCP MUST D-ES ME 33122000
= CARRYON THE MCP IGNORES THIS INTRUPT33123000
= TELLME THE MCP SETS SOME FLAGS 33124000
= FAULTROUTINE ENTER GENERAL FAULT ROUTINE 33125000
= SELECT ACCESS PCW APPROPRIATE TO 33126000
INTERRUPT 33127000
THESE CHOICES COULD BE LIMITED. GIVING A MORE 33128000
UNIFORM APPROACH BUT USING MORE CORE STORAGE. THEY ALLOW ALGOL,33129000
COBOL ETC. TO REACT DIFFERENTLY TO FAULT CONDITIONS - DO WE 33130000
WANT THIS 33131000
ALL CHOICES EXCEPT THE LAST TWO INVOLVE RETURN TO THE33132000
INTERRUPT ROUTINE. HOWEVER BAD GO TOS ASSOCIATED WITH THE LAST 33133000
TWO CHOICES (A LIKELY OCCURRENCE)MAY PREVENT SUCH A RETURN. 33134000
HENCE THE BAD GO TO MECHANISM MUST CALL THE PROCEDURE 33135000
WHATDOIDO (AMONG OTHER THINGS) 33136000
NOTE THAT THE CONCEPT OF MASTER AND SLAVE PROCESSORS 33137000
AS DESCRIBED BY DAHM IS CONSIDERED AN UNNECESSARY COMPLICATION 33138000
IN THE HANDLING OF SYLLABLE DEPENDENT INTERRUPTS 33139000
; 33140000
BEGIN 33141000
INTEGER MYACTION 33142000
; 33143000
LABEL BUZZ,LOOKFORJOB 33144000
; 33145000
33146000
33147000
33148000
IF MYACTION ~ MYCOURSE=UPTOYOU OR MYACTION=FINISH THEN 33149000
KILLME(WHICH) 33150000
ELSE IF MYACTION =CARRYON THEN GO LOOKFORJOB 33151000
ELSE IF MYACTION =TELLME THEN BEGIN SETOVERFLOWFF; 33152000
GO LOOKFORJOB END 33153000
ELSE IF MYACTION =FAULTROUTINE THEN 33154000
MYFAULT(P2) 33155000
ELSE 33156000
CASE WHICH OF 33157000
BEGIN 33158000
MYDIVIDEBYZERO(P2); 33159000
MYEXPONENTOVERFLOW(P2); 33160000
MYEXPONENTUNDERFLOW(P2); 33161000
MYINVALIDINDEX(P2); 33162000
MYINTEGEROVERFLOW(P2); 33163000
END CASE EXPRESSION; 33164000
LOOKFORJOB: 33165000
END ARITHMETICFAULT; 33166000
SAVE WORD PROCEDURE PRESENCEBIT; 33167000
COMMENT 33168000
(1) THE PROCEDURE DOES NOT RUN AROUND MAKING ABSENT COPIES PRESENT 33169000
MAYBE IT SHOULD; 33170000
BEGIN COMMENT MCS 1; 33171000
LABEL TOSLEEP 33172000
,FIN 33173000
,LOOKFORPREEMPT 33174000
,MOMPRESENT 33175000
33176000
; 33177000
INTEGER 33178000
TI1,TI2,TI3, 33179000
IOCW, 33180000
KIND )"WHETHER P2 IS OPERAND,DD,SEGDESC OR IRW "(33181000
FIRSTLOC )"MULTIPLE DESCRIPTORS-LOCATION FIRST ARG "(33182000
LASTLOC 33183000
; 33184000
EVENT EVNN 33185000
; 33186000
33187000
33188000
33189000
WORD 33190000
MOM %HOLDS MOM (NOT COPY) 33191000
, MOMLOCATION %INDEX INTO M FOR MOM 33192000
, TW1 = TI2 33193000
; 33194000
33195000
33196000
33197000
BOOLEAN ALREADYPRESENT; 33198000
33199000
33200000
33201000
33202000
BOOLEAN NOCHANGE 33203000
, OLAY 33203100
; 33204000
ARRAY DISKADDRESSES[*] 33205000
, IOCBREFERENCE [IOCBSIZE] 33206000
; 33207000
REFERENCE IOCB = IOCBREFERENCE 33208000
; 33209000
DEFINE FIXRECORDDESC(X) = WORD(AREADESC @ X).ADDRESSF # 33210000
; 33211000
33212000
BUZZCONTROL(PBLOK); COMMENT *** BUZZ; 33213000
COMMENT*** AT PRESENT THIS LOCK IS REDUNDANT. HOWEVER WHEN GROSS LOCK 33214000
IS REMOVED, AN EVEN FINER LOCK MAY BE REQUIRED; 33215000
ALREADYPRESENT~FALSE; 33216000
RTBIT ~ BOOLEAN(P1.RTBITF); 33217000
NOCHANGE~FALSE; 33218000
IF (KIND ~ ACTUALCOPY.TAG) = SINGL 33219000
THEN BEGIN COMMENT MCS 2MULTIPLE DESCRIPTORS; 33220000
LASTLOC := MYF - REAL(ACTUALCOPY); 33221000
FIRSTLOC := MYF - 1; 33222000
UNLOCK(PBLOK); 33223000
33224000
FOR TI1 := FIRSTLOC STEP -1 UNTIL LASTLOC DO 33225000
BEGIN 33226000
IF (TW1 := P2 := M[TI1]).TAG = DOUBL THEN 33227000
BEGIN 33227100
LASTLOC := * - 1; 33227200
TI1 := * - 1; 33227300
COMMENT P2 DOESN"T COUNT DOUBLES AS 2 33227400
WORDS; 33227500
END ELSE 33227600
IF TW1.TAG = DATADESC THEN 33228000
IF NOT BOOLEAN(REAL(TW1).PBITF) THEN 33229000
M[TI1] ~ PRESENCEBIT; 33230000
33231000
END; 33232000
GO TO FIN; 33233000
END MCS 2 MULTIPLE DESCRIPTORS 33234000
ELSE 33235000
33236000
IF (REAL(MOM~M[MOMLOCATION~(IF KIND=IRW 33237000
THEN STACKVECTOR [ACTUALCOPY.STKNRF].ADDRESSF33238000
+ACTUALCOPY.DISPF 33239000
+ACTUALCOPY.SIRWDELTAF 33240000
ELSE ACTUALCOPY.ADDRESSF)] 33241000
).LOCKBITF=1 AND KIND=SEGDESC) 33242000
OR DESCRIPTORLOCK 33242100
THEN 33243000
COMMENT *** NOTE ABSOLUTE ADDRESSES, THIS IS A MESSY BUSINESS AND33244000
SHOULD BE CHANGED IF POSSIBLE. NOTE THAT THE SIRW 33245000
IS CHANGED INTO AN ABSOLUTE ADDRESS BECAUSE GETSPACE 33246000
EXPECTS ONE; 33247000
BEGIN COMMENT MCS 3; 33248000
UNLOCK(PBLOK); 33249000
WAIT(EVNT @ REFERENCE(IOCBREFERENCE ~ 33250000
IOCBREFERENCE&REFERENCED 33251000
(1,*,* 33251100
,TI3~IF KIND=SEGDESC 33251200
THEN MOM.ADDRESSF 33251300
ELSE MOM.ADDRESF 33251400
) 33251500
)); 33252000
TI2~WORD(AREADESC@IOCB).ADDRESSF+1; 33253000
33254000
COMMENT *** MAYBE THIS CAN BE FIXED LATER; 33255000
GO TOSLEEP; 33256000
END MCS 3 33257000
ELSE; 33258000
33259000
33260000
33261000
33262000
UNLOCK(PBLOK); 33263000
IF MOM.AITINDICATORF=1 AND KIND=DATADESC 33264000
THEN BEGIN M[MOMLOCATION]~MOM~DOPEVECTOR(MOM); 33265000
IF BOOLEAN(ACTUALCOPY.IBITF) THEN 33266000
ACTUALCOPY~ MOM &DATADESCRIPTOR 33267000
(*,*,1,1,*,*,*,*, 33268000
ACTUALCOPY.INDEXF,*) ELSE 33269000
ACTUALCOPY~MOM&DATADESCRIPTOR(*,*,1,*,*,*,*33270000
,*,*,*); 33271000
GO LOOKFORPREEMPT; 33272000
END; 33273000
IF MOM.PBITF= 1 33274000
THEN 33275000
BEGIN COMMENT MCS 4; 33276000
TI2~MOM.ADDRESSF; 33277000
ALREADYPRESENT ~ TRUE; 33278000
MOMPRESENT: IF KIND!IRW THEN PRESENCEBIT~ACTUALCOPY 33279000
~ACTUALCOPY&FIXDESC(1,*,TI2); 33280000
IF NOT ALREADYPRESENT 33281000
THEN 33282000
BEGIN COMMENT MCS 4A ; 33283000
MOM~MOM&FIXDESC(1,*,TI2); 33284000
IF KIND=SEGDESC 33285000
THEN MOM.LOCKBITF~0; 33286000
M [MOMLOCATION] ~ MOM; 33287000
TURNOVERLAYKEY(MOMLOCATION); 33288000
END MCS 4A; 33288100
IF NOCHANGE 33289000
THEN 33290000
BEGIN COMMENT MCS 4B; 33291000
IF NOT ALREADYPRESENT THEN 33294000
FORGETAREA(IOCBSIZE,TI333294100
); 33294200
UNLOCK(MULTIPLEREFERENCELOK);33295000
GO FIN; 33296000
END MCS 4B; 33297000
33298000
LOOKFORPREEMPT: % *** THERE WAS A CONDITIONAL CALL ON WHATDOIDO 33299000
END MCS 4 33300000
ELSE 33301000
BEGIN COMMENT MCS 5 ; 33302000
COMMENT ********** *************33303000
******************* *************33304000
DATA AND SEGMENT DESCRIPTORS ARE INTERPRETED AS FOLLOWS 33305000
***** DATA DESCRIPTORS ***** 33306000
INTERPRETATION 33307000
FIELD OLAYTYPEF 33308000
MCPF FILETYPEF AITINDICATORF ADDRESF 33309000
(MCPCODEF) 33310000
BITS 19:1 18:1 17:1 16:17 33311000
0 0 0 >1 NON-MCP READ IN OLAYABLE 33312000
FROM OLAY FILE 33313000
0 0 0 0 NON-MCP GET OLAYABLE 33314000
0 0 0 1 NON-MCP GET SAVE SPACE 33315000
0 0 1 * NON-MCP AIT REFERENCE 33316000
0 1 0 * NON-MCP READ ONLY 33317000
FROM CODE FILE 33318000
0 1 1 * NOT USED 33319000
1 0 0 >1 NOT USED 33320000
1 0 0 0 MCP GET OLAYABLE SPACE 33321000
1 0 0 1 MCP GET SAVE SPACE 33322000
1 0 1 * MCP.AIT REFERENCE 33323000
1 1 0 * MCP READ ONLY 33324000
FROM CODE FILE 33325000
1 1 1 * ADDRESS IS THAT OF IOCB 33326000
SOMEBODY ELSE IS READING 33326100
IN ARRAY.WAIT ON EVENT IN 33326200
IOCB. (NOTE THIS IS A 33326300
SPECIAL COMBINATION WHERE 33326400
MEANINGS OF INDIVIDUAL 33326500
BITS DO NOT APPLY). 33326600
*****SEGMENT DESCRIPTORS ***** 33327000
INTERPRETATION 33328000
FIELD DICTIONARYF LOCKBITF ADDRESSF 33329000
BITS 45:1 44:1 19:20 33330000
1 0 * DO DICTIONARY READ IN 33331000
OVERLAYABLE PROGRAM FROM 33332000
MCP CODE FILE 33333000
0 0 * D1 DICTIONARY.READ IN 33334000
OVERLAYABLE FROM PROGRAM 33335000
CODE FILE 33336000
0 1 * ) ADDRESS IS THAT OF IOCB 33337000
1 1 * ) SOMEBODY ELSE IS READING 33338000
IN PROGRAM. WAIT ON EVENT 33339000
IN IOCB 33340000
DD FORMAT TO BE DETERMINED NON OLAYABLE FROM OLAY FILE 33343000
DD FORMAT TO BE DETERMINED NON OLAYABLE FROM CODE FILE 33344000
SD >1 * 0 READ IN OVERLABLE PROGRAM 33345000
SD >1 * 1 READ NON OVERLAYABLE PROGRAM33346000
; 33347000
TI1~MOM.LENGTHF; 33348000
COMMENT *** MAYBE WE SHOULD CALL GETAREA SOMETIMES; 33349000
TI2 ~GETSPACE 33350000
( TI1 ~(IF KIND=SEGDESC 33351000
THEN TI1 33352000
ELSE IF MOM.SZF = 1 33353000
THEN TI1 | 2 33354000
ELSE IF TI3~ MOM.SZF= 0 33355000
THEN TI1 33356000
ELSE (TI1 ~ (IF TI3 = 4 THEN 33357000
(TI3~6) - 1 33358000
ELSE IF TI3 = 3 THEN 33359000
(TI3~8) - 1 33360000
ELSE (TI3~12) - 1)) 33361000
DIV TI3) 33362000
, MYSNR 33363000
,0&SPACETYPE (1,1,1, 33364000
REAL(NOT ( KIND = DATADESC AND REAL(MOM).ADDRESSF = 1))) 33365000
33366000
,MOMLOCATION 33367000
); 33368000
IF KIND = SEGDESC OR MOM.ADDRESF > 1 OR 33369000
MOM.DESCRIPTORLOCKF = 2 THEN 33369100
33370000
BEGIN COMMENT MCS 6; 33371000
IF(KIND=SEGDESC AND MOM.DICTIONARYF=1) OR 33372000
(KIND=DATADESC AND MOM.MCPCODEF=3) 33373000
THEN TI3 ~ MOM.ADDRESF+MCPDISKBASE 33374000
ELSE 33375000
BEGIN 33376000
DISKADDRESSES~WORDSTACK 33377000
[IF(OLAY~KIND=DATADESC AND MOM.FILETYPEF=0) 33377500
THEN MYSNR 33378000
ELSE WORDSTACK[MYSNR,PROCESSFAMILYLINKPLACE]. 33378500
FATHERF 33378502
, IF OLAY 33379000
THEN OLAYFILEDESCRIPTORPLACE 33379500
ELSE D1CODEFILEDESCPLACE 33380000
]; 33380800
33381000
TI3~DISKADDRESSES 33382000
[FIRSTROWINDEX + (TI3 := MOM.ADDRESF) 33383000
DIV(IF OLAY THEN OLAYROWLENTH ELSE CODEROWLENTH)33384000
] 33385000
+TI3 MOD(IF OLAY THEN OLAYROWLENTH ELSE CODEROWLENTH)33386000
; 33387000
33388000
END; 33389000
IOCW ~ @440 + REAL(KIND = SEGDESC); 33390000
RESET(EVNN); 33391000
DISKADDRESSES~DISKADDRESSES&ARRAYDESCL(3,TI1,TI2); 33392000
MOM~MOM&POINTTOIOCB(*, 33393000
WORD(DISKIO(DISKADDRESSES,-1,TI1,TI3,IOCW,EVNN))); 33394000
M[MOMLOCATION]~MOM 33394100
~IF KIND=SEGDESC THEN MOM&LOKMOM(1,*) 33394200
ELSE MOM&LOKMOM(*,7); 33394300
UNLOCK(PBLOK); 33396000
WAIT (EVNN); 33397000
TI3 ~ MOM.ADDRESSF; 33398000
33399000
TOSLEEP: NOCHANGE~ TRUE; 33400000
BUZZCONTROL(MULTIPLEREFERENCELOK); COMMENT *** BUZZ; 33401000
IF BOOLEAN (M[MOMLOCATION].PBITF) 33402000
THEN BEGIN 33403000
ALREADYPRESENT ~ TRUE; 33404000
END; 33405000
33406000
GO TO MOMPRESENT; 33407000
END MCS 6 33408000
ELSE BEGIN 33409000
MOM~MOM&FIXDESC(1,*,TI2); 33410000
INITIALIZETOZERO (TI2, TI1); 33411000
COMMENT *** OPTIMISE LATER; 33412000
GO TO MOMPRESENT; 33413000
END; 33414000
END MCS 5; 33415000
FIN: 33416000
RETURN(ACTUALCOPY); 33417000
END MCS 1 PRESENCEBIT; 33418000
PROCEDURE NOTYETCODED(SPEC); VALUE SPEC; 33419000
REAL SPEC; COMMENT SPECIFIES MSSING CODE; 33420000
BEGIN 33421000
COMMENT MUST IMSERT CODE TO PRINT OUT MESSAGE HERE; 33422000
KILLME(SPEC); 33423000
END NOTYETCODED; 33424000
%%%%% INTERRUPT PROCEDURE OUTER BLOCK CODE %%%% 33425000
%%%%% %%%% 33426000
%%%%% %%%% 33427000
TRACTER~TRACE(0); 33428000
IF SIMULATING THEN 33428990
MONITORVALUE~D[31]; 33429000
P1~P1; COMMENT ***** REDUNDANT- FOR MONITORING; 33430000
COMMENT 33431000
IF P1= INTERVALTIMERSPEC AND BUSY(GROSSLOK) 33432000
THEN GO FINI 33433000
ELSE IF LOCK(GROSSLOK) THEN KILLME(GROSSLOCK); 33434000
COMMENT *** ELSE BUZZ(GROSSLOK) LATER; 33435000
COMMENT GROSSLOK IS NOMINALLY SET AT ENTRY TO INTERRUPT 33436000
PROCEDURE AND DETERMINES THAT ONLY ONE INTERRUPT33437000
AT A TIME IS HANDLED. THIS MAY BE A TEMPORARY 33438000
MEASURE IN WHICH CASE A LOCK LESS POWERFUL THAN 33439000
GROSSLOK, WHICH PREVENTS OVERLAY ACTION, WILL BE33440000
USED 33441000
WHEN AN INTERRUPT GOES THROUGH THE LOCK, IT33442000
MAY NOT BE INTERRUPTED (FOR HARDWARE OR 33443000
SOFTWARE REASONS) BY ANYTHING EXCEPT INTERVAL 33444000
TIMER. HENCE INTERVAL TIMER MUST NOT BUZZ THE 33445000
LOCK IF IT HAS BEEN SET BY SOMEBODY ELSE- IN 33446000
THIS CIRCUMSTANCE THE INTERVAL TIMER INTERRUPT 33447000
IS LOST 33448000
; 33449000
DISABLEOVERLAY; 33450000
COMMENT THIS SHOULD 33451000
(1) MAKE THE STACK NON OVERLAYABLE 33452000
(2) MARK THE STACK APPROPRIATELY 33453000
AT PRESENT IT DOES NOTHING. NOTE THAT THIS HAS TO MESH IN WITH 33454000
GENERAL SCHEME FOR HANDLING ABSOLUTE ADDRESSES IN STACKS 33455000
; 33456000
MYF ~ F; 33457000
MYSNR~SNR; 33458000
COMMENT *** ABSOLUTE ADDRESS; 33459000
COMMENT * ** * * * * * * *; CASE P1.MPXFIELD | P1.IFFIELD OF 33460000
BEGIN COMMENT MCS 2; 33461000
COMMENT ALL NON MPX INTERRUPTS HERE; 33462000
CASE P1.SDFIELD|FIRSTONE(P1.INTFIELD) OF 33463000
BEGIN COMMENT MCS 3; 33464000
COMMENT ALL NON MPX,NON SYLLABLE DEPENDENT INTERRUPTS HERE; 33465000
IF P1 = PROCTOPROCSPEC THEN PROCTOPROC 33466000
ELSE IF P1=INTERVALTIMERSPEC THEN 33467000
BEGIN COMMENT MCS 3A; 33468000
IF (COUNTFORTIMERINTERRUPTEVENT~*+1) 33469000
= NUMBEROFPROCESSORS AND NOT 33470000
BUSY(READYQ) 33470100
THEN BEGIN COMMENT MCS 3B; 33471000
COUNTFORTIMERINTERRUPTEVENT 33472000
~0; 33473000
CAUSE (TIMERINTERRUPTEVENT);33474000
END MCS 3B; 33475000
END MCS 3A 33476000
ELSE IF P1=STACKOVERFLOWSPEC THEN STACKOVERFLOW 33477000
ELSE IF P1=SYLLABLEDEPNDNT2SPEC THEN 33478000
SYLLABLEDEPENDENT2 33479000
ELSE IF P1 } ALARMSPEC THEN ALARM 33480000
ELSE STOP; 33481000
MEMORYPROTECT; 33482000
INVALIDOPERATOR; 33483000
ARITHMETICFAULT(DZ); COMMENT DIVIDE BY ZERO; 33484000
ARITHMETICFAULT(EO); COMMENT EXPONENT OVERFLOW; 33485000
ARITHMETICFAULT(EU); COMMENT EXPONENT UNDERFLOW; 33486000
ARITHMETICFAULT(II); COMMENT INVALID INDEX; 33487000
ARITHMETICFAULT(IO); COMMENT INTEGER OVERFLOW; 33488000
BOTTOMOFSTACK; 33489000
BEGIN 33490000
PRESENCEBIT; 33491000
33492000
GO FINI; 33493000
END; 33494000
STOP; 33495000
WHATDOIDO; 33496000
GO FINI; 33497000
END MCS 3 SYLLABLE DEPENDENT INTERRUPTS; 33498000
MLL1; 33499000
MLL2; 33500000
MLL3; 33501000
MLL4; 33502000
EXTERNALMPX; 33503000
COMMENT FIRST MPX UNASSIGNED INTERRUPT HANDLED HERE.IN-LINE CODE USED; 33504000
NOTYETCODED(GCAINTERRUPT); 33505000
COMMENT OTHER MPX UNASSIGNED INTERRUPTS HANDLED HERE; 33506000
MPXUNASSIGNED(UA2); 33507000
MPXUNASSIGNED(UA3); 33508000
AGAIN: 33508100
IOFINISH(P1.MPXSPECFIELD); 33509000
COMMENT SKIP UNUSED BIT POSITIONS IN IFFIELD HERE; 33510000
;;;;; 33511000
COMMENT REST OF THIS PROCEDURE DEVOTED TO IOFINISH. NOTE THE FOLLOWING:33512000
(1) IOFINISH AND GCA INTERRUPTS ARE HANDLED BY CODE LOCAL33513000
TO INTERRUPT PROCEDURE . ALL OTHER INTERRUPTS 33514000
HANDLED BY PROCEDURE CALLS 33515000
(2) CALLED PROCEDURES ARE DECLARED LOCAL TO THE 33516000
INTERRUPT PROCEDURE 33517000
(3) THERE MAY BE DUPLICATION OF CODE IN ORDER TO 33518000
SPEED THE PROCESSING OF SOME INTERRUPTS 33519000
; 33520000
STOP; 33522000
END MCS CASE EXPRESSION; 33523000
IF MULTIPLEXORMASK.BITONEF 33524000
THEN IF (P1~SCANIN(LITERALFUNCTIONA))!1 33525000
THEN GO AGAIN; 33526000
IF MULTIPLEXORMASK.BITTWOF 33527000
THEN IF (P1~SCANIN(LITERALFUNCTIONB))!2 33528000
THEN GO AGAIN; 33529000
WHATDOIDO; 33529100
FINI: 33530000
UNLOCK(GROSSLOK); 33531000
ENABLEOVERLAY; 33532000
TRACE(TRACTER); 33534998
IF RTBIT THEN RETURN(ACTUALCOPY); 33535000
END MCS 1 HARDWAREINTERRUPT; 33537000
SAVE PROCEDURE WHATDOIDO; 33538000
COMMENT IF THERE IS SOMETHING OF HIGHER PRIORITY IN THE READYQ THEN 33539000
FIRE IT UP ELSE EXIT. SIMILAR TO WAIT AND HOLD 33540000
; 33541000
BEGIN 33542000
LABEL FINI 33543000
; 33544000
REAL MYSNR 33545000
, NEXTSTACKNO 33546000
; 33547000
MONITOR JACKMONITOR(MYSNR); 33548000
33549000
SETINTERVALTIMER; 33550000
MYSNR ~ SNR; 33551000
STACK[MYSNR,PRIORITYPLACE]~0;% *** TAKE OUT WHEN PRIORITY ALGORTHMS OK 33551100
IF LOCK(READYQ) THEN GO FINIS; % *** WITH NO INTERVAL TIMER 33552000
% *** PROBLEMS BUZZCONTROL 33552100
COMMENT ***** SHOULD THIS BE BUZZ; 33553000
IF NOTHINGTODO 33554000
THEN GO FINI 33555000
ELSE IF STACK[NEXTSTACKNO~NEXTSTACKINREADYQ,PRIORITYPLACE]33556000
}STACK[MYSNR,PRIORITYPLACE] 33557000
THEN BEGIN 33558000
INSERTINQ(READYQ,DUMMYREF,MYSNR); 33559000
MOVETONEXTINREADYQ; 33560000
END 33561000
ELSE ; 33562000
33563000
FINI: UNLOCK(READYQ); 33564000
FINIS: 33564100
END WHATDOIDO; 33565000
33566000
SAVE PROCEDURE EVENTHANDLER (THEEVENT,EVENTWORD1,WAITFLAG); 33567000
VALUE EVENTWORD1,WAITFLAG; 33568000
WORD THEEVENT %IRW OR INDEXED DD POINTING TO EVENT 33569000
, EVENTWORD1 %FIRST WORD OF EVENT 33570000
; 33571000
BOOLEAN WAITFLAG %TRUE IF WAIT, FALSE IF CAUSE 33572000
; 33573000
COMMENT 33574000
THE ESPOL INTRINSIC WAIT(WAITFLAG TRUE) OR CAUSE, LOCKS THE EVENT 33575000
AND PASSES TO THIS PROCEDURE: 33576000
AN IRW OR INDEXED DD POINTING TO THE EVENT 33577000
THE FIRST WORD OF THE EVENT (WITH A DOUBLE TAG) 33578000
A FLAG INDICATING WHETHER CAUSE OR WAIT IS REQUIRED 33579000
33580000
33581000
WAIT ACTION: 33582000
1) THE INTERVAL TIMER IS RESET 33583000
2) IF THE READYQ IS EMPTY, THE NOTHING TO DO LOOP IS 33584000
ENTERED. IN THE NOTHING TO DO LOOP: 33585000
A THE READYQ IS BUZZED 33586000
B IF READYQ NON EMPTY THEN GO TO 3 33587000
C IF EVENT HAS HAPPENED,UNLOCK READYQ,E GO TO 4 33588000
D OTHERWISE CALL STATUS AND GO TO A 33589000
3) IF THE READYQ IS NOT EMPTY 33590000
A PUT THIS PROCESS IN EVENT QUEUE 33591000
B UNLOCK EVENT (BY REPLACING FIRST WORD OF EVENT) 33592000
C UNLOCK READYQ 33593000
D MOVE TO NEW JOB 33594000
E ON RETURN PROCESS ANY OUTSTANDING SOFTWARE 33595000
INTERRUPTS 33596000
4) EXIT 33597000
CAUSE ACTION 33598000
1) MOVE WAITQ TO READYQ 33599000
2) CHECK SOFTWARE INTERRUPT COUNT IN FIRST WORD OF EVENT 33600000
IF ZERO GO TO OTHERWISE 33601000
3) FOR EACH STACK IN INTERRUPT QUEUE IN TURN 33602000
A BUZZ SOFTWAREINTERRUPTLOCK 33603000
B IS THE INTERRUPT ENABLED,IF NOT GO TO NEXT STACK33604000
C OTHERWISE ENTER INTERRUPT IN SOFTWAREINTERRUPTQ 33605000
D IF STACK ACTIVE THEN DO A HEYOU 33606000
E UNLOCK SOFTWARE INTERRUPT LOCK 33607000
4) UNLOCK AND SET THE EVENT 33608000
; 33609000
BEGIN 33610000
LABEL LOOKFORNEWPROCESS 33611000
, LOOKFORANOTHER 33612000
; 33613000
EVENT THISEVENT=THEEVENT 33614000
; 33615000
DEFINE NEXTINTERRUPTPCW = 33616000
STACK[(NEXTSNR~NEXTSTACK.STKNRF), 33617000
DISPPCW~NEXTSTACK.DISPF+NEXTSTACK.SIRWDELTAF]# 33618000
33619000
33620000
,UNLOCKEVENT=THEEVENT~EVENTWORD1&FIRSTEVENTWORD(,*,*,33621000
*,*,*,0)# 33622000
, PROCESSINHOLD = REFERENCE(WORD(NEXTSNR))# 33623000
, EVENTWAITQ= EVENTWORD1 # 33624000
; 33625000
WORD EVENTPOINTER=THEEVENT %PREVENTS PARAMETER ACTION 33626000
, NEXTSTACK 33627000
, INTERRUPTPOINTER 33628000
; 33629000
REAL INTERRUPTQCOUNT 33630000
, NEXTSNR 33631000
, DISPPCW = NEXTSTACK 33632000
, MYSNR 33633000
; 33634000
REFERENCE REFERENCEINTERRUPTPOINTER=INTERRUPTPOINTER 33635000
; 33636000
MONITOR JACKMONITOR(WAITFLAG); 33637000
INTEGER IDLETI, REALTI; 33638000
MONITOR DONMONITOR (REALTI, IDLETI); 33639000
MYSNR~SNR; 33640000
IF SIMULATING THEN BEGIN 33641100
WAITFLAG ~ *; 33641200
REALTI ~ REGISTERS[61]; 33642000
IDLETI ~ REGISTERS[62]; 33643000
END; 33643100
IF WAITFLAG 33644000
THEN 33645000
BEGIN%%%%%%%%%%%%%%% %%%MCS 133646000
% WAIT PROCESSING 33647000
SETINTERVALTIMER; 33649000
IF BOOLEAN(EVENTWORD1.HAPPENEDBITF) 33649100
THEN BEGIN UNLOCKEVENT;GO FINI;END; 33649200
LOOKFORNEWPROCESS: BUZZCONTROL(READYQ); 33650000
COMMENT ***** SHOULD THIS BE BUZZ; 33651000
IF NOTHINGTODO 33652000
THEN 33653000
BEGIN%%%%%%%%%%%%%%% %%%MCS 233654000
% READYQ EMPTY 33655000
UNLOCK(READYQ); 33655100
UNLOCKEVENT; 33656000
33657000
33658000
COMMENT *** 33659000
ALLOW; 33660000
COMMENT * * * * SIMULATOR ONLY; PAUSE; 33661000
DISALLOW; 33662000
IF HAPPENED(THISEVENT) 33663000
THEN 33664000
BEGIN%%%%%%%%%%%%%%% %%%MCS 333665000
% CLEAN UP AND GET OUT 33666000
UNLOCK(READYQ); 33667000
33668000
COMMENT THE EVENT IS UNLOCKED WITH FIRST 33669000
WORD RESTORED; 33670000
END %%%%%%%%%%%%%%% %%%MCS 333671000
ELSE LOOKFORSOMETHING; 33672000
END %%%%%%%%%%%%%%% %%%MCS 233682000
ELSE 33683000
BEGIN%%%%%%%%%%%%%%% %%%MCS 533684000
% SEND PROCESS TO SLEEP 33685000
WORDSTACK[MYSNR,EVENTWAITQLINK] 33686000
.FULLINDICATORF~1; 33687000
IF EVENTWORD1.WAITQHEADF=0 33688000
THEN 33689000
%%%%%%%%%%%%%%%%%%%% %%%%%%% 33690000
%FIRST IN QUEUE 33691000
EVENTWORD1.WAITQHEADF~MYSNR 33692000
ELSE 33693000
BEGIN%%%%%%%%%% %%%MCS5133694000
% SECOND AND SUBSEQUENT IN QUEUE 33695000
33696000
WORDSTACK[MYSNR,EVENTWAITQLINK].BACKWARDLINKF~EVENTWORD1.WAITQTAILF; 33697000
WORDSTACK[EVENTWORD1.WAITQTAILF,EVENTWAITQLINK].FORWARDLINKF~MYSNR; 33698000
33699000
33700000
33701000
END; %%%%%%%%%% %%%MCS5133702000
EVENTWORD1.WAITQTAILF~MYSNR; 33703000
UNLOCKEVENT; 33704000
MOVETONEXTINREADYQ; 33705000
COMMENT A READYQ ALGORITAM:DELINKS,UNLOCKS,MOVES; 33706000
COMMENT AT THIS POINT WE LOSE CONTROL SOME LOGGING 33707000
ACTION IS REQUIRED; 33708000
LOOKFORANOTHER: IFTHEREISASOFTWAREINTERRUPT 33709000
THEN 33710000
BEGIN%%%%%%%%%%%%%%% %%%MCS 633711000
HANDLETHESOFTWAREINTERRUPT; 33712000
GO LOOKFORANOTHER; 33713000
END %%%%%%%%%%%%%%% %%%MCS 633714000
END %%%%%%%%%%%%%%% %%%MCS 533715000
END %%%%%%%%%%%%%%% %%%MCS 133716000
ELSE 33717000
BEGIN%%%%%%%%%%%%%%% %%%MCS 733718000
% CAUSE PROCESSING 33719000
IF EVENTWORD1.WAITQHEADF!0 33720000
THEN 33721000
BEGIN%%%%%%%%%%%%%%% %%%MCS 833722000
BUZZCONTROL(READYQ); 33723000
INSERTINQUEUE(WAITI,EVENTWAITQ); 33724000
UNLOCK(READYQ); 33725000
END ; %%%%%%%%%% %%%MCS 833726000
IF INTERRUPTQCOUNT ~ EVENTWORD1.COUNTF!0 33727000
THEN 33728000
BEGIN%%%%%%%%%%%%%%% %%%MCS 933729000
NEXTSTACK~INTERRUPTPOINTER 33730000
~SECONDWORD(THISEVENT) ;33731000
DO 33732000
BEGIN%%%%%%%%%%%%%%% %%%MCS9A33733000
BUZZ(SOFTWAREINTERRUPTLOCK); 33734000
IF BOOLEAN(NEXTINTERRUPTPCW). 33735000
ENABLEBITF 33736000
THEN 33737000
BEGIN%%%%%%%%%%%%%%% %%%MCS1033738000
INTERRUPTPOINTER~INTERRUPTPOINTER&STUFFEDIRW(,,*,*,*); 33739000
INSERT(SOFTWAREINTERRUPTQ,REFERENCEINTERRUPTPOINTER); 33740000
IF WORDSTACK[NEXTSNR,0].TAG = SINGL 33741000
THEN HEYOU 33742000
ELSE IF STACK[NEXTSNR,READYQLINK].FULLINDICATORF=0 33743000
THEN 33744000
BEGIN%%%%%%%%%%%%%%% %%%MCS5033745000
BUZZ(READYQ); 33746000
INSERTINQ(READYQ,DUMMYREF,MYSNR); 33747000
33748000
UNLOCK(READYQ); 33749000
END ;%%%%%%%%%%%%%%% %%%MCS5033750000
END ;%%%%%%%%%%%%%%% %%%MCS1033751000
NEXTSTACK~INTERRUPTPOINTER 33752000
~STACK[NEXTSNR,DISPPCW-1]; 33753000
UNLOCK(SOFTWAREINTERRUPTLOCK); 33754000
END %%%%%%%%%%%%%%% %%%MCS9A33755000
UNTIL INTERRUPTQCOUNT~INTERRUPTQCOUNT-1=0; 33756000
END ;%%%%%%%%%%%%%%% %%%MCS 933757000
THEEVENT~EVENTWORD1&FIRSTEVENTWORD(,*,0,0,*,1,0); 33758000
GO LOOKFORANOTHER; 33759000
END ;%%%%%%%%%%%%%%% %%%MCS 733760000
FINI: 33761000
END EVENTHANDLER; 33762000
SAVE PROCEDURE GAOLER(EVENTT, UNLOCK); 33762100
VALUE UNLOCK; 33762120
EVENT EVENTT; 33762140
BOOLEAN UNLOCK; 33762160
COMMENT THE GAOLER KEEPS THE KEYS TO THE INTERLOCKS; 33762180
BEGIN 33762200
LABEL LOCKUP; 33762220
IF UNLOCK THEN 33762240
BEGIN 33762260
FREE(EVENTT); 33762280
CAUSE(EVENTT); 33762300
END 33762320
ELSE 33762340
LOCKUP: IF FIX(EVENTT) THEN 33762360
BEGIN 33762400
WAIT(EVENTT); 33762420
GO LOCKUP; 33762440
END 33762460
ELSE 33762465
RESET(EVENTT); 33762470
END GAOLER; 33762480
SAVE WORD PROCEDURE SOFTWAREINTERRUPTDEC(THEEVENT,EVENTWORD1,EVENTWORD2,33763000
KLUDGE,PCWPOINTER); 33764000
VALUE EVENTWORD1,EVENTWORD2,PCWPOINTER,KLUDGE; 33765000
WORD THEEVENT, % IRW OR INDEXED DD POINTING TO 33766000
% INTERRUPT EVENT 33767000
EVENTWORD1, % FIRST WORD OF EVENT 33768000
EVENTWORD2, % ZERO USED TO FIX UP SECOND WORD OF 33769000
% EVENT AT FIRST ENTRY 33770000
PCWPOINTER % POINTER TO INTERRUPT PCW (SIRW) 33771000
,KLUDGE % HORRIBLE KLUDGE FOR COMPILER 33772000
; 33773000
COMMENT 33774000
THE ESPOL INTERRUPT DECLARATION PLACES ZERO IN THE FIRST WORD OF 33775000
INTERRUPT AND A PCW REFERENCING THE STATEMENT IN THE SECOND WORD. IT33776000
GENERATES A CALL ON THIS PROCEDURE. 33777000
THIS PROCEDURE LINKS THIS STACK INTO THE INTERRUPT QUEUE BEHIND33778000
THE EVENT AFTER FIRST CHECKING THAT THE STACK IS NOT ALREADY SO 33779000
LINKED (A RUN TIME ERROR IS NOTED IF THIS CHECK FAILS) 33780000
THE INTERRUPT QUEUE IS DERIVED AS FOLLOWS: 33781000
(1) THE EVENT DECLARATION HAS PRODUCED A DOUBLE-LENGTH REAL 33782000
(2) THE FIRST (ENCOUNTERED) INTERRUPT DECLARATION REFERENCING 33783000
THE EVENT CAUSES THE SECOND WORD OF THE EVENT TO POINT TO 33784000
THE INTERRUPT PCW.THE SECOND WORD OF THE EVENT IS NOW 33785000
ESSENTIALLY A STUFFED IRW EXCEPT FOR ITS TAG FIELD. 33786000
(3) THE SECOND AND SUBSEQUENT INTERRUPT DECLARATIONS CAUSE THE33787000
FIRST WORD OF INTERRUPT IN THE STACK AT THE END OF THE 33788000
INTERRUPT QUEUE TO BE CHANGED FROM ZERO TO A STUFFED IRW 33789000
THIS STUFFED IRW POINTS TO THE PCW OF THE NEW 33790000
INTERRUPT DECLARATION. 33791000
; 33792000
BEGIN 33793000
DOUBLE EVENTVALUE=EVENTWORD1 %TWO WORDS OF EVENT STARTING WITH33794000
%EVENTWORD1 33795000
, EVENTPLACE=THEEVENT %THEEVENT INVOKES OVRD.EVENTPLACE33796000
% INVOKES STOD.NOTE NO EVAL FOR 33797000
% EVENTPLACE, HOWEVER STOD CHASES33798000
% IRWS. 33799000
; 33800000
BOOLEAN FIRST % TRUE WHEN FIRST DECLARATION 33801000
; 33802000
INTEGER COUNT % NUMBER OF STACKS IN QUEUE (INC THIS ONE) 33803000
; 33804000
WORD NEXTSTACK % POINTS TO NEXT STACK IN QUEUE 33805000
; 33806000
REAL NEXTSTACKNO 33807000
, DISPSIRW 33808000
, MYSNR 33809000
; 33810000
DEFINE NEXTINTERRUPTSIRW = STACK 33811000
[NEXTSTACKNO 33812000
~NEXTSTACK.STKNRF,33813000
DISPSIRW~NEXTSTACK.DISPF-1 33814000
+ NEXTSTACK.SIRWDELTAF]# 33815000
; 33816000
MYSNR ~ SNR; 33817000
SOFTWAREINTERRUPTDEC~KLUDGE; 33818000
EVENTWORD1.COUNTF ~ COUNT ~ EVENTWORD1.COUNTF+1; 33819000
IF COUNT=1 33820000
THEN 33821000
BEGIN%%%%%%%%%%%%%%% %%%MCS 133822000
% FIRST DECLARATION 33823000
FIRST~TRUE; 33824000
COMMENT *** THIS CODE SLOPPY-OPTIMISE LATER; 33825000
END %%%%%%%%%%%%%%% %%%MCS 133826000
ELSE 33827000
33828000
BEGIN%%%%%%%%%%%%%%% %%%MCS 233829000
% SECOND AND SUBSEQUENT DECS. 33830000
NEXTSTACK~SECONDWORD(EVENTVALUE); 33831000
DO 33832000
BEGIN%%%%%%%%%%%%%%% %%%MCS 333833000
NEXTSTACK ~ NEXTINTERRUPTSIRW; 33834000
33835000
IF MYSNR=NEXTSTACKNO THEN KILLME(INTERRUPTDEC); 33836000
END %%%%%%%%%%%%%%% %%%MCS 333837000
UNTIL (COUNT~COUNT-1)=1; 33838000
STACK[NEXTSTACKNO,DISPSIRW-1] ~ PCWPOINTER; 33839000
END; %%%%%%%%%%%%%%% %%%MCS 233840000
%%%%%%%%%%%%%%% CLEAN UP 33841000
EVENTWORD1.EVENTLOCKBITF~0; 33842000
EVENTWORD1.TAG~DOUBL; 33843000
IF FIRST 33844000
THEN BEGIN 33845000
COMMENT *** (NO GOOD) EVENTWORD2~PCWPOINTER&STUFFEDIRW(DOUBL,*,*,*,*);33846000
PCWPOINTER.TAG~DOUBL;EVENTWORD2~PCWPOINTER; 33847000
THEEVENT~EVENTWORD1; 33848000
COMMENT THIS IS TERRIBLE,DOUBLE TAG SCREWS EVERYTHING; 33849000
EVENTPLACE~EVENTVALUE; 33850000
COMMENT *** OPTIMISE LATER; 33851000
END 33852000
ELSE THEEVENT ~ EVENTWORD1; % INVOKES OVRD 33853000
END SOFTWAREINTERRUPTDEC; 33854000
SAVE PROCEDURE HOLD; 33855000
COMMENT SENDS A PROCESS TO SLEEP. THE PROCESS WILL NOT WAKE UP UNTIL 33856000
A SOFTWARE INTERRUPT IS DIRECTED TO IT 33857000
IF THERE IS NOTHING IN THE READYQ, THE PROCESS ENTERS A 33858000
NOTHING TO DO LOOP (WITH INTERRUPTS ALLOWED). SHOULD A SOFTWARE33859000
INTERRUPTED BE DIRECTED AT IT IN THIS CONDITION, IT WILL BE 33860000
INTERRUPTED BY A HEYOU (HARDWARE) INTERRUPT 33861000
THE HEYOU INTERRUPT WILL TURN ON THE HEYOUINTERRUPT FIELD 33862000
TO INDICATE THE PROCESSING OF THE SOFTWARE INTERRUPT 33863000
33864000
PART OF THE NOTHING TO DO LOOP TESTS THE READYQLINK AND 33865000
THE PROCESS EXITS IF IT IS NON ZERO 33866000
; 33867000
BEGIN 33868000
REAL MYSNR 33869000
; 33870000
LABEL LOOKFORNEWPROCESS 33871000
,FINI 33872000
; 33873000
SETINTERVALTIMER; 33874000
MYSNR~SNR; 33875000
BUZZCONTROL(READYQ); % *** BUZZ 33876000
LOOKFORNEWPROCESS: 33877000
IF NOTHINGTODO 33878000
THEN IF WORDSTACK[MYSNR,LINKPLACE].HEYOUINTERRUPTF!0 33879000
THEN 33880000
BEGIN%%%%%%%%%%%%%%% %%%MCS 133881000
WORDSTACK[MYSNR,LINKPLACE].HEYOUINTERRUPTF~0; 33882000
UNLOCK(READYQ); 33883000
GO FINI; 33884000
END %%%%%%%%%%%%%%% %%%MCS 133885000
ELSE LOOKFORSOMETHING 33886000
ELSE MOVETONEXTONEINREADYQ; 33887000
FINI: 33888000
END HOLD; 33889000
SAVE PROCEDURE HOLDINITIALISE; 33890000
COMMENT THIS PROCEDURE IS ENTERED FROM INITIALISE AND PERFORMS THE 33891000
FOLLOWING FUNCTIONS: 33892000
A.FORGETS SPACE ASSOCIATED WITH INITIALISE 33893000
B.FIXES UP STACK SO THAT RUN WILL BE ENTERED WHEN IT IS 33894000
MOVED TO LATER ON (I.E. IT IS AN INDEPENDENTRUNNER STACK) 33895000
C.ENTERS A NOTHING-TO-DO LOOP 33896000
; 33897000
BEGIN 33898000
INTEGER I 33899000
, STACKNO 33899200
; 33900000
MONITOR JACKMONITOR(IRSTACKS) 33901000
; 33902000
REAL STAKADRES 33903000
, MYSNR 33904000
; 33905000
ARRAY MYSTACK[*]; 33906000
WORD ARRAY MYWORDSTACK = MYSTACK[*]; 33907000
33908000
LABEL FIXUPPROCESSOR 33909000
; 33910000
INTEGER HI % *** FOR MONITOR ONLY 33911000
; 33912000
MONITOR JACKMONITOR(HI) 33913000
; 33914000
HI~HI; % *** FOR MONITOR ONLY 33915000
MYSNR ~ SNR; 33916000
PIRSTACKS~IRSTACKS~SET(IRSTACKS,MYSNR); 33917000
WORDSTACK[MYSNR,PROCESSNATUREPLACE].DEDICATEDSTACKF ~ 1; 33918000
IF NOT LOCK(FIRSTLOK) 33919000
THEN BEGIN %%%MCS000010033920000
PERIPHERALINITIALIZE; 33921000
FORGETSPACE(SAVE1ADDRESS); 33922000
33922500
IF INDEPENDENTRUNNERSTACKS > NUMBEROFPROCESSORS 33923000
THEN 33924000
BEGIN %%%MCS000012533925000
COMMENT WE HAVE TO BUILD SOME MORE INDEPENDENT RUNNER STACKS; 33926000
DISABLEOVERLAY; 33927000
FOR I~NUMBEROFPROCESSORS+1 STEP 1 UNTIL INDEPENDENTRUNNERSTACKS DO 33928000
BEGIN %%%MCS000015033929000
IRSTACKS~SET(IRSTACKS,(STACKNO~GETINDEPENDENTRUNNERSTACK( 33930000
STAKADRES)));33931000
WORDSTACK[STACKNO,LINKPLACE ].DEDICATEDSTACKF ~ 1; 33932000
COMMENT *** 33933000
CHANGESPACE(STAKADRES); 33934000
END; %%%MCS000015033935000
ENABLEOVERLAY; 33936000
END %%%MCS000012533937000
ELSE INDEPENDENTRUNNERSTACKS~I~ 33938000
NUMBEROFPROCESSORS ; 33939000
PIRSTACKS~IRSTACKS~RESET(IRSTACKS,TERMINATESTACK~MYSNR); 33946000
NOTFIRSTWAIT~TRUE; COMMENT *** IS THIS A KLUDGE; 33947000
33948000
END; %%%MCS000010033949000
33950000
MYSTACK~STACK[MYSNR ,*]; 33951000
MYSTACK[COREPLACE]~IRCORE; 33952000
MYSTACK[PROCTIMEPLACE]~IRPROCTIME; 33953000
MYSTACK[IOTIMEPLACE]~IRIOTIME; 33954000
MYWORDSTACK[FIRSTPLACE]~IRTOSCW; 33954100
MYWORDSTACK[FIRSTMSCWPLACE]~IRMSCW1; 33955000
MYWORDSTACK[FIRSTRCWPLACE]~IRRCW1; 33956000
MYWORDSTACK[SECNDMSCWPLACE]~IRMSCW2&MARKSTACKWD(*,*,*,MYSNR 33957000
,*,*,*,*); 33958000
MYWORDSTACK[RETURNCONTROLWORDPLACE]~RUNRETURNCONTROLWORD; 33959000
LASTNOTAVAILABLEINVECTOR~(FIRSTAVAILABLEINVECTOR~FIRSTONE 33959020
(IRSTACKS))-1; 33959040
FORK(DIRECTORYCOMPLEMENT, SYSTEMDIRECTORY); 33959060
HOLD; 33959200
END HOLDINITIALISE; 33960000
SAVE 33960100
INTEGER PROCEDURE GETINDEPENDENTRUNNERSTACK(STAKADRES); 33961000
REAL STAKADRES 33962000
; 33963000
BEGIN 33964000
INTEGER NEWSTACK 33965000
; 33967000
INTEGER GIR ; % ***FOR MONITOR ONLY 33970000
MONITOR JACKMONITOR(GIR); 33971000
STAKADRES~GETSPACE ( INDEPENDENTRUNNERCORE 33973000
, 0 33974000
, 0&SPACETYPE(1,1,1,0) 33975000
, 0 33976000
) 33977000
; 33978000
GIR~STAKADRES; %*** FOR MONITOR ONLY 33979000
M[STAKADRES-LINKSIZE].INUSEID~NEWSTACK~ 33980000
GETINDEPENDENTRUNNERSTACK ~ 33981000
VECTORINSERT ( GETIRS 33982000
, DUMMYAREA & DATADESCRIPTOR 33983000
(*,1,0,0,0,0,0,0 33984000
,INDEPENDENTRUNNERCORE 33985000
,STAKADRES 33986000
) 33987000
) ; 33988000
M[STAKADRES-LINKSIZE+1].ADDRMOM ~ STACKVECTOR.ADDRESSF 33989000
+ NEWSTACK; 33990000
INITIALIZETOZERO(STAKADRES,INDEPENDENTRUNNERCORE); 33991000
LOADFIXEDIRSTACK(NEWSTACK); 33992000
UNLOCK(READYQ); 33993000
UNLOCK(VECTORLOK[1]); 33993100
END GETINDEPENDENTRUNNERSTACK; 33994000
33995000
SAVE PROCEDURE INDEPENDENTRUNNER(INDEX,PAR); 33996000
VALUE INDEX,PAR; 33997000
REAL INDEX; 33998000
WORD PAR; 33999000
BEGIN 34000000
INTEGER STACKNO 34001000
; 34002000
WORD ARRAY IRWORDSTACK [*]; 34002020
ARRAY IRSTACK=IRWORDSTACK[*] ; 34002040
BOOLEAN NEWSTACK 34002100
; 34002200
DEFINE MYSNR = SNR # 34002300
; 34002400
INTEGER IR; % ***FOR MONITOR ONLY 34003000
MONITOR JACKMONITOR(IR); 34004000
IR~INDEX; %*** FOR MONITOR ONLY 34005000
IR~PAR; %*** FOR MONITOR ONLY 34006000
BUZZCONTROL(INDEPENDENTRUNNERLOK); 34007000
IF INDEX=TERMINATEINDICATOR AND STACK[SNR,PROCESSNATUREPLACE] 34007200
.PROCESSHISTORYF =TERMINATEIR 34007400
THEN BEGIN %%%MCS000050034007600
UNLOCK(INDEPENDENTRUNNERLOK); 34007620
STACKINUSE[INDEX]~0 ; 34007700
IR~STACKINUSE[TERMINATEINDICATOR]; %*** FOR MONITOR ONLY 34007710
GO FINI; 34007800
END; %%%MCS000050034007900
BUZZCONTROL(IRPARAMETERLOK[INDEX]); 34007910
IF(NEWSTACK~(INDEX<ONEONLYINDEX OR((STACKNO~STACKINUSE[INDEX]) 34008000
=0))) 34009000
34010000
THEN 34011000
BEGIN %%%MCS000100034012000
COMMENT WE HAVE TO GET A NEW STACK; 34013000
UNLOCK(IRPARAMETERLOK[INDEX]); 34013100
IF INDEX=TERMINATEINDICATOR 34014000
THEN BEGIN %%%MCS000080034015000
STACKNO ~ TERMINATESTACK; 34015200
GO TO FIXEDSTACKS; 34015400
END %%%MCS000080034015600
ELSE 34016000
IF STACKNO~FIRSTONE(IRSTACKS)=0 34017000
THEN 34018000
34019000
COMMENT WE HAVE TO BUILD A NEW STACK; 34020000
BEGIN %%%MCS000200034021000
STACKNO~GETINDEPENDENTRUNNERSTACK(STACKNO);34022000
34023000
34024000
34025000
END %%%MCS000200034026000
ELSE 34027000
BEGIN %%%MCS000300034028000
IRSTACKS~RESET(IRSTACKS,STACKNO~STACKNO-1); 34029000
FIXEDSTACKS: REPLACE POINTER(STACK 34029200
[STACKNO,RETURNCONTROLWORDPLACE+1] 34029400
) BY 0 FOR INDEPENDENTRUNNERCORE 34029600
- RETURNCONTROLWORDPLACE -1 34029800
OVERWRITE; 34030000
END ; %%%MCS000300034030200
IRSTACK ~ STACKVECTOR[STACKNO]; 34031000
IRWORDSTACK[ FIRSTPLACE]~IRTOSCW; 34031200
IRWORDSTACK [IRPARAMETERPLACE]~PAR; 34031500
IRWORDSTACK [IRPCWPLACE]~0&NORMALIRW(,,IRPCWSTARTPLACE+INDEX); 34032000
PUTINJOBIDANDTIME(IRWORDSTACK ,STACKNO); 34032500
IRWORDSTACK [SECNDMSCWPLACE]~IRMSCW2&MARKSTACKWD(*,*,*,STACKNO,34033000
*,*,*,*); 34033500
IRWORDSTACK [RETURNCONTROLWORDPLACE]~ RUNRETURNCONTROLWORD; 34034000
IRSTACK [PRIORITYPLACE]~ IRPRIORITIES[INDEX]; 34034500
IRSTACK [PROCESSNATUREPLACE]~*&NATUREOFPROCESS(IF INDEX = 34035000
TERMINATEINDICATOR THEN TERMINATEIR ELSE INDEPENDENT, 34035500
INDEX);34035800
IRSTACK [STACKSIZEPLACE]~INDEPENDENTRUNNERCORE; 34036000
COMMENT *** WE SHOULD USE DIFFERENT STACK SIZES FOR DIFFERENT IR S; 34036200
END ELSE UNLOCK(IRPARAMETERLOK[INDEX]); %%%MCS000100034036500
IF INDEX } ONEONLYINDEX THEN 34037000
BEGIN %%%MCS000400034038000
BUZZCONTROL(IRPARAMETERLOK[INDEX]); 34039000
STACK[STACKNO,IRPARAMETERPLACE]~*+1; 34040000
UNLOCK(IRPARAMETERLOK[INDEX ]); 34041000
34042000
END ; %%%MCS000400034043000
STACKINUSE[INDEX ]~STACKNO; 34043100
IF INDEX = TERMINATEINDICATOR THEN 34043200
BEGIN %%%MCS000500034043300
BUZZCONTROL(IRPARAMETERLOK[TERMINATEINDICATOR]); 34043400
INSERTINQ(TERMINATEQ,DUMMYREF,MYSNR ); 34043500
UNLOCK(IRPARAMETERLOK[TERMINATEINDICATOR]); 34043600
END ; %%%MCS000500034043700
UNLOCK(INDEPENDENTRUNNERLOK); 34044000
BUZZCONTROL(READYQ); 34045200
IF NEWSTACK THEN 34046000
INSERTINQUEUE(OTHERREDY,STACKNO); 34047000
FINI: 34047200
UNLOCK(READYQ); 34048000
EXIT; 34048100
END INDEPENDENTRUNNER; 34049000
SAVE 34050000
PROCEDURE RUN (PARAMETER,PROCEEDURE); 34051000
VALUE PARAMETER 34052000
; 34053000
WORD PARAMETER 34054000
; 34055000
PROCEDURE PROCEEDURE 34056000
; 34057000
COMMENT INDEPENDENT RUNNER STACKS, INITIATE STACKS AND JOB (D2) STACKS 34058000
ALL EXIT TO RUN AFTER A MVST TAKES THEM OUT OF THE READYQ FOR 34058020
THE FIRST TIME 34058040
RUN DETERMINES (FROM "NATURE OF PROCESS" IN THE PROCESS 34058060
STACK) WHETHER INITIATE, AN INDEPENDENT RUNNER OR A NORMAL 34058080
STATE PROGRAM (WHICH MAY BE A TYPED OR UNTYPED PROCEDURE 34058100
REQUIRING OR NOT REQUIRING PARAMETERS) IS TO BE ENTERED 34058120
UPON RETURN TO RUN (AT EXIT OR RETURN FROM THE CALLED 34058140
PROCEDURE), RUN TAKES APPROPRIATE ACTION AS REQUIRED BY 34058160
COMPILERS, DIFFERENT INDEPENDENT RUNNERS ETC. AND THEN CALLS 34058180
TERMINATE 34058200
; 34059000
BEGIN 34059200
REAL PROCESSNATUR 34059300
, RESULT 34059400
, TEMPORARY = RESULT 34059500
, MYSNR 34059600
; 34060000
DEFINE COMPILER = PROCESSNATUR 34060200
.PROCESSHISTORYF!INDEPENDENT AND 34060220
(TEMPORARY~PROCESSNATUR.PROCESSCLASSF)34060240
}FIRSTCOMPILEROPTION AND 34060260
TEMPORARY{LASTCOMPILEROPTION# 34060400
, IFINDEPENDENTRUNNER 34060600
= IF (PROCESSNATUR~MYSTACK[PROCESSNATUREPLACE]) 34060800
.PROCESSHISTORYF=INDEPENDENT 34060802
OR PROCESSNATUR.PROCESSHISTORYF=TERMINATEIR34060805
OR PROCESSNATUR.INITIATESTACKF=1# 34060810
, SYNTAXTOG = PROCESSNATUR.PROCESSCLASSF= 34060820
COMPILENSYNTAXJOB# 34060830
; 34061000
ARRAY MYSTACK[*] 34061200
; 34062000
REAL PROCEDURE REALPROCEEDURE=PROCEEDURE;NULL; 34062010
INTEGER GALLOP ; % *** FOR MONITOR ONLY 34064740
MONITOR JACKMONITOR(GALLOP); 34064760
GALLOP~TRACE(0); 34064800
MYSTACK~STACKVECTOR[MYSNR~SNR]; 34065000
LOSR~MYSTACK[STACKSIZEPLACE]-STACKOFLOWSIZE; 34065200
IFINDEPENDENTRUNNER 34066000
THEN 34066020
BEGIN %%%MCS000100034066040
PROCEEDURE(PARAMETER); 34066200
END %%%MCS000100034066800
ELSE 34066900
BEGIN %%%MCS000150034067000
BOJMESSER(MYSNR); 34067200
IF COMPILER 34067400
THEN 34067600
BEGIN %%%MCS000200034067800
RESULT~REALPROCEEDURE(SYNTAXTOG);34068000
END %%%MCS000200034070600
ELSE 34070800
BEGIN %%%MCS000300034071000
COMMENT WE HAVE A PROGRAM WITH NO PARAMETERS; 34071200
PROCEEDURE; 34071400
END; %%%MCS000300034072800
EOJMESSER(MYSNR); 34073000
END; %%%MCS000150034074000
COMMENT *** 5 MARCH 1969, THE ABOVE CODE WILL HAVE TO BE EXPANDED TO 34074010
CATER FOR MORE EXTENSIVE TREATMENT OF COMPILERS AND PROGRAMS AS34074020
(TYPED OR UNTYPED) PROCEDURES. ALSO THE FOLLOWING TERMINATE 34074040
CODE MAY REQUIRE ALTERING 34074060
; 34074080
FORK(TERMINATE,0); 34075000
IF SIMULATING THEN 34075010
GALLOP~GALLOP; %*** FOR MONITOR ONLY 34075100
TRACE(GALLOP); 34075200
HOLD; 34076000
END RUN ; 34077000
SAVE PROCEDURE IRTEST(IND); INTEGER IND; 34077200
BEGIN 34078000
MONITOR JACKMONITOR(IND); 34079000
REAL MYSNR; 34080000
REAL OLDTIME; 34080100
MONITOR JACKMONITOR(MYSNR); 34081000
IND~IND; %*** FOR MONITOR ONLY 34082000
MYSNR~SNR; %*** FOR MONITOR ONLY 34083000
DO BEGIN 34083100
IF(OLDTIME~OLDTIME+1) MOD 10 = 0 THEN 34083200
FORK(STATUS,0); 34083300
WAIT(TIMERINTERRUPTEVENT); 34083400
END UNTIL FALSE; 34083500
HOLD; 34084000
END IRTEST; 34085000
SAVE 34085300
34085310
PROCEDURE LOADFIXEDIRSTACK(STACKNO); 34086000
VALUE STACKNO ; 34087000
INTEGER STACKNO 34088000
; 34089000
COMMENT PUTS THE FIRST (TOSCW),SECOND (SELF IDENTIFYING MSCW) WORDS 34090000
IN AN INDEPENDENT RUNNER STACK.PUTS THE RUN RETURN CONTROL 34091000
WORD AND THE PROCESS INFORMATION WHICH IS FIXED FOR ALL 34092000
INDEPENDENT RUNNERS I.E. CORE ESTIMATE,PROCESSOR TIME 34093000
ESTIMATE,I/O TIME ESTIMATE.PUTS IN SOME OTHER CONTROL WORDS 34094000
; 34095000
BEGIN 34096000
INTEGER LFI = STACKNO % *** FOR MONITOR ONLY 34097000
; 34098000
MONITOR JACKMONITOR(LFI) 34099000
; 34100000
ARRAY MYSTACK[*]; 34101000
WORD ARRAY MYWORDSTACK =MYSTACK[*] 34102000
; 34103000
LFI~LFI; % *** FOR MONITOR ONLY 34104000
MYSTACK~STACK[STACKNO,*]; 34105000
MYWORDSTACK[FIRSTPLACE]~IRTOSCW; 34106000
MYWORDSTACK[LINKPLACE]~0&MARKSTACKWD(,*,1,STACKNO,*,*,*,*); 34107000
34110100
MYWORDSTACK[FIRSTMSCWPLACE]~IRMSCW1; 34111000
MYWORDSTACK[FIRSTRCWPLACE]~IRRCW1; 34112000
EXIT; 34115100
END LOADFIXEDIRSTACK; 34116000
PROCEDURE CONTROLCARD (PARAMETER); 38000000
WORD PARAMETER; 38001000
BEGIN COMMENT CONTROL CARD PROCESSES THE EBCDIC RECORD AS 38002000
DESCRIBED BY THE AREA DESCRIPTOR OF THE IOCB AND38003000
READS ADDITIONAL RECORDS UNTIL A "LABEL", "DATA"38004000
OR "END" IS ENCOUNTERED. WHILE A CONTROL DECK 38005000
IS BEING PROCESSED, THE UNIT OF THE IOCB IS 38006000
ASSIGNED TO THE CONTROL CARD PROCEDURE. THE 38007000
FINAL OUTPUT OF CONTROLCARD IS ONE OR MORE SHEET38008000
ENTRIES OR AN ASSIGNMENT OF A LABEL TO A UNIT. 38009000
;38010000
REFERENCE IOCB =PARAMETER; 38011000
INTEGER UNITNO = PARAMETER; 38012000
VALUE ARRAY RESERVED ~ (0,0,0,0,0,0,0,0,0,0,0,0,0,0, 8"UNKNOWNID", 0 38013000
, 8"# " , 114800 % CLASS 148 38014000
, 8". " , 114600 % CLASS 146 38015000
, 8"~ " , 114100 % CLASS 141 38016000
, 8"- " , 114500 % CLASS 145 38017000
, 8"; " , 114300 % CLASS 143 38018000
, 8"/ " , 114700 % CLASS 147 38019000
, 8", " , 114200 % CLASS 142 38020000
,40"7F4040404040", 114400 % QUOTE MARK CLASS 144 38021000
,40"6F4040404040", 114100 % QUEST MARK CLASS 141 38022000
, 8"ALGOL " , 505202 % CLASS 52 CASE 2 38023000
, 8"ALPHA " , 513600 % CLASS 136 38024000
, 8"BACKUP" , 608900 % CLASS 89 38025000
, 8"CC " , 214000 % CLASS 140 38026000
, 8"CHANGE" , 600701 % CLASS 7 CASE 1 38027000
, 8"COBOL " , 506502 % CLASS 65 CASE 2 38028000
, 8"COMMON" , 603902 % CLASS 39 CASE 2 38029000
, 8"COMPILE" , 700301 % CLASS 3 CASE 1 38030000
, 8"CORE " , 404002 % CLASS 40 CASE 2 38031000
, 8"DATA " , 400801 % CLASS 8 CASE 1 38032000
, 8"DATAB " , 501401 % CLASS 14 CASE 1 38033000
, 8"DISK " , 407900 % CLASS 79 38034000
, 8"DISPLAY" , 708300 % CLASS 83 38035000
, 8"DUMP " , 400601 % CLASS 6 CASE 1 38036000
, 8"END " , 302401 % CLASS 24 CASE 1 38037000
, 8"ESPOL " , 505402 % CLASS 54 CASE 2 38038000
, 8"EXECUTE" , 700201 % CLASS 2 CASE 1 38039000
, 8"EXTERNAL" , 806600 % CLASS 66 38040000
, 8"FILE " , 403502 % CLASS 35 CASE 2 38041000
, 8"FORM " , 413700 % CLASS 137 38042000
, 8"FORTRAN" , 705302 % CLASS 53 CASE 2 38043000
, 8"FREE " , 401201 % CLASS 12 CASE 1 38044000
, 8"GO ", 206900 % CLASS 69 38045000
, 8"IO " , 203702 % CLASS 37 CASE 2 38046000
, 8"LIBRARY" , 706700 % CLASS 67 38047000
, 8"LOAD " , 400501 % CLASS 5 CASE 1 38048000
, 8"PAPER " , 508600 % CLASS 86 38049000
, 8"PRINT " , 508700 % CLASS 87 38050000
, 8"PRIORITY" , 803802 % CLASS 38 CASE 2 38051000
, 8"PROCESS" , 703602 % CLASS 36 CASE 2 38052000
, 8"PROTECT" , 711200 % CLASS 112 38053000
, 8"PUBLIC" , 601301 % CLASS 13 CASE 1 38054000
, 8"PUNCH " , 508500 % CLASS 85 38055000
, 8"RANDOM" , 612500 % CLASS 125 38056000
, 8"READER" , 608800 % CLASS 88 38057000
, 8"RELEASE" , 701101 % CLASS 11 CASE 1 38058000
, 8"REMOTE" , 608400 % CLASS 84 38059000
, 8"REMOVE" , 600401 % CLASS 4 CASE 1 38060000
, 8"RUN " , 300101 % CLASS 1 CASE 1 38061000
, 8"SAVE " , 411100 % CLASS 111 38062000
, 8"SERIAL" , 612300 % CLASS 123 38063000
, 8"SPECIAL" , 710000 % CLASS 100 38064000
, 8"STACK " , 504102 % CLASS 41 CASE 2 38065000
, 8"SYNTAX" , 606800 % CLASS 68 38066000
, 8"TAPE7 " , 508100 % CLASS 81 38067000
, 8"TAPE9 " , 508200 % CLASS 82 38068000
, 8"TAPE " , 408000 % CLASS 80 38069000
, 8"UNIT " , 413800 % CLASS 138 38070000
, 8"UNLABELED" , 913900 % CLASS 139 38071000
, 8"UPDATE" , 612400 % CLASS 124 38072000
, 8"USER " , 401001 % CLASS 10 CASE 1 38073000
, 8"USE " , 300901 % CLASS 9 CASE 1 38074000
); 38075000
DEFINE 38076000
RUNCLS = 1#, 38077000
EXECUTECLS = 2#, 38078000
COMPILECLS = 3#, 38079000
REMOVECLS = 4#, 38080000
LOADCLS = 5#, 38081000
DUMPCLS = 6#, 38082000
CHANGECLS = 7#, 38083000
DATACLS = 8#, 38084000
USECLS = 9#, 38085000
USERCLS = 10#, 38086000
RELEASECLS = 11#, 38087000
FREECLS = 12#, 38088000
PUBLICCLS = 13#, 38089000
DATABCLS =14#, 38090000
ENDCLS = 24#, 38091000
FILECLS = 35#, 38092000
PROCESSCLS = 36#, 38093000
IOCLS = 37#, 38094000
PRIORITYCLS = 38#, 38095000
COMMONCLS = 39#, 38096000
CORECLS = 40#, 38097000
STACKCLS = 41#, 38098000
ALGOLCLS = 52#, 38099000
FORTRANCLS = 53#, 38100000
ESPOLCLS = 54#, 38101000
COBOLCLS = 65#, 38102000
EXTERNALCLS = 66#, 38103000
LIBRARYCLS = 67#, 38104000
SYNTAXCLS = 68#, 38105000
GOCLS = 69#, 38106000
DISKCLS = 79#, 38107000
TAPECLS = 80#, 38108000
TAPE7CLS = 81#, 38109000
TAPE9CLS = 82#, 38110000
DISPLAYCLS = 83#, 38111000
REMOTECLS = 84#, 38112000
PUNCHCLS = 85#, 38113000
PAPERCLS = 86#, 38114000
PRINTCLS = 87#, 38115000
READERCLS = 88#, 38116000
BACKUPCLS = 89#, 38117000
SPECIALCLS = 100#, 38118000
SAVECLS = 111#, 38119000
PROTECTCLS = 112#, 38120000
SERIALCLS = 123#, 38121000
UPDATECLS = 124#, 38122000
RANDOMCLS = 125#, 38123000
ALPHACLS = 1346, 38124000
FORMCLS = 137#, 38125000
UNITCLS = 138#, 38126000
UNLABELEDCLS = 139#, 38127000
CCCLS = 140#, 38128000
QUESTIONCLS = 141#,% ~ 38129000
COMMACLS = 142#,% , 38130000
SEMICOLONCLS = 143#,% ; 38131000
QUOTECLS = 144#,% " 38132000
HYPHENCLS = 145#,% - 38133000
PERIODCLS = 146#,% . 38134000
SLASHCLS = 147#,% / 38135000
CROSSHATCHCLS = 148#,% # 38136000
UNKNOWNIDCLS = 0#; 38137000
INTEGER MYCOMMON; %%%%% 38138000
ARRAY SEGZERO [SIZE(SHEETQ)]; 38139000
COMMENT SEGMENT ZERO WILL BE READ INTO THIS ARRAY AND 38140000
THE SHEET WILL BE BUILT IN THE ARRAY AND A REF- 38141000
ERENCE TO THE ARRAY WILL BE ENTERED IN THE 38142000
SHEET.; 38143000
ARRAY SEGZEROSKELETON [SIZE(SHEETQ)]; 38144000
ARRAY SEGZEROTEMP [*] ; %%%%%% 38145000
COMMENT PRESERVE FOR LOOPING; 38146000
WORD SEGZEROWORD = SEGZEROSKELETON; 38147000
WORD ARRAY HEADERW [*]; COMMENT THE DISK HEADER RETURNED BY 38148000
DIRECTORYSEARCH BASED ON NAME POINTER;38149000
ARRAY SOURCEAREA [15], 38150000
COMMENT THE AREA DESCRIPTOR OF THE IOCB.; 38151000
ACCUMULATOR [13]; 38152000
COMMENT THE FIRST 14 WORDS OF THE RESERVED ARRAY. USED 38153000
AS A TEMPORARY HOLDING AREA FOR CONTROL CARD 38154000
SYNTACTICAL UNITS AND THE RESERVED SEARCH 38155000
ARGUMENT (AND STOPPER).; 38156000
REAL RESULT COMMENT AN I/O RESULT DESCRIPTOR; 38157000
, FILEID COMMENT WAITIO CALLS IT "USER"; 38158000
,ACTION COMMENT WAITIO CALLS IT " IOERRORMASK"; 38159000
,CONTROLWORD 38160000
; 38161000
INTEGER COUNT, COMMENT A UTILITY CHARACTER COUNTER.; 38162000
LIMIT, COMMENT THE CHARACTERS OF A RECORD THAT ARE38163000
TO BE SCANNED.; 38164000
WORDDIVCHARSIZE, COMMENT THE NUMBER OF CHARACTERS IN 38165000
A WORD.; 38166000
T, COMMENT TEMPORARY; 38167000
LABELTYPE, 38168000
ORIGINALLIMIT, COMMENT THE NUMBER OF CHARACTERS IN A 38169000
RECORD.; 38170000
RESERVECASE, 38171000
CLASS, 38172000
WORDCOUNT; COMMENT THE NUMBER OF WORDS REQUIRED TO 38173000
CONTAIN AN IDENTIFIER.; 38174000
WORD WORDMON; %%%%%%%%%%%%% 38175000
REFERENCE SOURCEREFERENCE = SOURCEAREA, 38176000
SUCCESSORSHEET, PREDECESSORSHEET; 38177000
COMMENT REFERENCES TO THE SHEET ENTRIES FOR THE 38178000
PROCESSES THAT ARE DIRECTLY RELATED TO THE 38179000
PROCESS REFERENCED BY SEGZERO.; 38180000
ARRAY SUCCESSOR = SUCCESSORSHEET [*], 38181000
PREDECESSOR = PREDECESSORSHEET [*]; 38182000
POINTER ACCUMPOINTER, COMMENT A POINTER TO THE ACCUMULATOR.; 38183000
SOURCE, COMMENT THE SOURCE AREA - MAY BE UPDATED.; 38184000
ORIGINALSOURCE, COMMENT SOURCE-MAY NOT BE UPDATED; 38185000
DESTINATION, COMMENT - DITTO FOR ACCUMULATOR.; 38186000
TSOURCE, COMMENT - USUALLY POINTS AT BEGINNING OF 38187000
LAST ENTITY SCANNED.; 38188000
NAMEPOINTER; COMMENT POINTS TO COMPLETE NAME 38189000
CHARACTER STRING.; 38190000
BOOLEAN SPECIAL, COMMENT TRUE WHILE A SPECIAL CHARACTER IS38191000
TO BE SCANNED.; 38192000
ALFA, COMMENT TRUE IF IDENTIFIER TYPE STUFF IS 38193000
BEING SCANNED.; 38194000
ENDOFRECORD, COMMENT TRUE IF LIMIT HAS BEEN REACHED 38195000
OR "." HAS BEEN SEEN.; 38196000
CONVERT, COMMENT WHEN TRUE THE SCANNER ATTEMPTS TO 38197000
LEAVE A CONVERTED INTEGER IN ACCUMULATOR[0].; 38198000
COMPILER, COMMENT TRUE WHEN "COMPILE" HAS BEE SEEN;38199000
EXECUTESHEET, COMMENT TRUE WHEN EXECUTE SHEET ENTRY 38200000
(IMPLICIT OR EXPLICIT) IS TO BE 38201000
ENTERED IN THE SHEET QUEUE.; 38202000
SHEETENTERED; COMMENT TRUE WHEN SEGZERO HAS BEEN 38203000
ENTERED IN THE SHEETQ.; 38204000
LABEL CCERROR, 38205000
NATURALDEATH, 38206000
NEWLIFE, 38207000
EXECUTE, 38208000
DATA, 38209000
SUICIDE; 38210000
DEFINE CONTROLCARDIO = 38211000
BEGIN 38212000
SOURCEAREA [0] ~ CONTROLWORD; 38213000
RESULT ~ WAITIO (SOURCEAREA, FILEID, ACTION); 38214000
LIMIT ~ORIGINALLIMIT; 38215000
SOURCE ~ ORIGINALSOURCE; 38216000
CONTROLCARDCHECK; 38217000
END #, 38218000
CONTROLCARDCHECK = 38219000
IF BOOLEAN (RESULT.RDNOTREADY) THEN GO SUICIDE; %STATUS VECTOR KLUDGE 38220000
COMMENT - WAIT ON MPX 38220100
IF NOT BOOLEAN (RESULT.RDCNTRLCARD) 38221000
THEN CONTROLCARDERROR (2); 38222000
#, 38223000
CONVERTEDINTEGER = 999#, 38224000
CHARSIZE = 8#, 38225000
QUOTE = 8 """#, 38226000
BLANK = 8 " "#, 38227000
A =8"A"#, 38228000
ZERO = 8"0"#, 38229000
DEBLANK (P) = 38230000
BEGIN 38231000
SCAN P:P FOR T:LIMIT WHILE = BLANK; 38232000
ENDOFRECORD ~ LIMIT ~ T =0; 38233000
END #, 38234000
BLANKIT (PTR, CHARS) = 38235000
REPLACE PTR BY BLANK FOR CHARS#, 38236000
CONTROLCARDERROR (WHICH) = 38237000
BEGIN 38238000
GO TO CCERROR; 38239000
END #, 38240000
LEQACTION = 0#, 38241000
CARDACTION =1#, 38242000
CODEACTION =2#, 38243000
NATUREOFPROCESS(A, V) = 38244000
A[PROCESSNATUREPLACE].PROCESSCLASSF ~ V #, 38245000
CURRENTTIME = TIMEOFDAY#, %%%%%%%%% 38246000
FIXEDFPBSIZE = 4#, 38247000
COMPARE (SOURCE, DESTINATION, COUNT) = 38248000
IF SOURCE = DESTINATION FOR COUNT 38249000
THEN TRUE ELSE FALSE#, 38250000
MOVE (SOURCE , DESTINATION , CONDITION) = 38251000
REPLACE DESTINATION BY SOURCE CONDITION #, 38252000
MOVEUPDATE (SOURCE , DESTINATION , COND) = 38253000
REPLACE DESTINATION:DESTINATION BY 38254000
SOURCE:SOURCE COND #, 38255000
RESERVEINFOWRD = 38256000
RESERVED [RESERVEI+((COUNT+WORDDIVCHARSIZE) DIV 38257000
WORDDIVCHARSIZE - 38258000
(IF COUNT MOD WORDDIVCHARSIZE=0 THEN 1 ELSE 0))]#38259000
, 38260000
RANGE (LOW, HIGH) = 38261000
(CLASS } LOW AND CLASS { HIGH)#, 38262000
COUNTDIV = 100000#, 38263000
CLASSDIV = 100#, 38264000
RESERVECOUNT = RESERVEINFOWRD DIV COUNTDIV#; 38265000
FIELD VECTOR = 7:3, 38266000
WHICHUNIT = (UNITNO MOD 32+1):1; 38267000
MONITOR DONMONITOR ( 38268000
SHEETENTERED, 38269000
RESULT, 38270000
CLASS); 38271000
SAVE INTEGER PROCEDURE SCANNER; 38272000
BEGIN 38273000
INTEGER RESERVEI 38274000
; 38275000
REAL DELIMIT 38276000
, MASK ~3"7777777777777777" 38277000
, RESERVEINFO 38278000
; 38279000
LABEL BACK 38280000
, AWAY 38281000
; 38282000
BOOLEAN FIRSTQUOTE 38283000
, FOUND 38284000
; 38285000
FIELD FIRSTCHAR = 47:CHARSIZE; 38286000
BACK: DESTINATION ~ ACCUMPOINTER; 38287000
MOVE (BLANK, DESTINATION, FOR WORDDIVCHARSIZE); 38288000
TSOURCE ~ SOURCE; 38289000
IF SPECIAL ~ SOURCE < A FOR 1 38290000
THEN MOVEUPDATE (SOURCE, DESTINATION, FOR 1) 38291000
ELSE IF ALFA ~ SOURCE < ZERO FOR 1 OR FIRSTQUOTE 38292000
THEN MOVEUPDATE (SOURCE, DESTINATION, 38293000
FOR COUNT:LIMIT UNTIL { QUOTE) 38294000
ELSE IF CONVERT 38295000
THEN BEGIN 38296000
SCAN SOURCE FOR COUNT:LIMIT UNTIL < QUOTE; 38297000
COUNT ~ LIMIT - COUNT; 38298000
LIMIT ~ LIMIT - COUNT; 38299000
ACCUMULATOR [0] ~ INTEGER (SOURCE, COUNT); 38300000
SOURCE ~ SOURCE + COUNT; 38301000
DEBLANK (SOURCE); 38302000
RETURN (CONVERTEDINTEGER); 38303000
END 38304000
ELSE MOVEUPDATE (SOURCE, DESTINATION, 38305000
FOR COUNT:LIMIT UNTIL { QUOTE); 38306000
COUNT ~ IF SPECIAL THEN 1 ELSE LIMIT - COUNT; 38307000
LIMIT ~ LIMIT - COUNT; 38308000
IF FIRSTQUOTE 38309000
THEN BEGIN 38310000
IF SOURCE ! QUOTE FOR 1 38311000
THEN BEGIN COMMENT FINISH THE STRING; 38312000
T ~ LIMIT - COUNT; 38313000
LIMIT ~ * - T; 38314000
MOVEUPDATE (SOURCE, DESTINATION, 38315000
FOR COUNT:LIMIT UNTIL = QUOTE); 38316000
COUNT ~ LIMIT - COUNT + T; 38317000
LIMIT ~ * - COUNT - 1; 38318000
END ELSE LIMIT ~ COUNT - 1; 38319000
SOURCE ~ SOURCE +1; 38320000
RESERVEI ~ 0; 38321000
END; 38322000
IF COUNT > 17 THEN COUNT ~ 17; % USASI 38323000
WORDCOUNT ~ (COUNT + WORDDIVCHARSIZE - 1) DIV WORDDIVCHARSIZE; 38324000
IF FIRSTQUOTE THEN GO AWAY; 38325000
RESERVEI ~ MASKSEARCH (RESERVED[0], MASK, RESERVED); 38326000
IF COUNT > WORDDIVCHARSIZE 38327000
THEN WHILE RESERVEI > 0 AND NOT FOUND 38328000
DO BEGIN 38329000
FOUND ~ COMPARE (ACCUMPOINTER+WORDDIVCHARSIZE, 38330000
POINTER(RESERVED[RESERVEI+1], CHARSIZE), 38331000
COUNT - WORDDIVCHARSIZE); 38332000
FOUND ~ FOUND AND COUNT = RESERVECOUNT; 38333000
IF NOT FOUND 38334000
THEN RESERVEI ~ MASKSEARCH (ACCUMULATOR[0], 38335000
MASK, 38336000
RESERVED & DATADESCRIPTOR 38337000
(,,,1,,,,,RESERVEI-1)); 38338000
END; 38339000
AWAY: DEBLANK (SOURCE); 38340000
RESERVEINFO ~ IF RESERVEI = 0 THEN 0 38341000
ELSE RESERVEINFOWRD MOD COUNTDIV; 38342000
CLASS ~ RESERVEINFO DIV CLASSDIV; 38343000
RESERVECASE ~ RESERVEINFO MOD CLASSDIV; 38344000
IF CLASS } CCCLS THEN 38345000
BEGIN 38346000
CASE CLASS - CCCLS OF 38347000
BEGIN 38348000
CLASS ~ QUESTIONCLS; % CC 38349000
; % QUESTION MARK 38350000
GO BACK; % , 38351000
CLASS ~ QUESTIONCLS; % ; 38352000
BEGIN % " 38353000
FIRSTQUOTE ~ TRUE; 38354000
GO BACK; 38355000
END; 38356000
BEGIN % - 38357000
CONTROLCARDIO; 38358000
DEBLANK (SOURCE); 38359000
GO BACK; 38360000
END; 38361000
ENDOFRECORD ~ TRUE; % . 38362000
; % / 38363000
; % # 38364000
END SPECIAL CHARACTER CASES; 38365000
END; 38366000
SCANNER ~ CLASS; 38367000
END SCANNER; 38368000
SAVE POINTER PROCEDURE NAMES (CALLER); 38369000
VALUE CALLER; 38370000
INTEGER CALLER; 38371000
BEGIN 38372000
REFERENCE THISNAME; 38373000
POINTER ANAME, ALLNAMEPTR, P; 38374000
ARRAY ONENAME, ALLNAMES, DUMMY [*]; 38375000
FIELD CHARS = 19:20; 38376000
LAYOUT WORDS (WRDCNT = 39:20); 38377000
LAYOUT IDSANDNAMES (47:8, 39:8); 38378000
FIELD COUNTF = 47:8; 38379000
INTEGER TOTALCHARS, COMMENT THE TOTAL CHARACTERS IN A NAM;38380000
TOTALNAMES, COMMENT THE NUMBER OF NAMES IN AN 38381000
IDENTIFIER (THE THING THAT UNIQUELY 38382000
IDENTIFIES A FILE); 38383000
TOTALIDENTIFIERS; COMMENT THE TOTAL NUMBER OF 38384000
IDENTIFIERS IN A SERIES (IDENTIFIERS 38385000
SEPARATED BY COMMAS); 38386000
LABEL SERIES; 38387000
TOTALCHARS ~ WORDDIVCHARSIZE + 3; % PROVIDE FOR INFO WORD, 38388000
% TOTAL IDENTIFIERS, NAMES AND 38389000
% STOPPER 38390000
IF LOCK (NAMEQUEUE) THEN BUZZ (NAMEQUEUE); 38391000
SERIES: TOTALIDENTIFIERS ~ * + 1; 38392000
DO BEGIN 38393000
SCANNER; 38394000
ONENAME ~ ONENAME & DATADESCRIPTOR 38395000
(,1,0,,,,,, WORDCOUNT+1, GETAREA (WORDCOUNT)); 38396000
ONENAME[0].COUNTF ~ COUNT; 38397000
TOTALNAMES ~ * + 1; 38398000
TOTALCHARS ~ * + COUNT + (IF CALLER =DATACLS 38399000
THEN 18 - COUNT ELSE 1); 38400000
ANAME ~ POINTER (ONENAME, CHARSIZE)+1; 38401000
MOVE (ACCUMPOINTER, ANAME, FOR COUNT); 38402000
THISNAME ~ ALLOCATE (NAMEQUEUE); 38403000
POINTERTONAME@(THISNAME) ~ANAME - 1; 38404000
CHARCOUNT @ (THISNAME) ~ COUNT +1 & WORDS(WORDCOUNT);38405000
NAMEQUEUE ~ THISNAME; 38406000
IF NOT ENDOFRECORD THEN SCANNER; 38407000
END 38408000
UNTIL CLASS !SLASHCLS; 38409000
IF CLASS = COMMACLS THEN GO SERIES; 38410000
ALLNAMES ~ ALLNAMES & DATADESCRIPTOR (,,0,,,,,, 38411000
(WORDDIVCHARSIZE - TOTALCHARS MOD WORDDIVCHARSIZE + 38412000
TOTALCHARS) DIV WORDDIVCHARSIZE, 1); 38413000
ANAME ~ POINTER (ALLNAMES, CHARSIZE); 38414000
ANAME ~ ANAME + WORDDIVCHARSIZE + 2; 38415000
WORDMON ~ WORD (ANAME); %%%%%% 38416000
WHILE THISNAME ~ FIRSTNAME ! NULL 38417000
DO BEGIN 38418000
T ~ CHARCOUNT @ (THISNAME).CHARS; 38419000
P ~ POINTERTONAME @(THISNAME); 38420000
MOVEUPDATE (P, ANAME, FOR T); 38421000
IF CALLER = DATACLS THEN ANAME ~ ANAME + (18 - T); 38422000
FORGETAREA (SIZE(NAMEQUEUE), 38423000
WORD (THISNAME).ADDRESSF); 38424000
FORGETAREA (CHARCOUNT @ (THISNAME).WRDCNT, 38425000
WORD (POINTERTONAME @ (THISNAME)).ADDRESSF); 38426000
DELINK (NAMEQUEUE, THISNAME); 38427000
END; 38428000
UNLOCK (NAMEQUEUE); 38429000
ALLNAMES [1] ~ * & IDSANDNAMES (TOTALIDENTIFIERS, TOTALNAMES); 38430000
ALLNAMES[0] ~ 0 & FIRSTPOINTERWORDL (*, ALLNAMES.LENGTHF, *, *,38431000
TOTALCHARS -6); 38432000
IF CALLER = DATACLS THEN RETURN (ALLNAMES); 38433000
RETURN( ANAME & STRINGDESCRIPTOR (,*,0,,*,*,*,TOTALCHARS,*)); 38434000
END OF NAMES; 38435000
SAVE INTEGER PROCEDURE GETANUMBER (AGAIN); 38436000
VALUE AGAIN; 38437000
BOOLEAN AGAIN; 38438000
BEGIN 38439000
SCANNER; COMMENT GET RID OF DELIMITER; 38440000
CONVERT ~ TRUE; 38441000
IF SCANNER !CONVERTEDINTEGER 38442000
THEN CONTROLCARDERROR (3) 38443000
ELSE GETANUMBER ~ ACCUMULATOR [0]; 38444000
IF AGAIN AND NOT ENDOFRECORD THEN SCANNER; 38445000
END GETANUMBER; 38446000
SAVE PROCEDURE QUEUEPARAMETERS(SEGZERO2); 38447000
ARRAY SEGZERO2[*]; 38448000
BEGIN COMMENT READ THE PARAMETER BLOCK THAT THE COMPILERS HAVE38449000
WRITTEN TO THE CODE FILE AND MAKE INDIVIDUAL 38450000
QUEUE ENTRIES FOR EACH OF THEM. IF THE BLOCK 38451000
DOES NOT EXIST, SET UP AN EMPTY QUEUE.; 38452000
ARRAY SEGZERO = SEGZERO2 [*,*]; 38453000
ARRAY PB, MYPB, HEADER [*]; 38454000
INTEGER L, A, I, T, PI, DA; 38455000
REAL X; 38456000
REFERENCE R, MYPBR = MYPB; 38457000
IF L ~ (PB ~ SEGZERO [FPBDESCPLACE,*]).LENGTHF > 1 38458000
THEN BEGIN COMMENT A COMPILE TIME PARAMETER BLOCK WAS 38459000
CREATED.; 38460000
MYPB ~ MYPB & ARRAYDESCL(0, L, 1); 38461000
HEADER ~ SEGZERO [CODEFILEDESCPLACE, *]; 38462000
BUZZ (PARAMETERQUEUE); 38463000
LASTPARAM ~ FIRSTPARAM ~ NULL; 38464000
PI ~ 1; 38465000
SEGZERO [FPBDESCPLACE, *].ADDRESSF ~ A ~ 38466000
MYPB.ADDRESSF; 38467000
DO BEGIN 38468000
A ~ A + (X ~ MYPB[PI]).INFOINDEXF; 38469000
R ~ ALLOCATE (PARAMETERQUEUE); 38470000
POINTERTOID @(R) ~ POINTER (MYPB[PI],8); 38471000
PARAMETERINFO@(R) ~ MYPBR& ARRAYDESCL 38472000
(3, X.INFOLENGTHF, A); 38473000
INITIALINSERT (PARAMETERQUEUE, R); 38474000
END 38475000
UNTIL PI ~ PI + X.TOTALINFOWORDSF ! PI; 38476000
COMMENT DITTO IS ZERO WHEN THE LAST 38477000
PARAMETER HAS BEEN PROCESSED.; 38478000
UPDATEWORDCOUNT (L, FIRSTPARAM ); 38479000
END 38480000
ELSE BEGIN 38481000
BUZZ (PARAMETERQUEUE); 38482000
FIRSTPARAM ~ LASTPARAM ~ NULL; 38483000
END; 38484000
READLOCK (FIRSTPARAM , SEGZERO[FIRSTPARAMETERPLACE, *]); 38485000
READLOCK (LASTPARAM , SEGZERO[LASTPARAMETERPLACE, *]); 38486000
UNLOCK (PARAMETERQUEUE); 38487000
EXIT; 38488000
END OF QUEUEPARAMETERS; 38489000
SAVE PROCEDURE EMPTYPARAMETERQ(SEGZERO2); 38490000
ARRAY SEGZERO2[*]; 38491000
BEGIN COMMENT EMPTY THE PARAMETER QUEUE. ALL PARAMETERS FOR 38492000
THIS RUN ARE NOW KNOWN AND THE INFORMATION FOR THEM 38493000
EXISTS AS INDIVIDUAL ENTRIES IN THE PARAMETER QUEUE. 38494000
THESE ENTRIES EXIST EITHER IN THE AREA DESCRIBED 38495000
BY THE ORIGINAL FPB DESCRIPTOR (AS SUPPLIED BY THE 38496000
COMPILER (AS SUPPLIED BY CONTROL CARD)) OR IN INDIV- 38497000
IDUAL AREAS THAT WERE OBTAINED AS INDIVIDUAL CONTROL 38498000
CARDS WERE PROCESSED. IT IS NOW TIME TO CONSOLIDATE 38499000
ALL ENTRIES INTO A SINGLE ENTRY AND PUT A NEW 38500000
DESCRIPTOR IN SEGMENT ZERO. WHEN THERE ARE ABSOLUTE-38501000
LY NO PARAMETERS, THE FPB DESCRIPTOR IS AN ABSENT 38502000
DESCRIPTOR WITH A LENGTH OF 1 WHICH WILL (AUTOMATIC- 38503000
ALLY) RETURN A ZERO WHEN THE ZEROTH WORD (WORD COUNT)38504000
IS ACCESSED.; 38505000
ARRAY SEGZERO =SEGZERO2 [*,*]; 38506000
ARRAY PB [1], PINFO [*]; 38507000
ARRAY PBW = PB [*]; 38508000
REFERENCE PINFOR = PINFO; 38509000
INTEGER PI, FWI, FWL; 38510000
POINTER PINFOP = PINFO; 38511000
REFERENCE RT, RTT; 38512000
REAL FW; 38513000
IF (RT ~ REFERENCE (SEGZERO [FIRSTPARAMETERPLACE, *]))! NULL 38514000
THEN BEGIN 38515000
FIRSTPARAM ~ RT; 38516000
LASTPARAM ~ REFERENCE(SEGZERO[LASTPARAMETERPLACE,*]);38517000
PB ~ PB & ARRAYDESCL (0, 38518000
(PI ~ REAL (POINTERTOID@(RT), 6).TOTALINFOWORDSF38519000
+1), 1); 38520000
PB[0] ~ PI; 38521000
PI ~ 1; 38522000
DO BEGIN 38523000
FW ~ REAL (POINTERTOID@(RT), 6); 38524000
PI ~ PI + FWI + FWL; 38525000
MOVE (PINFOP ~ POINTERTOID@(RT), 38526000
POINTER (PB[PI], CHARSIZE), 38527000
FOR FWI ~ FW.INFOINDEXF WORDS); 38528000
FORGETSPACE (PINFO.ADDRESSF); 38529000
PINFOR ~ PARAMETERINFO@(RT); 38530000
MOVE (POINTER(PINFO, CHARSIZE) 38531000
,POINTER(PB[PI+FWI], CHARSIZE), 38532000
FOR FWL ~ FW.INFOLENGTHF WORDS); 38533000
PB[PI].TOTALINFOWORDSF ~ FWI + FWL; 38534000
FORGETSPACE (PINFO.ADDRESSF); 38535000
RTT ~ NEXTPARAM@(RT); 38536000
DELINK (PARAMETERQUEUE, RT); 38537000
RT ~ RTT; 38538000
END 38539000
UNTIL RTT =NULL; 38540000
PB[PI].TOTALINFOWORDSF ~ 0; 38541000
FIRSTPARAM ~ LASTPARAM ~NULL; 38542000
IF SEGZERO[FPBDESCPLACE, *].LENGTHF > 1 38543000
THEN FORGETSPACE (SEGZERO [FPBDESCPLACE,*].ADDRESSF);38544000
COMMENT THIS IS THE PLACE TO WRITE PB TO MCP OLAY DISK, 38545000
FIX UP THE DESCRIPTOR ACCORDINGLY AND FORGET THE 38546000
SPACE USED BY PB. ALSO CHECK ON EXECUTABLE STATUS 38547000
OF SEGZERO BEING PROCESSED.; 38548000
END; 38549000
READLOCK (PBW,SEGZERO [FPBDESCPLACE, *]); 38550000
EXIT; 38551000
END EMPTYPARAMETERQ; 38552000
SAVE PROCEDURE FILECARD (SEGZERO, ACTION); 38553000
VALUE ACTION; 38554000
INTEGER ACTION; 38555000
ARRAY SEGZERO [*]; 38556000
BEGIN COMMENT PROCESS AND QUEUE FILE PARAMETER CARDS.; 38557000
REFERENCE THISFILE, TEMPR; 38558000
POINTER EXTERNALNAME, PT; 38559000
WORD EXTERNALNAMEW = EXTERNALNAME; 38560000
INTEGER T; 38561000
SAVE ARRAY FPB [1], 38562000
SCRATCH [1]; 38563000
REFERENCE FPBR = FPB; 38564000
WORD ARRAY SZ = SEGZERO[*], 38565000
SUCCESSOR = SUCCESSORSHEET [*,*]; 38566000
DEFINE FPPLACE = FIRSTPARAMETERPLACE #, 38567000
LPPLACE = LASTPARAMETERPLACE#, 38568000
REEDLOCK (LOCALP, GLOBALP, PLACE) = 38569000
LOCALP ~ GLOBALP; GLOBALP ~ REFERENCE (SZ[PLACE]); 38570000
SZ [PLACE] ~ WORD (LOCALP) #, 38571000
FPBSIZE (V) = 38572000
FPB ~ FPB & ARRAYDESCL (0, V + FIXEDFPBSIZE, 1)#, 38573000
SCRATCHSIZE (ARAY) = 38574000
SCRATCH ~ * & ARRAYDESCL(0,T~ARAY[0].INFOINDEXF,1)#; 38575000
IF COMPILEFORSYNTAX(SEGZERO[PROCESSNATUREPLACE]) THEN EXIT; 38576000
BUZZ (PARAMETERQUEUE); 38577000
REEDLOCK (TEMPR, FIRSTPARAM, FPPLACE); 38578000
REEDLOCK (TEMPR, LASTPARAM, LPPLACE); 38579000
THISFILE ~ ALLOCATE (PARAMETERQUEUE); 38580000
CASE ACTION OF 38581000
BEGIN 38582000
BEGIN % STANDARD LABEL EQUATION 38583000
POINTERTOID@(THISFILE) ~ PT ~ NAMES(FILECLS); 38584000
EXTERNALNAME ~ NAMES(FILECLS); 38585000
FPBSIZE (REAL (EXTERNALNAME, 6).INFOINDEXF); 38586000
WHILE CLASS ! QUESTIONCLS AND NOT ENDOFRECORD DO SCANNER; 38587000
COMMENT PRECEDING STATEMENT IS IN LIEU OF FULL LABEL 38588000
EQUATION PROCESSING.; 38589000
END; 38590000
BEGIN % COMPILE CARD FILE 38591000
SCRATCHSIZE (COMPILERCARDEXTERNAL); 38592000
MOVE (CURRENTTIME, POINTER(COMPILERCARDEXTERNAL[1], 38593000
CHARSIZE) +3, FOR 6); 38594000
MOVE (PT ~ POINTER(COMPILERCARDEXTERNAL, CHARSIZE), 38595000
POINTER (SCRATCH, CHARSIZE), FOR T WORDS); 38596000
MOMTOVECTOR (SCRATCH, UINFOW, FILEID.UNITNOF); 38597000
FPBSIZE (T); 38598000
MOVE (PT, POINTER (FPB[FIXEDFPBSIZE],CHARSIZE), 38599000
FOR T WORDS); 38600000
SCRATCHSIZE (COMPILERCARDFILE); 38601000
MOVE (POINTER(COMPILERCARDFILE, CHARSIZE), 38602000
POINTER (SCRATCH, CHARSIZE), FOR T WORDS); 38603000
POINTERTOID@(THISFILE) ~ PT ~ POINTER(SCRATCH, CHARSIZE); 38604000
END; 38605000
BEGIN % COMPILER CODE FILE 38606000
SCRATCHSIZE (COMPILERCODEFILE); 38607000
MOVE (POINTER(COMPILERCODEFILE, CHARSIZE), 38608000
POINTER(SCRATCH, CHARSIZE), FOR T WORDS); 38609000
POINTERTOID@(THISFILE) ~ PT ~ POINTER (SCRATCH, CHARSIZE);38610000
EXTERNALNAMEW~ WORD(SUCCESSOR[CODEFILENAMEDESCPLACE,*]); 38611000
FPBSIZE (REAL(EXTERNALNAME, 6).INFOINDEXF); 38612000
END; 38613000
END OF CASE; 38614000
IF ACTION ! CARDACTION 38615000
THEN MOVE (EXTERNALNAME, POINTER(FPB[FIXEDFPBSIZE], CHARSIZE), 38616000
FOR (REAL(EXTERNALNAME, 6).INFOINDEXF) WORDS); 38617000
IF ACTION = LEQACTION 38618000
THEN FORGETSPACE (EXTERNALNAME.ADDRESSF); 38619000
MOVE (REAL(PT, 6)& FIRSTPOINTERWORDL(*,*,*,FILETYPEP), PT, 38620000
FOR 1 WORDS); 38621000
PARAMETERINFO @(THISFILE) ~ FPBR; 38622000
PARAMETERQUEUE ~ THISFILE; 38623000
FIRSTPARAM ~ READLOCK(FIRSTPARAM ,SZ [FPPLACE]); 38624000
LASTPARAM ~ READLOCK (LASTPARAM , SZ [LPPLACE]); 38625000
UNLOCK (PARAMETERQUEUE); 38626000
EXIT; 38627000
END FILECARD; 38628000
SAVE PROCEDURE ENDGAME (SEGZERO); 38629000
ARRAY SEGZERO [*]; 38630000
BEGIN COMMENT DO ALL PROCESSING NORMALLY ASSOCIATED WITH THE 38631000
END OF A SCHEDULE DECK.; 38632000
REFERENCE PSR; 38633000
ARRAY PS = PSR[*]; 38634000
BOOLEAN PRIOR; 38635000
WORD ARRAY SEGZERW = SEGZERO [*]; 38636000
REFERENCE ARRAY SZR = SEGZERO [*]; 38637000
IF (PSR ~ PREVIOUSPROGRAM@(REFERENCE (SEGZERO)))! NULL 38638000
THEN BEGIN PRIOR ~ TRUE; ENDGAME (PS); END; 38639000
EMPTYPARAMETERQ(SEGZERO); 38640000
IF PRIOR THEN FIRSTPARAMETER@(PSR) ~ SZR[FPBDESCPLACE]; 38641000
SEGZERO [TIMEENTEREDPLACE] ~ TIMEOFDAY; 38642000
IF T ~ SEGZERO[PROCESSNATUREPLACE].PROCESSCLASSF ! 38643000
COMPILENSYNTAXOBJECT 38644000
THEN BEGIN 38645000
BUZZ (SHEETQ); 38646000
SHEETQ ~ REFERENCE(SEGZERO); 38647000
UNLOCK (SHEETQ); 38648000
SHEETENTERED ~ TRUE; 38649000
IF PRIOR 38650000
THEN READLOCK (SEGZERW[LINKPLACE].SELFIDENTF, 38651000
PS [NEXTPROGRAMPLACE]); 38652000
END 38653000
ELSE BEGIN 38654000
FORGETSPACE (SEGZERO.ADDRESSF); 38655000
END; 38656000
EXECUTESHEET ~ FALSE; 38657000
END ENDGAME; 38658000
SAVE PROCEDURE GETHEADER; 38659000
BEGIN COMMENT GETHEADER PRESUMES NAMEPOINTER HAS BEEN INITIAL-38660000
IZED TO POINT AT A NAME STRING. SEGMENT ZERO 38661000
WILL BE MADE PRESENT (BY PRESENCE BIT) AND 38662000
ENTRIES APPROPRIATE TO THE SHEETQ ARE MADE. 38663000
SEGZERO IS EVENTUALLY PLACED IN THE SHEETQ.; 38664000
WORD ARRAY NAMEPOINTERW = NAMEPOINTER [*]; 38665000
WORD ARRAY SEGZEROW = SEGZERO [*]; 38666000
REAL ARRAY HEADER =HEADERW [*]; 38667000
DEFINE 38668000
ARGUMENT = 0#, 38669000
LOCKER = FALSE #; 38670000
IF T ~ DIRECTORYSEARCH (NAMEPOINTER, ARGUMENT, LOCKER) < 0 38671000
THEN CONTROLCARDERROR (4) 38672000
ELSE HEADERW ~ DISKFILEHEADERS [T, *]; 38673000
T := @440; 38674000
DISKWAIT(SEGZERO, -1, SIZE(SHEETQ), FIRSTROWADDRESS(HEADER), 38675000
T); 38676000
SEGZEROW[FPBDESCPLACE].TAG ~ DATADESC; 38677000
QUEUEPARAMETERS (SEGZERO); 38678000
PREVIOUSPROGRAM@(REFERENCE(SEGZERO)) ~ NULL; 38679000
MOMTOVECTOR (NAMEPOINTERW, SEGZERO, CODEFILENAMEDESCPLACE); 38680000
MOMTOVECTOR (HEADERW, SEGZERO, CODEFILEDESCPLACE); 38681000
SEGZERO.CBITF ~ 1; 38682000
EXIT; 38683000
END OF GETTING HEADER; 38684000
COMMENT CONTROL CARD STARTS HERE; 38685000
WORDDIVCHARSIZE ~ 48 DIV CHARSIZE; 38686000
IF 5 = IOCB.TAG 38687000
THEN BEGIN COMMENT AN IOCB; 38688000
SOURCEREFERENCE ~ AREADESC @(IOCB); 38689000
RESULT ~ MISC @ (IOCB); 38690000
CONTROLCARDCHECK; 38691000
CONTROLWORD ~ SOURCEAREA [0]; 38692000
FILEID ~ USER @(IOCB); 38693000
END 38694000
ELSE BEGIN COMMENT A UNIT NUMBER; 38695000
CONTROLWORD ~ 30"044"; 38696000
FILEID ~ 0 & USERL (SNR, STACK[SNR, PRIORITYPLACE], 38697000
UNITNO); 38698000
ACTION ~ 3"1001"; % VALIDITY - WAIT FOR MPX ON CM 38698100
COMMENT * * * * 38698900
ACTION ~ 3"3001"; % CC OR CM AND VALIDITY 38699000
TRACE (23); 38700000
NEWLIFE: 38701000
SEGZERO ~ SEGZEROWORD; 38702000
CONTROLCARDIO; 38703000
ACTION ~ 3"3011"; % SIM KLUDGE 38704000
END; 38705000
LIMIT ~ ORIGINALLIMIT ~ RESULT.RDMEMADDR|WORDDIVCHARSIZE + 38707000
RESULT.RDCHRCNT - 1; 38708000
SOURCE ~ ORIGINALSOURCE ~ POINTER(SOURCEAREA, 38709000
CHARSIZE) + WORDDIVCHARSIZE; 38710000
RESULT ~ RESERVED [0]; 38711000
ACCUMULATOR ~ RESERVED & DATADESCRIPTOR 38712000
(,,,,,0,,,ACCUMULATOR.LENGTHF); 38713000
ACCUMPOINTER ~ POINTER(ACCUMULATOR, CHARSIZE); 38714000
SCANNER; 38715000
WHILE CLASS = QUESTIONCLS 38716000
DO BEGIN 38717000
SCANNER; 38718000
IF RANGE (ALGOLCLS, COBOLCLS) 38719000
THEN BEGIN COMMENT A COMPILER PARAMETER; 38720000
SCANNER; 38721000
SEGZERO ~ PREDECESSOR; 38722000
END; 38723000
CASE RESERVECASE OF 38724000
BEGIN 38725000
CONTROLCARDERROR(0); 38726000
BEGIN 38727000
IF CLASS > ENDCLS THEN CONTROLCARDERROR(1);38728000
IF EXECUTESHEET THEN ENDGAME(SEGZERO); 38729000
CASE CLASS - RUNCLS OF 38730000
BEGIN % FIRST CARD CASE 38731000
BEGIN % RUN 138732000
GO EXECUTE; 38733000
END; % RUN 138734000
EXECUTE: BEGIN 38735000
SHEETENTERED ~ FALSE; 38736000
NAMEPOINTER ~ NAMES(EXECUTECLS); 38737000
GETHEADER; 38738000
SUCCESSOR ~ SEGZERO; 38739000
NATUREOFPROCESS(SEGZERO,EXECUTEJOB); 38740000
EXECUTESHEET ~ TRUE; 38741000
END; % EXECUTE 238742000
BEGIN % COMPILE 338743000
COMPILER ~ TRUE; 38744000
NAMEPOINTER ~ NAMES (COMPILECLS); 38745000
MOMTOVECTOR (WORD(NAMEPOINTER),SEGZERO,CODEFILENAMEDESCPLACE); 38746000
SUCCESSORSHEET ~ REFERENCE (SEGZERO); 38747000
READLOCK(0&DATADESCRIPTOR (), SEGZERO[FPBDESCPLACE]); 38748000
SEGZERO ~ SEGZEROWORD; 38749000
WHILE NOT RANGE (ALGOLCLS, COBOLCLS) DO SCANNER; 38750000
SOURCE ~ TSOURCE; 38751000
NAMEPOINTER ~ NAMES (COMPILECLS); 38752000
GETHEADER; 38753000
NEXTPROGRAM@(REFERENCE(SEGZERO)) ~ SUCCESSORSHEET; 38754000
PREDECESSOR ~ SEGZERO; 38755000
PREVIOUSPROGRAM@(SUCCESSORSHEET) ~ PREDECESSORSHEET; 38756000
FILECARD (SEGZERO, CARDACTION); 38757000
WHILE NOT RANGE (LIBRARYCLS, DISKCLS -1) 38758000
DO IF CLASS ! QUESTIONCLS AND NOT ENDOFRECORD 38759000
THEN SCANNER 38760000
ELSE CLASS ~ GOCLS; 38761000
CASE CLASS - LIBRARYCLS OF 38762000
BEGIN 38763000
BEGIN % COMPILE FOR LIBRARY 38764000
NATUREOFPROCESS (SEGZERO, COMPILETOLIBRARYJOB); 38765000
DO UNTIL SCANNER = QUESTIONCLS OR ENDOFRECORD; 38766000
NATUREOFPROCESS (SUCCESSOR, IF ENDOFRECORD 38767000
THEN COMPILETOLIBRARYJOB ELSE LIBRARYNGOJOB); 38768000
FILECARD (SEGZERO, CODEACTION); 38769000
END; 38770000
BEGIN % COMPILE FOR SYNTAX 38771000
NATUREOFPROCESS (SEGZERO, COMPILENSYNTAXJOB); 38772000
NATUREOFPROCESS (SUCCESSOR, COMPILENSYNTAXOBJECT); 38773000
END; 38774000
BEGIN % COMPILE AND GO 38775000
NATUREOFPROCESS(SEGZERO, COMPILENGOJOB); 38776000
NATUREOFPROCESS(SUCCESSOR,GOJOB); 38777000
FILECARD (SEGZERO, CODEACTION); 38778000
CLASS ~ QUESTIONCLS; 38779000
END; 38780000
END; 38781000
FIRSTPARAMETER@(SUCCESSORSHEET)~LASTPARAMETER@(SUCCESSORSHEET)~38782000
NULL; 38783000
EXECUTESHEET ~ TRUE; 38784000
WHILE CLASS !QUESTIONCLS AND NOT ENDOFRECORD DO SCANNER; 38785000
END; % COMPILE 338786000
BEGIN % REMOVE 438787000
END; % REMOVE 438788000
BEGIN % LOAD 538789000
LIBMAIN(NAMES(LOADCLS)+6); 38789100
END; % LOAD 538790000
BEGIN % DUMP 638791000
END; % DUMP 638792000
BEGIN % CHANGE 738793000
END; % CHANGE 738794000
BEGIN % DATA 838795000
LABELTYPE ~ 4; %%%%%%%%%%%%%%%% 38796000
DATA: IF NOT ENDOFRECORD 38797000
THEN UINFOW [FILEID.UNITNOF] ~ WORD (NAMES(DATACLS)); 38798000
UINFOP [FILEID.UNITNOF, 0] ~ 0 & LEBCNTRL 38799000
(1,,,,,1,LABELTYPE); 38800000
GO SUICIDE; 38801000
END; % DATA 838802000
BEGIN % USE 938803000
END; % USE 938804000
BEGIN % USER 1038805000
END; % USER 1038806000
BEGIN % RELEASE 1138807000
END; % RELEASE 1138808000
BEGIN % FREE 1238809000
END; % FREE 1238810000
BEGIN % PUBLIC 1338811000
END; % PUBLIC 1338812000
BEGIN % DATAB 1438813000
LABELTYPE ~ 3; %%%%%%%%%%%% 38814000
GO DATA; 38815000
END; % DATAB 1438816000
BEGIN % UNUSED 1538817000
END; % UNUSED 1538818000
BEGIN % UNUSED 1638819000
END; % UNUSED 1638820000
BEGIN % UNUSED 1738821000
END; % UNUSED 1738822000
BEGIN % UNUSED 1838823000
END; % UNUSED 1838824000
BEGIN % UNUSED 1938825000
END; % UNUSED 1938826000
BEGIN % UNUSED 2038827000
END; % UNUSED 2038828000
BEGIN % UNUSED 2138829000
END; % UNUSED 2138830000
BEGIN % UNUSED 2238831000
END; % UNUSED 2238832000
BEGIN % UNUSED 2338833000
END; % UNUSED 2338834000
BEGIN % END 2438835000
END; % END 2438836000
END OF FIRST CARD CASE; 38837000
END; 38838000
CASE CLASS - FILECLS OF 38839000
BEGIN % PARAMETER CARD CASE 38840000
BEGIN % FILE 3538841000
FILECARD(SEGZERO, LEQACTION); 38842000
END; % FILE 3538843000
BEGIN % PROCESS 3638844000
END; % PROCESS 3638845000
BEGIN % IO 3738846000
MYCOMMON ~ 38847000
SEGZERO [IOTIMEPLACE ] ~ GETANUMBER(TRUE); 38848000
END; % IO 3738849000
BEGIN % PRIORITY 3838850000
SEGZERO [PRIORITYPLACE ] ~ GETANUMBER(TRUE); 38851000
END; % PRIORITY 3838852000
BEGIN % COMMON 3938853000
SEGZERO [COMMONVALUEPLACE ] ~ GETANUMBER(TRUE); 38854000
END; % COMMON 3938855000
BEGIN % CORE 4038856000
SEGZERO [COREPLACE ] ~ GETANUMBER(TRUE); 38857000
END; % CORE 4038858000
BEGIN % STACK 4138859000
SEGZERO [STACKSIZEPLACE ] ~ GETANUMBER(TRUE); 38860000
END; % STACK 4138861000
BEGIN % UNUSED 4238862000
END; % UNUSED 4238863000
BEGIN % UNUSED 4338864000
END; % UNUSED 4338865000
BEGIN % UNUSED 4438866000
END; % UNUSED 4438867000
BEGIN % UNUSED 4538868000
END; % UNUSED 4538869000
BEGIN % UNUSED 4638870000
END; % UNUSED 4638871000
BEGIN % UNUSED 4738872000
END; % UNUSED 4738873000
BEGIN % UNUSED 4838874000
END; % UNUSED 4838875000
BEGIN % UNUSED 4938876000
END; % UNUSED 4938877000
BEGIN % UNUSED 5038878000
END; % UNUSED 5038879000
BEGIN % UNUSED 5138880000
END; % UNUSED 5138881000
BEGIN % ALGOL 5238882000
END; % ALGOL 5238883000
BEGIN % FORTRAN 5338884000
END; % FORTRAN 5338885000
BEGIN % ESPOL 5438886000
END; % ESPOL 5438887000
BEGIN % UNUSED 5538888000
END; % UNUSED 5538889000
BEGIN % UNUSED 5638890000
END; % UNUSED 5638891000
BEGIN % UNUSED 5738892000
END; % UNUSED 5738893000
BEGIN % UNUSED 5838894000
END; % UNUSED 5838895000
BEGIN % UNUSED 5938896000
END; % UNUSED 5938897000
BEGIN % UNUSED 6038898000
END; % UNUSED 6038899000
BEGIN % UNUSED 6138900000
END; % UNUSED 6138901000
BEGIN % UNUSED 6238902000
END; % UNUSED 6238903000
BEGIN % UNUSED 6338904000
END; % UNUSED 6338905000
BEGIN % UNUSED 6438906000
END; % UNUSED 6438907000
BEGIN % COBOL 6538908000
END; % COBOL 6538909000
END; % PARAMETER CARD CASE 38910000
END RESERVED CASE; 38911000
IF ENDOFRECORD AND NOT SHEETENTERED 38912000
THEN BEGIN 38913000
CONTROLCARDIO; 38914000
SCANNER; 38915000
END; 38916000
SEGZERO ~ SUCCESSOR; 38917000
END OF QUESTION CLASS WHILE; 38918000
NATURALDEATH: 38919000
IF SCANIN (0 & USTATUSWORD (UNITNO.VECTOR,,,)).WHICHUNIT = 1 38920000
THEN GO NEWLIFE; 38921000
SUICIDE: 38922000
UNIT [FILEID.UNITNOF].UNITASSIGNED ~ 0; 38923000
EXIT; 38924000
38925000
CCERROR: 38926000
GLOBALSTOP; 38927000
END CONTROL CARD; 38928000
SAVE PROCEDURE INITIATEIO(AREADESC,UNITWORD,USERIDNO); 40000000
VALUE AREADESC,UNITWORD,USERIDNO; 40001000
REAL UNITWORD; 40002000
REFERENCE AREADESC; 40003000
INTEGER USERIDNO; FORWARD; 40004000
SAVE PROCEDURE STARTIO(U); VALUE U; INTEGER U; 40005000
COMMENT STARTIO FIRST CHECKS FOR CHANNEL IF THE UNIT IS IN AN USABLE 40006000
STATE.IF CHANNEL IS AVAILABLE, IT CALLS INITIATEIO, OTHERWISE 40007000
IT INSERTS ENTRY INTO WAITCHANNEL QUEUE. 40008000
U -LOGICAL UNIT NO.; 40009000
BEGIN 40010000
INTEGER N, COMMENT N STORES UNIT IN PROCESS OR BUSY BITS; 40011000
MPXINDEX; COMMENT MULTIPLEXOR NO. FOR WAITCHANNELQUE 40012000
INDEX; 40013000
REAL X, COMMENT X CONTAINS UNIT TABLE ENTRY; 40014000
UNITWORD; COMMENT RESULT OF INTERROGATE I/O PATH FOR 40015000
UNIT; 40016000
REFERENCE IOCB; COMMENT POINTER TO ENTRY OF I/O QUEUE; 40017000
X~ UNIT[U]; 40018000
IF X.UNITSTATUS=0 THEN COMMENT CHECKING CURRENT STATE OF UNIT;40019000
IF FIRSTIO[U]!NULL THEN COMMENT MORE I/O TO BE DONE FOR UNIT; 40020000
BEGIN 40021000
UNITWORD~SCANIN(0&IOPATHWORD(U,X.UNITMPXD,X.UNITMPXI)); 40022000
IF BOOLEAN(UNITWORD) THEN 40023000
BEGIN 40024000
IOCB ~FIRSTIO[U]; 40025000
INITIATEIO(AREADESC @IOCB,UNITWORD,USER @(IOCB).IDNO); 40026000
N~3; COMMENT SET UNIT IN PROCESS BITS; 40027000
END ELSE 40028000
BEGIN COMMENT ENTER IN WAITCHANNELQUE; 40029000
MPXINDEX~UNITWORD.MPXDESIGNATOR DIV 2; 40030000
WAITCHANNELQUE[MPXINDEX]~WAITCHANNELQUE(UNITWORD); 40031000
N~4; COMMENT SET UNIT WAITING FOR CHANNEL BIT; 40032000
END; 40033000
UNIT[U].UCHANWAITORBUSY~N; 40034000
END; 40035000
END STARTIO; 40036000
SAVE PROCEDURE INITIATEIO(AREADESC,UNITWORD,USERIDNO); 40037000
VALUE AREADESC,UNITWORD,USERIDNO; 40038000
REAL UNITWORD; 40039000
REFERENCE AREADESC; 40040000
INTEGER USERIDNO; 40041000
COMMENT INITIATEIO INITIATES I/O AND INITIALIZES I/O TIME FOR THE USER40042000
IT ALSO CHECKS FOR THE UNIT TYPE AND UPDATES THE TRANSACTION 40043000
COUNTER APPROPRIATELY 40044000
AREADESC - DESCRIPTOR POINTING TO THE I/O CONTROL WORD WHICH 40045000
PRECEEDS I/O AREA 40046000
THIS AREA MUST BE NON-OVERLAYABLE AT THIS POINT. 40046100
SEE DISKWAIT OR WAITIO FOR EXAMPLES OF HOW TO 40046200
GUARENTEE THIS. 40046300
UNITWORD - CONTROL WORD FOR THE UNIT ON WHICH I/O IS TO BE 40047000
INITIATED. 40048000
USERIDNO - USER IDENTIFICATION NO. FOR BOOK-KEEPING.; 40049000
BEGIN 40050000
REAL IOCW ; COMMENT LOCATION FOR I/O CONTROL WORD; 40052000
INTEGER U, COMMENT CONTAINS LOGICAL UNIT NO.; 40053000
TYPE; COMMENT CONTAINS UNIT TYPE; 40054000
WORD ARRAY IOAREA[*]; 40055000
IOAREA~WORD(AREADESC); 40056000
IOCW ~ TAGZOT(IOAREA[0]); 40057000
IIO(IOAREA,UNITWORD); 40060000
TYPE~UNIT[U~UNITWORD.UNITNO].UNITTYPE; 40062000
IOTIME[U] ~ * - SCANIN(TIMEOFDAYWORD); 40062100
IF BOOLEAN(IOCW.IOTESTBIT) THEN EXIT; 40063000
IF MAGTAPE(TYPE) THEN 40064000
IF BOOLEAN(IOCW.IOBACKWARD) THEN 40065000
BEGIN COMMENT IOMEMINHIBIT BIT IS USED TO CHECK WHETHER UNIT 40066000
IS REWINDING; 40067000
IF NOT BOOLEAN(IOCW.IOMEMINHIBIT) THEN 40068000
TRANSACTION[U]~*-1; 40069000
EXIT; 40070000
END; 40071000
TRANSACTION[ U ]~ * + 1; 40072000
EXIT; 40073000
END INITIATEIO; 40074000
SAVE PROCEDURE IOREQUEST(IOCB); 40075000
VALUE IOCB; 40076000
REFERENCE IOCB; 40077000
COMMENT IOREQUEST QUEUES UP I/O IN IOQUE IF THIS IS THE ONLY ENTRY 40078000
IN QUEUE IT CALLS STARTIO 40079000
IOCB - DESCRIPTOR POINTING TO THE ENTRY BLOCK FOR I/O QUEUE 40080000
6 WORDS IN A BLOCK; 40081000
BEGIN 40082000
INTEGER U; COMMENT U CONTAINS LOGICAL UNIT NO; 40083000
U~USER @(IOCB).UNITNOF; 40084000
IF UNIT[U].UNITTYPE=0 THEN 40084010
BEGIN % INVALID UNIT 40084020
MISC @(IOCB)~REAL(NOT FALSE); 40084030
USER @(IOCB).USERIOFINISH~1; 40084040
CAUSE(EVNT @ IOCB); 40084050
END ELSE 40084060
BEGIN % GO AHEAD 40084080
MISC @ (IOCB).RDEXCEPTION := 0; 40084100
IOQUE[U] ~ IOCB; 40085000
IF NEXT(IOQUE,U)=NULL THEN STARTIO(U); COMMENT ONLY ONE 40086000
ENTRY IN IOQUE; 40087000
END; 40087500
END IOREQUEST; 40088000
SAVE REAL PROCEDURE WAITIO(ARRA, USER, IOERRORMASK); 40089000
VALUE USER, IOERRORMASK; 40090000
ARRAY ARRA[*]; 40091000
REAL USER, IOERRORMASK; 40092000
COMMENT: WAITIO BUILDS AN IOCB AND CALLS IOREQUEST PASSING A LOCAL 40093000
EVENT ON WHICH IT WAITS. IF THERE ARE NO ERRORS OTHER 40094000
THAN THOSE ACCOUNTED FOR BY IOERRORMASK THEN WAITIO 40095000
RETURNS THE RESULT DESCRIPTOR. OTHERWISE IT CALLS 40096000
UNEXPECTEDIOERROR. 40097000
IOERRORMASK -ERROR MASK PROVIDED BY CALLER TO DO ITS OWN 40098000
ERROR-HANDLING 40099000
BUFFERLENGTH FIELD OF IOERRORMASK HAS A MASK 40100000
WHICH DETERMINES UNEXPECTED I/O ERROR. 40101000
USER -THIS IS THE USER WORD WHICH IS TO BE PUT IN THE IOCB. 40102000
IT MUST CONTAIN THE UNIT NUMBER IN THE UNIT FIELD. 40103000
ARRA -THIS IS AN UNINDEXED DATA DESCRIPTOR FOR THE IO AREA. 40104000
THE CALLER MUST HAVE STORED AN IOCW IN AREA[0]. ;40105000
BEGIN 40106000
REAL RD; 40107000
EVENT EVE; 40108000
REFERENCE ADAM; 40109000
WORD ARRAY AREA[*]; 40110000
INTEGER TRACTER;% USED TO SHUT OFF TRACE -- MAR 40112000
TRACTER~TRACE(0); 40113000
MAKEPRESENTANDSAVE(ARRA); %MAKE TEMPORARILY SAVE FOR I/O 40114000
AREA ~ ARRA & ARRAYDESCL(3, ARRA.LENGTHF - 1, *); 40116000
IOERRORMASK ~ REAL(NOT BOOLEAN(IOERRORMASK)); 40117000
ADAM ~ IOQUE(USER, -0, REFERENCE(AREA), EVE); 40118000
MISC@(ADAM).IOERRORMASKFIELD ~ IOERRORMASK; 40119000
IOREQUEST(ADAM); 40120000
WAIT(EVE); 40121000
IF BOOLEAN(WAITIO ~ RD ~ MISC@(ADAM)) THEN 40122000
IF REAL(BOOLEAN(RD.IOERRORMASKFIELD) AND 40123000
BOOLEAN(IOERRORMASK) AND 40124000
BOOLEAN(IOERRORMASK.BUFFERLENGTH)) !0 THEN 40125000
UNEXPIOERROR(ADAM,REAL(NOT BOOLEAN(IOERRORMASK. 40126000
IOERRORMASKFIELD))); 40127000
FORGETAREA(6,WORD(ADAM).ADDRESSF); 40128000
TURNOVERLAYKEY(ARRA.ADDRESSF);%RETURN TO PREVIOUS OLAY STATUS 40128100
TRACE(TRACTER); 40129000
RETURN(RD); 40129100
END WAITIO; 40130000
SAVE PROCEDURE NEWIO(MPXINDEX); VALUE MPXINDEX; 40131000
INTEGER MPXINDEX; 40132000
COMMENT NEWIO PICKS UP THE FIRST UNIT FOR GIVEN MPX WAITCHANNELQUE, 40133000
AND INTERROGATES FOR I/O PATH. IF PATH IS AVAILABLE IT PICKS 40134000
UP THE FIRST I/O FROM THE SPECIFIED UNIT I/O QUEUE. IT CALLS 40135000
INITIATEIO, DELINKS THE FIRST ENTRY FROM WAITCHANNELQUE AND 40136000
SETS UNIT BUSY BITS. 40137000
MPXINDEX -MULTIPLEXOR NO. FOR WAITCHANNELQUE INDEX; 40138000
BEGIN 40139000
INTEGER U; COMMENT U CONTAINS LOGICAL UNIT NO.; 40140000
REAL UNITWORD; COMMENT RESULT OF INTERROGATE I/O PATH FOR 40141000
UNIT; 40142000
REFERENCE IOCB; COMMENT POINTER TO ENTRY OF I/O QUEUE; 40143000
UNITWORD ~ SCANIN(UNTWORD @ FIRSTUNIT[MPXINDEX]); 40144000
IF BOOLEAN(UNITWORD) THEN 40145000
BEGIN 40146000
IOCB ~ FIRSTIO[U ~ UNITWORD.UNITNO]; 40147000
INITIATEIO(AREADESC @ IOCB ,UNITWORD,USER @(IOCB). IDNO); 40148000
COMMENT REMOVES ENTRY FROM TOP; 40149000
DELINK(WAITCHANNELQUE,FIRSTUNIT[MPXINDEX],MPXINDEX); 40150000
UNIT[U].UNITSTATUS ~3; COMMENT SETS UNIT BUSY BITS; 40151000
END; 40152000
END NEWIO; 40153000
SAVE PROCEDURE IOFINISH(MPXINDEX); VALUE MPXINDEX; INTEGER MPXINDEX;40154000
COMMENT IOFINISH READS A RESULT DESCRIPTOR FOR A SPECIFIED MULTIPLEXOR40155000
IT DOES ALL THE ERROR CHECKING. IF NO ERROR IS FOUND IT FIRES 40156000
UP NEW I/O WAITING FOR CHANNEL AND INSERTS I/O REQUEST FOR 40157000
THE UNIT ON WHICH I/O WAS FINISHED INTO A WAITCHANNELQUE. IF 40158000
NO UNIT IS WAITING FOR CHANNEL IT REMOVES FINISHED I/O ENTRY 40159000
FROM UNIT QUEUE AND IF QUEUE IS NOT EMPTY THEN CALLS STARTIO. 40160000
IF ERROR IS FOUND, IT SETS APPROPRIATE BITS IN THE UNIT TABLE.40161000
IF THERE IS A DISK ERROR, IT WILL TRY 10 TIMES TO RECOVER FROM40162000
THE ERROR. FOR OTHER ERRORS IT CALLS PROCESS IOERROR. IT KEEPS40163000
THE ERROR. FOR OTHER ERRORS IT CALLS PROCESS IOERR. IT KEEPS 40164000
TRACK OF I/O TIME AND FOR ERROR FREE OPERATION IT GIVES THE 40165000
WORD COUNT FOR READ OPERATION. 40166000
40167000
MPXINDEX -MULTIPLEXOR DESIGNATOR VALUE; 40168000
BEGIN 40169000
LABEL OK,NOWAIT,SETERRORBITS, RESETBUSYBITS,WRAPUP,DONEWIO, 40170000
UNITTYPETEST,EXIT; 40171000
INTEGER UNTTYPE, COMMENT UNIT TYPE; 40172000
U , COMMENT LOGICAL UNIT NO; 40173000
WORDCOUNT; COMMENT WORD COUNT FOR READ; 40174000
REAL CURRENTERROR, COMMENT ERROR FIELD OF CURRENT R. D.; 40175000
PASTERROR, COMMENT ERROR FIELD OF PAST R. D.; 40176000
UTABLEENTRY, COMMENT UNIT TABLE ENTRY; 40177000
RECDESC, COMMENT RECORD DESCRIPTOR SKELETON 40178000
IF NEGATIVE IT IS FOR MCP; 40179000
RD; COMMENT RESULT DESCRIPTOR; 40180000
WORD IOCW; COMMENT I/O CONTROL WORD; 40181000
REFERENCE IOCB; COMMENT TOP IOCB IN THE UNIT QUEUE; 40182000
BOOLEAN DELINKTOGGLE; % TRUE IF IOQUE ENTRY IS DELINKED 40183000
MONITOR RAJMONITOR(RD,IOCB); 40186000
DEFINE LINKINTOKEYINQ = 40187000
BEGIN 40188000
KEVNT @(IOCB) ~1; 40189000
BUZZCONTROL(KEYINQ); 40190000
KEYINQ~IOCB; 40191000
UNLOCK(KEYINQ);% TEMPORARY WHILE FORK MIGHT LOSE CONTROL 40192000
FORK(KEYIN,0); 40194000
END#,% 40194100
LINKINTOSPOUTQ=% 40195000
BEGIN% 40195100
BUZZCONTROL(SPOUTQ);% 40195200
SPOUTQ~IOCB;% 40195300
UNLOCK(SPOUTQ);% TEMPORARY 40195400
FORK(CONNSOUL,0);% 40195500
END#,% 40195590
ENDIOFDEF=0#;% 40195900
COMMENT READ THE RESULT DESCRIPTOR FOR A SPECIFIED MPX; 40196000
RD ~SCANIN(0&SCANINWORD(2,MPXINDEX,1)); 40197000
IF RD=0 THEN BEGIN GO EXIT; END; 40198000
MPXINDEX~FIRSTONE(MPXINDEX)-1; COMMENT TURNS MPXINDEX TO INDEX 40199000
FOR WAITCHANNELQUE; 40200000
U~ RD.RDUNITNO; 40201000
IOCB~FIRSTIO[U]; 40202000
UTABLEENTRY ~ UNIT[U]; 40203000
RECDESC~ MISC @ IOCB; 40204000
UNTTYPE~UTABLEENTRY.UNITTYPE; 40205000
IOCW~M[WORD(AREADESC @ IOCB)]; 40205200
IF MAGTAPE( UNTTYPE) AND NOT BOOLEAN(IOCW.IOTESTBIT) THEN 40205400
BEGIN % GET RID OF UNDESIRABLE BITS IN RD 40205450
IF RD.RDERROR=@2001 THEN % TURN OFF INCOMPLETE RECORD BIT 40205600
RD~REAL(BOOLEAN(RD) AND NOT BOOLEAN(@2001)); 40205800
IF BOOLEAN(RD.RDWLOOREOF) THEN 40205820
RD~REAL(BOOLEAN(RD)AND NOT BOOLEAN(4"C80")); 40205840
END; 40205860
IF BOOLEAN(CURRENTERROR := RD.RDERROR) OR 40206000
(PASTERROR~UTABLEENTRY.UNITERRORFIELD)!0 THEN 40207000
BEGIN COMMENT SOME KIND OF ERROR; 40208000
IF NOT BOOLEAN(USER@(IOCB).USERIOBIT) THEN COMMENT 40209000
MCP I/O OPERATION; 40210000
IF CURRENTERROR~ REAL(BOOLEAN(CURRENTERROR) AND 40211000
BOOLEAN(RECDESC .IOERRORMASKFIELD))=0 THEN 40212000
IF PASTERROR=0 THEN GO OK; COMMENT NO ERROR ON UNIT; 40213000
IF UTABLEENTRY.UNITTYPE !DISKFILE THEN GO SETERRORBITS; 40214000
COMMENT ERROR CHECKING FOR DISK UNIT; 40215000
IF CURRENTERROR=0 THEN COMMENT NO ERROR ON CURRENT R.D.; 40216000
IF NOT BOOLEAN(UTABLEENTRY.UNITRETRY) 40217000
THEN GO SETERRORBITS COMMENT IOERR WILL HANDLE IT; 40218000
ELSE BEGIN COMMENT ERROR ON MASS STORAGE RECOVERED; 40219000
PASTERROR~0; 40220000
UTABLEENTRY.UNITRETRY~0; 40220500
GO UNITTYPETEST; 40221000
END; 40222000
COMMENT ERROR ON CURRENT R.D.; 40223000
IF PASTERROR=0 THEN 40224000
BEGIN COMMENT ORIGINAL ERROR ON MASS STORAGE; 40225000
PASTERROR~1; 40226000
COMMENT TOTALUNITERROR~ * + 1; 40227000
UTABLEENTRY.UNITRETRY~1; 40228000
END ELSE 40229000
BEGIN COMMENT RECURRENT ERROR ON MASS STORAGE; 40230000
IF NOT BOOLEAN(UTABLEENTRY.UNITRETRY) THEN 40231000
GO SETERRORBITS; 40232000
IF (PASTERROR~* + 1)>10 THEN COMMENT THERE HAVE 40233000
BEEN 10 TRIES; 40234000
BEGIN 40235000
PASTERROR~0; 40236000
UTABLEENTRY.UNITRETRY ~0; 40237000
GO SETERRORBITS; 40238000
END; 40239000
END; 40240000
UTABLEENTRY.UNITERRORFIELD ~ PASTERROR; 40241000
UTABLEENTRY.UNITIOBUSY~0; 40242000
UNIT[U]~UTABLEENTRY; 40243000
STARTIO(U); 40244000
GO EXIT; 40245000
SETERRORBITS: 40246000
PASTERROR~ * + 1; 40247000
DELINKTOGGLE~TRUE; % PREVENTS DELINKING AT WRAPUP TIME 40248000
UTABLEENTRY.UNITERROR~1; 40249000
IF FIRSTUNIT[MPXINDEX]=NULL THEN 40251000
GO WRAPUP ELSE 40252000
GO DONEWIO; 40253000
END; 40254000
UNITTYPETEST: 40255000
COMMENT ****************** NEEDS PATCH FOR BUFFERED PRINTER; 40256000
OK: COMMENT CHECK WHETHER YOU CAN START NEW I/O ON SAME UNIT; 40257000
UTABLEENTRY.UNITIOBUSY~0; 40258000
UNIT[U]~UTABLEENTRY; 40259000
IF FIRSTUNIT[MPXINDEX]=NULL THEN 40260000
NOWAIT: COMMENT NO UNIT WAITING FOR CHANNEL; 40261000
BEGIN 40262000
DELINK(IOQUE,FIRSTIO[U],U); 40263000
DELINKTOGGLE~TRUE; 40264000
IF FIRSTIO[U]!NULL THEN 40265000
STARTIO(U) ELSE 40266000
RESETBUSYBITS: 40267000
UTABLEENTRY.UNITIOBUSY~0; 40268000
GO WRAPUP; 40269000
END; 40270000
DONEWIO: COMMENT DO NEW I/O FOR UNIT WAITING FOR CHANNEL; 40271000
NEWIO(MPXINDEX); 40272000
IF PASTERROR!0 THEN GO WRAPUP; 40273000
IF NEXT(IOQUE,U)=NULL THEN GO RESETBUSYBITS; 40274000
WAITCHANNELQUE[MPXINDEX]~ 40275000
WAITCHANNELQUE(0&IOPATHWORD(U,UTABLEENTRY.UNITMPXD, 40276000
UTABLEENTRY.UNITMPXI)); 40277000
UTABLEENTRY.UCHANWAIT~1; 40278000
WRAPUP: 40279000
COMMENT CLOCK THE OPERATION OFF 40280000
IOTIME[USER @ (IOCB).IDNO]~ * + SCANIN(TIMEOFDAYWORD); 40281000
IF CURRENTERROR=0 AND 40282000
(NOT DELINKTOGGLE) THEN DELINK(IOQUE,FIRSTIO[U],U); 40283000
UTABLEENTRY.UNITERRORFIELD~ PASTERROR; 40284000
USER @(IOCB).USERIOFINISH~1; 40284500
UNIT[U]~UTABLEENTRY; 40285000
IF BOOLEAN(IOCW.IOREADBIT) THEN COMMENT READ OPERATION; 40287000
BEGIN % COMPUTING NO OF WORDS READ 40288000
WORDCOUNT ~ABS(RD.RDMEMADDR- 40289000
((AREADESC@(IOCB)).ADDRESSF+1)); 40290000
IF ( UNTTYPE=MAGTAPE1 OR UNTTYPE=MAGTAPCLUSTER1) AND 40291000
NOT BOOLEAN(IOCW.IOBACKWARD) THEN 40292000
RD.RDCHRCNT~RD.RDCHRCNT-1; 40293000
RD.WORDCOUNTF~WORDCOUNT; 40299000
END; 40300000
IF CURRENTERROR!0 AND PASTERROR=1 THEN 40301000
BEGIN % ERROR FOR THE FIRST TIME FOR THIS I/O 40302000
USER@(IOCB).IOERRORRECOVERY~1; 40303000
FORK(IOERROR,RD); 40304000
GO EXIT; 40305000
END; 40309000
40310000
MISC @ ( IOCB ) ~ RD; 40311000
IF UNTTYPE=CONN THEN% 40312000
IF INPUT(IOCW) THEN LINKINTOKEYINQ% 40312100
ELSE IF (SEVNT@IOCB).TAG=1 THEN CAUSE(EVNT@IOCB)% 40312200
ELSE LINKINTOSPOUTQ% 40312300
ELSE% 40312400
CAUSE(EVNT @ IOCB); 40313000
EXIT: 40314000
END IOFINISH; 40315000
PROCEDURE STATUS (COUNT); INTEGER COUNT; % *** NOTE PARAMETER 40316000
COMMENT STATUS INTERROGATES ALL THE PERIPHERAL UNITS. IT COMPARES THE 40317000
NEWSTATUS WITH OLDSTATUS AND NOTES STATUS CHANGE CORRESPONDING40318000
TO EACH UNIT. IT CHECKS CURRENT STATE OF THE UNIT TO DETERMINE40319000
WHAT SHOULD BE DONE.IF A UNIT GOES NOT READY IT SETS 40320000
UNITNOTREADY IN UNIT TABLE. IF UNIT GOES READY IT RESETS 40321000
UNITNOTREADY. IF A UNIT WAS A USER AND THEN WENT READY, 40322000
IT CALLS STARTIO. 40323000
40324000
IF AN UNASSIGNED UNIT GOES READY, STATUS BRANCHES ON UNIT TYPE:40325000
RIATE ACTION ON THE RESULT. 40328000
FOR CARD READER IT CALLS INDEPENDENTRUNNER TO RUN CONTROLCARD 40329000
PROCESS AND MARKS UINFO TABLE APPROPRIATELY. 40330000
40331000
FOR TAPE, STATUS CALLS READALABEL; 40332000
BEGIN 40333000
REAL BITNO, % BIT # IN STATUS FIELD(32:32) 40334000
VECTORNO, % STATUS VECTOR # 40335000
U, % LOGICAL UNIT # 40336000
NRDLBLP, % # OF READALABEL PROCESSES 40337000
TEMP, % TEMPORARY 40337010
UNT; % UNIT TABLE ENTRY FOR UNIT[U] 40337020
40338000
BOOLEAN NEWSTATUS, % RESULT OF INTERROGATE 40339000
OLDSTATUS, % OLD STATUS OF CURRENT VECTOR 40340000
STATUSMASK, % TO MASK OUT UNITS ALREADY NOTED40341000
SAVESTATUS, % USED TO CONTROL READALABEL 40342000
BITWORD; % RELEVANT BIT # IN NEWSTATUS 40343000
LAYOUT BITSETL(BITNO:1~1); 40344000
LABEL FILENOTREADY,ENDOFREADY,SCRATCH,READALABEL2; 40350000
LABEL ENDOFUNIT,HR,PRG,UFU; 40351000
INTEGER STATEUS ; % *** FOR MONITOR ONLY 40352000
MONITOR JACKMONITOR(STATEUS); 40353000
MONITOR BOBMONITOR(NEWSTATUS,OLDSTATUS); 40353010
LABEL L;L:IF SIMULATING THEN BEGIN DISALLOW;SETINTERVALTIMER;PAUSE END; 40354000
STATEUS~STATEUS; % *** FOR MONITOR ONLY 40355000
40356000
VECTORNO~-1; 40357000
WHILE VECTORNO~VECTORNO+1{MAXVECTORNO 40358000
DO 40359000
BEGIN 40360000
OLDSTATUS~OLDSTATUSWORD[VECTORNO]; 40361000
% KLUDGE 40362000
OLDSTATUS~OLDSTATUS OR TRUE; 40363000
STATUSMASK~FALSE; 40364000
SAVESTATUS~BOOLEAN(REAL(NOT FALSE)); 40365000
WHILE REAL((NEWSTATUS~BOOLEAN(SCANIN(0& 40366000
USTATUSWORD(VECTORNO,,,)))OR STATUSMASK)AND SAVESTATUS) 40367000
! REAL(OLDSTATUS) 40368000
DO 40369000
BEGIN 40370000
U~VECTORNO|32+((BITNO~ 40371000
FIRSTONE(REAL(NEWSTATUS EQV NOT OLDSTATUS))-1)-1); 40372000
IF U>MAXUNIT THEN GO TO UFU; 40373000
WHILE BOOLEAN(UNT~READLOCK(1,UNIT[U])) DO; 40374000
40375000
BITWORD~FALSE&BITSETL(); 40376000
IF REAL(NEWSTATUS)<REAL(OLDSTATUS) THEN 40377000
BEGIN %%%%%%%%%%%%%%%%%%%%% UNIT NOT READY 40378000
OLDSTATUS~OLDSTATUS AND NOT BITWORD; 40379000
IF UNT.UNITTYPE=DISKFILE THEN 40380000
BEGIN 40381000
% CALL STEVE 40382000
END; 40383000
IF BOOLEAN(UNT.UNITASSIGNED)THEN 40384000
BEGIN % USER 40385000
IF NOT BOOLEAN(UNT.UINREWIND) THEN 40386000
IF NOT BOOLEAN(UNT.UNITNOTREADY)THEN 40387000
BEGIN 40388000
NOTREADYMSG(UNT);% 40389000
UNT.UNITNOTREADY~1; 40390000
END; 40391000
% CLOSED NO REWIND 40392000
END ELSE 40393000
% NO USER 40394000
BEGIN 40395000
UNT.ULOCKED~0; 40396000
FILENOTREADY: 40397000
UNT.UERRORSTATUSBITS~0; 40398000
UNT.UNITNOTREADY~1; 40399000
IF UINFOW[U].TAG!0 THEN 40400000
BEGIN 40401000
FORGETSPACE(UINFOW[U].ADDRESSF); 40402000
UINFOW[U]~0; 40403000
END; 40404000
END; 40405000
UNIT[U]~UNT; 40406000
STATUSMASK~STATUSMASK AND NOT BITWORD; 40407000
END ELSE 40408000
BEGIN %%%%%%%%%%%%%%%%%%%%% UNIT READY 40409000
OLDSTATUS~OLDSTATUS OR BITWORD; 40410000
UNT.UNITNOTREADY~0; 40411000
40412000
IF BOOLEAN(UNT.UNITASSIGNED) THEN 40413000
BEGIN % USER 40414000
STATUSMASK~STATUSMASK OR BITWORD; 40415000
40416000
UNT.UINREWIND~0; 40417000
UNIT[U]~UNT; 40418000
STARTIO(U); 40419000
GO TO ENDOFUNIT 40420000
END; 40421000
% UNIT NOT ASSIGNED 40422000
IF BOOLEAN(UNT.UINREWIND) THEN 40423000
IF BOOLEAN(UNT.ULOCKED) OR 40424000
BOOLEAN(UNT.USAVED) THEN 40425000
BEGIN 40426000
UNT.UINREWIND~0; 40427000
HR: 40428000
IF BOOLEAN(UNT.USAVED)THEN BITWORD~FALSE; 40429000
GO TO FILENOTREADY 40430000
END ELSE 40431000
IF BOOLEAN(UNT.UTOBEPURGED) THEN 40432000
BEGIN % PURGE THE FILE 40433000
UNT.UINREWIND~0; 40434000
PRG: 40435000
UNT.UTOBEPURGED~1; 40436000
WHILE BOOLEAN(TEMP~READLOCK(1,PRGT)) DO; 40437000
IF TEMP>0 THEN PRGT~TEMP+2 ELSE 40438000
BEGIN 40439000
PRGT~2; 40440000
FORK(PURGIT,U); 40441000
END; 40442000
END ELSE 40443000
BEGIN 40443010
UNT.UINREWIND~0; 40444000
IF BOOLEAN(UNT.ULABELLED) OR 40444010
BOOLEAN(UNT.USCRATCH)THEN GO ENDOFREADY;40444020
END; 40444030
IF BOOLEAN(UNT.USAVED) THEN GO TO ENDOFREADY; 40445000
IF BOOLEAN(UNT.ULOCKED)THEN GO FILENOTREADY; 40446000
IF BOOLEAN(UNT.UTOBEPURGED)THEN GO TO PRG; 40447000
STATUSMASK~STATUSMASK OR BITWORD; 40448000
CASE UNT.UNITTYPE OF 40449000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%40450000
BEGIN % NO UNIT 040451000
UFU: 40452000
UFUMSG(UNT);% 40453000
OLDSTATUS~OLDSTATUS AND NOT BITWORD; 40454000
STATUSMASK~STATUSMASK AND NOT BITWORD; 40455000
UNT.UNITNOTREADY~0; 40456000
IF U{MAXUNIT THEN UNIT[U]~UNT; 40457000
END; 40458000
BEGIN % DISK FILE 140459000
% CALL STEVE 40460000
END; 40461000
BEGIN % SNGL LINE CNTL 240462000
% CALL MIKE -- UNIT WENT WRITE READY 40462100
END; 40468000
; % UNASSIGNED 340469000
BEGIN % PAPER TAPE RDR 440470000
UNT.ULABELLED~1; 40471000
END; 40472000
40473000
40474000
BEGIN % PAPER TAPE PCH 540475000
SCRATCH: 40476000
UNT.UERRORSTATUSBITS~0; 40477000
UNT.UNITSTATE~0; 40478000
UNT.USCRATCH~1; 40479000
IF UINFOW[U].TAG!0 THEN 40480000
BEGIN 40481000
FORGETSPACE(UINFOW[U].ADDRESSF); 40482000
UINFOW[U]~0; 40483000
END; 40484000
% CHECK FOR BACKUP MESAGE PENDING 40485000
END; 40486000
40487000
GO TO SCRATCH; % LINE PRINTER I 640488000
GO TO SCRATCH; % LINE PRNTER II 740489000
40490000
; % UNASSIGNED 840491000
BEGIN % CARD READER 940492000
UNT.UNITASSIGNED~1; 40493000
UNIT[U]~UNT; 40494000
STATUSMASK~STATUSMASK OR BITWORD; 40495000
FORK(CONTROLCARD,U); 40496000
40497000
40498000
END; 40499000
GO TO SCRATCH; % CARD PUNCH I 1040500000
GO TO SCRATCH; % CARD PUNCH II 1140501000
; % UNASSIGNED 1240502000
BEGIN % MAG TAPE I 1340503000
TEMP~1; 40504000
READALABEL2: 40505000
WHILE BOOLEAN(NRDLBLP~READLOCK(1,RDLBLP))DO;40506000
IF ONES(NRDLBLP)}MAXRDLBLP THEN 40507000
BEGIN 40508000
OLDSTATUS~OLDSTATUS AND NOT BITWORD; 40509000
SAVESTATUS~SAVESTATUS&BITSETL(0); 40510000
END ELSE 40511000
BEGIN 40512000
UNT.UERRORSTATUSBITS~0; 40513000
UNT.UNITSTATE~0; 40514000
UNT.UNITASSIGNED~1; 40515000
FORK(READALABEL,0&RDLBL(BITNO~FIRSTONE( 40516000
REAL(NOT BOOLEAN(NRDLBLP)).RF), 40517000
TEMP,U)); 40518000
NRDLBLP~*&BITSETL(); 40519000
END; 40520000
RDLBLP~NRDLBLP; 40521000
STATUSMASK~STATUSMASK OR BITWORD; 40522000
END; 40523000
BEGIN % MAG TAPE II 1440524000
TEMP~2; 40525000
GO TO READALABEL2 40526000
END; 40527000
BEGIN % MAG TAPE III 1540528000
TEMP~3; 40529000
GO TO READALABEL2 40530000
END; 40531000
;;;;; ;;;;; ;;; % UNASSIGNED 16-2840532000
BEGIN % CLUSTER I 2940533000
TEMP~1; 40534000
GO TO READALABEL2 40535000
END; 40536000
BEGIN % CLUSTER II 3040537000
TEMP~2; 40538000
GO TO READALABEL2 40539000
END; 40540000
BEGIN % CLUSTER III 3140541000
TEMP~3; 40542000
GO TO READALABEL2 40543000
END; 40544000
END; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%40545000
40546000
ENDOFREADY: 40547000
END; %%%%%% READY 40548000
UNIT[U]~UNT; 40549000
ENDOFUNIT: 40549100
END; COMMENT END OF SINGLE UNIT HANDLING; 40550000
40551000
OLDSTATUSWORD[VECTORNO]~OLDSTATUS AND NOT TRUE; 40552000
END; COMMENT END OF VECTORNO LOOP; 40553000
40554000
IF SIMULATING THEN BEGIN GO TO L; 40555000
STACKINUSE[NAME(STATUS).ADRCPLF-IRPCWSTARTPLACE]~0 ; HOLD; 40556000
END; 40556500
END STATUS; 40557000
40558000
SAVE REFERENCE PROCEDURE DISKIO(CORE,INDEX,SIZE,DISK,MASK,DISKIOEVENT); 40559000
VALUE INDEX,SIZE,DISK,MASK; 40560000
INTEGER INDEX,SIZE,DISK,MASK; 40561000
ARRAY CORE[*]; 40562000
EVENT DISKIOEVENT; 40563000
COMMENT DISKIO CONVERTS SOFTWARE DISK ADDRESS INTO HARDWARE 40564000
DISK ADDRESS AND MAKES UP IOCW. IT MAKES UP AREADESC 40565000
AND INSERTS INTO IOCB. IT THEN CALLS IOREQUEST. 40566000
CORE -ARRAY DESCRIPTOR FOR CORE AREA. 40567000
THIS AREA MUST BE NON-OVERLAYABLE. SEE DISKWAIT FOR 40568000
AN EXAMPLE OF HOW TO GUARENTEE THIS. 40569000
INDEX -STARTING INDEX FOR CORE AREA DESCRIPTOR. 40570000
SIZE NO. OF WORDS TO TRANSFER. 40571000
NOTE: AREA MUST BE AT LEAST SIZE+1 WORDS LONG. 40572000
DISK -SOFTWARE DISK ADDRESS. 40573000
MASK MASK OF STANDARD I/O CONTROL WORD 40574000
(E.G. @440 READ , NO PROTECT, SINGLE TAG 40575000
@461 READ, MEMORY PROTECT, PROGRAM TAG) 40576000
DISKIOEVENT -EVENT TO BE CAUSED ON I/O COMPLETE; 40577000
BEGIN 40578000
WORD ARRAY AREA[*]; COMMENT WE BUILD THIS FOR IOCB; 40579000
REFERENCE IOCB; COMMENT POINTS TO IOCB; 40580000
REAL USER; COMMENT USER ITEM OF IOCB; 40581000
WORD ARRAY ARA = CORE[*]; COMMENT USED FOR PBIT; 40582000
USER := 0 & USERL(SNR,STACK[SNR,PRIORITYPLACE],DISK.EUNOF); 40583000
AREA~AREA & 40584000
ARRAYDESCL(3, SIZE, CORE.ADDRESS + INDEX); 40585000
AREA[0] ~ * & IOCWL(MASK, COMMENT PRESERVE THE TAG OF AREA[0];40586000
DECIMAL(DISK.ADDRESSF)); 40587000
IOREQUEST(IOCB~IOQUE(USER,-0,REFERENCE(AREA),DISKIOEVENT)); 40588000
RETURN(WORD(IOCB)); 40589000
END DISKIO; 40590000
SAVE PROCEDURE DISKWAIT(CORE,INDEX,SIZE,DISK,MASK); 40591000
VALUE INDEX,SIZE,DISK,MASK; 40592000
INTEGER INDEX,SIZE,DISK,MASK; 40593000
ARRAY CORE[*]; 40594000
COMMENT DISKWAIT CALLS PROCEDURE DISKIO WITH PASSED PARAMETERS AND 40595000
A LOCAL EVENT AND WAITS ON THE EVENT. 40596000
WAITS ON IT. 40597000
CORE -ARRAY DESCRIPTOR FOR CORE AREA. 40598000
INDEX -STARTING INDEX FOR CORE AREA DESCRIPTOR. 40599000
SIZE NO. OF WORDS TRANFER. 40600000
NOTE: AREA MUST BE AT LEAST SIZE+1 WORDS LONG. 40601000
DISK -SOFTWARE DISK ADDRESS 40602000
MASK MASK OF STANDARD I/O CONTROL WORD 40603000
@461 READ, MEMORY PROTECT, PROGRAM TAG) ; 40604000
BEGIN 40605000
REFERENCE IOCB; 40606000
EVENT DISKIOEVENT; 40607000
MAKEPRESENTANDSAVE(CORE); %MAKE TEMPORARILY SAVE FOR I/O 40608000
IOCB~ DISKIO(CORE,INDEX,SIZE,DISK,MASK,DISKIOEVENT); 40609000
WAIT(DISKIOEVENT); 40610000
TURNOVERLAYKEY(CORE.ADDRESSF);%RETURN TO PREVIOUS OLAY STATUS 40611000
END DISKWAIT; 40612000
PROCEDURE READALABEL(LINFO);VALUE LINFO;REAL LINFO; 40613000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%40614000
% READALABEL READS VARIOUS MAGNETIC TAPE LABELS AND STUFFS %40615000
% THE INFORMATION THEY CONTAIN INTO THE LABEL TABLE. %40616000
% %40617000
% ALL RETRY ACTION IS ACCOMPLISHED THROUGH IOERROR. %40618000
% UNEXPECTED IOERROR IS ONLY CALLED FOR MEMORY ERRORS. %40619000
% A PARITY CONDITION CAUSES THE UNIT TO BE MARKED AS %40620000
% NOT-READY AND SAVED. %40621000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%40622000
REAL T, % TEMP 40623000
TAPETYPE~LINFO.PTP, % TAPE TYPE: 1,2,3 40624000
U~LINFO.UNO, % UNIT # 40625000
DNSTY, % DENSITY 40626000
RSLT, % RESULT 40627000
UNT, % UNIT TABLE ENTRY 40628000
VECTORNO~U.DIV32F, % VECTOR # 40629000
BITNO~U.MOD32F+1, % BIT NUMBER IN STATUS VECTOR 40630000
DNSTYW~IF TAPETYPE=1 % DENSITY WORD 40631000
THEN 7 ELSE IF TAPETYPE=2 THEN 5 ELSE 8, 40632000
BITWORD, % UNIT POSITION IN STATUS WORD 40633000
N1, % NAME 1 40634000
N2, % NAME 2 40635000
PTPN, % PHYSICAL TAPE # 40636000
WRTRNG, % WRITE RING 40644000
LBLTP, % LABELTYPE 40645000
PRTY~1; % PARITY 40646000
BOOLEAN TPMRK, % TAPEMARK 40647000
OLDSTATUS; % OLD STATUS WORD 40648000
ARRAY LABELAREA[IF TAPETYPE=1 THEN 11 ELSE 15], 40649000
LABLOCK[*], 40649010
NAMES[6]; 40650000
LABEL WRAPUP,NOTREADY,RTRY,PARITYL,SCRATCH,READALABL,SCRATCHL, 40651000
ASCRATCH,BUSASI,USASIQ,CMN,RETRY,BCKSPC; 40652000
LAYOUT BITSETL(BITNO:1~1); 40653000
DEFINE NNL(S,E) = (IF TAPETYPE=1 THEN S ELSE E)#; 40653010
POINTER PVOL1,PNMS,PNMU; 40654000
MONITOR BOBMONITOR(RSLT,T); 40654010
BITWORD~0&BITSETL(); 40655000
LABELAREA[0].IOSTANDARDFIELD~TAPETEST; 40656000
IF REAL(BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,4"4F01") 40657000
).RDERROR)AND BOOLEAN(4"1B0FE"))!0 THEN GO TO NOTREADY; 40658000
% MASK, REWINDING, DENSITY, WLO, BOT 40658100
GETUNT; 40659000
UNT.UWRITERING~WRTRNG~RSLT.RDWLOOREOF+1; 40660000
UNIT[U]~UNT; 40661000
BITNO~DNSTY~(IF ONES(T~RSLT.RDDENSITY)!1THEN T ELSE REAL(T=2));40662000
% KLUDGE 40662010
RETRY: 40663000
LABELAREA[0]~0&IOCWL(TAPEREWIND,0); 40664000
PUTUNT(0,0,2,1); 40665000
GETOLDS; 40666000
IF REAL(BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,4"4101") 40667000
).RDERROR)AND BOOLEAN(4"1BEFE"))!0 THEN GO TO NOTREADY; 40668000
READALABL: 40669000
LABELAREA[0]~0&TAPEIOCWL(1,REAL(TAPETYPE=1AND BOOLEAN(PRTY+1)),40670000
REAL(TAPETYPE!1),DNSTY+4,PRTY); 40671000
DNSTYW~*&BITSETL(0); 40672000
IF BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,0))) THEN 40673000
% ACCEPT ALL ERRORS EXCEPT MEMORY 40674000
IF RSLT.RD432!0 THEN 40675000
BEGIN 40676000
NOTREADY: 40677000
PUTUNT(1,1,0,0); 40678000
GETOLDS; 40679000
% UNIT FAILURE 40680000
% WRITE TROUBLE LOG 40681000
GO TO WRAPUP 40682000
END ELSE 40683000
IF TAPEPARITY THEN 40684000
BEGIN 40685000
IF TAPETYPE=3 THEN GO TO PARITYL; 40686000
IF NOT(BOOLEAN(PRTY~PRTY+1))THEN GO TO RETRY; 40687000
IF DNSTY!0 THEN 40688000
BEGIN 40689000
DNSTY~BITNO~FIRSTONE(DNSTYW)-1; 40690000
GO TO RETRY; 40691000
END; 40692000
PARITYL: 40693000
PARITYRWLMSG(U);% 40694000
PUTUNT(1,1,0,0); 40695000
GETOLDS; 40696000
END ELSE 40697000
IF REAL(BOOLEAN(RSLT.RDERROR)AND WERRORS)!0 THEN GO NOTREADY 40698000
ELSE 40699000
IF BOOLEAN(RSLT.RDBLANKTAPE) THEN 40700000
BEGIN % PROBLEMS AT 40701000
IF DNSTY=2 AND DNSTYW!0 THEN % 200 BPI 40702000
BEGIN 40703000
PRTY~1; 40704000
DNSTY~BITNO~FIRSTONE(DNSTYW)-1; 40705000
GO TO RETRY 40706000
END; 40707000
% IT IS A BLANK TAPE 40708000
% GET SERIAL NUMBER AND STICK IT IN PTPN 40709000
SCRATCH: 40710000
LABELAREA[0].IOSTANDARDFIELD~TAPEREWIND; 40711000
PUTUNT(0,0,2,1); 40712000
IF REAL(BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,4"4101") 40713000
).RDERROR)AND BOOLEAN(4"1BEFE"))!0 THEN GO TO NOTREADY; 40714000
IF TAPETYPE=1 THEN REPLACE POINTER(LABELAREA[1],6) BY 40715000
6"VOL1",PTPN FOR 6 DIGITS,6"0X0X0X0X"FOR 18,6"650", 40716000
% TRANSLATION NEEDED 40716010
6" "FOR 48,6"0" 40717000
ELSE REPLACE POINTER(LABELAREA[1],8) BY 40718000
8"VOL1",PTPN FOR 6,8"0X0X0X" FOR 18,8"650", 40719000
8" "FOR 48,8"0"; 40720000
LABELAREA[0]~0&IOCWDETAILL(,,REAL(TAPETYPE!1), 40721000
0&IOCWTAPEL(,1,,1,,)); 40722000
IF BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,0)))THEN 40723000
GO TO NOTREADY; 40724000
LABELAREA[0]~0&IOCWTAPEL(REAL(SIMULATING)-2,,,1); % TAPE MARK 40725000
IF BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,0))) THEN 40726000
GO TO NOTREADY; 40727000
SCRATCHL: 40728000
UINFOW[U]~PTPN; 40729000
LABELAREA[0].IOSTANDARDFIELD~TAPEREWIND; 40730000
PUTUNT(0,0,4,1); 40731000
GETOLDS; 40731010
IF REAL(BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,4"4101") 40732000
).RDERROR)AND BOOLEAN(4"1BEFE"))!0 THEN GO TO NOTREADY; 40733000
GO TO WRAPUP 40734000
END ELSE 40735000
IF TPMRK AND TPMRK~BOOLEAN(RSLT.RDWLOOREOF) THEN GO TO PARITYL 40736000
ELSE GO TO READALABL; 40737000
IF BOOLEAN(RSLT.RDINCREC)THEN 40737010
IF RSLT.RDMEMADDR-LABELAREA.ADDRESSF>LABELAREA.LENGTHF THEN 40737020
T~(RSLT.RDMEMADDR-LABELAREA.ADDRESSF)+(IF RSLT.RDCHRCNT=0 THEN 40737030
0 ELSE 1); 40737040
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%40738000
% IF GET TO HERE HAVE READ FIRST RECORD (IT MAY BE WRONG %40739000
% SIZE HOWEVER) %40740000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%40741000
IF TAPETYPE!1 THEN 40742000
IF PVOL1~POINTER(LABELAREA[1],8)=8"VOL1"THEN % USASI LABEL 40743000
BUSASI: 40744000
IF REAL(USYSN,2)=(IF TAPETYPE=1 THEN 6"65" ELSE 8"65") THEN 40745000
IF REAL(ULSL,1)=(IF TAPETYPE=1 THEN 6"0"ELSE 8"0")THEN 40746000
IF REAL(USYST,1)=0 AND REAL(UMFID,6)IS(IF TAPETYPE=1 THEN 40747000
6"0X0X0X" ELSE 8"0X0X0X") THEN % SCRATCH 40747010
ASCRATCH: 40748000
IF BOOLEAN(WRTRNG)THEN GO TO SCRATCHL ELSE % WRITE RING 40749000
BEGIN 40750000
% SCRATCH TAPE, NO WRITE RING 40751000
PUTUNT(1,1,4,0); 40752000
GETOLDS; 40753000
GO TO WRAPUP; 40754000
END 40755000
ELSE GO TO USASIQ 40756000
ELSE % STANDARD 40757000
IF REAL(ULSL,1)!(IF TAPETYPE=1 THEN 6"1"ELSE 8"1") THEN 40757010
GO TO USASIQ ELSE % STANDARD 40757020
IF REAL(USYST,1)=0 THEN GO TO USASIQ ELSE % SCRATCH 40758000
IF REAL(USYST,1)=1 THEN 40759000
BEGIN % "USER" TAPE 40760000
IF TAPETYPE=1 THEN 40761000
BEGIN 40762000
REPLACE (PNMS~POINTER(NAMES,8))+1 BY UMFID FOR 17 40763000
WITH BCLTOEBC[*]; 40764000
SCAN PNMU:PNMS+1 FOR N1:17 WHILE!8" " 40765000
END ELSE 40766000
REPLACE PNMU:(PNMS~POINTER(NAMES,8))+1 BY UMFID FOR N1:17 40767000
WHILE!8" "; 40768000
REPLACE PNMS BY N1~17-N1 FOR 1 CORRECTLY; 40769000
IF REAL(UMFID,1)=(IF TAPETYPE=1 THEN 6"0"ELSE 4"00") THEN 40769010
BEGIN N1~0;PNMU~PNMS END; 40769020
PTPN~REAL(UVSN,6); 40770000
%%%%% READ HDR1 40771000
IF REAL(BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,0) 40772000
).RDERROR)AND BOOLEAN(3"376776"))!0 THEN 40773000
IF RSLT.RD432!0 THEN GO TO NOTREADY ELSE 40774000
IF TAPEPARITY THEN GO TO PARITYL ELSE GO TO NOTREADY; 40775000
IF BOOLEAN(RSLT.RDWLOOREOF) THEN 40776000
BEGIN % TAPE MARK 40777000
BCKSPC: 40778000
LABELAREA[0]~0&IOCWSPACEL(,1,1); 40779000
IF BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,0))) THEN 40780000
GO TO NOTREADY; 40781000
GO TO USASIQ; 40782000
END; 40783000
IF REAL(PHDR1,4)!(IF TAPETYPE=1 THEN 6"HDR1" ELSE 8"HDR1") OR 40784000
NOT(REAL(USYSL,6)IS(IF TAPETYPE=1 THEN 6" B6500" ELSE 40784010
8" B6500")) THEN GO TO BCKSPC; 40784020
IF TAPETYPE=1 THEN 40785000
BEGIN 40786000
REPLACE PNMU+1 BY UFID FOR 17 WITH BCLTOEBC[*]; 40787000
SCAN PNMU+1 FOR N2:17 WHILE!8" "; 40788000
END ELSE 40789000
REPLACE PNMU+1 BY UFID FOR N2:17 WHILE!8" "; 40790000
REPLACE PNMU BY N2~17-N2 FOR 1 CORRECTLY; 40791000
IF BOOLEAN(WRTRNG) THEN 40792000
IF INTEGER(UEDT,5){TODAYSDATE THEN GO TO SCRATCH ELSE% 40793000
IF RETTOG AND LBLTP!0 THEN% 40794000
BEGIN 40795000
RETMSG(UNT);% 407959904079600?
RETMSG(UNT);% 40796000
END; 40797000
LABLOCK~*&ARRAYDESCL(0,7+(N1+N2+9)DIV 6,0); 40800000
REPLACE PNMU~POINTER(LABLOCK[7],8) BY 1 FOR 1 CORRECTLY, 40802000
REAL(N1!0)+1 FOR 1 CORRECTLY,PNMS FOR N1+N2+2; 40803000
UINFOP[U,*]~WORD(LABLOCK); 40803010
LCNTRL~0&LEBCNTRL(5,3"30000",,1,,1,LBLTP,,UNT.UNITTYPE); 40804000
LGEN1~0&GENEALOGY1(INTEGER(UGNRTN,4),INTEGER(UVRSN,2), 40805000
1,INTEGER(URLNMBR,4)); 40806000
LGEN2~0&GENEALOGY2(,INTEGER(UCDT,5)); 40807000
LMISC~0&LMISCL(INTEGER(UBCNT,6),INTEGER(URCNT,7)); 40808000
%%%%% HDR2 40809000
IF REAL(BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,0) 40810000
).RDERROR)AND BOOLEAN(3"376776"))!0 THEN 40810050
BEGIN 40811000
CMN: 40812000
FORGETSPACE(UINFOW[U].ADDRESSF); 40813000
IF RSLT.RD432!0 THEN GO TO NOTREADY ELSE 40815000
IF TAPEPARITY THEN GO TO PARITYL ELSE GO TO NOTREADY; 40816000
GO TO BCKSPC; % PREMATURE TPMRK 40816010
END; 40817000
IF REAL(PHDR2,4)!(IF TAPETYPE=1 THEN 6"HDR2" ELSE 8"HDR2") 40818000
THEN GO TO CMN; 40818010
LBLK1~0&BLOCKING1(RCRDFRMT,,,INTEGER(URL,5),INTEGER(UBL,5)); 40819000
LCNTRL.DENSITYL~DNSTY~REAL(UDNSTY,1)+4; 40820000
LCNTRL.LPARITY~PRTY~REAL(UPRTY,1); 40821000
LCNTRL.EXTFORML~REAL(UFORM,1); 40822000
LBLK2.MINRECSZL~INTEGER(UMRL,5); 40823000
LCNTRL.FPRTCTD~REAL(INTEGER(UOFS,2)!0); 40824000
PUTUNT(0,0,1,0); 40825000
END ELSE 40826000
IF REAL(USYST,1)=2 THEN % SYSTEM TAPE 40827000
BEGIN 40828000
IF NOT(REAL(UMFID,6)IS(IF TAPETYPE=1 THEN 6"SYSTEM" ELSE 40829000
8"SYSTEM")) THEN GO TO USASIQ; 40829010
LBLTP~7; 40830000
GO TO BUSASI 40831000
END ELSE 40832000
IF REAL(USYST,1)=3 THEN % BACKUP 40833000
BEGIN 40834000
IF NOT(REAL(UMFID,6)IS(IF TAPETYPE=1 THEN 6"BACKUP" ELSE 40835000
8"BACKUP")) THEN GO TO USASIQ; 40835010
LBLTP~6; 40836000
PBTONMSG(UNT);% 40837000
GO TO BUSASI 40838000
END ELSE 40839000
% LIBRARY TAPE 40839050
ELSE % NON B6500 40840000
IF REAL(ULSL,1)=(IF TAPETYPE=1 THEN 6"1" ELSE 8"1") THEN 40840100
BEGIN 40840120
PTPN~REAL(UVSN,6); 40840130
IF REAL(BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,0) 40840140
).RDERROR)AND BOOLEAN(3"376776"))!0 THEN 40840150
IF RSLT.RD432!0 THEN GO TO NOTREADY ELSE 40840160
IF TAPEPARITY THEN GO TO PARITYL ELSE GO TO NOTREADY; 40840170
IF BOOLEAN(RSLT.RDWLOOREOF)THEN GO TO BCKSPC; 40840180
IF REAL(PHDR1,4)!(IF TAPETYPE=1 THEN 6"HDR1"ELSE 8"HDR1") OR 40840190
NOT(REAL(USYSL,6)IS(IF TAPETYPE=1 THEN 6"BUR " ELSE 40840200
8"BUR ")) THEN GO TO BCKSPC; 40840210
%%%%% B3500 USASI LABEL 40840220
IF TAPETYPE=1 THEN 40840230
BEGIN 40840240
REPLACE (PNMS~POINTER(NAMES,8))+1 BY B35MFID FOR 6 40840250
WITH BCLTOEBC[*]; 40840260
SCAN PNMU:PNMS+1 FOR N1:6 WHILE!8" "; 40840270
IF REAL(PNMS+1,1)=8"0"THEN BEGIN N1~6;PNMU~PNMS END; 40840280
REPLACE PNMU+1 BY B35FID FOR 8 WITH BCLTOEBC[*]; 40840290
SCAN PNMU+1 FOR N2:8 WHILE!8" "; 40840300
END ELSE 40840310
BEGIN 40840320
REPLACE PNMU:(PNMS~POINTER(NAMES,8))+1 BY B35MFID FOR N1:6 40840330
WHILE ! 8" "; 40840340
IF REAL(PNMS+1,1)=8"0"THEN BEGIN N1~6;PNMU~PNMS END; 40840350
REPLACE PNMU+1 BY B35FID FOR N2:8 WHILE!8" "; 40840360
END;; 40840370
REPLACE PNMS BY N1~6-N1 FOR 1 CORRECTLY; 40840380
REPLACE PNMU BY N2~8-N2 FOR 1 CORRECTLY; 40840390
IF BOOLEAN(WRTRNG)THEN 40840400
IF INTEGER(UEDT,5){TODAYSDATE THEN GO TO SCRATCH ELSE 40840410
IF RETTOG THEN% 40840420
BEGIN 40840430
RETMSG(UNT);% 40840440
END; 40840450
LABLOCK~*&ARRAYDESCL(0,5+(N1+N2+9)DIV 6,0); 40840460
REPLACE PNMU~POINTER(LABLOCK[5],8) BY 1 FOR 1 CORRECTLY, 40840470
REAL(N1!0)+1 FOR 1 CORRECTLY,PNMS FOR N1+N2+2; 40840480
UINFOP[U,*]~WORD(LABLOCK); 40840490
LCNTRL~0&LEBCNTRL(5,,,1,DNSTY+4,1,4,,UNT.UNITTYPE); 40840500
% RECHECK 40840505
LGEN1~0&GENEALOGY1(INTEGER(UGNRTN,4),INTEGER(UVRSN,2), 40840510
1,INTEGER(URLNMBR,4)); 40840520
LGEN2~0&GENEALOGY2(,INTEGER(UCDT,5)); 40840530
LMISC~0&LMISCL(INTEGER(UBCNT,6),INTEGER(URCNT,7)); 40840540
END ELSE 40840550
ELSE 40841000
BEGIN % NON-USASI 40842000
USASIQ: 40843000
T~REAL(PVOL1,8); 40843010
PUTUNT(0,1,0,1); 40844000
GETOLDS; 40845000
LABELAREA[0]~0&IOCWL(TAPEREWIND,0); 40846000
IF REAL(BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,4"4101") 40847000
).RDERROR)AND BOOLEAN(4"1BEFE"))!0 THEN GO TO NOTREADY; 40848000
END 40849000
ELSE % TAPETYPE 1 40850000
IF PVOL1~POINTER(LABELAREA[1],6)=6"VOL1"THEN % USASI 40851000
GO TO BUSASI 40852000
ELSE % NON USASI 40853000
IF PVOL1=6" LABEL " THEN % B5500 LABEL 40854000
BEGIN 40855000
PTPN~REAL(LVSN,5); 40855010
IF LFID=6"FILE000"THEN LBLTP~11 ELSE 40856000
IF LMFID=6"X0X0X0X" OR LFID=6" X"THEN GO TO ASCRATCH ELSE 40856010
IF LMFID=6"PBTMCP "AND LFID=6"BACK-UP"THEN LBLTP~10; 40857000
IF BOOLEAN(WRTRNG) THEN 40858000
IF INTEGER(LEDT,5){TODAYSDATE AND LBLTP=0 THEN GO SCRATCH ELSE 40859000
IF RETTOG OR LBLTP!0 THEN% 40860000
BEGIN 40861000
RETMSG(UNT);% 40862000
END; 40863000
REPLACE (PNMS~POINTER(NAMES,8))+1 BY LMFID FOR 7 40864000
WITH BCLTOEBC[*]; 40865000
SCAN PNMU:PNMS+1 FOR N1:7 WHILE!8" "; 40866000
REPLACE PNMS BY N1~7-N1 FOR 1 CORRECTLY; 40867000
IF REAL(LMFID,7)=0 THEN BEGIN PNMU~PNMS;N1~0 END; 40867010
REPLACE PNMU+1 BY LFID FOR 7 WITH BCLTOEBC[*]; 40868000
SCAN PNMU+1 FOR N2:7 WHILE!8" "; 40869000
REPLACE PNMU BY N2~7-N2 FOR 1 CORRECTLY; 40870000
LABLOCK~*&ARRAYDESCL(0,5+(N1+N2+9)DIV 6,0); 40871000
REPLACE PNMU~POINTER(LABLOCK[5],8) BY 1 FOR 1 CORRECTLY, 40873000
REAL(N1!0)+1 FOR 1 CORRECTLY,PNMS FOR N1+N2+2; 40874000
UINFOP[U,*]~WORD(LABLOCK); 40874010
LCNTRL~0&LEBCNTRL(5,,PRTY,1,DNSTY+4,1,2,2,UNT.UNITTYPE); 40875000
% RECHECK 40875010
LGEN1~0&GENEALOGY1(INTEGER(LCYCLE,2),,1,INTEGER(LREEL,3)); 40876000
LGEN2~0&GENEALOGY2(,INTEGER(LCDT,5)); 40877000
LMISC~0&LMISCL(INTEGER(LBCNT,5),INTEGER(LRCNT,7)); 40878000
IF T!0 THEN 40878010
BEGIN % USERS PORTION 40878020
LMISC~SET(LMISC,46); 40878030
LMISC.BCNTL~T; 40878040
END; 40878050
PUTUNT(0,0,1,0); 40879000
END 40880000
ELSE GO TO USASIQ; 40881000
WRAPUP: 40882000
DIVORCEMOM(LABLOCK); 40882010
CAUSE(FINDINPUTEVENT); 40882015
WHILE BOOLEAN(T~READLOCK(1,RDLBLP)) DO; 40883000
BITNO~LINFO.PNO; 40884000
RDLBLP~T&BITSETL(0); 40885000
END READALABEL; 40886000
PROCEDURE PURGIT(U);VALUE U;REAL U; 40887000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%40888000
% PURGIT PURGES TAPES. IT IS CALLED FROM KEYIN OR STATUS. %40889000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%40890000
REAL UNT, 40891000
T, 40892000
RSLT, 40893000
BITNO, 40894000
BITWORD, 40895000
VECTORNO, 40896000
PTPN; 40897000
LABEL STRT,NOTREADY,PARITYL,WRAPUP; 40898000
ARRAY LABELAREA[IF SCHANNEL THEN 11 ELSE 15]; 40899000
BOOLEAN OLDSTATUS; 40900000
LAYOUT BITSETL(BITNO:1~1); 40901000
STRT: 40902000
VECTORNO~U.DIV32F; 40903000
BITNO~U.MOD32F+1; 40904000
BITWORD~0&BITSETL(); 40905000
GETUNT; 40906000
UNT.UNITASSIGNED~1; 40907000
UNIT[U]~UNT; 40908000
IF PTPN~(IF BOOLEAN(UNT.ULABELLED)THEN LGEN2.SERIALN ELSE 40909000
UINFO[U])=0 THEN; 40910000
% MESSAGE FOR SERIAL NUMBER 40911000
LABELAREA[0]~0&IOCWL(TAPEREWIND,0); 40912000
PUTUNT(1,0,2,1); 40913000
IF BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,0))) THEN 40914000
BEGIN 40915000
NOTREADY: 40916000
PUTUNT(1,1,0,0); 40917000
GETOLDS; 40918000
% UNIT FAILURE 40919000
% WRITE TROUBLE LOG 40920000
GO TO WRAPUP 40921000
END ELSE 40922000
IF SCHANNEL THEN REPLACE POINTER(LABELAREA[1],6) BY 40923000
6"VOL1",PTPN FOR 6 DIGITS,6"0X0X0X0X"FOR 18,6"650", 40924000
6" "FOR 48,6"0" 40925000
ELSE REPLACE POINTER(LABELAREA[1],8) BY 40926000
8"VOL1",PTPN FOR 6 DIGITS,8"0X0X0X"FOR 18,8"650", 40927000
8" "FOR 48,8"0"; 40928000
LABELAREA[0]~0&TAPEIOCWL(,,REAL(NCHANNEL),,1); 40929000
IF BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,0))) THEN 40931000
IF RSLT.RD432!0 THEN GO TO NOTREADY ELSE 40932000
IF TAPEPARITY THEN 40933000
BEGIN 40934000
PARITYL: 40935000
PARITYRWLMSG(UNT);% 40936000
PUTUNT(1,1,0,0); 40937000
GETOLDS; 40938000
GO TO WRAPUP; 40939000
END ELSE 40940000
GO TO NOTREADY; 40941000
LABELAREA[0]~0&IOCWTAPEL(REAL(SIMULATING)-2,,,1); % TAPE MARK 40942000
IF BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,0))) THEN 40943000
GO TO NOTREADY; 40944000
LABELAREA[0]~0&IOCWL(TAPEREWIND,0); 40945000
PUTUNT(1,0,4,1); 40946000
IF UINFOW[U].TAG!0 THEN FORGETSPACE(UINFOW[U].ADDRESSF); 40947000
UINFOW[U]~PTPN; 40948000
IF BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,0))) THEN 40949000
GO TO NOTREADY; 40950000
WRAPUP: 40951000
WHILE BOOLEAN(T~READLOCK(1,PRGT)) DO; 40952000
IF PRGT~T-2>0 THEN 40953000
IF U~MASKSEARCH(@1400,@207067400,UNIT)}0 THEN GO TO STRT; 40954000
WHILE BOOLEAN(T~READLOCK(1,PRGT)) DO; 40955000
PRGT~0; 40956000
END PURGIT; 40957000
40958000
REAL PROCEDURE SPACEOF(IOCW);VALUE IOCW;REAL IOCW; 40959000
BEGIN 40960000
ARRAY LABELAREA[5]; 40961000
REAL RSLT, 40962000
U~IOCW.UNITNUM; 40963000
LABELAREA[0]~IOCW&IOCWL(TAPESPACE); 40964000
WHILE REAL(BOOLEAN(RSLT~WAITIO(LABELAREA,USAH, 40965000
ERAH(UNEXP,4"E81")).RDERROR)AND BOOLEAN(3"377776"))=0 DO; 40966000
SPACEOF~IF RSLT IS 4"E81"OR RSLT IS 4"201"THEN 0 ELSE RSLT; 40967000
END SPACEOF; 40968000
PROCEDURE CLOSERR(RSLT,U);VALUE RSLT,U;REAL RSLT,U; 40969000
BEGIN 40970000
BOOLEAN OLDSTATUS; 40971000
REAL 40972000
CLOSERROR, 40973000
VECTORNO~U.DIV32F, 40974000
BITWORD, 40975000
BITNO~U.MOD32F+1, 40976000
UNT; 40977000
LAYOUT BITSETL(BITNO:1~1); 40978000
MONITOR BOBMONITOR(CLOSERROR,U); 40979000
CLOSERROR~*; 40980000
U~*; 40981000
BITWORD~0&BITSETL(); 40982000
PUTUNT(1,1,0,0); 40983000
GETOLDS; 40984000
PARITYRWLMSG(U); 40985000
END CLOSERR; 40986000
PROCEDURE LIBMAIN(MFID);VALUE MFID;POINTER MFID; 40987000
BEGIN 40988000
ARRAY DHEADER[31], 40989000
TAPEBLOCK[905], 40990000
LEB[9]; 40991000
LABEL XIT; 40992000
REAL 40993000
UNT, 40994000
RSLT, 40995000
DISKADDRESS~DISKFILEHEADERS[0,10], 40996000
FRSLT, 40997000
FINDWORD, 40998000
IOCW, 40999000
U; 41000000
MONITOR BOBMONITOR(U,RSLT,DISKADDRESS); 41001000
LEBC.FXD~1; 41002000
REPLACE POINTER(LEB[5],8) BY 41003000
1 FOR 1 CORRECTLY, 41005000
2 FOR 1 CORRECTLY, 41006000
MFID+2 FOR REAL(MFID+2,1)+1, 41007000
7 FOR 1 CORRECTLY, 41008000
8"FILE000"; 41008100
U~17; 41009000
% KLUDGE 41009100
IF FRSLT~FINDWORD.REPVALF=OFV THEN GO TO XIT; 41010000
GETUNT; 41011000
UNIT[U]~UNT&UNITL(0,0,3,0); 41011100
IF NOT MAGTAPE(UNT.UNITTYPE)THEN IOTERMINATE; 41012000
IOCW~0&TAPEIOCWL(1,0,0,5,1); 41013000
IOCW.UNITNUM~U; 41013100
THRU 3 DO IF BOOLEAN(RSLT~SPACEOF(IOCW))THEN 41014000
BEGIN CLOSERR(RSLT,U); GO TO XIT END; 41015000
DHEADER[0]~IOCW; 41016000
IF BOOLEAN(RSLT~WAITIO(DHEADER,USAH,ERAH(UNEXP,4"401")))THEN 41017000
IF NOT(RSLT.RDERROR IS 4"401")THEN 41017010
BEGIN CLOSERR(RSLT,U);GO TO XIT END; 41018000
WHILE TRUE DO 41021000
BEGIN 41022000
TAPEBLOCK[0]~IOCW; 41023000
IF REAL(BOOLEAN((RSLT~WAITIO(TAPEBLOCK,USAH,ERAH(UNEXP,3"3001")41024000
)).RDERROR) AND BOOLEAN(3"374776"))!0 THEN 41025000
BEGIN CLOSERR(RSLT,U);GO XIT END; 41026000
IF BOOLEAN(RSLT.RDWLOOREOF)THEN GO TO XIT; 41027000
DISKWAIT( 41028000
TAPEBLOCK 41029000
,0 41030000
,FRSLT~IF BOOLEAN(RSLT.RDINCREC)THEN RSLT.WORDCOUNTF ELSE 41031000
900 41032000
, DISKADDRESS 41033000
,DISKWRITE 41034000
); 41035000
DISKADDRESS~*+FRSLT DIV 30; 41036000
END; 41037000
XIT: 41038000
GETUNT; 41038050
UNT.UNITASSIGNED~0; 41038100
UNIT[U]~UNT; 41038200
STOP; 41039000
END LIBMAIN; 41040000
% START OF KEYIN AND ASSOCIATED PROCEDURES 44000000
SAVE REAL PROCEDURE DELTA(P1,P2); VALUE P1,P2; WORD P1,P2; 44000100
BEGIN 44000110
REAL S; 44000120
DEFINE DEFAULT =8#; 44000125
IF S~P1.SZF=P2.SZF THEN 44000130
DELTA~(S~(IF S=0 THEN DEFAULT ELSE 48/(S|2))) 44000140
| (P2.INDEXSTF-P1.INDEXSTF)+P2.BYTEF-P1.BYTEF; 44000150
END DELTA; 44000160
SAVE PROCEDURE BILDCDEFID(FIDREF,P);VALUE FIDREF; REFERENCE FIDREF; 44000200
POINTER P;% 44000210
BEGIN 44000220
ARRAY CDEFIDAREA = FIDREF[*];% 44000230
INTEGER I~3, FIDS;% 44000240
POINTER T~P;% 44000250
DEFINE% 44000300
BILDCDEFIDPOINTER= FIDREF~*&STRINGDESCRIPTOR(*,,,*,,,EBCDIC, 44000310
,FIDREF.ADDRESSF+KFPSCRATCHWORDSZ)#, 44000312
NUMBEROFIDS = REAL(POINTER(CDEFIDAREA[1],*),1)#,% 44000320
NUMBEROFNAMES= REAL(POINTER(CDEFIDAREA[2],*),1)#,% 44000330
NUMBEROFCHRS = REAL(POINTER(CDEFIDAREA[I],*),1)#,% 44000340
ANAME=POINTER(CDEFIDAREA[I+1],*)FOR NUMBEROFCHRS, SLASH#, 44000350
ENDBCFDEF=0#;% 44000390
BILDCDEFIDPOINTER;% 44000400
IF FIDS~NUMBEROFIDS=1 THEN% 44000410
THRU NUMBEROFNAMES DO% 44000420
BEGIN% 44000430
REPLACE T:T BY ANAME;% 44000440
I~*+NUMBEROFCHRS+1;% 44000450
END ELSE% 44000460
REPLACE T:T BY FIDS FOR 3 DIGITS,8" FILE IDENTIFIERS. "; 44000470
P~T-1;% 44000480
END BILDCDEFID;% 44000490
PROCEDURE JOBMESSER(STKNO,POINTTOBUF); VALUE STKNO;% 44000500
INTEGER STKNO; POINTER POINTTOBUF;% 44000510
BEGIN% 44000520
POINTER P~POINTTOBUF;% 44000535
REFERENCE FIDREF;% 44000550
REAL X, Y;% 44000560
DEFINE% 44000600
COMPILER = 8"CMPLR "#,% 44000630
CORE= COLON, PERCENTAGE(X)#,% 44000640
PROCTIME= COLON, PERCENTAGE(Y)#,% 44000650
GETCORE= X~(STACK[STKNO,COREPLACE]/MEMMAX)|1000#,% 44000660
GETPROCTIME= Y~STACK[STKNO,PROCTIMEPLACE]/(TIMECORRFACT|60)#, 44000670
CFND= MYCODEFILENAME(STKNO)#,% 44000680
PRIORITY = AT, STACK[STKNO,PRIORITYPLACE] FOR 2 DIGITS#, 44000710
JOBIDENT = STKNO FOR 4 DIGITS, BLANK#,% 44000720
STATUS = BLANK FOR STATUSSZ#,% 44000730
ENDJOBMESSDEF=0#;% 44000790
FIDREF~CFND;% 44000800
REPLACE P:P BY HOME, JOBIDENT, COMPILER;% 44000850
BILDCDEFID(FIDREF,P);% 44000860
GETCORE;% 44000930
GETPROCTIME;% 44000940
REPLACE P:P BY PRIORITY, CORE, PROCTIME, STATUS, ETX;% 44000950
POINTTOBUF~P;% 44000980
END JOBMESSER;% 44000990
REAL PROCEDURE GETUNITNUM(UNITMNEM,UNITNUM);VALUE UNITMNEM,UNITNUM; 44001000
REAL UNITMNEM, UNITNUM; 44002000
BEGIN 44003000
REAL I; 44004000
LABEL XIT ;44005000
REAL Q; 44006000
Q ~ MNEMLIM | MNEMSZ; 44007000
IF ABS(UNITNUM)>MAXUNIT THEN ELSE 44008000
FOR I ~ 0 STEP MNEMSZ UNTIL Q DO 44009000
IF REAL(POINTER(MNEMONIC[I],*),MNEMSZ)=UNITMNEM THEN 44010000
IF UNIT[I~UNITBL[TI(I/MNEMSZ),UNITNUM]].UNITTYPECNTRF= 44011000
UNITNUM THEN 44012000
BEGIN 44013000
GETUNITNUM~I; 44014000
GO TO XIT; 44015000
END ELSE 44016000
I~Q; 44017000
GETUNITNUM~-UNITNUM; 44018000
XIT: 44019000
END GETUNITNUM; 44020000
PROCEDURE MIXUPDATE;% 44021000
BEGIN% 44022000
ARRAY TMPBUF[*];% 44023000
REFERENCE PREVLASTITEM,% 44023200
TMPENTRY~NULL;% 44023300
BOOLEAN BLANKPIC~MIXQHD=NULL;% 44023400
POINTER LINE;% 44023500
INTEGER I,% 44023700
LINENO;% 44023800
DEFINE% 44024000
44024001
ENDMIXUPDEF=0#;% 44024990
FOR I~0 STEP 1 UNTIL MAXSTACKS DO% 44026000
IF USINGSTACK(I) THEN% 44026100
IF D2STACKIS(I) THEN% 44026200
IF MCPNOTUSINGSTACK(I) THEN% 44026300
BEGIN% 44026400
TMPENTRY~JOBREF(I);% 44026500
LINE~POINTER((TMPBUF~LNBUF@TMPENTRY)[1],8);44026600
IF HAVENTSUSPENDED(I) THEN% 44026700
BEGIN% 44026800
JOBMESSER(LNID@TMPENTRY,LINE);% 44026900
END;% 44027000
LINENO~LINENO+1;% 44027100
LNDESC@(TMPENTRY)~CURRENTIMAGE(% 44027200
LINENO MOD MAXLNS,LINENO DIV MAXLNS); 44027300
INSERT(MIXQ(TMPENTRY));% 44027400
END% 44027800
ELSE% 44027900
ELSE BEGIN% 44028000
END;% 44028200
IF BLANKPIC THEN ELSE REARRANGE(MIXQ(PREVLASTITEM));% 44032000
END MIXUPDATE;% 44034000
PROCEDURE FILEMESS(IOCB,UNITNO);VALUE UNITNO;REAL UNITNO; 44035000
REFERENCE IOCB; 44036000
BEGIN 44037000
REAL U, UE, I;% 44038000
ARRAY UI[*]; WORD UINFOREF=UI;% 44038100
WORD FIDREF;% 44038200
ARRAY MSGAREA[*];REFERENCE MSGAREAREF=MSGAREA;% 44039000
POINTER SPAM;% 44040000
DEFINE% 44041000
LSTB= 44#,% LEAST SIGNIFICANT TEST BIT 44042000
UNOTREADY= U.UNITNOTREADY#,% 44043000
NOTREADY= 8" NOT READY"#,% 44044000
UINUSE= BOOLEAN(U.UNITASSIGNED)#,% 44045000
INUSE= 8"I"#,% 44046000
REELNO= UI[GENEALOGY1].REEL FOR 3 DIGITS#,% 44048000
GENEALOGY1= 1#,% 44048100
UNITLABELED= U.ULABELLED#,% 44049000
LABELED= 8" "#,% 44050000
UNITSCRATCH= U.USCRATCH#,% 44051000
SCRATCH= 8" SCRATCH"#,% 44052000
URWORLOCK= REAL(BOOLEAN(U.UINREWIND) OR BOOLEAN(U.ULOCKED))#, 44053000
RWORLOCK= 8"RW/L"#,% 44054000
MIX= SNR FOR 4 DIGITS#,% 44055000
ENDFILMESDEF=0#;% 44060000
MSGAREAREF~ KBUF @ IOCB; 44061000
U~UNIT[UNITNO]; 44062000
UINFOREF~UINFO[UNITNO];% 44065000
FIDREF~0&ARRAYDESCL(3,UINFOREF.LENGTHF-(I~((I~UI[0].FXD) 44065100
-ONES(I.OPTMASK)+KFPSCRATCHWORDSZ)),UINFOREF.ADDRESSF+1); 44065102
REPLACE SPAM:POINTTOMSGAREA BY HOME, 44066000
POINTER(MNEMONIC[(U.UNITTYPE)|MNEMSZ],*) FOR MNEMSZ, 44067000
UE.UNITTYPECNTRF FOR 3 DIGITS; 44068000
I~0&BITL(% 44069000
UNOTREADY, 44070000
URWORLOCK, 44071000
UNITSCRATCH, 44072000
UNITLABELED, 44073000
);% THIS TAKES UP SLACK FROM LSTB TO ZERO 44074000
CASE (IF I~FIRSTONE(I)-LSTB>0 THEN I ELSE 0) OF 44076000
BEGIN% CASES 44077000
;% TEST RESULTED IN ALL ZERO -- SHOULD NEVER HAPPEN 44078000
44079000
BEGIN% UNITLABELED 44085000
BILDCDEFID(FIDREF,SPAM);% 44086000
REPLACE SPAM:SPAM BY REELNO;% 44086100
IF UINUSE THEN REPLACE SPAM:SPAM BY MIX;% 44087000
END; 44088000
REPLACE SPAM:SPAM BY SCRATCH; 44089000
REPLACE SPAM:SPAM BY RWORLOCK; 44090000
REPLACE SPAM:SPAM BY NOTREADY; 44091000
END CASE; 44092000
REPLACE SPAM:SPAM BY ETX; 44093000
SPOUT(IOCB,DISPLAYONPER); 44094000
END FILEMESS; 44095000
PROCEDURE KEYIN(COUNT); REAL COUNT; 44096000
BEGIN 44097000
REFERENCE IOCB; 44098000
POINTER P; 44099000
INTEGER I,J,K,N; 44100000
INTEGER MSGSZ, 44101000
POPIN, DEATHS,% 44101100
ALIM, BLIM, 44102000
PRESZ, SUFSZ; 44103000
INTEGER PREFIX, SUFFIX; 44104000
ARRAY MSGAREA[*]; 44105000
WORD ARRAY BUFFO[*]; 44106000
EVENT REPEVNT; WORD REPEVNTWRD = REPEVNT; 44106100
REAL RSDS; 44107000
REAL CONNO; 44108000
INTEGER BITWORD, REPWRD; 44109000
BOOLEAN SPOED;% 44109100
REAL TMPTRAC; 44110000
REFERENCE MSGAREAREF=MSGAREA; 44111000
LAYOUT SCANL(TYPF=47:2,SYZF=39:FIRSTONE(LINESZ),CHRF=7:8); 44112000
LABEL IL,FM,UL,OU,FR,OHF,RM,TI,DS,ST,PR,XS,OK,ES,US,AX; 44113000
LABEL OL,RY,PG,PB,SV,RW,CL ;44114000
LABEL TF,LD,RN,RD,SF,SO,RO,TOH,TR,DR,WT,WD,WM,PI,EI,LE,TC ;44115000
LABEL QTOP, CAUZIT, CHECKB, ENDOFMSG, SPOUTIT, ANSREPLY;% 44115100
DEFINE 44116000
PIMSG=HOME,8"PI=",POINTER(PIE,8) FOR MAXMSGSZ,LINEERASE,ETX#, 44117000
EIMSG= BACKSPACE,BACKSPACE,8" EIO",LINEERASE,ETX#,% 44118000
CHECKUMNEM= I~GETUNITNUM(REAL(P,MNEMSZ), 44119000
INTEGER(P+MNEMSZ,SUFSZ-MNEMSZ))<0#, 44120000
CHCKANS= IF CHECKUMNEM THEN BEGIN INVKBD; GO TO ENDOFMSG;END; 44120100
REPWRD.REPINFOF~I;GO TO ANSREPLY#,% 44120102
SHIFTBUF=BUFFO~BUFFO&ARRAYDESCL(3,IOCB.LENGTHF-IOCBSIZE, 44121000
IOCB.ADDRESSF+IOCBSIZE); 44122000
KBUF @(IOCB)~REFERENCE(BUFFO)#, 44123000
POINTTOBUFFO= POINTER(BUFFO[1],BYTESZ)#, 44124000
PNSSZ= 7#,% NUMBER OF PREFIX NO SUFFIX 44125000
PSSZ= 9#,% PREFIX AND SUFFIX 44125010
NPSSZ= 17#,% SUFFIX NO PREFIX 44125020
NPNSSZ= 10#,% NO PREFIX NO SUFFIX 44125030
NPSORNSSZ= 2#,% SUFFIX OR NO SUFFIX 44125040
TPNS= 0#,% TOP OF PREFIX NO SUFFIX 44126000
TPS= BPNS+DICBSZ#,% PREFIX AND SUFFIX 44126010
TNPS= BPS+DICBSZ#,% SUFFIX NO PREFIX 44126020
TNPNS= BNPS-DICBSZ|NPSORNSSZ#,% NO PREFIX NO SUFFIX 44126030
BPNS= DICBSZ|(PNSSZ-1)#,% BOTTOM OF PREFIX NO SUFFIX 44127000
BPS= TPS+DICBSZ|(PSSZ-1)#,% PREFIX AND SUFFIX 44127010
BNPS= TNPS+DICBSZ|(NPSSZ-1)#,% SUFFIX NO PREFIX 44127020
BNPNS= TNPNS+DICBSZ|(NPNSSZ-1)#,% NO PREFIX NO SUFFIX 44127030
MINREPCDE= 6#, 44132100
MAXREPCDE= 16#,% 44132110
STKNUM= PREFIX#, 44132200
SETTIME= 44132300
COMMENT PREFIX~TIMEOFDAY-TIMEBASE WAIT FOR TOM 44132320
TIMEBASE~-1;% 44132330
SCANOUT(I~(K+J|60+I|3600)|TIMECORRFACT,TIMEOFDAYWORD); 44132340
COMMENT TIMEBASE~I-PREFIX **** WAIT FOR TOM ALSO; #, 44132360
SCNUNTEQ(DELIM,LIM)= SCAN P FOR N:LIM UNTIL = DELIM#, 44133000
NORPLYREQD= HAPPENED(REPEVNT) OR% 44133100
NOT BOOLEAN(REPLY[STKNUM].[I:1])#,% 44133110
ALF= 2#,% 44133300
SPC= 1#,% 44133310
NUM= 0#,% 44133320
ENDKEYINDEFINES=0#; 44134000
SAVE PROCEDURE INVKBD; 44135000
BEGIN 44136000
DEFINE 44137000
INVKBDM=8"INV KBD "#,% 44138000
D=0#; 44139000
SHIFTBUF; 44140000
REPLACE POINTTOBUFFO BY INVKBDM, 44141000
POINTTOMSGAREA FOR MSGSZ, 44142000
ETX; 44143000
SPOUT(IOCB,DISPLAYONKEYER); 44144000
SPOED~TRUE;% 44144100
EXIT;% 44144900
END INVKBD;% 44144990
SAVE REAL PROCEDURE SCANKY(PP,C); INTEGER C; POINTER PP;% 44145000
BEGIN% 44145010
REAL I;% 44145020
DOUBLE D;% 44145030
POINTER P~PP;% KLUDGE UNTIL POINTER UPDATE FIXED 44145040
DEFINE 44145050
ERROR= 0&SCANL(3)#,% 44145060
TYPEANDSIZE= 0&SCANL(ALF,C-I)#,% 44145070
TYPESIZEAND1CHR= REAL(P-I,1)&SCANL(SPC,I)#,% 44145080
SCNDEFEND=0#;% 44145090
IF C=0 THEN RETURN(0&SCANL(SPC,1,ETX));% 44145092
SCAN P:P FOR C:C WHILE=BLANK;% 44145095
SCAN P FOR I:C WHILE IN EBCDICNUMERIC;% 44145100
IF I<C THEN% 44145200
BEGIN% 44145210
SCAN P:P FOR I:C-(C~I)-1 WHILE = ZERO;% 44145220
IF I<12 THEN% 44145230
IF D~DOUBLE(P,I~I+1){MAXNO THEN% 44145240
BEGIN% 44145250
P~P+I; PP~P;% 44145260
RETURN(D);% 44145270
END;% 44145280
END% 44145290
ELSE BEGIN% 44145300
SCAN P FOR I:C WHILE IN EBCDICALPHABETIC;% 44145310
IF I<C THEN% 44145320
BEGIN% 44145330
PP~P;% 44145340
RETURN(TYPEANDSIZE);% 44145350
END% 44145390
ELSE BEGIN% 44145400
SCAN P FOR I:C WHILE IN EBCDICSPECIALS;% 44145410
IF I<C THEN% 44145420
BEGIN% 44145430
P~P+I~(C-(C~I));% 44145440
PP~P;% 44145450
RETURN(TYPESIZEAND1CHR);% 44145480
END;% 44145490
END;% 44145590
END;% 44145690
RETURN(ERROR);% 44145900
END SCANKY;% 44145950
MONITOR MIKEMONITOR(KEYINLK);KEYINLK~*+1; 44145990
TMPTRAC~TRACE(TMPTRAC); 44146000
BUZZCONTROL(KEYINQ); 44147000
POPIN~POPULATION(KEYINQ);% 44147100
QTOP: 44148000
IOCB~NEXTINP~FIRSTINP;% 44148100
WHILE COUNT>DEATHS DO 44149000
IF IOCB=NULL THEN% 44149100
BEGIN% 44149200
IF POPIN-DEATHS=POPULATION(KEYINQ) THEN% MAYBE *** 44149300
BEGIN% 44149400
COUNT~DEATHS~0;% 44149500
END 44149600
ELSE GO TO QTOP% 44149800
END ELSE% 44150000
BEGIN 44151000
CAUZIT: 44152000
DEATHS~*+1;% 44153200
IF BOOLEAN(RSDS~ MISC @ IOCB ) THEN 44154000
IF BOOLEAN(RSDS.RDTIMEOUT) THEN% HANDLE TIME-OUT 44155000
ELSE IF BOOLEAN(RSDS.RDCNTRLCARD) THEN% 44156000
BEGIN% 44156100
UNLOCK(KEYINQ);% 44156200
FORK(CONTROLCARD,IOCB);% 44156300
SPOED~TRUE;% 44156400
GO TO ENDOFMSG;% 44156500
END% 44156900
ELSE IF BOOLEAN(RSDS.RDOVERFLOW) THEN% 44157000
BEGIN% 44157100
END;% 44157900
DISPLAYONKEYER~RSDS.UNITNOF;% 44160000
UNLOCK(KEYINQ); 44161000
MSGAREAREF~KBUF @ IOCB; 44162000
P~POINTTOMSGAREA; 44163000
SCAN P:P FOR J:(BUFFS-1)|CHRS WHILE = 8" ";% 44164000
SCAN P FOR N:J UNTIL = ETX;% 44165000
IF MSGSZ~J-N=DICBSZ THEN% NO PREFIX AND NO SUFFIX 44166000
BEGIN 44167000
I~TNPNS; 44168000
BLIM~BNPNS; 44169000
PRESZ~SUFSZ~0; 44170000
GO TO CHECKB; 44171000
END 44172000
ELSE IF MSGSZ<DICBSZ THEN 44173000
BEGIN 44174000
INVKBD; 44175000
GO TO ENDOFMSG; 44176000
END; 44177000
ALIM~MAXDICA;% KLUDGE UNTIL WE SYNTAX CHECK DICA REQUESTS 44177900
FOR I~I STEP DICASZ UNTIL ALIM DO 44178000
IF P=POINTER(DICA[I],*) FOR DICASZ THEN 44179000
BEGIN 44180000
P~P+DICASZ; 44181000
CASE I/DICASZ OF 44182000
BEGIN% CASE 44183000
BEGIN 44184000
FOR I~0 STEP 1 UNTIL 9 DO CHANNELGUIDE[1]~SET(0,18);% KLUDGE ****** 44184100
MIXPRINT(MSGAREA);% 44185000
END; 44186000
;% SCH 44187000
;% JOB 44188000
;% FOR EXPANSION 44189000
BEGIN 44190000
%LABELPRINT 44191000
END; 44192000
;% PCD 44193000
;% ;% FOR EXPANSION 44194000
;% DIR 44195000
;% EXP 44196000
END CASE; 44197000
GO TO ENDOFMSG;% 44198000
END ; 44199000
SCAN P FOR J:MSGSZ WHILE IN EBCDICNUMERIC; 44200000
IF J=MSGSZ THEN% NO PREFIX, BUT MUST HAVE SUFFIX 44201000
BEGIN% MIGHT ALSO CHECK WHETHER SUFFIX IS ALPHA OR NUMERIC 44202000
PRESZ~0; 44203000
SUFSZ~MSGSZ-DICBSZ; 44204000
I~TNPS; 44205000
BLIM~BNPS; 44206000
END 44207000
ELSE IF J=0 THEN% A NUMBER ONLY 44208000
BEGIN 44209000
INVKBD; 44210000
GO TO ENDOFMSG; 44211000
END 44212000
ELSE BEGIN% HAS PREFIX, MAY OR MAY NOT HAVE SUFFIX 44213000
PREFIX~INTEGER(P,PRESZ~MSGSZ-J); 44214000
P~P+PRESZ; 44215000
IF I~ J-DICBSZ<0 THEN 44216000
BEGIN% A NUMBER FOLLOWED BY ANY ONE NON-NUMERIC CHARACTER 44217000
INVKBD; 44218000
GO TO ENDOFMSG; 44219000
END 44220000
ELSE IF I=0 THEN% PREFIX, BUT NO SUFFIX 44221000
BEGIN 44222000
I~TPNS; 44223000
BLIM~BPNS; 44224000
SUFSZ~0; 44225000
END 44226000
ELSE BEGIN% PREFIX AND SUFFIX -- MIGHT CHECK SUFFIX TYPE 44227000
SUFSZ~I; 44234000
I~TPS; 44235000
BLIM~BPS; 44236000
END; 44237000
END; 44238000
CHECKB: 44239000
FOR I~I STEP DICBSZ UNTIL BLIM DO 44240000
IF P=POINTER(DICB[I],*) FOR DICBSZ THEN 44241000
BEGIN 44242000
IF (I~I/DICBSZ)}MINREPCDE AND I{MAXREPCDE THEN 44242100
BEGIN REPEVNTWRD~WORDSTACK[STKNUM,REPLYEVENTPLACE];% TIL COMPILER FIXED 44242105
IF NORPLYREQD THEN 44242190
BEGIN 44242200
INVKBD; 44242210
GO TO ENDOFMSG; 44242220
END % 44242290
ELSE% 44242300
REPWRD~I;% 44242400
END;% UNTIL COMPILER FIXED 44242500
P~P+DICBSZ; 44243000
CASE I OF 44244000
BEGIN% CASE 44245000
TI: ; 44246000
ST: ; 44247000
XS: ; 44248000
ES: ; 44249000
DS: ; 44251000
RM: ; 44252000
OK: ; 44253000
IL: BEGIN% 44254000
CHCKANS;% 44254100
END;% 44254990
FM: BEGIN% 44255000
CHCKANS;% 44255100
END;% 44255990
UL: BEGIN% 44256000
CHCKANS;% 44256100
END; 44256990
OU: BEGIN% 44257000
I~MNEMLIM|MNEMSZ;% 44257100
FOR J~0 STEP MNEMSZ UNTIL I DO% 44257200
IF POINTER(MNEMONIC[J], *)= P FOR MNEMSZ THEN 44257300
BEGIN REPWRD.REPINFOF~J/MNEMSZ;GO ANSREPLY;END;44257400
INVKBD;% 44257500
GO TO ENDOFMSG;% 44257600
END;% 44257990
FR: ; 44258000
OHF: ; 44259000
US: BEGIN% 44259100
IF (I~SCANKY(P,SUFSZ)).TYPF=NUM THEN% 44259200
IF SUFSZ=0 OR I>MAXGENNO THEN% 44259300
ELSE IF (J~SCANKY(P,SUFSZ)).TYPF=SPC AND J.SZF=1 44259400
AND J.CHRF=COLON THEN% 44259410
IF (J~SCANKY(P,SUFSZ)).TYPF=NUM THEN% 44259500
IF J>MAXVERNO THEN% 44259600
ELSE BEGIN% 44259610
REPWRD~REPWRD&GENEALOGY1(I,J);% 44259620
GO TO ANSREPLY;% 44259630
END% 44259690
ELSE ELSE ELSE% 44259700
IF P=8"LATEST" FOR SUFSZ THEN GO TO ANSREPLY; 44259710
INVKBD;% 44259800
END;% 44259900
AX: ; 44260000
PR: ; 44261000
OL: BEGIN 44263000
IF CHECKUMNEM THEN INVKBD 44264000
ELSE FILEMESS(IOCB,I); 44265000
GO TO ENDOFMSG; 44266000
END; 44267000
RY: BEGIN 44268000
IF CHECKUMNEM THEN 44269000
BEGIN INVKBD; GO TO ENDOFMSG; END 44270000
ELSE UPDATEUNITBITSTABLE(OLDSTATUSWORD,I); 44271000
END; 44272000
PG: BEGIN% 44273000
IF CHECKUMNEM THEN BEGIN INVKBD;GO ENDOFMSG;END;44273100
PURGIT(I);% 44273200
END;% 44273900
PB: ; 44274000
SV: BEGIN% 44275000
IF CHECKUMNEM THEN BEGIN INVKBD;GO ENDOFMSG;END;44275100
UNIT[I].USAVED~1;% 44275200
END;% 44275990
RW: ; 44276000
CL: ; 44277000
TR: BEGIN% 44279000
K~SUFSZ;% 44279100
IF (I~SCANKY(P,SUFSZ)).TYPF=NUM THEN% 44279200
IF K=6 THEN% 44279300
BEGIN% 44279310
K~I MOD 100;% 44279320
I~I DIV 100;% 44279330
END;% 44279390
IF J~I MOD 100<60 AND I~I DIV 100<24 AND K<60 THEN 44279400
BEGIN% 44279410
SETTIME;% 44279420
GO TO WT;% 44279480
END;% 44279490
INVKBD;% 44279500
END;% 44279900
DR: BEGIN% 44280000
REPLACE P+SUFSZ BY P:P FOR SUFSZ;% 44280010
IF JULIT(P) THEN% 44280100
BEGIN% 44280200
DATIT(P);% 44280300
REPLACE POINTER(DATE[*],8) BY% 44280310
P UNTIL = ETX,NUL;% 44280320
TODAYSDATE~INTEGER(P+2,5);% 44280330
GO TO WD;% 44280390
END;% 44280400
INVKBD;% 44280490
END;% 44280500
RD: ; 44281000
SF: ; 44282000
SO: ; 44283000
RO: ; 44284000
TC: BEGIN 44285000
IF (I~SCANKY(P,SUFSZ)).TYPF=NUM THEN% 44286000
IF SUFSZ=0 THEN% 44286100
BEGIN% 44286200
TMPTRAC~I;% 44286300
GO TO ENDOFMSG;% 44286500
END ELSE% 44286900
IF (J~SCANKY(P,SUFSZ)).TYPF=SPC AND J.SYZF=1% 44287000
AND J.CHRF=COLON THEN% 44288000
IF (J~SCANKY(P,SUFSZ)).TYPF=NUM THEN% 44289000
IF (K~SCANKY(P,SUFSZ)).TYPF=SPC AND K.SYZF=1% 44290000
AND K.CHRF=EQUAAL THEN% 44291000
IF (K~SCANKY(P,SUFSZ)).TYPF=NUM THEN% 44292000
BEGIN% 44293000
SEGTRACE(I&SEGTRACEL(K,J));% 44294000
GO TO ENDOFMSG;% 44295000
END;% 44296000
INVKBD;% 44297000
END; 44306000
LD: ; 44308000
RN: ; 44309000
TOH: ; 44310000
TF: ; 44312000
WT: BEGIN% 44313000
CURRENTTIME;% 44313100
REPLACE POINTTOMSGAREA BY HOME,TIMEIS, 44313200
P:POINTER(TIME[*],8) FOR 2,COLON,% 44313300
P:P FOR 2,COLON,P FOR 2,LINEERASE,ETX; 44313400
GO TO SPOUTIT;% 44313500
END;% 44313900
WD: BEGIN% 44314000
REPLACE POINTTOMSGAREA BY HOME, DATEIS,% 44314100
POINTER(DATE,8)+JULDATESZ UNTIL = NUL,% 44314200
LINEERASE, ETX;% 44314300
GO TO SPOUTIT;% 44314400
END;% 44314990
WM: BEGIN 44315000
REPLACE P~POINTTOMSGAREA BY HOME, 44316000
POINTER(OUTPUTMESS[BEGMCPID],BYTESZ) UNTIL=NUL,ETX; 44317000
GO TO SPOUTIT; 44318000
END; 44319000
PI: BEGIN 44320000
SHIFTBUF; 44321000
REPLACE P~POINTTOBUFFO BY PIMSG; 44322000
GO TO SPOUTIT; 44323000
END; 44324000
EI: BEGIN 44325000
REPLACE P~POINTTOMSGAREA BY EIMSG; 44326000
GO TO SPOUTIT; 44327000
END; 44328000
LE: ; 44329000
END CASE; 44331000
GO TO ENDOFMSG;% 44331500
END;% 44332000
INVKBD;% 44332100
GO TO ENDOFMSG;% 44333000
SPOUTIT:% 44334000
SPOED~TRUE;% 44334100
SPOUT(IOCB,DISPLAYONKEYER);% 44334200
GO TO ENDOFMSG;% 44334300
ANSREPLY: 44335000
REPLY[STKNUM]~REPWRD;% 44335100
CAUSE(REPEVNT);% 44335200
ENDOFMSG:% 44336000
BUZZCONTROL(KEYINQ);% 44337000
NEXT(KEYINQ);% 44338000
DELINK(KEYINQ,IOCB);% 44339000
IF SPOED THEN SPOED~FALSE 44341000
ELSE BEGIN% 44341100
FORGETSPACE(WORD(IOCB).ADDRESSF);% 44343000
END;% 44344000
END;% 44345000
IF POPIN-DEATHS=POPULATION(KEYINQ) THEN 44346000
COUNT~0% 44346100
ELSE;% SOME THINGS WRONG 44347000
UNLOCK(KEYINQ);% 44347100
TRACE(TMPTRAC); 44348000
EXIT;% 44348990
END KEYIN; 44349000
SAVE 44350000
PROCEDURE SPOUT(IOCB,U);VALUE IOCB,U;REAL U;REFERENCE IOCB; 44351000
BEGIN 44352000
ARRAY MSGAREA[*];REFERENCE MSGAREAREF=MSGAREA; 44353000
REAL RSDS; 44354000
DEFINE 44357000
IMSPOSEDTOWAIT= BOOLEAN(U.SIGNBITF)#,% 44357100
ENDSPOUTDEFINES=0#; 44358000
IF IMSPOSEDTOWAIT THEN% 44359000
BEGIN 44360000
MSGAREAREF~IOCB; 44361000
MSGAREA[0]~WIOCW;% 44362000
RSDS~WAITIO(MSGAREA,WUSER(U),WERRMSK); 44363000
END 44364000
ELSE BEGIN 44365000
MSGAREAREF~ KBUF @ IOCB; 44366000
MSGAREA[0]~WIOCW;% 44367000
MISC @(IOCB)~0&MISCL(, REAL(NOT BOOLEAN(WERRMSK))); 44368000
USER@(IOCB)~WUSER(U);% 44369000
SEVNT@(IOCB)~1;% 44370000
IOREQUEST(IOCB); 44371000
EXIT;% 44373000
END; 44374000
IF BOOLEAN(RSDS) THEN 44375000
IF BOOLEAN(RSDS.RDTIMEOUT) THEN% HANDLE TIME-OUT 44376000
ELSE 44377000
IF BOOLEAN(RSDS.RDOVERFLOW) THEN% HANDLE OVERFLOW 44378000
ELSE 44379000
;% DO SOMETHING 44380000
FORGETSPACE(WORD(IOCB).ADDRESSF); 44382000
EXIT;% 44382990
END SPOUT; 44383000
SAVE PROCEDURE CONNQUEST(UNIT); VALUE UNIT; REAL UNIT; 44384000
BEGIN 44385000
WORD ARRAY MSGAREA[*]; 44386000
WORD ARRAY IOCB[*]; 44387000
REAL TMP; 44389000
IOCB~IOCB&ARRAYDESCL(3,TMP~MAXMSGSZ DIV CHRS+IOCBSIZE+JFACTOR, 44390000
GETSPACE(TMP,MCP,4,0)); 44391000
INITIALIZETOZERO(IOCB.ADDRESSF,TMP); 44392000
MSGAREA~MSGAREA&ARRAYDESCL(3,IOCB.LENGTHF-IOCBSIZE-INVKBDSZ, 44393000
IOCB.ADDRESSF+IOCBSIZE+INVKBDSZ); 44394000
IOCB[0]~RUSER(UNIT); 44395000
IOCB[1]~0&MISCL( ,REAL(NOT BOOLEAN(RERRMSK))); 44396000
IOCB[2]~MSGAREA; 44397000
IOCB[3]~0; 44398000
MSGAREA[0]~RIOCW;% 44399000
IOREQUEST(REFERENCE(IOCB)); 44400000
END CONNREQUEST; 44401000
SAVE 44419999
PROCEDURE MESSER(WHOWHICH,INFO); VALUE WHOWHICH, INFO;% 44420000
REAL WHOWHICH;WORD INFO; 44420100
BEGIN% 44420200
INTEGER W~WHOWHICH.WHOF,% 44420300
Z~WHOWHICH.WHATF, 44420305
X~WHOWHICH.WHICHF;% 44420310
POINTER P, Q;% 44420400
ARRAY MSGAREA[*];% 44420500
REFERENCE MSGAREAREF; 44420510
REAL RINFO=INFO;% 44420600
POINTER PINFO=INFO;% 44420700
INTEGER I;% 44420800
DEFINE% 44421000
MSG= Q UNTIL=NUL#,% 44421100
INVLD= 8"INVLD "#,% 44422000
ARG= 8" ARG"#,% 44422010
ERRR = 8" ERROR # "#, 44422020
ENDMESDEF=0#;% 44422900
Q~POINTER(OUTPUTMESS[OPMINDXR(W)],8);% 44423000
MSGAREA~*&ARRAYDESCL(3,I~LINESZ DIV CHRS+JFACTOR,GETAREA(I)); 44423010
P~POINTTOMSGAREA;% 44423050
THRU X DO BEGIN SCAN Q:Q UNTIL=NUL;Q~Q+1;END;% 44423100
CASE W OF% 44424000
BEGIN% CASES 44424010
BEGIN% FINDINPUT ACTION 44424100
CASE X OF% 44424200
BEGIN% 44424300
;% NO FIL USES POINTER TO LEB 44424400
;% NO FIL ON DISK SAME AS NO FIL 44424500
;% DUP FIL USES POINTER TO UNITS AND FIDS 44424600
;% ACCEPT USES BUFF WITH DATA-NAME 44424700
END;% FIND-INPUT CASES;% 44424800
END;% 44424900
BEGIN% FINDOUTPUT ACTION 44425000
END;% 44425500
BEGIN% MATH INTRINSIC ERRORS 44426000
REPLACE P:P BY INVLD,Q UNTIL=NUL,ARG,ETX;% 44426100
END;% 44426900
BEGIN% STATUS ACTION 44427000
CASE X OF% 44427100
BEGIN% 44427200
REPLACE P:P BY% 44427300
POINTER(MNEMONIC[RINFO.UNITTYPE|MNEMSZ],*) 44427320
FOR MNEMSZ,% 44427322
RINFO.UNITTYPECNTRF FOR 3 DIGITS,% 44427330
BLANK, MSG, ETX;% 44427350
;% UNIDENTIFIED FLYING UNIT 44427400
;% PARITY RW/L 44427500
;% UNIT RET FIDS USES POINTER TO UNIT AND FIDS 44427600
;% BACKUP ON UNIT USES UNIT NUMB. 44427700
END STATUS CASES; 44427800
END; 44427900
BEGIN % MCP ID 44428010
END; 44428110
BEGIN % I/O ERRORS 44428210
REPLACE P:P BY Q UNTIL=NUL,ERRR,Z FOR 2 DIGITS, 44428310
8" "; 44428410
W~REAL(PINFO+1,1); 44428510
PINFO~PINFO+2; 44428610
THRU W DO REPLACE P:P BY PINFO:PINFO+1 FOR 44428710
REAL(PINFO,1), 8"/"; 44428810
REPLACE P-1 BY ETX; 44428910
END; 44429110
BEGIN% STDIOERR -- BETTER CHECK RAJ RE SEQUENCE NOS. 44429200
END;% STDIOERR 44429900
BEGIN% MISC. MESS 44430000
CASE X OF% 44430100
BEGIN% 44430110
BEGIN% BOJ MESS 44430200
MSGAREAREF~*&ARRAYDESCL(3,PICQSZ,% 44430350
GETAREA(PICQSZ)); 44430352
LNID@(MSGAREAREF)~RINFO;% 44430400
LNBUF@(MSGAREAREF)~MSGAREA;% 44430500
INSERTINTO(MIXQ(MSGAREAREF));% 44430600
JOBMESSER(RINFO,P);% 44430700
REPLACE POINTTOMSGAREA+STATUSPOSIT BY MSG; 44430750
JOBREF(RINFO)~MSGAREAREF;% 44430800
PRINTMIXPIC(MSGAREA);% 44430850
WHOWHICH~NABS(WHOWHICH);% 44430900
END;% 44430990
BEGIN% EOJ MESS 44431000
MSGAREAREF~JOBREF(RINFO);% 44431100
P~POINTER((LNBUF@MSGAREAREF)[1],8);% 44431200
REPLACE P+STATUSPOSIT BY MSG;% 44431300
LNDESC@(MSGAREAREF)~*&LNDESCL(0);% 44431400
PRINTMIXPIC(MSGAREA);% 44431500
WHOWHICH~NABS(WHOWHICH);% 44431600
END;% 44431900
END;% MISC CASE 44432500
END;% MISC HANDLING 44432900
END CASES;% 44435000
IF WHOWHICH}0 THEN% 44436000
SPOUT(REFERENCE(MSGAREA),-DISPLAYONMIX);% 44436100
EXIT;% UNTIL DISKIO AND BILDAHDR ARE COMPLETE 44436190
BUZZCONTROL(LOGLOCK);% 44436200
LOGBUF[1+I~(LOGRECSZ|(REAL(BOOLEAN(LOGRECCNT~*+1) AND TRUE)))] 44436300
~WHOWHICH;% 44436310
REPLACE POINTER(LOGBUF[2+I],8) BY% 44436600
POINTTOMSGAREA FOR LOGRECSZ-1 WORDS;% 44436610
IF BOOLEAN(I) THEN% 44436700
BEGIN% 44436710
DISKWAIT (LOGBUF,% 44436730
0,% 44436740
SEGMENTSZ,% 44436750
ROWADDRESS(LOGBUF,(I~LOGRECCNT.DIV2F) DIV LOGROWSZ) 44436760
+I MOD LOGROWSZ,% 44436762
@40);% 44436770
END;% 44436800
UNLOCK(LOGLOCK);% 44436900
END MESSER;% 44439000
BOOLEAN PROCEDURE JULIT(P);POINTER P; 44451300
BEGIN 44451400
INTEGER I, J,% 44451500
M~INTEGER(P,2),% 44451600
D~INTEGER(P+3,2),% 44451700
Y~INTEGER(P+6,4),% 44451800
S~D;% 44451810
FOR I~1 STEP 1 UNTIL M DO% 44451900
BEGIN% 44451910
J~(IF I=1 THEN 31 ELSE IF I=2 THEN 28+REAL(LEAP(Y)) ELSE 44451920
30+REAL((BOOLEAN(I) AND I<8) OR (I>7 AND NOT BOOLEAN(I)))); 44451930
IF I<M THEN S~S+J% 44451940
ELSE IF D{J THEN% 44452000
BEGIN% 44452010
JULIT~TRUE;% 44452020
REPLACE P BY Y FOR 4 DIGITS, S FOR 3 DIGITS;% 44452030
END;% 44452090
END;% 44452100
END JULIT;% 44452190
PROCEDURE DATIT(P); POINTER P;% 44452200
BEGIN 44452300
INTEGER Y~INTEGER(P+STARTYEARPLACE,YEARSZ),% 44452400
DY~ABS(Y-BASEYEAR)-1,% 44452410
D~INTEGER(P+STARTDAYPLACE,DAYSZ),% 44452420
M, I, J;% 44452430
POINTER Q~P+JULDATESZ;% 44452500
DEFINE% 44452510
ALGOR= (I~(D+CORR+SHIFT)MOD 7)#,% 44452570
DYCORR= DY+(DY.DIV4F+DY DIV 400-DY DIV 100-DY DIV 4000)#, 44452575
CORR= 1+DYCORR#, 44452580
SHIFT= 4#, 44452585
DATDEFEND=0#;% 44452595
WHILE J<D DO% 44452600
BEGIN% 44452700
M~M+1;% 44452800
J~J+I~(IF M=1 THEN 31 ELSE IF M=2 THEN 28+REAL(LEAP(Y)) ELSE 44452900
30+REAL((BOOLEAN(M)AND M<8)OR(M>7 AND NOT BOOLEAN(M))));44452910
END;% 44453000
J~D-J+I;% 44453100
REPLACE Q BY% 44454600
CASE ALGOR OF (8"SUN ",8"MON ",8"TUES ",8"WEDNES", 44454610
8"THURS ",8"FRI ",8"SATUR ") FOR 6; 44454700
SCAN Q:Q WHILE IN EBCDICALPHABETIC;% 44454710
REPLACE Q:Q BY DAY,COMMA,BLANK,% 44454790
POINTER(MONTHS[(M-1)|2],8) UNTIL=NUL,BLANK,% 44454800
J FOR 2 DIGITS,COMMA,BLANK,Y FOR 4 DIGITS, ETX;% 44454810
END DATIT;% 44454900
REAL PROCEDURE CURRENTTIME; 44455000
BEGIN% 44455100
REAL H, M, S;% 44455200
DEFINE SECONDS= TIMEOFDAY/TIMECORRFACT#;% 44455300
S~ABS((M~(S~ABS((H~(S~SECONDS)DIV 3600)|3600-S))DIV 60)|60-S); 44455400
REPLACE POINTER(TIME[*],8) BY H FOR 2 DIGITS, M FOR 2 DIGITS, 44455500
S FOR 2 DIGITS;% 44455600
CURRENTTIME~S&TIMEL(H,M);% 44455700
END CURRENTTIME;% 44455900
PROCEDURE CONNSOUL(COUNT); REAL COUNT;% 44500000
BEGIN% 44500100
ARRAY CHNLCNTR[MAXPSUEDOCHANNELS];% 44500200
REFERENCE IOCB;% 44500300
REAL I,% 44500400
RSDS;% 44500500
BOOLEAN GOBACK;% 44500600
LABEL QTOP;% 44500700
DEFINE% 44501000
SATISFIEDCUSTOMERS= CHNLCNTR[I].SERF#,% 44501100
CUSTOMERSENTERED= CHNLCNTR[I].CUSTF#,% 44501200
ADDRESSOFCHNLBUFFER=CHNLCNTR[I].RATINGSAMPLEF% 44501300
-IOCBSIZE|CUSTOMERSENTERED#,% 44501302
CHNLID= 0#,% 44501400
CHNLLOCK= CHANNELLOCKS[I]#,% 44501500
ENDCSDEF=0#;% 44501990
QTOP: BUZZCONTROL(SPOUTQ); 44502000
IOCB~NEXTOUTP~FIRSTOUTP;% 44503000
WHILE IOCB!NULL DO% 44504000
BEGIN% 44505000
IF BOOLEAN(RSDS~MISC@IOCB) THEN% 44506000
BEGIN% 44507000
IF TIMEDOUT THEN% 44508000
BEGIN% 44509000
DELINK(SPOUTQ,IOCB);% 44510000
MISC@(IOCB)~WERRMSK;% 44511000
IOREQUEST(IOCB);% 44512000
END ELSE% UNEXPECTED I/O ERROR 44513000
END ELSE% 44514000
BEGIN% 44515000
IF CHNLCNTR[CHNLID]=0 THEN% 44516000
CHNLCNTR[CHNLID]~SEVNT@IOCB;% 44517000
CHNLCNTR[CHNLID].SERF~CHNLCNTR[CHNLID].SERF+1;% 44518000
END;% 44519000
GOBACK~FALSE;% 44520000
IOCB~NEXT(SPOUTQ);% 44521000
END;% 44522000
UNLOCK(SPOUTQ);% 44523000
IF GOBACK THEN% 44524000
BEGIN% 44525000
GOBACK~FALSE;% 44526000
PAUSE;% 44527000
GO TO QTOP;% 44528000
END;% 44529000
FOR I~0 STEP 1 UNTIL MAXPSUEDOCHANNELS DO% 44530000
IF SATISFIEDCUSTOMERS=CUSTOMERSENTERED THEN% 44531000
IF CUSTOMERSENTERED=0 THEN% 44532000
ELSE BEGIN% 44533000
FORGETSPACE(ADDRESSOFCHNLBUFFER);% 44535000
CHNLCNTR[I]~0;% 44535100
LIBERATE(CHNLLOCK);% 44536000
END% 44537000
ELSE GOBACK~TRUE;% 44538000
IF GOBACK THEN GO TO QTOP;% 44539000
END CONNSOUL;% 44540000
PROCEDURE CHANLOUT(CHNNO,MSGAREA);VALUE CHNNO;% 44550000
REAL CHNNO; ARRAY MSGAREA[*];% 44550100
BEGIN% 44550200
DEFINE% 44551000
CHNLDESC= CHANNELGUIDE[CHNNO]#,% 44551100
MODELNO = UNITBL[TI(CONN),J~VIEWER]#,% 44551200
SAMPLESHEET= CHNLDESC.RATINGSAMPLEF#,% 44551300
RATINGS= ONES(SURVEYSHEET)#,% 44551400
TURNOFFSET= RESET(SURVEYSHEET,J)#,% 44551500
VIEWER= FIRSTONE(SURVEYSHEET)#,% 44551600
ENDCHANTDEF=0#;% 44551990
WORD ARRAY IOCBS[*];% 44552000
REFERENCE IOCB;% 44552100
REAL SURVEYSHEET~SAMPLESHEET;% 44552200
INTEGER I,J,% 44552300
N~RATINGS;% 44552400
IOCBS~*&ARRAYDESCL(3,I~N|IOCBSIZE,I~GETSPACE(I,MCP,4,0));% 44553000
IOCBS[0]~0;% 44553010
IOCBS[1]~0&MISCL(,REAL(NOT BOOLEAN(WERRMSK)));% 44553100
IOCBS[3]~CHNLDESC&GYDEFORM((IOCBS[2]~MSGAREA).ADDRESSF,*,*,); 44553200
MSGAREA[0]~WIOCW;% 44553300
IOCB~*&ARRAYDESCL(3,IOCBSIZE,I-IOCBSIZE);% 44553400
IF N~N-1>0 THEN% 44553450
REPLACE POINTER(IOCBS[IOCBSIZE],8) BY POINTER(IOCBS,8) 44553500
FOR IOCBSIZE|N OVERWRITE;% 44553600
FOR I~0 STEP 1 UNTIL N DO% 44554000
BEGIN% 44554100
USER@(IOCB~*&ARRAYDESCL(,,IOCB.ADDRESSF+IOCBSIZE))% 44554200
~WUSER(MODELNO);% 44554210
IOREQUEST(IOCB);% 44554300
TURNOFFSET;% 44554400
END;% 44554900
EXIT;% 44559000
END CHANLOUT;% 44559900
PROCEDURE MIXPRINT(MSGAREA); ARRAY MSGAREA[*];% 44600000
BEGIN% 44601000
REFERENCE TMPEN;% 44602000
POINTER P~POINTTOMSGAREA,% 44603000
Q;% 44604000
REAL LD,% 44605000
LINENO;% 44606000
BOOLEAN SCREENFILLED;% 44607000
DEFINE% 44608000
NULLMIX= MIXQHD=NULL#,% 44609000
NULMIXMSG= 8"NULL MIX",LINEERASE#,% 44610000
SCREENABOUTTOOVERFLOW= SCREENFILLED~LINENO}MAXLNS#,% 44611000
FIRSTTIME= (LD~LNDESC@TMPEN).LNSTATF=2#,% 44612000
LASTTIME = LD.LNSTATF=1#,% 44613000
BOTTOMLINE= HOME,REVERSELF,8"MIX 1 OF ",MAXPGS FOR 2 DIGITS#, 44614000
ENDMXPTDEF=0#;% 44615000
REPLACE P:P BY HOME;% 44616000
PROCURE(MIXCHNLLK);% 44617000
IF NULLMIX THEN REPLACE P:P BY NULMIXMSG% 44618000
ELSE BEGIN% 44619000
DO% 44620000
BEGIN% 44621000
REPLACE P:P BY% 44622000
(Q~POINTER((LNBUF@TMPEN)[1],8))+1 UNTIL = ETX, 44622100
CARRETURN;% 44623000
IF FIRSTTIME THEN% 44624000
BEGIN% 44625000
REPLACE Q+STATUSPOSIT BY BLANK FOR STATUSSZ; 44626000
LNDESC@(TMPEN)~LD&LNDESCL(1,1);% 44627000
END% 44628000
ELSE IF LASTTIME THEN% 44629000
BEGIN% 44630000
REPLACE Q BY ETX FOR 2;% 44631000
LNDESC@(TMPEN)~LD&LNDESCL(0,0);% 44632000
END;% 44633000
LINENO~LINENO+1;% 44634000
IF SCREENFILLED THEN% 44635000
ELSE IF SCREENABOUTTOOVERFLOW THEN% 44636000
BEGIN% 44637000
REPLACE P:P BY BOTTOMLINE;% 44638000
TMPEN~PRELN@MIXQHD;% 44639000
END;% 44640000
END UNTIL TMPEN~NEXLN@(TMPEN)=MIXQHD;% 44641000
END;% 44642000
REPLACE P BY ETX;% 44643000
PRINTMIXPIC(MSGAREA);% 44644000
END MIXPRINT;% 44645000
SAVE PROCEDURE IOERROR(RD); REAL RD; 50000000
BEGIN 50001000
INTEGER U, COMMENT LOGICAL UNIT NO.; 50002000
UTYPE, COMMENT UNIT TYPE; 50003000
BITNO, COMMENT REMAINDER OF(U MOD 32); 50004000
VECTORNO; COMMENT VECTOR FOR UNIT; 50005000
REAL UTABLEENTRY, COMMENT CONTENTS OF UNIT TABLE ENTRY; 50006000
UERRORMASK , COMMENT ERROR MASK FOR I/O ERROR; 50007000
UERROR , COMMENT UNIT ERROR; 50008000
IOCW , COMMENT I/O CONTROL WORD; 50009000
ERRORSET , COMMENT RESULT DESCPIPTOR ERROR BIT NO; 50010000
INIOERROR , COMMENT FOR MONITORING; 50011000
UNITMASK ; COMMENT TO SET UP MASK FOR UNIT; 50012000
WORD ARRAY IOCBAREA[*]; 50012200
WORD OEVENTIRW; % FOR STORING ORIGINAL EVENT IRW 50012400
EVENT IOERROREVENT; % FOR DOING I/O IN IOERROR 50012600
REFERENCE IOCB=IOCBAREA; % POINTER TO FIRST I/O FOR UNIT 50013000
BOOLEAN SKIPTOG, COMMENT TOGGLE FOR IDENTIFYING DIFF. SOURCES 50014000
OF ENTRIES TO A LABEL; 50015000
MEMACCESSERRORTOG, % ON MEMORY ACCESS ERROR 50015500
BITWORD; COMMENT FOR SETTING BIT CORRESPONDING TO 50016000
UNIT NO.; 50017000
LABEL DISPLAYMSG,NOTREADY,KILLIT,MEMPARITY,SETERROR,FIXIOQUE,50018000
SETMEMPARITY,DISPLAYMSGANDTRY,TRYAGAIN,WRITELOCK,START,50019000
CARDREAD,ENDOFFILE,CLEARERROR,MSGWITHERRCOUNT,PRINTER, 50020000
INCOMPLETE,MPXMEMACCESS,CARDPUNCH,INVALIDADDR,LEAVE; 50021000
LABEL REWINDING,COMMONCODE,SETMEMPARITYERR,CHECKUSER; 50021500
LAYOUT BITSETL(BITNO:1~1); COMMENT LAYOUT FOR DYNAMIC 50022000
BIT SETTING; 50023000
DEFINE READCHECK=RDENDOFTAPE#, 50024000
EUBUSY=RDENDOFTAPE#, 50025000
OPUNOTREADY=RDOVERFLOW#, 50026000
UTIMEOUT=RDBLANKTAPE#, 50027000
READPARITY=RDWLOOREOF#, 50028000
INCOMPLETERECORD=RDCNTRLCARD#, 50029000
ENDOFPAGE=RDCRCCORRECT#, 50030000
PRINTCHECK=RDCNTRLCARD#, 50031000
PUNCHCHECK=RDCNTRLCARD#, 50032000
PRINTERBITTRANSFER=RDENDOFTAPE#; 50033000
MONITOR RAJMONITOR(IOCB,ERRORSET,INIOERROR,UERROR); 50033500
INIOERROR~1; 50033700
U~RD.RDUNITNO; 50034000
IOCB~FIRSTIO[U]; 50035000
UTABLEENTRY~UNIT[U]; 50036000
VECTORNO~U DIV 32; 50037000
BITNO~U-VECTORNO | 32; 50038000
BITWORD~FALSE & BITSETL( ); 50038500
UERRORMASK~IF BOOLEAN(USER@(IOCB).USERIOBIT) THEN @377777 50038600
ELSE MISC @(IOCB).IOERRORMASKFIELD; 50038700
UTYPE~UTABLEENTRY.UNITTYPE; 50038800
UERROR~REAL(BOOLEAN(RD.RDERROR) AND BOOLEAN(UERRORMASK)); 50038900
START: 50039000
IOCW~M[WORD(AREADESC @ IOCB)]; 50040000
UTABLEENTRY.UNITNOTREADY~0; 50041000
UTABLEENTRY.UNITERROR~0; 50042000
TRANSACTION[U]~*-1; 50043000
MEMACCESSERRORTOG~BOOLEAN(UERROR.RDMEMACCESS); 50053000
IF BOOLEAN(UERROR.RDBUSY) THEN 50054000
BEGIN COMMENT UNIT BUSY; 50055000
UNITMASK~ 4; 50056000
IF UTYPE!SPO THEN 50062000
BEGIN 50063000
COMMENT BUILD MESSAGE "UNIT BUSY"; 50064000
ERRORSET~2; 50064500
DISPLAYMSGANDTRY: 50065000
%SPOUT(MSGAREA,DISPLAYONPER);% MAR 50066000
END; 50067000
TRYAGAIN: 50068000
DO BEGIN 50069000
WAIT(TIMERINTERRUPTEVENT); 50070000
UNIT[U]~UTABLEENTRY; 50071000
OEVENTIRW~IOCBAREA[EVENTINDEX]; 50071500
STOREITEM(EVNT @ IOCB.IOERROREVENT); 50071700
STARTIO(U); 50072000
WAIT(IOERROREVENT); 50073000
RESET(IOERROREVENT); 50073500
MISC @(IOCB)~UERRORMASK; 50073600
IOCBAREA[EVENTINDEX]~OEVENTIRW; 50073700
IF UTABLEENTRY.UNITERRORFIELD }20 THEN 50074000
GO SETERROR; 50074500
END UNTIL REAL(BOOLEAN(RD~MISC @(IOCB)) AND 50075000
BOOLEAN(UNITMASK)) =0; 50076000
TRANSACTION[U]~ *+1; 50077000
IF (UERROR ~ REAL(BOOLEAN(RD.RDERROR) AND 50078000
BOOLEAN(UERRORMASK))) =0 THEN GO CLEARERROR; 50079000
GO START; 50080000
END; 50081000
IF BOOLEAN(UERROR.RDNOTREADY) THEN 50082000
BEGIN COMMENT UNIT NOT READY; 50083000
IF UTYPE=CARDREADER AND BOOLEAN(UERROR.READCHECK) THEN 50084000
GO CARDREAD; 50085000
IF UTYPE!SPO THEN 50086000
BEGIN 50087000
COMMENT BUILD MESSAGE "UNIT NOT READY"; 50088000
IF NOT BOOLEAN(UNIT[U].UNITNOTREADY) THEN 50088100
MESSER(0 & WHOCALLSL(STATMSGSEC,0),U); 50088200
ERRORSET~3; 50088500
END; 50089000
NOTREADY: 50090000
COMMENT MAKE OLDSTATUS OF THE UNIT NOT READY; 50091000
OLDSTATUSWORD[VECTORNO]~OLDSTATUSWORD[VECTORNO] AND 50093000
NOT BITWORD; 50094000
%SPOUT(MSGAREA,DISPLAYONPER);% MAR 50097000
UTABLEENTRY.UNITERRORFIELD~0; 50098000
UTABLEENTRY.UNITNOTREADY~1; 50099000
UNIT[U]~UTABLEENTRY; 50101000
GO TO KILLIT; 50104000
END; 50105000
IF REAL(BOOLEAN(UERROR) AND BOOLEAN(@157))=0 THEN 50106000
COMMENT DESCRIPTOR ERROR BIT ALSO GETS TURNED ON IF CONTROL BUSY 50106200
,MEM. ADDRESS OR MEM. PARITY ERROR OCCUR AT I/O INITIATE 50106400
TIME(BEFORE ACTUAL DATA TRANSFER OCCUR).HENCE ABOVE CHECK;50106600
BEGIN % DESCRIPTOR ERROR ONLY. EITHER WORD COUNT=0 FOR DATA 50106800
% TRANSFER REQUEST OR BAD IOCW RECEIVED BY CONTROL 50107000
COMMENT BUILD MESSAGE "DESCRIPTOR ERROR"; 50108000
MESSER(0 & WHOCALLSL(STDIOERRSEC,0),U); 50108100
ERRORSET~4; 50108500
SETERROR: 50109000
%SPOUT(MSGAREA,DISPLAYONPER);% MAR 50110000
GO COMMONCODE; 50112000
END; 50113000
IF BOOLEAN(UERROR.RDMEMADDRBIT) THEN 50114000
INVALIDADDR: 50115000
BEGIN COMMENT INVALID ADDRESS; 50116000
COMMENT BUILD MESSAGE "I/O INVALID ADDRESS"; 50117000
MESSER(0 & WHOCALLSL(STDIOERRSEC,1),U); 50117200
COMMENT ADD CODE TO CHECK WHETHER ERROR IS DUE TO MPX TROUBLE; 50117300
ERRORSET~5; 50117500
GO SETERROR; 50118000
END; 50119000
MEMPARITY: 50120000
IF BOOLEAN(UERROR.RDMEMPARITY) THEN 50121000
BEGIN 50122000
COMMENT BUILD MESSAGE "I/O MEMORY PARITY"; 50123000
MESSER(0 & WHOCALLSL(STDIOERRSEC,2),U); 50123100
ERRORSET~6; 50123500
GO SETERROR; 50124000
END; 50125000
IF BOOLEAN(UERROR.RDMEMPROTECT) THEN 50125100
BEGIN 50125200
COMMENT MEMORY PROTECT ERROR; 50125300
MESSER(0 & WHOCALLSL(STDIOERRSEC,3),U); 50125330
ERRORSET~16; 50125350
GO SETERROR; 50125400
END; 50125500
CASE UTYPE OF 50126000
BEGIN 50127000
; COMMENT NO UNIT; 50128000
BEGIN COMMENT DISK FILE; 50129000
IF BOOLEAN(UERROR.EUBUSY) THEN 50130000
BEGIN COMMENT DISK ELECTRONICS UNIT NOT READY; 50131000
UNITMASK~ @400; 50132000
COMMENT BUILD MESSAGE "EU NOT READY"; 50133000
ERRORSET~8; 50133500
GO DISPLAYMSGANDTRY; 50134000
END; 50135000
IF MEMACCESSERRORTOG THEN 50136000
IF BOOLEAN(UERROR.RDWLOOREOF) THEN 50137000
BEGIN COMMENT READ ERROR; 50138000
ERRORSET~ 4096 |7 +9; 50139000
GO SETERROR; 50140000
END ELSE 50144000
MPXMEMACCESS: 50145000
BEGIN % MEMORY ACCESS ERROR 50146000
ERRORSET~7; 50147000
GO CLEARERROR; 50148000
END; 50149000
IF BOOLEAN(UERROR.OPUNOTREADY) THEN 50150000
BEGIN % OPERATING UNIT NOT READY 50150200
COMMENT DURING TRANSFER STORAGE UNIT WAS CROSSED FROM 50150400
A READY S.U. TO A NOT READY S.U.; 50150600
ERRORSET~11; 50150800
GO SETERROR; 50150900
END; 50150950
IF BOOLEAN(UERROR.UTIMEOUT) THEN 50151000
BEGIN % TIME OUT 50152000
ERRORSET~15; 50153000
GO SETERROR; 50154000
END; 50155000
IF BOOLEAN(UERROR.RDWLOOREOF) THEN 50156000
WRITELOCK: 50157000
BEGIN 50158000
ERRORSET~9; 50159000
COMMENT BUILD MESSACE "WRITE-LOCK"; 50160000
GO SETERROR; 50161000
END; 50162000
END; 50163000
; COMMENT SPO; 50164000
; COMMENT DISPLAY; 50165000
COMMENT PAPER TAPE READER; 50166000
BEGIN 50167000
IF BOOLEAN(UERROR.RDENDOFTAPE) THEN 50168000
BEGIN % BEGINNING OR END OF TAPE 50168200
ERRORSET~8; 50168400
END ELSE 50168600
IF BOOLEAN(UERROR.INCOMPLETERECORD) THEN 50169000
BEGIN % INCOMPLETE RECORD 50170000
ERRORSET~10; 50171000
END; 50171500
IF MEMACCESSERRORTOG THEN 50172000
IF BOOLEAN(UERROR.READPARITY) THEN 50173000
BEGIN 50174000
ERRORSET~ 4096 |7 +9; 50175000
COMMENT *********** WRITE SPECIAL RETRY PROCEDURE; 50176000
END ELSE 50177000
GO MPXMEMACCESS; 50178000
BEGIN % MEMORY ACCESS ERROR 50178200
ERRORSET~7; 50178300
END; 50178400
DISPLAYMSG: 50179000
BEGIN 50180000
COMMENT BUILD MESSAGE "UNIT I/O ERROR"; 50181000
GO SETERROR; 50182000
END; 50183000
END; 50184000
COMMENT PAPER TAPE PUNCH; 50185000
BEGIN 50186000
IF BOOLEAN(UERROR.RDENDOFTAPE) THEN 50187000
BEGIN % PAPER TAPE RUNNING LOW 50187200
ERRORSET~8; 50187400
END ELSE 50187600
IF BOOLEAN(UERROR.INCOMPLETERECORD) THEN 50188000
BEGIN % INCOMPLETE RECORD 50189000
ERRORSET~10; 50190000
END; 50190200
GO COMMONCODE; 50190600
END; 50191000
GO PRINTER; COMMENT BUFFERED PRINTER; 50193000
PRINTER: 50195000
BEGIN 50196000
IF BOOLEAN(UERROR.ENDOFPAGE) THEN 50197000
BEGIN 50198000
COMMENT IGNORE END OF PAGE IF NO SPACE OR SKIP; 50199000
IF IOCW.IOUNITFIELD=0 THEN GO COMMONCODE; 50200000
M[WORD(AREADESC @ IOCB)]~ 0 & IOCWL(@200, 50201000
0 & IOCWPRINTERL(0,1)); 50202000
ERRORSET~12; 50202500
GO CLEARERROR; 50203000
END; 50204000
IF MEMACCESSERRORTOG THEN 50204500
IF BOOLEAN(UERROR.PRINTERBITTRANSFER) THEN 50205000
BEGIN 50205100
COMMENT BIT TRANSFER ERROR; 50205200
ERRORSET~4096 | 7 +8; 50205300
END ELSE 50205900
IF BOOLEAN(UERROR.PRINTCHECK) THEN 50206000
BEGIN 50207000
COMMENT BUILD MESSAGE "UNIT PRINT CHECK"; 50208000
MSGWITHERRCOUNT: % SPOUT(MSGAREA,DISPLAYONPER);% MAR 50209000
COMMENT TOTALUNITERROR~ * +1; 50210000
ERRORSET~4096 | 10; 50211000
GO COMMONCODE; 50212000
END; 50213000
END; 50217000
; COMMENT DUMMY; 50218000
BEGIN COMMENT CARD READER; 50219000
CARDREAD: 50220000
IF BOOLEAN(UERROR.READCHECK) THEN 50221000
BEGIN COMMENT READ CHECK ON CARD READER; 50222000
COMMENT BUILD MESSAGE "UNIT READ CHECK"; 50224000
MESSER(0 & WHOCALLSL(STDIOERRSEC,4),U); 50224500
ERRORSET~8; 50225000
END ELSE 50226000
IF MEMACCESSERRORTOG THEN 50227000
IF BOOLEAN(UERROR.READPARITY) THEN 50228000
BEGIN COMMENT VALIDITY ERROR; 50229000
COMMENT BUILD MESSAGE "INVALID CHARACTER IN COL"; 50230000
ERRORSET~ 4096|7 + 9; 50231000
END ELSE 50232000
BEGIN % MEMORY ACCESS ERROR- TREAT AS READ CHECK 50233000
ERRORSET~7; 50234000
END; 50235000
GO NOTREADY; 50236000
END; 50238000
GO CARDPUNCH; COMMENT CARD PUNCH I; 50240000
CARDPUNCH: 50242000
BEGIN COMMENT CARD PUNCH II; 50243000
IF BOOLEAN(UERROR.PUNCHCHECK) THEN 50244000
IF MEMACCESSERRORTOG THEN 50245000
BEGIN % PUNCH CHECK 50247000
ERRORSET~4096 |10 + 7; 50248000
GO MSGWITHERRCOUNT; 50249000
END ELSE 50250000
BEGIN % MEMORY ACCESS ERROR 50250200
ERRORSET~10; 50250400
GO CLEARERROR; 50250600
END; 50250800
END; 50251000
; COMMENT DUMMY; 50252000
BEGIN COMMENT MAGNETIC TAPE TRANSPORT; 50252010
IF MEMACCESSERRORTOG AND 50252020
BOOLEAN(UERROR.RDOVERFLOW) THEN 50252023
BEGIN % PARITY ERROR OR MEMORY ACCESS ERROR 50252025
ERRORSET~ 4096 |7 + 11; 50252030
COMMENT *********************************************** 50252035
TAPEPARITYRETRY(RD); 50252040
GO SETERROR; 50252045
END; 50252050
IF BOOLEAN(UERROR.RDNONPRESENT) THEN 50252060
BEGIN 50252070
COMMENT NON-PRESENT OPTIONS; 50252080
MESSER(0 & WHOCALLSL(STDIOERRSEC,0),U); 50252083
ERRORSET~13; 50252085
GO SETERROR; 50252090
END; 50252100
IF BOOLEAN(IOCW.IOREADBIT) THEN 50252180
BEGIN COMMENT ERROR ON READ OPERATION; 50252190
IF BOOLEAN(UERROR.RDENDOFTAPE) THEN 50252200
BEGIN 50252230
COMMENT BEGINNING OF TAPE OR END OF TAPE; 50252250
ERRORSET~8; 50252265
USER @(IOCB).USEREOFORTBIT~1; 50252267
END ELSE 50252270
IF BOOLEAN(UERROR.RDWLOOREOF) THEN 50252275
BEGIN % END OF FILE 50252280
ERRORSET~9; 50252290
USER @(IOCB).USEREOFORTBIT~1; 50252295
END ELSE 50252320
IF BOOLEAN(UERROR.INCOMPLETERECORD) THEN 50252360
BEGIN 50252370
COMMENT RECORD SHORTER THEN MEMORY ALLOCATED; 50252380
ERRORSET~10; 50252390
END ELSE 50252400
IF BOOLEAN(UERROR.RDOVERFLOW) THEN 50252410
BEGIN 50252420
COMMENT RECORD LONGER THEN MEMORY ALLOCATED; 50252430
ERRORSET~11; 50252440
END ELSE 50252450
IF BOOLEAN(UERROR.RDBLANKTAPE) THEN 50252530
BEGIN 50252540
COMMENT READ OR SPACED SIX FEET OF BLANK TAPE; 50252550
ERRORSET~15; 50252560
USER @(IOCB).USERSPECIALIO ~1; 50252580
END; 50252600
END ELSE 50252650
IF BOOLEAN(UERROR.RDWLOOREOF) THEN 50252700
BEGIN % NO WRITE RING ON UNIT 50252750
ERRORSET~9; 50252780
USER @(IOCB).USERSPECIALIO ~1; 50252784
MESSER(0 & WHOCALLSL(STDIOERRSEC,5),U); 50252786
END; 50252790
CHECKUSER: 50252800
GO SETERROR; 50252850
END; 50252900
END; 50253000
COMMONCODE: 50254000
MISC @(IOCB)~RD; 50255000
DELINK(IOQUE,FIRSTIO[U],U); 50259000
CAUSE(EVNT @(IOCB)); 50265000
CLEARERROR: 50266000
UTABLEENTRY.UERRORSTATUSBITS~0; 50267000
UNIT[U]~UTABLEENTRY; 50267500
STARTIO(U); 50268000
KILLIT: 50269000
USER @(IOCB).IOERRORRECOVERY~0; 50270000
SETMEMPARITYERR: 50271000
INCOMPLETE: 50272000
ENDOFFILE: 50273000
COMMENT 50274000
BREAKTOG~ BREAKTOG-1; 50275000
HOLD; 50275500
END IOERROR; 50276000
REAL PROCEDURE GETUSERDISK(SEGMENTS, ORIGINALSPEED); 52000000
VALUE SEGMENTS, ORIGINALSPEED; 52001000
REAL SEGMENTS, ORIGINALSPEED; 52002000
COMMENT FIND AN AREA OF DISK "SEGMENTS" LARGE, PREFERABLY ON AN 52003000
EU OF "SPEED" DISK. 52004000
IF "SPEED" IS NEGATIVE, ITS ABSOLUTE VALUE IS AN EU UNIT 52005000
NUMBER FROM WHICH THE REOUESTED SEGMENTS SHOULD BE 52006000
ASSIGNED; 52007000
BEGIN 52008000
LABEL FOUND, TRYAGAIN, SEARCH, GETNEXTSPEED, GOTIT; 52009000
REAL DISKUNIT, T, I, ORIGINALUNIT, INDEX, STOPPER, MAXINDEX, K, J, 52010000
SPEED := ORIGINALSPEED, T1; 52011000
BOOLEAN FAILED; 52012000
ARRAY ROW[*]; 52013000
LAYOUT DISKSEARCHL(UNITTYPE, DENSITYF); 52014000
REAL GETDISK; 52015000
MONITOR STEVEMONITOR(SEGMENTS,SPEED,DISKUNIT,STOPPER,GETDISK); 52016000
GETDISK:=*;SEGMENTS:=*;SPEED:=*;%FOR MONITOR 52017000
RETURN(MCPTOP+10);COMMENT TEMP FOR SIMULATION**************************;52018000
PROCURE(USERDISKLOCK); 52019000
IF SPEED < 0 THEN 52020000
ORIGINALSPEED := SPEED := UNIT[ORIGINALUNIT := DISKUNIT := 52021000
ABS(SPEED)].DENSITYF 52022000
ELSE 52023000
TRYAGAIN: 52024000
ORIGINALUNIT := DISKUNIT := NEXTEU[SPEED]; 52025000
SEARCH: 52026000
FOR I := MASKSEARCH(0&USERDISKHEADWORD(*,DISKUNIT,*), 52027000
0&USERDISKHEADWORD(*,4"FF",*), GETUSERDISKHEAD) 52028000
STEP -1 WHILE (T := GETUSERDISKHEAD[I]).EUNOF = DISKUNIT DO 52029000
IF T.ADDRESSF } SEGMENTS THEN GO FOUND; 52030000
FAILED := TRUE; 52031000
COMMENT THE FOLLOWING DOES NOT COMPILE... YET 52032000
IF DISKUNIT ! 0 THEN 52033000
IF DISKUNIT := MASKSEARCH(0&DISKSEARCHL(DISKFILE,SPEED),0& 52034000
DISKSEAHCHL(4"FF", 4"F"), UNIT[DISKUNIT-1]) > 0 THEN 52035000
IF DISKUNIT ! ORIGINALUNIT THEN 52036000
GO SEARCH 52037000
ELSE 52038000
GO GETNEXTSPEED; 52039000
IF DISKUNIT := MASKSEARCH(0&DISKSEARCHL(DISKFILE,SPEED),0& 52040000
DISKSEARCHL(4"FF", 4"F"), UNIT) > ORIGINALUNIT THEN 52041000
GO SEARCH; 52042000
GETNEXTSPEED: 52043000
IF SPEED := IF ORIGINALSPEED { 1 THEN (SPEED + 1) MOD 4 ELSE 52044000
CASE (SPEED + 4 | ORIGINALSPEED) - 8 OF ( 52045000
2,0,3,1, 52046000
3,0,1,2 52047000
) ! ORIGINALSPEED THEN 52048000
GO TRYAGAIN; 52049000
COMMENT WE HAVE TRIED.... OH HOW WE HAVE TRIED, BUT IT JUST 52050000
DID NOT WORK; 52051000
LIBERATE(USERDISKLOCK); 52052000
GETDISK:=ABS(REAL(NOT FALSE)); 52053000
RETURN(NOUSERDISK(SEGMENTS, SPEED)); 52054000
FOUND: 52055000
ROW := USERDISKLIST[INDEX := T.USERDISKINDEXF, *]; 52056000
STOPPER := 0&DISKADDRESSL(REAL(NOT BOOLEAN(DISKUNIT)), *); 52057000
FOR J := MAXINDEX := ROW.LENGTHF - 1 STEP - 1 WHILE 52058000
(T := ROW[J]) ! STOPPER DO 52059000
IF T.DISKAREASIZEF } SEGMENTS THEN 52060000
GO TO GOTIT; 52061000
COMMENT USER DISK FAILURE IF WE GET HERE; 52062000
GETDISK:=REAL(NOT FALSE); 52063000
HOLD; 52064000
GOTIT: 52065000
IF T.DISKAREASIZEF = SEGMENTS THEN 52066000
BEGIN 52067000
FOR K := J - 1 STEP -1 WHILE T1 := ROW[K] ! STOPPER DO 52068000
ROW[K+1] := T1; 52069000
ROW[K+1] := STOPPER; 52070000
IF J = MAXINDEX THEN 52071000
BEGIN COMMENT THE ROW IS EMPTY NOW; 52072000
END 52073000
END 52074000
ELSE 52075000
ROW[J] := (T.DISKADDRESSF + SEGMENTS) & DISKAREAWORDL( 52076000
T.DISKAREASIZEF - SEGMENTS, *); 52077000
IF J > 0 THEN 52078000
IF ROW[J-1] = STOPPER THEN 52079000
FORGETUSERDISKHEAD[MASKSEARCH(0&USERDISKHEADWORD(INDEX), 52080000
0&USERDISKHEADWORD(REAL(NOT FALSE)), 52081000
FORGETUSERDISKHEAD)].ADDRESSF := ROW[J+1]; 52082000
IF SEGMENTS = GETUSERDISKHEAD[I].ADDRESSF THEN 52083000
BEGIN 52084000
J := 0; 52085000
FOR K := MAXINDEX STEP -1 WHILE T1 := ROW[K] ! STOPPER DO 52086000
IF J < T1 := T1.DISKAREASIZEF THEN 52087000
J := T1; 52088000
GETUSERDISKHEAD[I].ADDRESSF := J; 52089000
END; 52090000
LIBERATE(USERDISKLOCK); 52091000
GETDISK:=T.DISKADDRESSF; 52092000
RETURN(T.DISKADDRESSF); 52093000
END GETUSERDISK; 52094000
PROCEDURE FORGETUSERDISK(DKADDR, SEGMENTS); 52095000
VALUE DKADDR, SEGMENTS; 52096000
REAL DKADDR, SEGMENTS; 52097000
COMMENT RETURN "SEGMENTS" STARTING AT "DKADDR"; 52098000
BEGIN 52099000
REAL I, J, K, L, N, T, INDEX, STOPPER, MAXINDEX, 52100000
RIGHTENDADDRESS ~ DKADDR + SEGMENTS, 52101000
DISKUNIT ~ DKADDR.EUNOF; 52102000
LABEL PUTITBACK, CLEANUP; 52103000
ARRAY ROW[*]; 52104000
BOOLEAN STOPPERINSERT, LEFTENDCHECK; 52105000
REAL FORGETDISK; 52106000
MONITOR STEVEMONITOR (INDEX,DISKUNIT,RIGHTENDADDRESS,DKADDR,FORGETDISK, 52107000
SEGMENTS, STOPPER); 52108000
FORGETDISK:=*;DKADDR:=*;RIGHTENDADDRESS:=*;DISKUNIT:=*;%FOR MONITOR 52109000
PROCURE(USERDISKLOCK); 52110000
STOPPER ~ 0&DISKADDRESSL(REAL(NOT BOOLEAN(DISKUNIT)), *); 52111000
FOR I ~ MASKSEARCH(0&DISKADDRESSL(DISKUNIT,*),0&DISKADDRESSL(4"FF", 52112000
*), FORGETUSERDISKHEAD) STEP - 1 WHILE (T ~ FORGETUSERDISKHEAD[I])52113000
.EUNOF ! DISKUNIT DO 52114000
IF T.DISKADDRESSF < DKADDR THEN GO PUTITBACK; 52115000
T ~ FORGETUSERDISKHEAD[I+1]; 52116000
PUTITBACK: 52117000
ROW ~ USERDISKLIST[INDEX ~ T.USERDISKINDEXF, *]; 52118000
FOR J ~ MAXINDEX ~ ROW.LENGTHF - 1 STEP - 1 WHILE T ~ ROW[J] ! 52119000
STOPPER DO 52120000
IF T.DISKADDRESSF = RIGHTENDADDRESS THEN 52121000
BEGIN 52122000
SEGMENTS ~ * + T ~ T.DISKAREASIZEF; 52123000
ROW[J] := STOPPER; 52124000
STOPPERINSERT ~ TRUE; 52125000
RIGHTENDADDRESS ~ * + T; 52126000
END ELSE 52127000
IF T.DISKADDRESSF + T.DISKAREASIZEF = DKADDR THEN 52128000
BEGIN 52129000
ROW[J].DISKAREASIZEF ~ SEGMENTS ~ T.DISKAREASIZEF + 52130000
SEGMENTS; 52131000
RIGHTENDADDRESS ~ (DKADDR ~ ROW[J].DISKADDRESSF) + 52132000
SEGMENTS; 52133000
GO TO CLEANUP; 52134000
END ELSE 52135000
IF T.DISKADDRESSF < DKADDR THEN 52136000
BEGIN 52137000
REPLACE POINTER(ROW[0],*) BY POINTER(ROW[1],*) FOR 52138000
I WORDS; 52139000
ROW[J] ~ DKADDR & DISKAREAWORDL(SEGMENTS, *); 52140000
GO TO CLEANUP; 52141000
END; 52142000
ROW[J] ~ DKADDR & DISKAREAWORDL(SEGMENTS, *); 52143000
LEFTENDCHECK ~ TRUE; 52144000
CLEANUP: 52145000
IF J = MAXINDEX AND I < FORGETUSERDISKHEAD.LENGTHF - 1 THEN 52146000
IF RIGHTENDADDRESS = FORGETUSERDISKHEAD[I+1]. 52147000
DISKADDRESSF THEN 52148000
BEGIN 52149000
ROW[J].DISKAREASIZEF ~ SEGMENTS + L ~ USERDISKLIST[ 52150000
K ~ FORGETUSERDISKHEAD[I+1].USERDISKINDEXF, T ~ 52151000
MASKSEARCH(STOPPER, REAL(NOT FALSE), 52152000
USERDISKLIST[I+1,*]) + 1].DISKAREASIZEF; 52153000
IF T = MAXINDEX THEN 52154000
BEGIN COMMENT THE ROW IS EMPTY NOW; 52155000
END 52156000
ELSE 52157000
BEGIN 52158000
USERDISKLIST[K,T] ~ STOPPER; 52159000
FORGETUSERDISKHEAD[I+1].DISKADDRESSF ~ 52160000
USERDISKLIST[K,T+1]; 52161000
IF GETUSERDISKHEAD[N ~ MASKSEARCH( 52162000
0&USERDISKHEADWORD(K,*),0&USERDISKHEADWORD( 52163000
REAL(NOT FALSE),*), GETUSERDISKHEAD)]. 52164000
ADDRESSF = L THEN 52165000
BEGIN 52166000
J := 0; 52167000
FOR T := MAXINDEX STEP -1 WHILE L := 52168000
USERDISKLIST[K,T] ! STOPPER DO 52169000
IF L := L.DISKAREASIZEF > J THEN 52170000
J := L; 52171000
GETUSERDISKHEAD[N].ADDRESSF := J; 52172000
END; 52173000
END; 52174000
IF LEFTENDCHECK AND I > 0 THEN 52175000
IF (T ~ FORGETUSERDISKHEAD[I-1]).EUNOF = DISKUNIT THEN 52176000
IF DKADDR = (L ~ USERDISKLIST[K ~ T.USERDISKINDEXF, 52177000
MAXINDEX]).DISKADDRESSF + L.DISKAREASIZEF THEN 52178000
BEGIN 52179000
USERDISKLIST[K,MAXINDEX].DISKAREASIZEF ~ L ~ 52180000
L.DISKAREASIZEF + SEGMENTS; 52181000
ROW[J] ~ STOPPER; 52182000
IF J = MAXINDEX THEN 52183000
BEGIN COMMENT THIS ROW IS EMPTY; 52184000
END; 52185000
IF GETUSERDISKHEAD[N ~ MASKSEARCH( 52186000
0&USERDISKHEADWORD(K,*),0&USERDISKHEADWORD( 52187000
REAL(NOT FALSE),*), GETUSERDISKHEAD)]. 52188000
ADDRESSF < L THEN 52189000
GETUSERDISKHEAD[N].ADDRESSF := L; 52190000
END; 52191000
END; 52192000
IF STOPPERINSERT THEN 52193000
BEGIN 52194000
FOR L ~ N ~ MAXINDEX STEP - 1 UNTIL 0 DO 52195000
IF ROW[L] ! STOPPER THEN 52196000
BEGIN 52197000
ROW[N] ~ ROW[L]; N ~ N - 1; 52198000
END; 52199000
REPLACE POINTER(ROW[0]) BY STOPPER FOR N WORDS; 52200000
END; 52201000
IF T ~ ROW[0] ! STOPPER THEN 52202000
BEGIN COMMENT FULL ROW; 52203000
IF N ~ MASKSEARCH(0, REAL(NOT FALSE), 52204000
USERDISKDOPEVECTOR) < 0 THEN 52205000
BEGIN COMMENT SPACE EXPANSION REQUIRED; 52206000
END; 52207000
USERDISKLIST[N,*] ~ DUMMYAREA&ARRAYDESCL(0,MAXINDEX+1,0); 52208000
REPLACE POINTER(USERDISKLIST[N,0]) BY STOPPER FOR L ~ 52209000
MAXINDEX DIV 2 WORDS, POINTER(ROW[0]) FOR L WORDS; 52210000
REPLACE POINTER(ROW[0]) BY STOPPER FOR L WORDS; 52211000
REPLACE POINTER(FORGETUSERDISKHEAD[0]) BY 52212000
POINTER(FORGETUSERDISKHEAD[1]) FOR I WORDS; 52213000
FORGETUSERDISKHEAD[I-1] ~ T & USERDISKHEADWORD(N,*); 52214000
T ~ 0; 52215000
FOR L ~ MAXINDEX - L STEP 1 UNTIL MAXINDEX DO 52216000
IF T < K ~ USERDISKLIST[N,L].DISKAREASIZEF THEN 52217000
T ~ K; 52218000
FOR L ~ MASKSEARCH(0&USERDISKHEADWORD(L,*), 52219000
0&USERDISKHEADWORD(REAL(NOT FALSE), *), 52220000
GETUSERDISKHEAD) STEP - 1 WHILE GETUSERDISKHEAD[L]. 52221000
EUNOF ! DISKUNIT DO; 52222000
REPLACE POINTER(GETUSERDISKHEAD[0]) BY 52223000
POINTER(GETUSERDISKHEAD[1]) FOR L WORDS; 52224000
GETUSERDISKHEAD[L] ~ T & USERDISKHEADWORD(N,DISKUNIT,*); 52225000
END; 52226000
FORGETUSERDISKHEAD[I] ~ ROW[L ~ MASKSEARCH(STOPPER, 52227000
REAL(NOT FALSE), ROW) + 1] & USERDISKHEADWORD(INDEX,*); 52228000
T ~ 0; 52229000
FOR L ~ L STEP 1 UNTIL MAXINDEX DO 52230000
IF T < K ~ ROW[L].DISKAREASIZEF THEN 52231000
T ~ K; 52232000
GETUSERDISKHEAD[MASKSEARCH(0&USERDISKHEADWORD(INDEX,*), 52233000
0&USERDISKHEADWORD(REAL(NOT FALSE),*), GETUSERDISKHEAD)] ~ 52234000
T; 52235000
LIBERATE(USERDISKLOCK); 52236000
EXIT; 52237000
FORGETDISK:=1; 52238000
END FORGETUSERDISK; 52239000
REAL PROCEDURE NOUSERDISK(SEGMENTS, SPEED); 52240000
VALUE SEGMENTS, SPEED; 52241000
REAL SEGMENTS, SPEED; 52242000
COMMENT THIS PROCEDURE MANAGES TO OBTAIN THE DISK REQUIRED BY 52243000
CAUSING FILES TO BE UNLOADED TO BACKUP; 52244000
BEGIN 52245000
REAL DISKPUNT;%FOR MONITOR ONLY 52246000
MONITOR STEVEMONITOR(DISKPUNT); 52247000
DISKPUNT :=1;%FOR MONITOR ONLY 52248000
HOLD; 52249000
END; 52250000
PROCEDURE RELEASEHEADER(HEADER, CODE); 55000000
VALUE HEADER, CODE; 55001000
WORD HEADER; 55002000
REAL CODE; 55002500
COMMENT A CALL ON THIS PROCEDURE WILL RELEASE THE CALLER"S USE OF 55003000
A DISK FILE HEADER. DEPENDING ON THE VALUES OF CODE, AND 55004000
VARIOUS BITS IN THE HEADER ITSELF, OTHER WONDEROUS THINGS WILL 55005000
HAPPEN. 55006000
; 55007000
BEGIN 55008000
REAL COUNT, T, INDEX = HEADER; 55009000
ARRAY HDR[*]; 55010000
REAL RELHDR; 55011000
MONITOR STEVEMONITOR(HEADER, CODE, COUNT, RELHDR); 55012000
RELHDR:=*;CODE:=*;INDEX:=*;%MONITOR 55013000
COMMENT SOME PEOPLE PASS ME A DESCRIPTOR, SO I MUST FIND THE 55013100
ACTUAL INDEX; 55013150
IF HEADER.TAG ! SINGL THEN 55013200
IF HEADER := MASKSEARCH(HEADER, 4"80FFFFFFFFFF" & 55013250
SETTAG(DATADESC), DISKFILEHEADERSDOPEVECTOR) 55013300
< 0 THEN 55013350
STOP; COMMENT THE CALLER BLEW IT; 55013500
EXIT;%DON"T SCREW UP ANYTHING DIRECTORYSEARCH DIDN"T DO 55013600
HDR := DISKFILEHEADERS[INDEX, *]; 55014000
PROCURE(HEADERLOCK); 55015000
IF HEADERUPDATED(HDR) OR COUNT := OPENCOUNT(HDR) - 1 = 0 THEN 55016000
BEGIN 55017000
T := READLOCK(IF COUNT = 0 THEN 0 ELSE INDEX, HDR[0]); 55018000
DISKWAIT(HDR, -1, HEADERSIZE(HDR), M[HDR.ADDRESSF - 1]. 55019000
DISKADDRESSF, @40); 55020000
HDR[6] := T; 55021000
END DISK COPY UPDATING; 55022000
IF COUNT ! 0 THEN 55023000
BEGIN 55024000
OPENCOUNT(HDR) := COUNT; 55025000
END 55026000
ELSE IF INDEX ! 0 THEN 55027000
BEGIN 55028000
DISKFILEHEADERS[INDEX, *] := HDR & ARRAYDESCL(0,0,0); 55029000
FORGETSPACE(HDR.ADDRESSF); 55030000
END; 55031000
LIBERATE(HEADERLOCK); 55032000
RELHDR:=1; 55033000
EXIT; 55034000
END RELEASEHEADER; 55035000
REAL PROCEDURE SCRAMBLEINX(P, MODULUS); 55036000
VALUE P, MODULUS; 55037000
POINTER P; 55038000
REAL MODULUS; 55039000
BEGIN 55040000
REAL S, I, J; 55041000
J~ (J~ REAL(P, 1))-(I~ J MOD 4); 55042000
IF I>0 THEN S~ REAL(P, I); 55043000
IF J>0 THEN 55044000
FOR I~ I+1 BY 4 UNTIL J DO 55045000
S~ S+REAL(P+I, 4); 55046000
RETURN(S MOD MODULUS); 55047000
END CALCULATE SCRAMBLE INDEX; 55048000
REAL PROCEDURE SUBDIRECTORYSEARCH(HDR, NMP); 55049000
VALUE NMP; 55050000
ARRAY HDR[*]; 55051000
POINTER NMP; 55052000
COMMENT THIS IS THE GUTS OF THE SEARCH MECHANISM OF 55053000
DIRECTORYSEARCH. 55054000
HDR IS A CORE AREA CONTAINING A DIRECTORY HEADER AND AN I/O 55055000
BUFFER AREA. 55056000
NMP IS A POINTER TO THE NAME WHICH IS HOPED TO EXIST AT THIS 55057000
LEVEL IN THE DIRECTORY. IT IS IN THE FORM 55058000
"NXX...X" 55059000
WHERE N IS THE NUMBER OF CHARACTERS IN THE NAME. 55060000
THE NAME SOUGHT IS FOUND, SUBDIRECTORYSEARCH RETURNS THE 55061000
INDEX INTO HDR OF THE DIRECTORY ENTRY ASSOCIATED WITH THAT 55062000
NAME. OTHERWISE, IT RETURNS A NEGATIVE NUMBER, WHICH 55063000
MAY HAVE SIGNIFICANCE AT A LATER DATE. 55064000
; 55065000
BEGIN 55066000
LAYOUT LEFTJUSTIFY(8|(6-I):8|I), FIRSTCHR(47:8); 55067000
REAL I, J, MODX, INDEX, NOMEN, CHRS; 55068000
REAL RWSZ := ROWSIZE(HDR); 55069000
ARRAY TNAME[3]; 55070000
LABEL RESTART, OUT; 55071000
DEFINE WHATSTHEADDRESS(RECORDNO) = 55072000
HDR[FIRSTROWINDEX + (MODX ~ RECORDNO | 55073000
SEGMENTSPERDIRECTORYBITE) DIV RWSZ] + MODX MOD RWSZ # 55074000
; 55075000
REAL SUBSRCH; 55076000
MONITOR STEVEMONITOR(MODEX,SUBSRCH,INDEX,NOMEN); 55077000
MONITOR STEVEMONITOR(SUBDIRECTORYSEARCH); 55078000
SUBSRCH:=*; 55079000
IF J := NMP.SZF ! EBCDIC THEN 55080000
BEGIN 55081000
I := 6; 55082000
CHRS := REAL(NMP,1); 55083000
IF J = BCL THEN 55084000
REPLACE POINTER(TNAME,8) + 1 BY NMP + 1 FOR CHRS WITH 55085000
BCLTOEBC 55086000
ELSE 55087000
REPLACE POINTER(TNAME,8) + 1 BY NMP + 1 FOR CHRS WITH 55088000
HEXTOEBC; 55089000
TNAME[0] := * & FIRSTCHR(CHRS); 55090000
END; 55091000
INDEX := (HEADERSIZE(HDR) + 29) DIV 30 - 1; 55092000
NOMEN := 0&LEFTJUSTIFY(REAL(NMP, I ~ MIN(CHRS ~ REAL(NMP,1)+1,6))); 55093000
IF MODX := SCRAMBLEMOD(HDR) > 1 THEN 55094000
MODX := SCRAMBLEINX(NMP, MODX); 55095000
IF MODX ! HDR[INDEX + 3] THEN 55096000
DISKWAIT(HDR, INDEX-1, DIRECTORYBITE, 55097000
WHATSTHEADDRESS(MODX), @440); 55098000
RESTART: 55099000
FOR I := INDEX+4 STEP 5 WHILE NOT BOOLEAN(HDR[I]) DO 55100000
IF NOMEN IS HDR[I+2] THEN 55101000
IF NMP = POINTER(HDR[I+2], 8) FOR CHRS THEN 55102000
BEGIN 55103000
SUBDIRECTORYSEARCH := I; 55104000
GO OUT; 55105000
END; 55106000
IF HDR[I] = 3 THEN 55107000
BEGIN 55108000
DISKWAIT(HDR, INDEX-1, DIRECTORYBITE, WHATSTHEADDRESS( 55109000
HDR[INDEX]), @440); 55110000
GO RESTART; 55111000
END; 55112000
SUBDIRECTORYSEARCH := -1; 55113000
OUT: 55114000
SUBSRCH:=1; 55115000
END SUBDIRECTORYSEARCH; 55116000
REAL PROCEDURE DIRECTORYSEARCH(NMP, CODE, LOCKIT); 55117000
VALUE NMP, CODE, LOCKIT; 55118000
POINTER NMP; 55119000
REAL CODE; 55120000
BOOLEAN LOCKIT; 55121000
COMMENT DIRECTORYSEARCH WILL ATTEMPT TO FIND THE FILE WHOSE 55122000
STANDARDFORM NAME IS POINTED TO BY NMP. THE FORM OF THIS NAME 55123000
IS: 55124000
NMXXX...XXMXX...XX... 55125000
WHERE N IS THE NUMBER OF NAMES AND M IS THE CHARACTER COUNT 55126000
FOR A NAME. 55127000
IF SUCCESSFUL IN FINDING THE FILE, DIRECTORYSEARCH WILL SET 55128000
UP THE FILE HEADER AS A ROW IN "DISKFILEHEADERS" AND RETURN 55129000
THE ROW INDEX OF THIS HEADER. 55130000
IF UN-SUCCESSFUL, A NEGATIVE NUMBER WILL BE RETURNED. THE 55131000
DCODE1 FIELD OF THIS NUMBER WILL CONTAIN THE NUMBER OF THE 55132000
NAME ON WHICH THE SEARCH FAILED, THE ADDRESS FIELD WILL CONTAIN55133000
A CODE INDICATING THE REASON THE SEARCH FAILED (I.E. NO FILE, 55134000
NON-DIRECTORY FOUND WHEN DIRECTORY REQUIRED, SECURITY BLOCK). 55135000
; 55136000
BEGIN 55137000
REAL DEPTH := REAL(NMP, 1); 55138000
REAL I, J, SIZE, DKADDR; 55139000
LABEL THEEND; 55140000
BOOLEAN FILE, ALREADYTHERE; 55141000
ARRAY HDR[*]; 55142000
DEFINE 55143000
EVENTT = HEADEREVENTS[INDEX] #, 55144000
HDRINFO = HDR[J] #, 55145000
NOBODYTHERE = - NOSUCHFILE #, 55146000
UNMOGLICH = - NOTAVALIDFILENAME #, 55147000
WRONGEN = - FILEWITHWRONGGENEOLOGY #; 55148000
REAL DIRSRCH; 55149000
MONITOR STEVEMONITOR (CODE,LOCKIT,DIRSRCH,SIZE,DEPTH,DKADDR); 55150000
MONITOR STEVEMONITOR (DIRECTORYSEARCH); 55151000
DIRSRCH:=*;DEPTH:=*; 55152000
PROCURE(DIRECTORYLOCK); 55154000
HDR := SYSTEMDIRECTORY; 55155000
NMP := NMP + 1; 55156000
GO TO THEEND; % * KLUDGE FOR SIMULATING * 55156010
FOR I := 0 STEP 1 UNTIL DEPTH DO 55157000
BEGIN 55158000
IF J := SUBDIRECTORYSEARCH(HDR, NMP) < 0 THEN 55159000
BEGIN 55160000
DIRECTORYSEARCH := NOBODYTHERE & DIRECTORYSEARCHCODES(I); 55161000
GO TO THEEND; 55162000
END; 55163000
IF HDRINFO.FILEKINDF ! DIRECTORY AND I ! DEPTH THEN 55164000
BEGIN 55165000
DIRECTORYSEARCH := UNMOGLICH & DIRECTORYSEARCHCODES(I); 55166000
GO TO THEEND; 55167000
END; 55168000
DKADDR := HDR[J+1]; 55169000
IF I = 0 OR HDR.LENGTHF < SIZE := (HDRINFO.HEADERSIZEF + 29) 55170000
DIV 30 + DIRECTORYBITE OR FILE := HDRINFO.FILEKINDF > 55171000
DIRECTORY THEN 55172000
BEGIN 55173000
IF I ! 0 THEN 55174000
FORGETSPACE(HDR.ADDRESSF); 55175000
HDR := HDR & ARRAYDESCL(0, IF FILE THEN SIZE := HDRINFO. 55176000
HEADERSIZEF ELSE SIZE, 1); 55177000
END; 55178000
IF ALREADYTHERE := J := HDR[0] ! 0 THEN 55179000
DISKWAIT(HDR, -1, SIZE, DKADDR, @440); 55180000
BEGIN 55181000
END; 55182000
END; 55183000
IF NOT ALREADYTHERE THEN 55184000
M[HDR.ADDRESSF - 1] := DKADDR & SETTAG(MEMLINK); 55185000
THEEND: 55186000
LIBERATE(DIRECTORYLOCK); 55187000
DIRSRCH:=1; 55188000
END DIRECTORYSEARCH; 55189000
SAVE 1 PROCEDURE PERIPHERALINITIALIZE; 59000000
BEGIN 59001000
COMMENT THIS PROCEDURE EVENTUALLY WILL RE BUILD THE DIRECTORY, 59002000
BUILD THE ESPDISK AND USERDISK MAPS, ETC. IT WILL ALSO CONTAIN59003000
THE DCP INITIALIZATION CODE (WHATEVER THAT IS). RIGHT NOW ALL 59004000
IT DOES IS BUILD THE PERIPHERAL TABLES, REWIND TAPES AND WRITE 59005000
HALT LOAD MESSAGES ON THE SUPERVISORY CONSOLES THAT HAPPEN TO 59006000
BE IN RECEIVE MODE; 59007000
SAVE ARRAY TUNITS, IOAREA, DISKS [256]; 59008000
REAL I, UNID, MAXU, TOTALEU, T1, J, UMPXD, FIRSTREADY, T, 59011000
DIRECTORYHEADERSIZE := 30, %THE ":= 30" IS TEMPORARY 59011100
DISKUSERW = MAXU, SWITCHES = UMPXD; 59012000
POINTER TP; 59013000
ARRAY SLCDESC[*]; 59014000
WORD WIPEOUTPCW = PERIPHERALINITIALIZE; 59015000
DEFINE TYPEINT = TYPEINTERROGATE #, 59016000
PATHINT = TYPEINTERROGATE #, 59017000
TYPECNTR = TUNITS #; 59018000
DEFINE INITIALIZERARRAY(QARRAY, RARRAY, LENGTH) = 59019000
REPLACE POINTER(RARRAY) BY POINTER(QARRAY) 59020000
FOR LENGTH OVERWRITE #; 59021000
DEFINE STATE (I) = BOOLEAN(SCANIN(0 & USTATUSWORD(I.DIV32F, 59021100
,*,*))).[I.MOD32F+1:1] #; 59021200
DEFINE UNITREALLYOUTTHERE= UNID>0#;% 59021300
FIELD DUNITF = DIAGNOSTICUNIT.MOD32F:1, 59022000
BITF = I.MOD32F:1; 59023000
PROCEDURE DISKMAPPER; 59024000
BEGIN 59025000
SAVE ARRAY LLLARRAY[LLLROWS, LLLCHUNK]; 59026000
WORD ARRAY DOPEVECTOR1 = DISKFILEHEADERS [*], 59026100
DOPEVECTOR2 = USERDISKLIST [*]; 59026200
COMMENT THESE ARE USED TO CREATE THE DOPE 59026300
VECTORS FOR THE GLOBAL TWO DIMENSIONAL ARRAYS TO59026400
WHICH THEIR ADDRESSES ARE EQUATED. 59026500
; 59026600
ARRAY SWITCHPOINTS[*]; 59026700
BOOLEAN READY; 59027000
MONITOR STEVEMONITOR( SWITCHES,UNID,T1,READY,NEXTADDR); 59027100
SAVE %SO THE MONITOR DOESNT MAKE IT A SEGMENT 59027990
BOOLEAN PROCEDURE TESTSWITCH(USERW, SWITCH); 59028000
VALUE USERW, SWITCH; 59029000
REAL USERW, SWITCH; 59030000
BEGIN 59031000
BOOLEAN NTRDY; MONITOR STEVEMONITOR (NTRDY); 59031100
IOAREA[0] := SET(DECIMAL(SWITCH), 38); % TEST S. U. 59032000
IF NOT SIMULATING THEN IOAREA[0]~*&IOCWL(@440,*);%KLUDGE FOR DFC 1 & 2 59032010
NTRDY := %FOR MONITOR ONLY 59032990
TESTSWITCH ~ BOOLEAN(WAITIO(IOAREA, USERW, REAL(NOT FALSE)59033000
).RDNOTREADY); 59034000
END; 59035000
DEFINE CHECKFOROVERFLOW = 59036000
IF NEXTADDR ~ * + 2 } MAXADDR THEN 59037000
BEGIN 59038000
LLLARRAY[NEXTROW ~ * + 1, 0] ~ 0; 59039000
MAXADDR ~ (NEXTADDR ~ LLLARRAY[NEXTROW, *].ADDRESSF) 59040000
+ LLLCHUNK; 59041000
END 59042000
#; 59043000
DOPEVECTOR1 := DOPEVECTOR1 & ARRAYDESCL(0, 59074100
HEADERSTOSTARTWITH, 0); 59074150
DOPEVECTOR2 := DOPEVECTOR2 & ARRAYDESCL(0, 59074200
TOTALEU | EUFACTOR, 0); 59074250
INITIALIZEARRAY(SYSTEMDIRECTORY, SYSTEMDIRECTORY, 59074300
DIRECTORYHEADERSIZE + DIRECTORYBITE); 59074320
DOPEVECTOR1[0] := SYSTEMDIRECTORY & ARRAYDESCL(,*,*); 59074340
COMMENT NOTE THE TWO NAMES FOR THE SAME AREA; 59074360
M[DOPEVECTOR1.ADDRESSF + DOPEVECTOR1.LENGTHF]. 59074380
SPACEOLAYLOCK := 0; %MAKE IT SAVE AT HIGH MEMORY END 59074390
DOPEVECTOR1[1] := 0 & DATADESCRIPTOR(,*); 59074400
REPLACE POINTER(DOPEVECTOR1[2],*) BY 59074420
POINTER(DOPEVECTOR1[1],*) FOR HEADERSTOSTARTWITH 59074450
- 2 OVERWRITE; 59074480
DOPEVECTOR2[0] := 0 & DATADESCRIPTOR(,*,*,*,*,*,*,*, 59074500
USERDISKLISTROWSIZE, 1); 59074520
REPLACE POINTER(DOPEVECTOR2[1],*) BY 59074550
POINTER(DOPEVECTOR2[0],*) FOR TOTALEU | EUFACTOR 59074580
- 1 OVERWRITE; 59074600
M[DOPEVECTOR2.ADDRESSF + DOPEVECTOR2.LENGTHF]. 59074640
SPACEOLAYLOCK := 0; %MAKE IT SAVE AT HIGH MEMORY END 59074680
GETUSERDISKHEAD := FORGETUSERDISKHEAD := 59074700
GETUSERDISKHEAD & ARRAYDESCL(0,TOTALEU|EUFACTOR,1); 59074800
COMMENT KLUDGE IT UP FOR DIRECTORY SEARCHERS; 59074900
DISKFILEHEADERS[0,10]:=IF SIMULATING THEN 0&DISKADDRESSL(DISKB,*) ELSE 59074950
1250 & DISKADDRESSL(MCPDISKUNITNO,*); 59074960
TOTALEU ~ * - 1; 59076000
MAXADDR ~ NEXTROW ~ -1; 59077000
LASTADDR := IOAREA.ADDRESSF; %FOR THE FIRST STORE 59077100
FOR J ~ 0 STEP 1 UNTIL TOTALEU DO 59078000
BEGIN 59079000
IOAREA[0] := SET(0, 38); %TEST DISK TYPE 59080000
SWITCHES := (SWITCHPOINTS := 59080050
CASE T1 := WAITIO(IOAREA, DISKUSERW := 0 & 59080100
USERL(*,,UNID := DISKS[J], ), REAL(NOT FALSE))59080200
.RDDISKFILETYPEF OF ( 59080300
DISKFILE1C5, 59080400
IF SIMULATING THEN DISKFILESIM ELSE 59080500
DISKFILE1AX, 59080600
DISKFILE1C3, 59080700
DISKFILE1C4 59080800
)).LENGTHF - 1; 59080900
UNIT[UNID].DENSITYF := T1; 59080950
READY := FALSE; 59080960
FOR I := 0 STEP 4 UNTIL SWITCHES DO 59081000
IF TESTSWITCH(DISKUSERW, SWITCHPOINTS[I]) THEN 59082000
IF READY THEN 59083000
BEGIN 59084000
CHECKFOROVERFLOW; 59085000
T1 := %FOR MONITORING 59085010
M[NEXTADDR] ~ 0 & FIRSTMAPWORD( 59086000
UNID, SWITCHPOINTS[FIRSTREADY], *); 59087000
T1 := %FOR MONITORING 59087010
M[NEXTADDR+1] ~ SWITCHPOINTS[I] - 59088000
SWITCHPOINTS[FIRSTREADY]; 59089000
M[LASTADDR].ADDRESSF := 59090000
LASTADDR := NEXTADDR; 59091000
READY ~ FALSE; 59093000
END 59094000
ELSE 59095000
ELSE 59096000
IF NOT READY THEN 59097000
BEGIN 59098000
READY ~ TRUE; 59099000
FIRSTREADY ~ I; 59100000
END; 59101000
END; 59102000
CHECKFOROVERFLOW; 59103000
FIRSTADDR := LLLARRAY[0,*].ADDRESSF; 59104000
M[NEXTADDR] ~ 0 & FIRSTMAPWORDPRIME(REAL(NOT FALSE), *); 59105000
IF FIRSTADDR = NEXTADDR THEN EXIT; % BECAUSE SOMETHING SCREWED UP 59105100
M[LASTADDR].ADDRESSF ~ NEXTADDR; 59106000
DISKMAPARRAY := LLLARRAY; 59106100
GIVEBACKDISK(MCPDISKBASE, MCPINFO.ADDRESF + 59107000
(MCPINFOSIZE DIV 30)); 59108000
EXIT; 59108100
END DISKMAPPER; 59109000
MCPARRAYINFOT[0]~1; 59600000
WIPEOUTPCW := NEXTADDR := 0; 59601000
FOR I ~ 0 STEP 1 UNTIL 255 DO 59603000
IF UNID ~ SCANIN(0&TYPEINT(I,,*,*)) ! 0 THEN 59604000
BEGIN 59605000
MAXU ~ I; 59606000
TUNITS[I] := 0 & UNITINITIALIZE(UNID, (T := 59607000
SCANIN(0 & PATHINT(I,*,*,*))).MPXDESIGNATOR59608000
, T); 59609000
END; 59620000
MAXUNIT ~ MAXU; 59621000
INITIALIZEARRAY(OLDSTATUSWORD, OLDSTATUSWORD, 1 + 59622000
MAXVECTORNO := ((MAXU := * + 1) + 30).DIV32F - 1); 59623000
INITIALIZEARRAY(UNIT,TRANSACTION,MAXU); 59624000
MAXCHANNELS ~ FIRSTONE(MAXCHANNELS); 59625000
INITIALIZEQARRAY(FIRSTIO, MAXU); 59626000
INITIALIZEQARRAY(FIRSTUNIT, MAXCHANNELS); 59627000
INITIALIZERARRAY(FIRSTIO, LASTIO, MAXU); 59628000
INITIALIZEARRAY(LASTUNIT,LASTUNIT,MAXCHANNELS); 59629000
INITIALIZERARRAY(FIRSTUNIT, LASTUNIT, MAXCHANNELS); 59630000
COMMENT ALL UNITS ARE LEFT MARKED NOT READY SO THAT 59631000
STATUS WILL REACT TO THEM AND TAKE THE PROPER ACTION;59632000
REPLACE POINTER(UNIT[0]) BY POINTER(TUNITS[0]) 59633000
FOR MAXU WORDS; 59634000
INITIALIZEARRAY(TYPEINDX, TYPEINDX, (MAXUNITTYPE+1) DIV 6 59635000
+ 1); 59636000
INITIALIZEARRAY(MNEMTOUNIT, MNEMTOUNIT, MAXUNIT 59637000
DIV 6 + 1); 59638000
COMMENT MARK FILE IDS NOT READY; 59639000
REPLACE POINTER(TYPECNTR) BY 0 FOR MAXU WORDS; 59643000
FOR I := 0 STEP 1 UNTIL MAXUNIT DO 59644000
BEGIN 59645000
IF UNID := UNIT[I].UNITTYPE = DISKFILE THEN 59651000
BEGIN 59652000
IF STATE[I] THEN 59652100
BEGIN 59652400
DISKS[TOTALEU] ~ I; 59653000
IF TOTALEU ~ * + 1 = 1 THEN 59654000
MCPDISKBASE ~ 0 & DISKADDRESSL(I, *); 59655000
IF TOTALEU = 2 THEN DISKB ~ I; %KLUDGE FOR KLUDGED DIRECTORYSEARCH 59655100
END 59655200
ELSE UNIT[I] := UNID := 0 %NOT REALLY A DISK 59655300
END 59657000
ELSE 59658000
IF UNID = SPO THEN 59659000
BEGIN 59660000
IOAREA[0] := SET(0, 38); %TEST 59661000
IF WAITIO(IOAREA, 0&USERL(*,,I,*), REAL(NOT 59662000
FALSE)).CONSOLEIDF = 0 THEN 59662100
UNIT[I] := UNID := 0 %NO DISPLAY ATTACHED 59662200
END 59664000
ELSE 59665000
IF MAGTAPE(UNID) THEN 59666000
BEGIN 59668000
IOAREA[0]~0&IOCWL(TAPEREWIND,0); 59669000
WAITIO(IOAREA,0&USERL(*,,I,*),REAL(NOT FALSE)); 59671000
UNIT[I]~*&UNITL(1,,,1); 59671100
END; 59676000
IF UNITREALLYOUTTHERE THEN% 59676100
BEGIN% 59676200
UNIT[I].UNITTYPECNTRF~TYPECNTR[UNID]~*+1;% 59676300
IF MINUNIT<0 THEN MINUNIT~I;% 59676400
END;% 59676500
END; 59677000
INITIALIZEARRAY(LOGHDR,LOGHDR,LOGHDRSZ);% 59678000
INITIALIZEARRAY(LOGBUF,LOGBUF,SEGMENTSZ+1);% 59678100
INITIALIZEARRAY(CHANNELLOCKS,CHANNELLOCKS,% 59679000
MAXPSUEDOCHANNELS); 59679002
INITIALIZEARRAY(CHANNELGUIDE,CHANNELGUIDE,% 59679100
MAXPSUEDOCHANNELS); 59679102
INITIALIZEQARRAY(PICQ, MAXPSUEDOCHANNELS);% 59679200
INITIALIZEARRAY(SCREEN,SCREEN,NOOFSCREENSRQD); 59680000
T ~ NAME(TYPEINDX).ADDRESSF; 59681000
FOR I~ NAME(DICA).ADDRESSF STEP 1 UNTIL T DO 59682000
M[I] ~ M[1] & STRINGDESCRIPTOR(*, *, *, *, *, *, 59683000
EBCDIC,M[I].LENGTHF | CHRS, *); 59684000
FOR I := 1 STEP 1 UNTIL MAXUNITTYPE DO 59686000
REPLACE POINTER(TYPEINDX[I+1], *) BY 0 & BINEL( 59687000
TYPECNTR[I]+REAL(POINTER(TYPEINDX[I],*),1)) FOR 1; 59688000
FOR I := 0 STEP 1 UNTIL MAXUNIT DO 59689000
IF T ~ UNIT[I].UNITTYPE > 0 THEN 59690000
REPLACE POINTER(MNEMTOUNIT[TI(T) + 59691000
UNIT[I].UNITTYPECNTRF-1],*)BY 0&BINEL(I)FOR 1;59692000
% ***** NEED THE FOLLOWING KLUDGE UNTIL WE DYNAMICALLY SET SCREENS 59692200
SCREEN[0]~UNITBL[TI(CONN),1];% 59692201
INITIALIZERARRAY(SCREEN[0],SCREEN[1],NOOFSCREENSRQD-1);% 59692202
59693000
DIAGNOSTICUNIT ~ MASKSEARCH(0&UNITINITIALIZE( 59694000
DIAGNOSTICUNITTYPE),0&UNITINITIALIZE(4"FF"),UNIT); 59695000
DIAGNOSTICARRAY[0] := 0&USERL(*,,DIAGNOSTICUNIT,*); 59699100
DIAGNOSTICARRAY[1] := -0; 59699200
DIAGNOSTICARRAY[2] := MONITER := MONITER&ARRAYDESCL(3, 59699300
DIAGNOSTICARRAY.LENGTHF - IOCBSIZE, 59699400
DIAGNOSTICARRAY.ADDRESSF + IOCBSIZE); 59699500
DIAGNOSTICARRAY[2].LENGTHF := MONITER.LENGTHF - 1; 59699550
STOREITEM(EVNT @ REFERENCE(DIAGNOSTICARRAY), 59699600
MONITORFINISH); 59699700
IOAREA[0] := SET(0 & IOCWL(@300, *), 32); 59699720
IF NOT SIMULATING THEN BEGIN 59699735
WAITIO(IOAREA, 0 & USERL(*,,DIAGNOSTICUNIT,*), 59699740
REAL(NOT FALSE)); 59699760
MONITORVALUE := MCPINFO[10].MONVALF; 59700000
MONITORMASK := MCPINFO[10].MONMASKF; 59700100
STOP(3"721127",3"700007"); %SEE IF MONITOR IS RIGHT 59700105
END IF NOT SIMULATING; 59700110
UBITSTABLESIZE := (MAXUNIT + 47) DIV 48; 59700200
MCPDISKUNITNO := MCPDISKBASE.EUNOF; 59700300
UNLOCK(MONITORLOCK); % IT IS OK TO MONITOR NOW 59700400
REPLACE TP:POINTER(IOAREA[1], 8) BY CLEARSCREEN, 59701000
POINTER(OUTPUTMESS[BEGMCPID], 8) UNTIL = NUL, 59702000
HOME LINEFEED, FORMATTEDDATEPOINTER UNTIL = NUL, 59703000
NUL FOR 5; 59703100
IOAREA[0] ~ 0 & IOCWL(@40, *); 59704000
SLCDESC := IOAREA & ARRAYDESCL(3, TP.INDEXSTF, *); 59704200
FOR I ~ 0 STEP 1 UNTIL MAXUNIT DO 59705000
IF UNIT[I].UNITTYPE = SPO THEN 59706000
WAITIO(SLCDESC,0&USERL(*,,I,*),REAL(NOT 59707000
FALSE)); 59707010
FOR I := MAXCHANNELS STEP -1 UNTIL 1 DO 59707100
IF MULTIPLEXORMASK.[I:1] THEN 59707150
SCANOUT(0, SET(1 & SCANOUTWORD(4,*,*), I)); 59707200
PROCURE(DIRECTORYLOCK); 59710000
PROCURE(USERDISKLOCK); 59711000
DISKMAPPER; 59713000
END PERIPHERALINITIALIZE; 59799900
BOOLEAN PROCEDURE GIVEBACKDISK(DISKADDRESS, SIZE); 59800000
VALUE DISKADDRESS, SIZE; 59801000
REAL DISKADDRESS, SIZE; 59802000
BEGIN 59803000
REAL T, T1; 59804000
DEFINE LLLARRAY = DISKMAPARRAY#; 59805000
DEFINE CHECKFOROVERFLOW = 59806000
IF NEXTADDR ~ * + 2 } MAXADDR THEN 59807000
BEGIN 59808000
LLLARRAY[NEXTROW ~ * + 1, 0] ~ 0; 59809000
MAXADDR ~ (NEXTADDR ~ LLLARRAY[NEXTROW, *].ADDRESSF) 59810000
+ LLLCHUNK; 59811000
END 59812000
#; 59813000
REAL GBD;MONITOR STEVEMONITOR(GBD,T,T1,NEXTADDR); GBD := 0; 59813010
IF (T ~ M[LASTADDR ~ LISTLOOKUP(DISKADDRESS, MEMORY, 59814000
FIRSTADDR)]).MAPADDRESSF + T1 ~ M[LASTADDR + 1] < 59815000
DISKADDRESS + SIZE THEN 59816000
RETURN(1); COMMENT WE ARE GIVING BACK DISK WHICH 59817000
WE DO NOT HAVE; 59818000
IF T1 = SIZE THEN 59819000
T1:= %FOR MONITORING 59819010
M[LASTADDR + 1] ~ 0 COMMENT IF MEMORY EVER IS A 59820000
PROBLEM, HERE IS WHERE SOME 59821000
GETS WASTED; 59822000
ELSE 59823000
IF T.MAPADDRESSF + T1 = DISKADDRESS + SIZE THEN 59824000
T1:= %FOR MONITORING 59824010
M[LASTADDR + 1] ~ T1 - SIZE 59825000
ELSE IF T.MAPADDRESSF = DISKADDRESS THEN 59826000
BEGIN 59827000
M[LASTADDR].MAPADDRESSF ~ DISKADDRESS + SIZE; 59828000
T:=M[LASTADDR];T1:=%FOR MONITORING 59828010
M[LASTADDR+1] ~T1 - SIZE; 59829000
END 59830000
ELSE BEGIN 59831000
T1:= %FOR MONITORING 59831010
M[LASTADDR+1] ~ DISKADDRESS - T.MAPADDRESSF; 59832000
CHECKFOROVERFLOW; 59833000
M[LASTADDR].ADDRESSF ~ NEXTADDR; 59834000
T := %FOR MONITORING 59834010
M[NEXTADDR] ~ T & FIRSTMAPWORDPRIME(DISKADDRESS 59835000
+ SIZE, *); 59836000
T1:= %FOR MONITORING 59836010
M[NEXTADDR+1] ~ (T.MAPADDRESSF + T1) - 59837000
DISKADDRESS - SIZE; 59838000
END; 59839000
GBD:=1; %FOR MONITORING 59839010
END GIVE BACK DISK SPACE SOMEONE OWNS; 59840000
PROCEDURE DIRECTORYCOMPLEMENT(DIRECTRY); 59842000
ARRAY DIRECTRY[*]; 59843000
COMMENT THIS PROCEDURE CHASES THROUGH A DIRECTORY, AND ALL THAT 59844000
DWELL THEREIN, AND TAKES ALL DISK SPACE CLAIMED FROM THE 59845000
AVAILABLE DISK TABLE. 59846000
IT ALSO RESOLVES ANY FUNNY STUFF IN THE HEADER. 59847000
; 59848000
BEGIN 59849000
ARRAY HDR[200]; 59850000
REAL I, J, T, T1, K, SIZE, INDEX, LIMIT, 59851000
WHOAMI := DIRECTRY[0]; 59852000
LABEL BACK; 59853000
DEFINE BUZZREPORTBACK = 59857000
WHILE BOOLEAN(K ~ READLOCK(1, DIRECTORYCOMPLEMENTREPORTBACK)) 59858000
DO #; 59859000
REAL DISKCOMP; 59859100
MONITOR STEVEMONITOR(INDEX,DISKCOMP, T, LIMIT,SIZE, T1,WHOAMI); 59859200
DISKCOMP:=*; WHOAMI:=*; 59859300
INDEX := (HEADERSIZE(DIRECTRY) + 29) DIV 30; 59860000
GO ENDIT; % TEMPORARILY 59860100
BACK: 59861000
FOR I := INDEX + 4 STEP 5 WHILE NOT BOOLEAN(T := DIRECTRY[I]) DO 59862000
BEGIN 59863000
DISKWAIT(HDR, -1, IF T.FILEKINDF > DIRECTORY THEN (T1 := 59864000
(T.HEADERSIZEF + 29) DIV 30) + DIRECTORYBITE ELSE T1 := 59865000
T.HEADERSIZEF, J := DIRECTRY[I+1], @440); 59866000
COMMENT CONSISTANCY CHECKING AND HEADER DIDILING GO HERE; 59867000
PROCURE(DISKRETURNLOCK); 59868000
GIVEBACKDISK(J, T1 DIV 30); 59869000
SIZE := ROWSIZE(HDR); 59870000
LIMIT := NUMBEROFROWS(HDR) - CRUNCHED(HDR) + FIRSTROWINDEX - 1;59871000
FOR J := FIRSTROWINDEX STEP 1 UNTIL LIMIT DO 59872000
IF T1 := HDR[J] ! 0 THEN 59873000
GIVEBACKDISK(T1, SIZE); 59874000
IF BOOLEAN(CRUNCHED(HDR)) THEN 59875000
BEGIN 59876000
END; 59877000
LIBERATE(DISKRETURNLOCK); 59878000
IF T.FILEKINDF { DIRECTORY THEN 59879000
IF WHOAMI < 0 THEN 59880000
BEGIN COMMENT I AM THE CONTROLING PROCESS; 59881000
BUZZREPORTBACK; 59882000
DIRECTORYCOMPLEMENTREPORTBACK := 59884000
RESET(K, T1 := FIRSTONE(K + 1) - 1); 59885000
IF HDR[0] := T1 > 0 THEN 59886000
FORK(DIRECTORYCOMPLEMENT, HDR) 59887000
ELSE 59888000
DIRECTORYCOMPLEMENT(HDR); 59889000
END 59890000
ELSE 59891000
DIRECTORYCOMPLEMENT(HDR); 59892000
END; 59893000
IF T > 0 THEN 59894000
BEGIN 59895000
DISKWAIT(DIRECTRY, INDEX-1, DIRECTORYBITE, 59896000
DIRECTRY[FIRSTROWINDEX + (K := DIRECTRY[INDEX] | 59897000
SEGMENTSPERDIRECTORYBITE) DIV T := ROWSIZE(DIRECTRY)] + 59898000
K MOD T, @440); 59899000
GO BACK; 59900000
END; 59901000
IF WHOAMI > 0 THEN 59902000
BEGIN 59903000
BUZZREPORTBACK; 59904000
DIRECTORYCOMPLEMENTREPORTBACK := SET(K, WHOAMI); 59905000
END; 59906000
IF WHOAMI < 0 THEN 59906100
IF DIRECTRY.ADDRESSF = SYSTEMDIRECTORY.ADDRESSF THEN 59906150
BEGIN 59906200
ENDIT: COMMENT SQUASH LINKED LISTS INTO USER DISK TABLES; 59907000
LIBERATE(USERDISKLOCK); 59908000
LIBERATE(DIRECTORYLOCK); 59909000
FORGETDOPEVECTORS(DISKMAPARRAY); 59910000
FORGETSPACE(DISKMAPARRAY.ADDRESSF); 59910100
END; 59911000
DISKCOMP := 1; 59912000
END DIRECTORYCOMPLEMENT; 59929000
SAVE PROCEDURE UPDATEUNITBITSTABLE(TABLENAME, U); 60000000
VALUE U; 60001000
INTEGER U; 60002000
BOOLEAN ARRAY TABLENAME[*]; 60003000
COMMENT FOR A GIVEN TABLE (OLDSTATUSWORD,STATUSMASKWORD,ETC) AND UNIT 60004000
NO, THE PROCEDURE FINDS THE RIGHT INDEX IN THE TABLE AND 60005000
SETS (OR RESETS FOR NEGATIVE UNIT NO) BIT CORRESPONDING TO 60006000
UNIT NO. 60007000
NOTE EACH WORD HAS ONLY 32 BIT POSITIONS. 60008000
TABLENAME - -ARRAY NAME FOR A GIVEN TABLE. 60009000
U -LOGICAL UNIT NO; 60010000
BEGIN 60011000
FIELD UBITNOF = ABS(U) MOD 32:1; 60012000
TABLENAME[ABS(U) DIV 32].UBITNOF ~ NOT BOOLEAN(U.SIGNBITF); 60013000
END UPDATEUNITBITSTABLE; 60019000
PROCEDURE ARRAYDEC(NOOFDIMS,NOOFARRAYS,TYPE); 65000000
VALUE NOOFDIMS,NOOFARRAYS,TYPE; 65001000
INTEGER NOOFDIMS,NOOFARRAYS,TYPE; 65002000
COMMENT ENTERS DIMENSION INFORMATION FOR EACH ARRAY INTO ARRAYINFOT. 65003000
A SPECIAL DESCRIPTOR IS MADE FOR EACH ARRAY(SEE SARRAYDESCL 65004000
LAYOUT) .AITINDICATOR BIT IS TURNED ON SO THAT PRESENCEBIT 65005000
COULD TAKE SPECIAL ACTION. IN 65006000
CASE ARRAYINFOT GETS FULL INVALID INDEX INTERRUPT WILL OCCUR 65007000
AND THEN ARRAYINFOT WILL BE EXTENDED. NOTE THAT VARIABLE NO OF65008000
PARAMETERS ARE PASSED. 65009000
NOOFDIMS - WHAT IT SAYS. 65010000
NOOFARRAYS- NO OF ARRAYS IN A SINGLE LIST HAVING SAME DIMENSIONS.65011000
E.G. A,B,C[2,3,4] 65012000
TYPE - CODE SPECIFYING DIFFERENT KINDS OF ARRAY 65013000
IF TYPE IS NEGATIVE THEN ARRAY IS FOR MCP 65014000
; 65015000
BEGIN 65016000
WORD ARRAY ARRAYLIST[*]; COMMENT DESC POINTING TO LIST OF 65017000
ARRAYS IN STACK; 65018000
ARRAY ARRAYINFOT[*], COMMENT ARRAY INFORMATION TABLE; 65019000
DIMINFO[*]; COMMENT DESC POINTING TO WHERE 65020000
DIMENSION INFORMATION STARTS IN STACK;65021000
REAL DIMINFOSIZE, % NO OF DIMENSIONS 65022000
INDEX, 65023000
FREG, COMMENT F REG SETTING; 65023100
ARRAYINFOTI; COMMENT LAST USED INDEX OF ARRAYINFOT;65024000
WORD MSCW; COMMENT MARK STACK CONTROL WORD; 65025000
LABEL CUTSTACK,QUIT; 65026000
BOOLEAN LOBOUNDTOG; COMMENT TRUE IF LOWER BOUND IS PASSED;65027000
COMMENT LOCK THE STACK & WAKE UP DESCRIPTORS FOR ARRAYLIST AND DIMINFO;65028000
COMMENT SET LOBOUNDTOG IF LOWER BOUND IS PASSED FOR OWN ARRAY; 65029000
FREG~F; 65029100
DIMINFOSIZE~ ( 1 + REAL(LOBOUNDTOG)) | NOOFDIMS; 65029200
ARRAYINFOT~IF BOOLEAN(TYPE.SIGNBITF) THEN MCPARRAYINFOT 65030000
ELSE WORDSTACK[SNR,AITDESCRIPTORPLACE]; 65031000
IF DATADESC ! ARRAYINFOT.TAG THEN 65031100
BEGIN 65031300
ARRAYINFOT~ARRAYINFOT & 65031350
DATADESCRIPTOR(,,,,,,,,AITSIZE,0); 65031400
ARRAYINFOT[0]~1; 65031500
WORDSTACK[SNR,AITDESCRIPTORPLACE] ~ARRAYINFOT & 65031600
ARRAYDESCL(2, ,); 65031700
END; 65031800
IF ((ARRAYINFOTI~ARRAYINFOT[0]) + DIMINFOSIZE) } 65031900
(INDEX~WORD(ARRAYINFOT).LENGTHF) THEN 65032000
BEGIN % EXTEND AIT TABLE 65032100
INDEX~INDEX + AITSIZE; 65032200
MSCW~ARRAYINFOTI + DIMINFOSIZE; 65032250
DIMINFO~DIMINFO & DATADESCRIPTOR(,,,,,,,, INDEX ,0); 65032300
FOR INDEX~0 STEP 1 UNTIL ARRAYINFOTI DO 65032500
DIMINFO[INDEX]~ARRAYINFOT[INDEX]; 65032600
FORGETSPACE(WORD(ARRAYINFOT).ADDRESS); 65032700
IF BOOLEAN(TYPE.SIGNBITF) THEN 65032800
MCPARRAYINFOT~DIMINFO ELSE 65032900
WORDSTACK[SNR,AITDESCRIPTORPLACE]~DIMINFO & 65032920
ARRAYDESCL(2, ,); 65032930
ARRAYINFOT~DIMINFO; 65032940
END; 65032960
INDEX~FREG-DIMINFOSIZE-REAL(NOOFDIMS=1); 65033000
DIMINFO~DIMINFO & ARRAYDESCL(,DIMINFOSIZE,INDEX); 65034000
ARRAYLIST~ARRAYLIST & ARRAYDESCL(,NOOFARRAYS,INDEX-NOOFARRAYS);65035000
DIMINFOSIZE~DIMINFOSIZE-1; 65036000
IF (INDEX~DIMINFO[DIMINFOSIZE]) {0 THEN 65038000
BEGIN 65039000
COMMENT BUILD MESSAGE "DEC-ERROR- ARRAY DIMENSION= " ;65040000
GO QUIT; 65041000
END; 65042000
IF NOOFDIMS=1 AND INDEX{256 THEN 65043000
BEGIN COMMENT ARRAY NOT TO BE SEGMENTED; 65044000
ARRAYLIST[0]~0 & DATADESCRIPTOR(,,,,,,,TYPE.DOUBLEBIT, 65045000
INDEX,TYPE.LSAVEBIT); 65046000
GO CUTSTACK; 65047000
END; 65048000
ARRAYLIST[0]~ARRAYLIST[0] & SARRAYDESCL(,DIMINFO[0],TYPE. 65049000
SIGNBITF,,1,ARRAYINFOTI,ABS(TYPE)); 65050000
IF NOOFDIMS=1 THEN 65051000
BEGIN 65052000
ARRAYLIST[0].SBITF~1; 65053000
INDEX~DIMINFO[0]; 65054000
DIMINFO[0]~INDEX DIV 256; 65055000
ARRAYINFOT[ARRAYINFOTI]~INDEX~INDEX MOD 256; 65056000
DIMINFO[0]~ * + REAL(INDEX>0); 65057000
ARRAYINFOTI~ARRAYINFOTI +1; 65058000
ARRAYLIST[0].LENGTHF~DIMINFO[0]; 65059000
GO CUTSTACK; 65060000
END; 65061000
FOR INDEX~1 STEP 1 UNTIL DIMINFOSIZE DO 65062000
BEGIN 65063000
ARRAYINFOT[ARRAYINFOTI]~DIMINFO[INDEX]; 65064000
ARRAYINFOTI~ARRAYINFOTI + 1; 65065000
END; 65066000
CUTSTACK: 65067000
IF NOOFDIMS=1 THEN DIMINFOSIZE~ DIMINFOSIZE + 1; 65067500
ARRAYINFOT[ARRAYINFOTI- 1].SIGNBITF~1; 65068000
ARRAYINFOT[0] ~ ARRAYINFOTI; 65069000
NOOFARRAYS~NOOFARRAYS-1; 65070000
IF NOOFARRAYS>0 THEN 65071000
FOR INDEX~1 STEP 1 UNTIL NOOFARRAYS DO 65072000
ARRAYLIST[INDEX] ~ ARRAYLIST[0]; 65073000
COMMENT CUTTING BACK STACK; 65073200
DIMINFOSIZE~DIMINFOSIZE+1; 65074000
MSCW~M[FREG]; 65075000
INDEX~MSCW.DFF; 65076000
M[FREG].DFF~DIMINFOSIZE; 65077000
MSCW.DFF~INDEX-DIMINFOSIZE; 65078000
M[INDEX~FREG-DIMINFOSIZE]~MSCW; 65079000
M[INDEX+1]~M[FREG+1]; 65080000
M[FREG+1]~DUMMYFORCUTTINGSTACKPCW & SETTAG(RCW); 65081000
COMMENT UNLOCK STACK; 65082000
QUIT: EXIT; 65083000
END ARRAYDEC; 65084000
SAVE 65085000
WORD PROCEDURE DOPEVECTOR(MOMDESC); 65086000
VALUE MOMDESC; WORD MOMDESC; 65087000
COMMENT 65088000
BUILDS UP DOPE VECTOR TABLE AT PRESENCE TIME. OBTAINS DIMENSION65089000
SIZE FROM ARRAY INFORMATION TABLE(ARRAYINF0T) AND GETS SPACE 65090000
FOR IT. IF NEXT ENTRY IN ARRAYINFOT IS NOT THE LAST DIMENSION, 65091000
IT BUILDS UP SPECIAL ARRAY DESCRIPTORS(SEE SARRAYDESCL LAYOUT) 65092000
OTHERWISE 65093000
IT BUILDS UP NORMAL DATA DESCRIPTORS WITW LAST DIMENSION IN THE65094000
LENGTH FIELD. SUBSEQUENTLY REGULAR PRESENCE BIT ACTION WILL 65095000
OCCUR TO BRING IN THE RIGHT ROW. ADDRESS OF DOPEVECTABLE IS 65096000
RETURNED. 65097000
MOMDESC - ORIGINAL MOM DESCRIPTOR 65098000
; 65099000
BEGIN 65100000
REAL DOPEVECTADDR; COMMENT ADDRESS POINTS DOPEVECTABLE; 65101000
INTEGER AITINDEX, COMMENT POINTS TO AIT LOCATION WHICH HAS 65102000
DIMENSION INFORMATION; 65103000
I, COMMENT INDEX FOR DOPE VECTOR TABLE; 65104000
LASTDOPEVECSIZE, COMMENT SIZE OF LAST SEG. OF 65105000
SEGMENTED ARRAY; 65106000
TYPE=AITINDEX, COMMENT ARRAY TYPE CODE; 65107000
DOPEVECTSIZE; COMMENT DOPE VECTOR TABLE SIZE; 65108000
ARRAY AIT[*]; COMMENT ARRAY IMFORMATION TABLE; 65109000
WORD ARRAY DOPEVECTABLE[*]; COMMENT ARRAY FOR CREATING DOPE 65110000
VECTOR TABLE; 65111000
WORD DOPEVECT=DOPEVECTABLE; 65112000
AITINDEX~MOMDESC.AITINDEXF; 65113000
AIT~IF BOOLEAN(MOMDESC.MCPARRAYBIT) THEN 65114000
MCPARRAYINFOT ELSE WORDSTACK[SNR,AITDESCRIPTORPLACE]; 65115000
DOPEVECTSIZE~MOMDESC.LENGTHF; 65116000
DOPEVECTADDR~GETSPACE(DOPEVECTSIZE,SNR,4,0); 65117000
DOPEVECTABLE~DOPEVECTABLE & ARRAYDESCL(,DOPEVECTSIZE, 65118000
DOPEVECTADDR); 65119000
IF (I+AIT[AITINDEX]) <0 THEN 65120000
BEGIN 65121000
IF BOOLEAN(MOMDESC.SBITF) THEN 65122000
BEGIN 65123000
LASTDOPEVECSIZE~ABS(I); 65124000
DOPEVECT.SBITF~1; 65125000
I~256; 65126000
END; 65127000
TYPE~MOMDESC.ARRAYTYPEF; 65128000
DOPEVECTABLE[0]~0 & DATADESCRIPTOR(,,,,,,,TYPE.DOUBLEBIT, 65129000
I,TYPE.LSAVEBIT); 65130000
END ELSE 65131000
DOPEVECTABLE[0]~MOMDESC & SARRAYDESCL(,I,,,,AITINDEX+1,); 65132000
DOPEVECTSIZE~DOPEVECTSIZE-1; 65133000
FOR I~ 1 STEP 1 UNTIL DOPEVECTSIZE 65134000
DO 65135000
DOPEVECTABLE[I] ~ DOPEVECTABLE[0]; 65136000
IF LASTDOPEVECSIZE>0 THEN 65137000
DOPEVECTABLE[DOPEVECTSIZE].LENGTHF~LASTDOPEVECSIZE; 65138000
RETURN(WORD(DOPEVECT)); 65139000
END DOPEVECTOR; 65140000
SAVE PROCEDURE BLOCKEXIT; 65174000
COMMENT BLOCKEXIT IS CALLED JUST PRIOR TO EXITING A BLOCK. BLOCKEXIT 65175000
FORGETS SPACE GOTTEN FOR THE BLOCK; 65176000
BEGIN 65177000
REAL LIMIT, COMMENT STACK SEARCH LIMIT; 65180000
ADDR, COMMENT ADDRESS FOR GETSPACE; 65181000
I; 65182000
WORD STK; COMMENT FOR ACCESSING MSCW; 65183000
LABEL QUIT; 65184000
REAL BLKEXIT,DISP,STKBASE; %FOR MONITORING ONLY 65184100
MONITOR STEVEMONITOR(BLKEXIT,DISP); 65184200
REAL TRACTER;TRACTER~TRACE(0);% TURNS OFF TRACE 65184300
COMMENT LOCK STACK; 65185000
STKBASE ~ %FOR MONITOR CALCULATIONS 65186000
STK ~ (LIMIT ~ F - 1) - M[F].DFF + 3; 65187000
BLKEXIT ~ LIMIT - STKBASE + 1; %MONITOR 65188000
FOR I~STK STEP 1 UNTIL LIMIT DO 65190000
BEGIN 65191000
STK~M[I]; 65192000
IF STK.TAG=6 THEN GO QUIT; 65193000
IF STK.TAG=DATADESC AND STK.PCBITSF=2 THEN 65194000
BEGIN COMMENT DATA DESCRIPTOR WITH ONLY P BIT ON; 65195000
IF M[ADDR~STK.ADDRESS].TAG=DATADESC THEN 65196000
65197000
FORGETDOPEVECTORS(STK); 65198000
FORGETSPACE(ADDR); 65199000
DISP ~ I - STKBASE + 2; %7ONITOR THE DISPLACEMENT FROM LL 65199100
END; 65200000
END; 65201000
QUIT: 65202000
COMMENT UNLOCK STACK; 65203000
TRACE(TRACTER);% RESTORES TRACE 65203900
END BLOCKEXIT; 65204000
PROCEDURE FORGETDOPEVECTORS(DD); WORD ARRAY DD[*]; 65205000
COMMENT FORGETDOPEVECTORS WILL MAKE RECURSIVE CALLS ON ITSELF UNTIL 65206000
THE WHOLE CHAIN OF DOPE VECTORS ARE FORGOTTEN 65207000
DD -DATA DESCRIPTOR FOR DOPE VECTOR TABLE; 65208000
BEGIN 65209000
INTEGER I, COMMENT INDEX FOR LOOP; 65210000
ADDR, COMMENT DESCRIPTOR ADDRESS; 65211000
LENGTH; COMMENT LENGTH OF TABLE; 65212000
WORD DDV; COMMENT CONTENT OF DD LOCATION; 65213000
65214000
LENGTH ~ DD.LENGTHF - 1; 65215000
FOR I~0 STEP 1 UNTIL LENGTH DO 65216000
BEGIN 65217000
DDV ~ DD[I]; DDV.CBITF ~ 1; 65218000
IF BOOLEAN(DDV.PBITF) THEN 65219000
IF M[ADDR~DDV.ADDRESS].TAG=DATADESC THEN 65220000
BEGIN 65221000
FORGETDOPEVECTORS(DDV); 65222000
FORGETSPACE(ADDR); 65223000
END ELSE 65224000
FORGETSPACE(ADDR); 65225000
END; 65226000
END FORGETDOPEVECTORS; 65227000
PROCEDURE GOTOSOLVER(SIRW); VALUE SIRW; REAL SIRW; 65228000
COMMENT SOLVES BADGOTO PROBLEM; 65229000
BEGIN 65230000
INTEGER FREG, COMMENT F REG. SETTING; 65231000
FINALF, COMMENT FINAL F VALUE; 65232000
LIMIT, COMMENT LIMIT FOR SEARCHING STACK; 65233000
DISP, COMMENT TOTAL DISPLACEMENT; 65233500
ADDR, COMMENT ADDRESS FOR FORGETSPACE; 65234000
I; COMMENT INDEX; 65235000
BOOLEAN BADLABELFOUNDTOG; 65235500
WORD STK, COMMENT CONTENTS OF STACK LOCATION; 65236000
MSCW; COMMENT CURRENT MKST WORD; 65237000
LABEL SEARCHAGAIN,LOOPEND,SKIPFORGETPART; 65238000
IF SIRW=0 THEN EXIT; COMMENT USE TERMINATE WHEN AVAILABLE; 65238999
65239000
FINALF ~ STACKVECTOR[SIRW.STKNRF].ADDRESS + SIRW.DISPF ; 65240000
COMMENT LOCK STACK; 65241000
FREG ~F; 65242000
SEARCHAGAIN: 65243000
LIMIT~FREG-1; 65244000
MSCW~M[FREG]; 65244500
ADDR~MSCW.DFF; COMMENT TEMP STORAGE OF DISPLACEMENT; 65244700
IF (FREG~FREG-ADDR) {FINALF THEN BADLABELFOUNDTOG~TRUE ; 65245000
I~FREG+2; 65248000
DISP~DISP+ADDR; 65248500
FOR I~I STEP 1 UNTIL LIMIT DO 65249000
BEGIN 65250000
STK ~ M[I]; 65251000
IF STK.TAG=6 THEN IF BADLABELFOUNDTOG THEN GO LOOPEND 65252000
ELSE GO SEARCHAGAIN 65252100
ELSE 65252200
IF BADLABELFOUNDTOG THEN GO SKIPFORGETPART ELSE 65252300
IF STK.TAG=DATADESC AND STK.PCBITSF=2 THEN 65253000
BEGIN COMMENT DATA DESCRIPTOR WITH P BIT ON; 65254000
IF M[ADDR ~STK.ADDRESS].TAG=DATADESC THEN 65255000
FORGETDOPEVECTORS(STK); 65256000
FORGETSPACE(ADDR); 65257000
END; 65258000
SKIPFORGETPART: 65259000
END; 65260000
GO SEARCHAGAIN; 65261000
LOOPEND: 65262000
I~I+1; 65263000
STK~M[FINALF+SIRW.SIRWDELTAF]; COMMENT PCW FOR LABEL; 65264000
ADDR~I-FREG; 65265000
DISP~DISP-ADDR; 65265500
FREG~F; 65266000
MSCW~M[FREG]; 65267000
MSCW.DFF~ADDR; 65268000
M[I]~MSCW; 65269000
M[I+1]~ STK & SETTAG(RCW); 65270000
MSCW.DFF~DISP; 65270100
M[FREG]~MSCW; 65270200
M[FREG+1]~DUMMYFORCUTTINGSTACKPCW & SETTAG(RCW); 65270300
COMMENT UNLOCK STACK; 65271000
END GOTOSOLVER; 65272000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70000000
% I/O INTRINSICS %70001000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70002000
SAVE EVENT ARRAY IOEVENT[192]; 70003000
SAVE ARRAY IOEVENTS[5]; 70004000
EVENT IOEVNT; 70005000
PROCEDURE WAITON(IOCB);REFERENCE IOCB; 70006000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70007000
% WAITON IS DESIGNED TO "SAVE" EVENTS, UTILIZING JUST ONE %70008000
% PER FILE ... THERE ARE TIMING PROBLEMS %70009000
% ONE BUFFER AND DIRECT-ACCESS %70010000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70011000
LABEL HR; 70012000
HR: 70013000
WAIT(EVNT@IOCB); 70014000
IF IOPENDING THEN 70015000
BEGIN 70016000
RESET(EVNT@IOCB); 70017000
STOP; %%%%% 70018000
IF IOPENDING THEN GO TO HR; 70019000
END; 70020000
IOCOMPLET~0; 70020100
END WAITON; 70021000
INTEGER PROCEDURE EVENTNUMBER; 70022000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70023000
% EVENTNUMBER PROCURES AN EVENT FOR A FILE %70024000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70025000
EVENT EVNT; 70026000
LABEL STRT,XIT; 70027000
LAYOUT IOEVENTSL((I-1):1~1); 70028000
REAL I,T; 70029000
STRT: 70030000
WHILE BOOLEAN(READLOCK(1,IOEVENTS[4])) DO WAIT(IOEVNT); 70031000
RESET(IOEVNT); 70032000
T~-1; 70033000
WHILE T~T+1<4 DO 70034000
IF I~FIRSTONE(REAL(NOT BOOLEAN(IOEVENTS[I])))!0 THEN GO XIT; 70035000
READLOCK(0,IOEVENTS[4]); 70036000
CAUSE(IOEVNT); 70037000
% SLEEP(1,EVNT); 70038000
RESET(EVNT); 70039000
GO TO STRT; 70040000
XIT: 70041000
IOEVENTS[T]~*&IOEVENTSL(); 70042000
READLOCK(0,IOEVENTS[4]); 70043000
CAUSE(IOEVNT); 70044000
RESET(IOEVENT[EVENTNUMBER~(I-1)+T|48]) 70045000
END EVENTNUMBER; 70046000
PROCEDURE FORGETEVENT(NMBR);VALUE NMBR;REAL NMBR; 70047000
BEGIN 70048000
LAYOUT IOEVENTSL(I:1~0); 70049000
REAL I~NMBR MOD 48; 70050000
WHILE BOOLEAN(READLOCK(1,IOEVENTS[4])) DO WAIT(IOEVNT); 70051000
RESET(IOEVNT); 70052000
RESET(IOEVENT[NMBR]); 70053000
IOEVENTS[NMBR DIV 48]~*&IOEVENTSL(); 70054000
READLOCK(0,IOEVENTS[4]); 70055000
CAUSE(IOEVNT); 70056000
END FORGET EVENT; 70057000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70058000
WORD PROCEDURE SETUPTANK(NAREAS,AR,ASIZE,BCKWRD,SKLTN,FEVENT,UNMBR);70059000
VALUE AR,ASIZE,BCKWRD,SKLTN,UNMBR; 70060000
REAL NAREAS,AR,ASIZE,BCKWRD,SKLTN,UNMBR; 70061000
EVENT FEVENT; 70062000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70063000
% SETS UP BUFFERS AND LINKS THEM TOGETHER %70064000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70065000
FIELD CBIT=1:1; 70066000
BOOLEAN CNTGS~BOOLEAN(BCKWRD.CBIT); 70067000
LABEL OUT; 70068000
REAL I,T~NAREAS,P~AR-1; 70069000
REAL FRST,CRLC,LSTLC; 70070000
PROCEDURE BUILDIOAREA(ADDRESS);VALUE ADDRESS;INTEGER ADDRESS; 70071000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70072000
% BUILDS IOAREA: IOCB + LINKS + BUFFER %70073000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70074000
ARRAY IOAREA[*]; 70075000
LAYOUT USERL(18:1~1,UNITNOF); 70075100
WORD ARRAY IOAREAWA=IOAREA[*]; 70076000
IOAREA~IOAREA&ARRAYDESCL(,ASIZE,ADDRESS); 70077000
REPLACE POINTER(IOAREA) BY 0 FOR ASIZE OVERWRITE; 70078000
IOAREA[0]~0&USERL(,UNMBR); 70079000
STOREITEM(EVNT@REFERENCE(IOAREA),FEVENT); 70080000
IOAREAWA[2]~IOAREA~IOAREA& 70081000
ARRAYDESCL(,ASIZE-IOTANKSZ,IOAREA.ADDRESSF+IOTANKSZ-1); 70082000
IOAREA[0]~SKLTN; 70083000
DIVORCEMOM(IOAREA); 70084000
END BUILDIOAREA; 70085000
IF CNTGS THEN I~REQSPACE(ASIZE|NAREAS); 70086000
BUILDIOAREA(FRST~CRLC~LSTLC~(IF CNTGS THEN I ELSE 70087000
REQSPACE(ASIZE))); 70088000
WHILE T~T-1>0 DO 70089000
BEGIN 70090000
IF CNTGS THEN I~I~ASIZE ELSE 70091000
IF T>P THEN 70092000
IF I~OPTSPACE(ASIZE)<0 THEN 70093000
BEGIN NAREAS~NAREAS-1;GO TO OUT END ELSE 70094000
ELSE I~REQSPACE(ASIZE); 70095000
BUILDIOAREA(I); 70096000
M[LSTLC+IOAL].FL~CRLC~I; 70097000
IF BOOLEAN(BCKWRD) THEN M[I+IOAL].BL~LSTLC; 70098000
LSTLC~CRLC; 70099000
OUT: 70100000
END; 70101000
IF NAREAS>1 THEN 70102000
BEGIN 70103000
M[LSTLC+IOAL].FL~FRST; 70104000
IF BOOLEAN(BCKWRD) THEN M[FRST+IOAL].BL~LSTLC; 70105000
END; 70106000
SETUPTANK~IOEVENTS&ARRAYDESCL(,ASIZE,FRST); 70107000
END SETUPTANK; 70108000
PROCEDURE ATTRIBUTEHANDLER=(0,42)(FIB,TYPE,ARGH); 70109000
VALUE TYPE,ARGH; 70110000
REAL TYPE,ARGH; 70111000
ARRAY FIB[*]; 70112000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70113000
% ATTRIBUTEHANDLER CHANGES VARIOUS FILE ATTRIBUTES %70114000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70115000
ARRAY IOAREA,LEB,NULEB[*],NLEB[31]; 70116000
POINTER PTEMP,PBGN; 70116010
FIELD PTYPE=30:6,TYPEF=TYPE:1; 70117000
FIELD INTNAME=43:1; 70118000
LAYOUT 70119000
BLCKNG(RCRDTYPE,SIZEMODE,SIZEOFF,SIZESZ), 70120000
ENDL(0:1); 70121000
POINTER NAMES=ARGH,PLEB,PNLB; 70122000
BOOLEAN MSG; 70123000
REAL 70124000
T, 70125000
U, 70126000
I, 70127000
FIB0, 70128000
MSK ~4"FFFFFFFFFFF", 70129000
BTYPES~4"F776", 70130000
PTYPES~4"9540", 70131000
CARE~4"FFFFFFFFFFF"; 70132000
WORD ARRAY FIBW=FIB[*]; 70133000
IOAREA~IOADESC; 70134000
FIB0~FIBSIZE; 70135000
FIBUZZ; 70136000
IF BOOLEAN(CARE.TYPEF) THEN 70137000
IF BOOLEAN(MSK.TYPEF)EQV ALREADYOPEN THEN 70138000
BEGIN TRACE(18);TRACE(21); END; 70138100
%IF NOT LABELEQTD THEN GETFPB(FIB); 70139000
LEB~LBLEQTN&DATADESCRIPTOR(); 70140000
MAKEPRESENTANDSAVE(LEB); 70140100
LBLEQTN~LEB; 70140200
CASE TYPE OF 70143000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70144000
BEGIN % FILE.TITLE 070145000
PLEB~NAMES; 70145010
PNLB~(PTEMP~(PBGN~POINTER(NLEB,8))+3)+1; 70145020
REPLACE PBGN+1 BY 1 FOR 1 CORRECTLY; 70145030
WHILE TRUE DO 70145040
BEGIN 70145050
REPLACE PNLB:PNLB BY PLEB:PLEB WHILE IN EBCDICALPHANUMERIC; 70145060
REPLACE PBGN+2 BY REAL(PBGN+2,1)+1 FOR 1 CORRECTLY; 70145070
REPLACE PTEMP BY DELTA(PTEMP+1,PNLB) FOR 1 CORRECTLY; 70145080
IF PLEB=8"/" THEN 70145090
BEGIN 70145100
PLEB~PLEB+1; 70145110
PNLB~(PTEMP~PNLB)+1; 70145120
END ELSE 70145130
BEGIN 70145140
REPLACE PBGN BY DELTA(PBGN,PNLB)FOR 1 CORRECTLY; 70145150
GO OUT; 70145160
END; 70145170
END; 70145180
OUT: 70145190
IF ((I~REAL(PBGN,1))+5)DIV 6>(REAL(PLEB~POINTER(LEB[U~( 70146000
(T~LEB[0]).FXD+ONES(T.OPTMASK))],8),1)+5)DIV 6 THEN 70147000
BEGIN 70148000
NULEB~*&ARRAYDESCL(0,U+((I+5)DIV 6),0); 70149000
REPLACE POINTER(NULEB,8) BY PLEB FOR U WORDS,PBGN FOR I; 70150000
MAKEPRESENTANDSAVE(NULEB); 70151000
LBLEQTN~NULEB; 70151100
DIVORCEMOM(NULEB); 70152000
FORGETSPACE(LEB.ADDRESSF); 70153000
END ELSE 70154000
BEGIN 70155000
REPLACE POINTER(LEB[U],8) BY PBGN FOR I; 70156000
LBLEQTN~LEB 70157000
END; 70158000
END; 70158050
BEGIN % FILE.REEL 170159000
MSG~(ARGH>9999 OR ARGH<0); 70160000
GEN1~*&GENEALOGY1(*,*,1,ARGH); 70161000
END; 70162000
BEGIN % FILE.DATE 270163000
MSG~(ARGH<0 OR ARGH DIV 1000>99); 70164000
GEN2.CRTNDATE~ARGH; 70165000
END; 70166000
BEGIN % FILE.CYCLE 370167000
MSG~(ARGH>9999 OR ARGH<0); 70168000
GEN1.CYCLE~ARGH; 70169000
END; 70170000
BEGIN % FILE.VERSION 470171000
MSG~(ARGH>99 OR ARGH<0); 70172000
GEN1.GENVERSN~ARGH; 70173000
END; 70174000
BEGIN % FILE.SAVEFACTOR 570175000
MSG~(ARGH>999 OR ARGH<0); 70176000
GEN2.SAVFACTOR~ARGH; 70177000
END; 70178000
BEGIN % FILE.DENSITY 670179000
MSG~ARGH>3 OR ARGH<0; 70180000
LEBC~*&LEBCNTRL(*,*,*,1,ARGH); 70182000
END; 70183000
BEGIN % FILE.PARITY 770184000
MSG~(ARGH>1 OR ARGH<0); 70185000
LEBC.LPARITY~ARGH; 70186000
END; 70187000
BEGIN % FILE.KIND 870188000
T~TYPE; 70189000
TYPE~ARGH.MOD32F; 70190000
MSG~(BOOLEAN(PTYPES.TYPEF)OR BOOLEAN(BTYPES.TYPEF)OR 70191000
ARGH.DIV32F>7 OR ARGH<0); 70192000
LEBC.PTYPEL~ARGH; 70193000
TYPE~T; 70194000
END; 70195000
BEGIN % FILE.LABELTYPE 970196000
MSG~(ARGH>2 OR ARGH<0); 70197000
LEBC.LABELTYPEL~ARGH; 70198000
LEBC.LABELTYPES~1; 70199000
END; 70200000
BEGIN % FILE.EXTMODE 1070201000
MSG~ARGH>4 OR ARGH<0; 70202000
LEBC.EXTFORML~ARGH; 70203000
END; 70204000
BEGIN % FILE.OPTIONAL 1170205000
MSG~(ARGH>1 OR ARGH<0); 70206000
LEBC.OPTIONALF~ARGH; 70207000
END; 70208000
BEGIN % FILE.PROTECTION 1270209000
MSG~(ARGH>2 OR ARGH<0); 70210000
LEBC.FPRTCTD~ARGH; 70211000
END; 70212000
BEGIN % FILE.FILETYPE 1370213000
MSG~ARGH>5 OR ARGH<0; 70214000
BLK1.FILETYPEL~T; 70218000
END; 70219000
BEGIN % FILE.BLOCKSIZE 1470220000
MSG~(ARGH<0 OR ARGH>65535); 70221000
BLK1.BLOCKSZL~ARGH; 70222000
END; 70223000
BEGIN % FILE.MAXRECSIZE 1570224000
MSG~(ARGH<0 OR ARGH>65535); 70225000
BLK1.MAXRECSZL~ARGH; 70226000
END; 70227000
BEGIN % FILE.MINRECSIZE 1670228000
BLK2.MINRECSZL~ARGH; 70229000
MSG~(ARGH<0 OR ARGH>65535); 70230000
END; 70231000
BEGIN % FILE.AREASIZE 1770232000
MSG~ARGH<0 OR ARGH>65535; 70233000
DSKS.AREASIZE~ARGH; 70234000
END; 70235000
BEGIN % FILE.AREAS 1870236000
MSG~ARGH<0 OR ARGH>1023; 70237000
DSKS.NUMAREAS~ARGH; 70238000
END; 70239000
BEGIN % FILE.ACCESS 1970240000
MSG~ARGH<0 OR ARGH>2; 70241000
DSKS.ACCSSTYPEF~ARGH; 70242000
END; 70243000
BEGIN % FILE.MYUSE 2070244000
MSG~ARGH<0 OR ARGH>3; 70245000
DSKS.MYUSEF~ARGH; 70246000
END; 70247000
BEGIN % FILE.OTHERUSE 2170247100
MSG~ARGH<0 OR ARGH>3; 70247200
DSKS.OTHERUSEF~ARGH; 70247300
END; 70247400
BEGIN % FILE.FLEXIBLE 2270248000
MSG~ARGH<0 OR ARGH>1; 70249000
DSKS.FLEXIBLEF~ARGH; 70250000
END; 70251000
BEGIN % FILE.PACKED 2370252000
MSG~ARGH<0 OR ARGH>1; 70253000
DSKS.PACKEDF~ARGH; 70254000
END; 70255000
BEGIN % FILE.SPEED 2470256100
MSG~ARGH>2 OR ARGH<0; 70256110
DSKS.SPEEDF~ARGH; 70256120
END; 70256130
BEGIN % FILE.BUFFERED 2570256140
MSG~ARGH>1 OR ARGH<0; 70256150
BFFRD~ARGH; 70256160
END; 70256170
BEGIN % FILE.BUFFERS 2670256180
MSG~ARGH>63 OR ARGH<0; 70256190
BUFFREQ~ARGH; 70256200
END; 70256210
BEGIN % FILE.DIRECTION 2770256220
MSG~ARGH>1 OR ARGH<0; 70256230
DSKS.DIRECTIONF~ARGH; 70256240
END; 70256250
BEGIN % FILE.ERRECOVERY 2870256260
MSG~ARGH>1 OR ARGH<0; 70256270
FILESTATUS.ERRLEVEL~ARGH; 70256280
END; 70256290
BEGIN % FILE.INTMODE 2970256300
MSG~ARGH>4 OR ARGH<0; 70256310
INTERNALMODE~ARGH; 70256320
END; 70256330
BEGIN % FILE.OPEN 3070256340
MSG~BOOLEAN(ARGH)EQV ALREADYOPEN; 70256350
IF BOOLEAN(ARGH)THEN OPEN(FIB,0) ELSE 70256360
% CLOSE(FIB,0) 70256370
; 70256380
END; 70256390
BEGIN % FILE.PRESENT 3170256400
OPEN(FIB,3); 70256410
% RETURN 70256420
MSG~TRUE; 70256430
END; 70256440
BEGIN % FILE.SIZEMODE 3270256450
MSG~ARGH>4 OR ARGH<0; 70256460
RECORDMODE~ARGH; 70256470
END; 70256480
BEGIN % FILE.SIZEOFFSET 3370256490
MSG~ARGH>65535 OR ARGH<0; 70256500
RECORDOFF~ARGH; 70256510
END; 70256520
BEGIN % FILE.SIZE2 3470256530
MSG~ARGH>65535 OR ARGH<0; 70256540
RECORDSZ~ARGH; 70256550
END; 70256560
MSG~TRUE; % FILE.STATE 3570256570
MSG~TRUE; % FILE.EOF 3670256580
MSG~TRUE; % FILE.PARITYERR 3770256590
MSG~TRUE; % FILE.SIZERR 3870256600
MSG~TRUE; % FILE.LOCKOUT 3970256610
MSG~TRUE; % FILE.NULINPUT 4070256620
MSG~TRUE; % FILE.BREAK 4170256630
BEGIN % FILE.STATUS 4270256640
OPEN(FIB,STATUSV); 70256650
% RETURN 70256660
MSG~TRUE; 70256670
END; 70256680
BEGIN % FILE.WRAPAROUND 4370256690
MSG~ARGH>1 OR ARGH<0; 70256700
WRAPAROUND~1; 70256710
END; 70256720
END; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70257000
IF MSG THEN IOERRMESSL(1,TYPE,POINTER(LEB[(T+LEBC).FXD+ 70258000
ONES(T.OPTMASK)],8)); 70259000
DIVORCEMOM(IOAREA); 70260000
DIVORCEMOM(LEB); 70261000
TURNOVERLAYKEY(LBLEQTN.ADDRESSF); 70261100
UNLOCKFIB; 70262000
END ATTRIBUTEHANDLER; 70263000
REAL PROCEDURE ATTRIBUTEGRABBER=(0,41)(FIB,TYPE,ARGH); 70263100
VALUE TYPE; 70263110
ARRAY FIB[*]; 70263120
REAL TYPE; 70263130
WORD ARGH; 70263140
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70263150
% ATTRIBUTEGRABBER GRABS FILE ATTRIBUTES ... SERIOUSLY %70263160
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70263170
ARRAY IOAREA,LEB[*]; 70263180
BOOLEAN MSG; 70263190
FIELD TYPEF=TYPE:1; 70263200
POINTER NAMES=ARGH,PLEB,PNLB; 70263210
REAL 70263220
FIB0, 70263230
U, 70263240
T, 70263250
CARE ~4"FFFFFFFFFFF", 70263260
MSK ~4"FFFFFFFFFFF"; 70263270
WORD ARRAY FIBW=FIB[*]; 70263280
FIBUZZ; 70263290
FIB0~FIBSIZE; 70263300
IOAREA~IOADESC; 70263310
IF BOOLEAN(CARE.TYPEF) THEN 70263320
IF BOOLEAN(MSK.TYPEF)EQV NOTOPEN THEN 70263330
BEGIN TRACE(18);TRACE(21) END; 70263340
% IF NOT LABELEQTD THEN GETFPB(FIB); 70263350
LEB~LBLEQTN&DATADESCRIPTOR(); 70263360
MAKEPRESENTANDSAVE(LEB); 70263370
LBLEQTN~LEB; 70263380
CASE TYPE OF 70263390
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70263400
BEGIN % FILE.TITLE 070263410
PNLB~NAMES; 70263420
THRU REAL((PLEB~POINTER(LEB[U~((T~LEB[0]).FXD+ONES(T.OPTMASK))]70263430
,8)+3)-1,1)DO 70263440
REPLACE PNLB:PNLB BY PLEB:PLEB+1 FOR REAL(PLEB,1),8"/"; 70263450
REPLACE PNLB-1 BY 8"." 70263460
END; 70263470
RETURN(GEN1.REEL); % FILE.REEL 170263480
RETURN(GEN2.CRTNDATE); % FILE.DATE 270263490
RETURN(GEN1.CYCLE); % FILE.CYCLE 370263500
RETURN(GEN1.GENVERSN); % FILE.VERSION 470263510
RETURN(GEN2.SAVFACTOR); % FILE.SAVEFACTOR 570263520
RETURN(LEBC.DENSITYL); % FILE.DENSITY 670263530
RETURN(LEBC.LPARITY); % FILE.PARITY 770263540
RETURN(LEBC.PTYPEL); % FILE.KIND 870263550
RETURN(LABELTYPE); % FILE.LABELTYPE 970263560
RETURN(LEBC.EXTFORML); % FILE.EXTMODE 1070263570
RETURN(LEBC.OPTIONALF); % FILE.OPTIONAL 1170263580
RETURN(LEBC.FPRTCTD); % FILE.PROTECTION 1270263590
RETURN(BLK1.FILETYPEL); % FILE.FILETYPE 1370263600
RETURN(BLK1.BLOCKSZL); % FILE.BLOCKSIZE 1470263610
RETURN(BLK1.MAXRECSZL); % FILE.MAXRECSIZE 1570263620
RETURN(BLK2.MINRECSZL); % FILE.MINRECSIZE 1670263630
RETURN(DSKS.AREASIZE); % FILE.AREASIZE 1770263640
RETURN(DSKS.NUMAREAS); % FILE.NUMAREAS 1870263650
RETURN(DSKS.ACCSSTYPEF); % FILE.ACCESS 1970263660
RETURN(DSKS.MYUSEF); % FILE.MYUSE 2070263670
RETURN(DSKS.OTHERUSEF); % FILE.OTHERUSEF 2170263680
RETURN(DSKS.FLEXIBLEF); % FILE.FLEXIBLE 2270263690
RETURN(DSKS.PACKEDF); % FILE.PACKED 2370263700
RETURN(DSKS.SPEEDF); % FILE.SPEED 2470263710
RETURN(BFFRD); % FILE.BUFFERED 2570263720
RETURN(NUMBEROFBUFFERS); % FILE.BUFFERS 2670263730
RETURN(DIRECTION); % FILE.DIRECTION 2770263740
RETURN(FILESTATUS.ERRLEVEL); % FILE.ERRECOVERY 2870263750
RETURN(INTERNALMODE); % FILE.INTMODE 2970263760
RETURN(REAL(ALREADYOPEN)); % FILE.OPEN 3070263770
BEGIN % FILE.PRESENT 3170263780
OPEN(FIB,3); 70263790
% RETURN 70263800
MSG~TRUE; 70263810
END; 70263820
RETURN(RECORDMODE); % FILE.SIZEMODE 3270263830
RETURN(RECORDOFF); % FILE.SIZEOFFSET 3370263840
RETURN(RECORDSZ); % FILE.SIZE2 3470263850
RETURN(FIRSTONE(FILESTATUS.STATEF)); % FILE.STATE 3570263860
RETURN(ENDOV); % FILE.EOF 3670263870
RETURN(FILESTATUS.PARITYB); % FILE.PARITYERR 3770263880
RETURN(FILESTATUS.DATAERRORB); % FILE.SIZERR 3870263890
RETURN(FILESTATUS.LOCKOUTB); % FILE.LOCKOUT 3970263900
RETURN(FILESTATUS.NOINPUTB); % FILE.NULINPUT 4070263910
RETURN(FILESTATUS.BREAKB); % FILE.BREAK 4170263920
BEGIN % FILE.STATUS 4270263930
OPEN(FIB,STATUSV); 70263940
% RETURN 70263950
MSG~TRUE; 70263960
END; 70263970
RETURN(WRAPAROUND); % FILE.WRAPAROUND 4370263980
END; 70263990
IF MSG THEN IOERRMESSL(2,TYPE,POINTER(LEB[(T~LEBC).FXD+ 70264000
ONES(T.OPTMASK)],8)); 70264010
DIVORCEMOM(IOAREA); 70264020
DIVORCEMOM(LEB); 70264030
TURNOVERLAYKEY(LBLEQTN.ADDRESSF); 70264040
UNLOCKFIB; 70264050
END ATTRIBUTE GRABBER; 70264060
WORD PROCEDURE MAKEFIB=(0,26)(BUFFERS,LOGICALUNITTYPE,NAMES); 70264070
VALUE BUFFERS,LOGICALUNITTYPE; 70264080
REAL BUFFERS,LOGICALUNITTYPE; 70264090
POINTER NAMES; 70264100
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70264110
% BUILD AN FIB FOR SIMPLE I/O %70264120
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70264130
ARRAY 70264140
FIB[10+REAL(LOGICALUNITTYPE=DISKFILE)], 70264150
LEB[5+((REAL(NAMES,1)+5)DIV 6)]; 70264160
LAYOUT 70264170
FIBSZL(FIBFXD~9,39-DISKHDRF:1,39-SORTWORDF:1~1) 70264180
, RECORDSTATSL(MTBUF~1,SIO~1) 70264190
, FILESTATSL(EOFACTION~1,PARACTION~1) 70264200
, LEBCL(FXD~5,FPRTCTD~1,LPARITY~1) 70264210
, DISKSPCL(DRCTRYF~1,FLEXIBLEF~1,SPEEDF,NUMAREAS~20) 70264220
; 70264230
REAL FIB0; 70264240
WORD ARRAY FIBW=FIB[*]; 70264250
FIB0~FIBSIZE~0&FIBSZL(,REAL(LOGICALUNITTYPE=DISKFILE),); 70264260
RECORDSTATUS~0&RECORDSTATSL(,); 70264270
FILESTATUS~0&FILESTATSL(,); 70264280
BUFFREQ~BUFFERS; 70264290
SORTWORD~SNR; 70264300
LEBC~LOGICALUNITTYPE&LEBCL(,,); 70264310
DSKS~0&DISKSPCL(,,,); 70264320
REPLACE POINTER(LEB[5],8) BY NAMES FOR REAL(NAMES,1); 70264330
LBLEQTN~LEB; 70264340
MAKEFIB~FIB; 70264350
DIVORCEMOM(FIB); 70264360
DIVORCEMOM(LEB); 70264370
END MAKEFIB; 70264371
REAL PROCEDURE WRITEALABEL=(0,48)(LEB,U,LBLS,VSN,TYPE,BCNT,RCNT); 70266000
VALUE U,LBLS,VSN,TYPE,BCNT,RCNT; 70266100
REAL U,LBLS,VSN,TYPE,BCNT,RCNT; 70266200
ARRAY LEB[*]; 70267000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70268000
% THIS PROCEDURE BUILDS THE USASI FILE HEADERS. THE FORMATS %70269000
% ARE: %70270000
% %70271000
% # CHARS NAME %70272000
% %70273000
% VOLUME HEADER LABEL %70274000
% %70275000
% 4 "VOL1" %70276000
% 6 VOLUME SERIAL NUMBER %70277000
% 1 ACCESSIBILITY %70278000
% 17 FILE SET ID (MULTIPLE FILE ID) %70279000
% 2 "65" %70280000
% 1 TAPE TYPE %70281000
% 6 RFE %70282000
% 14 OWNER %70283000
% 28 RFE %70284000
% 1 LABEL STANDARD LEVEL (1) %70285000
% %70286000
% FIRST FILE HEADER %70287000
% %70288000
% 4 "HDR1" %70289000
% 17 FILE IDENTIFIER %70290000
% 6 SET IDENTIFIER (FIRST 6 CHARACTERS OF %70291000
% FILE SET ID) %70292000
% 4 FILE SECTION NUMBER (RELATIVE REEL NUMBER) %70293000
% 4 FILE SEQUENCE NUMBER (WITHIN SET) %70294000
% 4 GENERATION NUMBER %70295000
% 2 GENERATION VERSION %70296000
% 6 CREATION DATE (BYYDDD) %70297000
% 6 EXPIRATION DATE (BYYDDD) %70298000
% 1 ACCESSIBILITY %70299000
% 6 BLOCK COUNT %70300000
% 7 RECORD COUNT %70301000
% 6 " B6500" %70302000
% 7 RFE %70303000
% %70304000
% SECOND FILE HEADER %70305000
% %70306000
% 4 "HDR2" %70307000
% 1 RECORD FORMAT %70308000
% STANDARD: %70309000
% F = FIXED LENGTH %70310000
% D = VARIABLE IN DECIMAL IN FIRST 4 %70311000
% CHARACTERS %70312000
% V = VARIABLE IN BINARY IN FIRST 4 %70313000
% CHARACTERS %70314000
% U = UNDEFINED %70315000
% EXTENSIONS: %70316000
% I - INTERNAL %70317000
% L = LINKS %70318000
% Z = FORTRAN FUNNY %70319000
% 5 BLOCK LENGTH IN EXTERNAL FORM (MAXIMUM) %70320000
% 5 RECORDLENGTH IN EXTERNAL FORM (MAXIMUM) %70321000
% 1 DENSITY %70322000
% 0 = 200 %70323000
% 1 = 556 %70324000
% 2 = 800 %70325000
% 3 = 1600 %70326000
% 1 VOLUME SWITCH (0 IF FIRST VOLUME OF A FILE) %70327000
% 1 PARITY %70328000
% 0 = ALPHA (EVEN) %70329000
% 1 = BINARY (ODD) %70330000
% 1 EXTERNAL FORM: %70331000
% 0 - UNSPECIFIED (WORDS) %70332000
% 1 - EBCDIC %70333000
% 2 - BCL %70334000
% 3 - ASCII %70335000
% 1 PROTECTION %70336000
% 5 MINIMUM RECORD LENGTH %70337000
% 25 TBS %70338000
% 2 OFFSET TO DATA (6 IF PROTECTED) %70339000
% 28 RFE %70340000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70341000
% %70342000
% FIRST END-OF-FILE LABEL %70343000
% %70344000
% SAME AS FIRST FILE HEADER EXCEPT FOR FIRST 4 %70345000
% CHARACTERS "EOF1" %70346000
% %70347000
% SECOND END-OF-FILE LABEL %70348000
% %70349000
% SAME AS SECOND FILE HEADER EXCEPT FOR FIRST 4 %70350000
% CHARACTERS "EOF2" %70351000
% %70352000
% END-OF-VOLUME LABEL %70353000
% %70354000
% SAME AS FIRST END-OF-FILE LABEL EXCEPT FOR FIRST 4 %70355000
% CHARACTERS "EOV1" %70356000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70357000
REAL T, 70358000
EOT, 70359000
I, 70360000
N, 70361000
TAPETYPE~IF UNIT[U].UNITTYPE=13OR UNIT[U].UNITTYPE=29 70362000
THEN 1 ELSE 0, 70363000
RSLT, 70364000
X, 70365000
Z; 70366000
LABEL XIT,WRAPUP; 70367000
ARRAY LABELAREA[IF TAPETYPE=1 THEN 11 ELSE 15], 70368000
NAMES[IF TAPETYPE=1 THEN 5 ELSE 7]; 70369000
POINTER PLEB~POINTER(LEB), 70370000
PNMS, 70371000
PLABELAREA, 70372000
PLBL~POINTER(LEB[(T~LEBC).FXD+ONES(T.OPTMASK)],8)+2; 70373000
FIELD USASIL=5:1,ENDL=1:1,VLML=0:1; 70374000
FIELD INTNAME=44:1; 70375000
DEFINE NNL(S,E) =(IF TAPETYPE=1THEN S ELSE E)#; 70376000
IF TAPETYPE=1 THEN PLABELAREA~POINTER(LABELAREA[1],6) ELSE 70377000
PLABELAREA~POINTER(LABELAREA[1],8); 70378000
N~REAL(PLBL-1,1); 70379000
WHILE N~N-1>2 DO PLBL~PLBL+1+REAL(PLBL,1); 70380000
IF TAPETYPE=1 THEN REPLACE PNMS~POINTER(NAMES,6)BY 70381000
PLBL FOR (X~REAL(PLBL,1))+1+(IF N=0THEN 0ELSE 70382000
REAL(PLBL+1+X,1)+1) 70383000
WITH EBCTOBCL[*] 70384000
ELSE REPLACE PNMS~POINTER(NAMES,8)BY PLBL FOR 70385000
(X~REAL(PLBL,1)) +1+(IF N=0THEN 0ELSE 70386000
REAL(PLBL+1+X,1)+1); 70387000
IF BOOLEAN(LBLS.USASIL)THEN 70388000
BEGIN 70389000
IF MAGTAPE(U)THEN 70390000
LABELAREA[0]~0&TAPEIOCWL(0,REAL(TAPETYPE=1 AND 70391000
BOOLEAN(T.LPARITY+1)),REAL(TAPETYPE!1),T.DENSITYL, 70392000
T.LPARITY) 70393000
ELSE 70394000
LABELAREA[0]~0&PRINTIOCWL(,1,REAL(T.EXTFORML=1),0,1); 70395000
IF BOOLEAN(LBLS.VLML)AND NOT BOOLEAN(LBLS.ENDL) THEN 70396000
BEGIN 70397000
REPLACE PLABELAREA BY 70398000
NNL(6"VOL1",8"VOL1") FOR 4 CORRECTLY, 70399000
VSN FOR 6 CORRECTLY, % SERIAL # 70400000
% TRANSLATION 70401000
NNL(6" ",8" ") FOR 1 CORRECTLY, 70402000
PNMS+1 FOR REAL(PNMS,1), 70403000
NNL(6" ",8" ")FOR 17-REAL(PNMS,1), 70404000
NNL(6"65",8"65") FOR 2 CORRECTLY, 70405000
TYPE FOR 1 CORRECTLY, 70406000
NNL(6" ",8" ")FOR 48, 70407000
NNL(6"1",8"1") FOR 1 CORRECTLY; 70408000
IF REAL(BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,0) 70409000
).RDERROR)AND BOOLEAN(3"377376"))!0 THEN 70410000
BEGIN WRITEALABEL~RSLT;GO TO XIT END; 70411000
EOT~RSLT.RDENDOFTAPE; 70412000
IF N=1 THEN REPLACE PLABELAREA+11 BY 0 FOR 17; 70413000
END; 70414000
REPLACE PLABELAREA BY 70415000
(IF BOOLEAN(LBLS.ENDL)THEN 70416000
IF BOOLEAN(LBLS.VLML)THEN 70417000
NNL(6"EOV1",8"EOV1") ELSE 70418000
NNL(6"EOF1",8"EOF1") 70419000
ELSE NNL(6"HDR1",8"HDR1")) FOR 4 CORRECTLY, 70420000
PNMS+(X~IF N=1 THEN REAL(PNMS,1)ELSE 0)+1 FOR 70421000
REAL(PNMS+X,1), % FILE ID 70422000
NNL(6" ",8" ")FOR 17-REAL(PNMS+X,1), 70423000
IF N=1 THEN 0 ELSE REAL(PNMS+1,MIN(6,REAL(PNMS+1,1))) 70424000
FOR 6 CORRECTLY, % SET ID 70425000
NNL(6" ",8" ")FOR IF N=1THEN 6ELSE 70426000
6-REAL(PNMS,1), 70427000
GEN1.REEL FOR 4 DIGITS, % SECTION # 70428000
1 FOR 4 DIGITS, % SEQUENCE # 70429000
GEN1.CYCLE FOR 4 DIGITS, % GENERATION # 70430000
GEN1.GENVERSN FOR 2 DIGITS, % VERSION # 70431000
NNL(6" ",8" ") FOR 1 CORRECTLY, 70432000
(Z~IF(X~GEN2).CRTNDATE=0THEN TODAYSDATE ELSE X.CRTNDATE) 70433000
FOR 5 DIGITS, 70434000
NNL(6" ",8" ") FOR 1 CORRECTLY, 70435000
((X~Z MOD 100+X.SAVFACTOR+3649)MOD 365 % EXPIRATION DATE 70436000
+(X DIV 365+Z DIV 100-10)|1000+1)FOR 5 DIGITS, 70437000
NNL(6" ",8" ") FOR 1 CORRECTLY, 70438000
BCNT FOR 6 DIGITS, % BLOCK COUNT 70439000
RCNT FOR 7 DIGITS, % RECORD COUNT 70440000
NNL(6" B6500",8" B6500")FOR 6 CORRECTLY, 70441000
NNL(6" ",8" ")FOR 7 CORRECTLY; 70442000
IF REAL(BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,0) 70443000
).RDERROR)AND BOOLEAN(3"377376"))!0 THEN 70444000
BEGIN WRITEALABEL~RSLT;GO TO XIT END; 70445000
EOT~RSLT.RDENDOFTAPE; 70446000
IF BOOLEAN(LBLS.ENDL)AND BOOLEAN(LBLS.VLML)THEN GO TO XIT; 70447000
%%%%% HDR2 70448000
X~U; 70449000
U~T.FXD+T.INTNAME; 70450000
REPLACE PLABELAREA BY 70451000
(IF BOOLEAN(LBLS.ENDL)THEN NNL(6"EOF2",8"EOF2")ELSE 70452000
NNL(6"HDR2",8"HDR2"))FOR 4 CORRECTLY, 70453000
NNL(CASE (Z~BLK1).FILETYPEL OF 70454000
(6"F",6"D",6"V",6"U",6"I",6"L",6"Z"), 70455000
CASE Z OF(8"F",8"D",8"V",8"U",8"I",8"L",8"Z")) 70456000
FOR 1 CORRECTLY, 70457000
Z.BLOCKSZL FOR 5 DIGITS, % BLOCK.LENGTH 70458000
Z.MAXRECSZL FOR 5 DIGITS, % RECORD LENGTH 70459000
(IF T.DENSITYL=0 THEN 2ELSE IF T.DENSITYL=2THEN 0 ELSE 70460000
T.DENSITYL)FOR 1 CORRECTLY, % DENSITY 70461000
REAL(GEN1.REEL!1)FOR 1 CORRECTLY, % SENTINEL 70462000
T.LPARITY FOR 1 CORRECTLY, % PARITY 70463000
T.EXTFORML FOR 1 CORRECTLY, % EXTERNAL FORM 70464000
T.FPRTCTD FOR 1 CORRECTLY, % PROTECTION 70465000
BLK2.MINRECSZL FOR 5 DIGITS, % MIN RECORD SIZE 70466000
NNL(6" ",8" ")FOR 25, 70467000
(IF BOOLEAN(T.FPRTCTD)THEN NNL(8,6)ELSE 0) 70468000
FOR 2 CORRECTLY, % BUFFER OFFSET 70469000
NNL(6" ",8" ")FOR 28; 70470000
U~X; 70471000
IF REAL(BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,0) 70472000
).RDERROR)AND BOOLEAN(3"377376"))!0 THEN 70473000
BEGIN WRITEALABEL~RSLT;GO TO XIT END; 70474000
EOT~RSLT.RDENDOFTAPE; 70475000
END ELSE 70476000
; 70477000
WRAPUP: 70478000
WRITEALABEL~EOT; 70479000
XIT: 70480000
END WRITEALABEL; 70481000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70482000
PROCEDURE OPEN(FIB,TYPEV); 70483000
VALUE TYPEV; 70484000
ARRAY FIB[*]; 70485000
REAL TYPEV; 70486000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70487000
% OPEN MAKES A SOWS EAR OUT OF A SILK PURSE %70488000
% TYPEV = %70489000
% 0 - NORMAL OPEN %70490000
% 1 - REEL SWITCH %70491000
% 2 - SEARCH (FILE.STATUS) %70492000
% 3 - ASSIGN IF AVAILABLE (FILE.PRESENT) %70493000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70494000
WORD LBLSW=FIB,TEMPW,LBLDSCW; %70495000
ARRAY DHEADER,IOAREA,LABELAREA,LEB[*]; %70496000
ARRAY LBLDSC=LBLDSCW[*]; 70497000
DEFINE OUTPUTL=INPUTL#; 70498000
DEFINE SEARCHV = 2#; 70499000
DEFINE SKLTN = IOINFO#; 70500000
FIELD DISKF=47:1; 70501000
LABEL HR,OUT,CLOSET,TAPEL,CMN,XIT; 70502000
LABEL SETUP; 70503000
LABEL RETRYL; 70504000
LAYOUT 70505000
BTL(1:1,0:1), 70506000
INPUTL(IOREADBIT~1,IOTRANSLATE,IOFRAMESIZE,IOMEMPROTECT~1,70507000
IOBACKWARD); % FORMAT INPUT IOCW 70508000
POINTER PNMS,PLBL; 70509000
POINTER PC; 70510000
REAL 70511000
FIB0, 70512000
FRSLT, 70513000
T, 70514000
U, 70515000
UNT, 70516000
UTYPE, 70517000
LBLSZ, 70518000
P, 70519000
TUSZ, 70520000
FINDWORD, 70521000
TAPETYPE, 70522000
RSLT; 70523000
EVENT EVNT; 70524000
REFERENCE IOCB; 70525000
WORD IOCBW=IOCB; 70525100
WORD ARRAY FIBW=FIB[*]; 70526000
VALUE ARRAY CARDCODES ~ ( 70527000
% A-I 70528000
3"0000440042004100", 3"4040402040104004", 70529000
3"3002400100000000", 0, 70530000
% "-"-R 70531000
3"2000240022002100", 3"2040202020102004", 70532000
3"2002200100000000", 0, 70533000
% S-Z 70534000
3"0000000012001100", 3"1040102010101004", 70535000
3"1002100100000000", 0, 70536000
% 0-9 70537000
3"1000040002000100", 3"0040002000100004", 70538000
3"0002000100000000", 0 ); 70539000
MONITOR BOBMONITOR(FINDWORD,RSLT,U,UTYPE); 70540000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70541000
PROCEDURE WRITEUSERSLABELS(MASK);VALUE MASK;REAL MASK; 70542000
BEGIN 70543000
WORD LBLDSCW; 70544000
ARRAY LBLDSC=LBLDSCW[*]; 70545000
REAL 70546000
P, 70547000
LABELNO; 70548000
LBLDSCW~LBLSW; 70549000
LBLDSCW.SIRWDELTAF~LBLSW.SIRWDELTAF+1; 70550000
TEMPW~LBLSW; 70551000
LBLSW~LBLDSCW; 70552000
LBLDSC~FIB; 70553000
MAKEPRESENTANDSAVE(LBLDSC); 70554000
LBLSW~TEMPW; 70555000
P~((LBLDSC.LENGTHF+CASE(P~LBLDSC.SZF)OF(0,0,11,7,5)) 70556000
DIV CASE P OF (1,.5,12,8,6))DIV NUMLABELS; 70557000
LABELAREA~*&ARRAYDESCL(,P,M[LBLDSC.ADDRESSF].ADDRESSF); 70558000
% BEFORE USE ROUTINES 70559000
THRU NUMLABELS DO 70560000
BEGIN 70561000
LABELAREA[0]~SKLTN; 70562000
IF INTERNALMODE=3THEN REPLACE POINTER(LABELAREA[1],6)BY 6"UHL",70563000
LABELNO~LABELNO+1 FOR 1 CORRECTLY 70564000
ELSE 70565000
REPLACE POINTER(LABELAREA[1],8)BY 8"UHL", 70566000
LABELNO+LABELNO+1 FOR 1 CORRECTLY; 70567000
LABELAREA~*&ARRAYDESCL(,P-1,*); 70568000
IOREQUEST(IOCB~IOQUE(USAH,-@377777,REFERENCE(LABELAREA),EVNT));70569000
WAIT(EVNT); 70570000
RESET(EVNT); 70571000
IF REAL(BOOLEAN(RSLT~REAL(BOOLEAN((MISC@IOCB).RDERROR)OR 70572000
BOOLEAN(RSLT)))AND BOOLEAN(MASK))!0 THEN 70573000
BEGIN 70574000
TRACE(18); 70575000
TRACE(0); 70576000
PUTUNT(1,1,0,0); 70577000
GO TO RETRYL; 70578000
END; 70579000
FORGETAREA(6,WORD(IOCB).ADDRESSF); 70580000
LABELAREA~*&ARRAYDESCL(,P,LABELAREA.ADDRESSF+P-1); 70581000
END; 70582000
% USE ROUTINES 70583000
DIVORCEMOM(LABELAREA); 70584000
TURNOVERLAYKEY(LBLDSC.ADDRESSF); 70585000
DIVORCEMOM(LBLDSC); 70586000
END WRITEUSERSLABELS; 70587000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70588000
IF ALREADYOPEN THEN %%%%%%%%%%%%%%%%%%%%%%%%% ALREADY OPEN% 70589000
TRACE(21) 70590000
ELSE 70591000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% CLOSED APPROP. 70592000
BEGIN 70593000
% GET FPB 70594000
LEB~LBLEQTN&DATADESCRIPTOR(); 70595000
MAKEPRESENTANDSAVE(LEB); 70596000
LBLEQTN~LEB; 70597000
RETRYL: 70598000
IF TYPEV=REGOPEN THEN 70599000
IF INOUTPART{INV THEN 70600000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% INPUT 70601000
OPNINPUT~1; 70602000
U~(FINDWORD~FINDINPUT(LEB,0)).REPINFOF; 70603000
%%%% FIND INPUT HAS TO CHECK LABEL TYPE 70604000
IF FINDWORD<0 THEN IF TYPEV!SEARCHV THEN TRACE(21)ELSE GO XIT; 70605000
IF FRSLT~(FINDWORD.REPVALF)=OFV THEN 70606000
BEGIN % OPTIONAL 70607000
IF BOOLEAN(NOPTIONAL)THEN TRACE(21); 70608000
RECORDSTATUS.EXCEPTION~1; 70609000
ENDOV~1; 70610000
FILESTATUS.OPT~1; 70611000
GO TO XIT 70612000
END ELSE 70613000
IF FRSLT=FRV THEN 70614000
BEGIN % FINAL REEL 70615000
RECORDSTATUS.EXCEPTION~1; 70616000
ENDOV~1; 70617000
GO TO XIT 70618000
END ELSE 70619000
BEGIN %********************************************************%70620000
FIB0~FIBSIZE; 70621000
PNMS~POINTER(LEB[LEBC.FXD+ONES(LEBC.OPTMASK)],8); 70622000
OPENTIME~*-SCANIN(TIMEOFDAYWORD); 70623000
% FILE OPEN MESSAGE 70624000
% HOUSEKEEPING Q 70625000
IF BOOLEAN(FINDWORD.DISKF)THEN 70626000
BEGIN %***************************************% DISK FILE 170627000
SKLTNSTNDRD~DISKREAD; 70628000
DISKCOMMONL: 70629000
DHEADER~DISKHEADER~DISKFILEHEADERS[U,*]; 70630000
IF DHEADER[1].LOGICALMODEF=BCL AND INTERNALMODE>BCL THEN 70631000
IOERRMESSL(0,1,PNMS); % TRANSLATION PROB70632000
IF DHEADER[2].RCRDTYPE!RECORDTYPE THEN IOERRMESSL(0,4,PNMS); 70633000
% USERS LABELS 70634000
IF REVERSED THEN IF RECORDTYPE>2THEN IOERRMESSL(0,5,PNMS); 70635000
% COMPATIBILITY 70636000
UNITYP~DISKFILE; 70637000
UNITNUMBER~U; 70638000
GO TO BUFFERSL; 70639000
END; 70640000
GETUNT; 70641000
IF UTYPE~(UNT.UNITTYPE)=CARDREADER THEN 70642000
BEGIN %***************************************% CARD READER 70643000
SKLTNSTNDRD~0&INPUTL(,REAL(LCNTRL.EXTFORML=BCL), 70644000
REAL(INTERNALMODE!BCL)); 70645000
IF LCNTRL.EXTFORML=BCL AND INTERNALMODE>BCL THEN % TRANS PROB 70646000
IOERRMESSL(0,1,PNMS); 70647000
% BLOCKSIZE CHECK Q 70648000
UNT.UNITASSIGNED~1; 70649000
UNIT[U]~UNT; 70650000
UNITYP~UTYPE; 70651000
UNITNUMBER~U; 70652000
% USERS LABELS 70653000
IF REVERSED THEN IOERRMESSL(0,5,PNMS); 70654000
UINFOW[U]~LBLSW; 70655000
END ELSE 70656000
IF MAGTAPE(UTYPE)THEN 70657000
IF FRSLT=0 THEN % NO SPECIAL MSG 70658000
BEGIN %***************************************% MAGNETIC TAPE 70659000
SETUP: 70660000
TAPETYPE~IF UTYPE=13 OR UTYPE=29 THEN 1 ELSE 2; 70661000
SKLTN~0&TAPEIOCWL(1, 70662000
T~REAL(TAPETYPE=1 AND LCNTRL.LPARITY=0),% TRANSLATE 70663000
IF TAPETYPE=1THEN REAL(INTERNALMODE!BCL AND T=1)ELSE 1, 70664000
% FRAMESIZE 70665000
LCNTRL.DENSITYL, % DENSITY 70666000
LCNTRL.LPARITY); % PARITY 70667000
UNITYP~UTYPE; 70668000
UNITNUMBER~U; 70669000
IF RECORDTYPE>1 THEN IOERRMESSL(0,2,PNMS); % BAD RECORD TYPE 70670000
% IF BOOLEAN((UNT~UNIT[U]).ULABELLED)THEN USERFIB~WORD(NAME(FIB))70671000
% ELSE UINFOW[U]~WORD(NAME(FIB)); 70672000
UNT.UNITASSIGNED~1; 70673000
UNIT[U]~UNT; 70674000
IF LCNTRL.EXTFORML=BCL AND INTERNALMODE>BCL THEN % TRANS PROB 70675000
IOERRMESSL(0,1,PNMS); 70676000
IF REVERSED THEN IF RECORDTYPE>2THEN IOERRMESSL(0,5,PNMS); 70677000
IF RECORDTYPE=7 THEN 70678000
BEGIN % DEPENDENT SPEC 70679000
IF LCNTRL.LABELTYPEL!0 THEN IOERRMESSL(0,3,PNMS); 70680000
RECORDTYPE~LBLK1.FILETYPEL; 70681000
BLOCKSZ~LBLK1.BLOCKSZL; 70682000
MAXRECSZ~LBLK1.MAXRECSZL; 70683000
MINRECSZ~LBLK2.MINRECSZL; 70684000
END; 70685000
IF LCNTRL.LABELTYPEL=0 THEN 70686000
BEGIN % B6500 USASI LBL 70687000
IF LBLK1.FILETYPEL!RECORDTYPE THEN IOERRMESSL(0,4,PNMS); 70688000
% BLOCK SIZE 70689000
% RECORD SIZE 70690000
END ELSE 70691000
IF LCNTRL.LABELTYPEL=1 THEN % B5500 LABEL 70692000
BEGIN 70693000
% RECORD TYPE 70694000
END ELSE 70695000
IF LCNTRL.LABELTYPEL=2 THEN 70696000
BEGIN 70697000
END ELSE 70698000
; 70699000
% MEMORY DUMP 70700000
IF NUMLABELS!0 THEN % USERS LABELS 70701000
IF LCNTRL.LABELTYPEL=0 THEN % B6500 USASI 70702000
BEGIN 70703000
LBLDSCW~LBLSW; 70704000
LBLDSCW.SIRWDELTAF~LBLSW.SIRWDELTAF+1; 70705000
TEMPW~LBLSW; 70706000
LBLSW~LBLDSCW; 70707000
LBLDSC~FIB; 70708000
LBLSW~TEMPW; 70709000
MAKEPRESENTANDSAVE(LBLDSC); 70710000
P~((LBLDSC.LENGTHF+CASE (P~LBLDSC.SZF)OF(0,0,11,7,5)) 70711000
DIV CASE P OF(1,.5,12,8,6))DIV NUMLABELS; 70712000
LABELAREA~*&ARRAYDESCL(,P,M[LBLDSC.ADDRESSF].ADDRESSF); 70713000
THRU NUMLABELS DO 70714000
BEGIN 70715000
LABELAREA[0]~SKLTN; 70716000
LABELAREA~*&ARRAYDESCL(,P-1,*); 70717000
IOREQUEST(IOCB~IOQUE(USAH,-@377777,REFERENCE(LABELAREA),EVNT));70718000
WAIT(EVNT); 70719000
RESET(EVNT); 70720000
IF REAL(BOOLEAN(RSLT~(MISC@IOCB).RDERROR)AND 70721000
BOOLEAN(3"376776"))!0 THEN 70722000
BEGIN 70723000
CLOSET: 70724000
TRACE(18); 70725000
TRACE(0); 70726000
GO TO OUT; 70727000
END; 70728000
FORGETAREA(6,WORD(IOCB).ADDRESSF); 70729000
IF BOOLEAN(RSLT.RDWLOOREOF)THEN GO OUT; 70730000
LABELAREA~*&ARRAYDESCL(,P,LABELAREA.ADDRESSF+P); 70731000
END; 70732000
LABELAREA~*&ARRAYDESCL(,P,M[LBLDSC.ADDRESSF].ADDRESSF); 70733000
HR: 70734000
LABELAREA[0]~*&IOCWL(TAPESPACE,*); 70735000
IF REAL(BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,3"1001") 70736000
).RDERROR)AND BOOLEAN(3"376776"))!0 THEN GO TO CLOSET; 70737000
IF RSLT.RDWLOOREOF=0 THEN GO TO CLOSET; 70738000
LABELAREA[0]~SKLTN; 70739000
OUT: 70740000
DIVORCEMOM(LABELAREA); 70741000
TURNOVERLAYKEY(LBLDSC.ADDRESSF); 70742000
DIVORCEMOM(LEB); 70743000
TURNOVERLAYKEY(LBLEQTN.ADDRESSF); 70744000
GO TO INXITL; 70745000
END ELSE 70746000
IF LCNTRL.LABELTYPEL=2 THEN 70747000
BEGIN % B5500 70748000
IF LMISC<0THEN % USERS LABEL 70749000
BEGIN 70750000
LABELAREA~*&ARRAYDESCL(0,16,0); 70751000
LABELAREA[0]~*&IOCWSPACEL(,1,1); % BACK SPACE 70752000
IF BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,0))) THEN 70753000
GO TO CLOSET; 70754000
FORGETSPACE(LABELAREA.ADDRESSF); 70755000
LABELAREA~*&ARRAYDESCL(0,LMISC.BCNTL,0); 70756000
LABELAREA[0]~SKLTN; 70757000
IF BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,0))) THEN 70758000
GO TO CLOSET; 70759000
IF INTERNALMODE=3 THEN PLBL~POINTER(LABELAREA[8],6) ELSE 70760000
PLBL~POINTER(LABELAREA[10],8)+4; 70761000
LBLDSCW.SIRWDELTAF~LBLSW.SIRWDELTAF+1; 70762000
P~LMISC.BCNTL DIV (LBLSZ~IF INTERNALMODE=3 THEN 8 ELSE 6); 70763000
T~0; 70764000
TUSZ~0; 70765000
WHILE T~T+1{NUMLABELS AND P!0 DO 70766000
BEGIN 70767000
REPLACE POINTER(LBLDSC,*)+(TUSZ+LBLSZ)BY PLBL:PLBL FOR P:P 70768000
WHILE!4"FF"; 70769000
TUSZ~TUSZ+LBLSZ|11; 70770000
END; 70771000
GO TO HR 70772000
END; 70773000
END; 70774000
LABELAREA~*&ARRAYDESCL(0,2,0); 70775000
GO TO HR; 70776000
END ELSE 70777000
IF FRSLT=ILV THEN % "IL" MESSAGE 70778000
BEGIN % IGNORE LABEL 70779000
CMN: 70780000
IF BOOLEAN(UNT.ULABELLED)THEN GO TO SETUP; 70781000
SKLTN~0&TAPEIOCWL(1,0,REAL(TAPETYPE!1),0,1); 70782000
LABELTYPE~1; 70783000
% USERS LABELS 70784000
END ELSE 70785000
IF FRSLT=ULV THEN GO TO CMN % "UL" MESSAGE 70786000
ELSE TRACE(21) 70787000
ELSE 70788000
IF UTYPE=PAPERTAPERDR THEN 70789000
BEGIN %***************************************% PAPER TAPE 70790000
IF LEBC.EXTFORML=SINGLE THEN LEBC.EXTFORML~INTERNALMODE; 70791000
SKLTN~0&PPRTIOCWL(1,REAL(LEBC.EXTFORML=BCL), 70792000
REAL(INTERNALMODE!BCL), 70793000
IF LEBC.EXTFORML=BCL THEN 1 ELSE 70794000
IF LEBC.EXTFORML=5 THEN 0 ELSE 2); 70795000
IF REVERSED THEN IOERRMESSL(0,5,PNMS); 70796000
% USERS LABELS 70797000
UNITYP~UTYPE; 70798000
UNITNUMBER~U; 70799000
END ELSE 70800000
TRACE(21); 70801000
INXITL: 70802000
% IF USERS THEN GETUSERS(ABFI); 70803000
END; 70804000
END ELSE 70805000
IF INOUTPART=OUTV THEN 70806000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% OUTPUT 70807000
OPNOUTPUT~1; 70808000
%%%%%% NEW DISK FILE 70809000
IF LEBC.PTYPEL=1 AND DSKS.AREASIZE!0 THEN GO TO DISKL; 70810000
% U~(FINDWORD~FINDOUTPUT(LBLEQTN,0)).LENGTHF; 70811000
IF BOOLEAN(FINDWORD.DISKF) THEN 70812000
%***************************************% DISK 70813000
IF FINDWORD.REPVALF=OUV THEN 70814000
BEGIN % NEW OUTPUT FILE 70815000
%%%%%% GENERAL OUDK 70816000
DISKL: 70817000
IF DSKS.NUMAREAS=0 THEN DSKS.NUMAREAS~20; 70818000
IF DSKS.AREASIZE=0 THEN DSKS.AREASIZE~1000; 70819000
SKLTNSTNDRD~DISKWRITE; 70820000
UNITYP~UTYPE~DISKFILE; 70821000
% BUILDAHEADER 70822000
DHEADER[1]~LEBC.EXTFORML&HEADERINFOONE( 70823000
1 % UPDATE 70824000
, 1 % OPEN COUNT 70825000
, 1 % FILE KIND 70826000
, 30 % HEADER SIZE 70827000
); 70828000
DHEADER[2]~FILEACCESS&HEADERINFOTWO( 70829000
DSKS.PACKEDF % PACKED 70830000
, LEBC.FPRTCTD 70831000
, DSKS.DRCTRYF 70832000
, RECORDTYPE % RECORD TYPE 70833000
); 70834000
DHEADER[3]~TANKDATA2; 70835000
DHEADER[5]~(IF BOOLEAN(DSKS.PACKEDF)THEN 70836000
((MAXRECSZ|DSKS.AREASIZE+ 70837000
CASE INTERNALMODE OF(0,0,11,7,5,5))DIV 70838000
CASE INTERNALMODE OF(1,.5,12,8,6,6)+29)DIV 30 70839000
ELSE 70840000
((BLOCKSZ+CASE INTERNALMODE OF (0,0,11,7,5,5))DIV 70841000
CASE INTERNALMODE OF(1,.5,12,8,6,6)+29)DIV 30 70842000
|(DSKS.AREASIZE DIV (BLOCKSZ DIV MAXRECSZ)) 70843000
)&ROWINFO(DSKS.NUMAREAS); 70844000
DHEADER[6]~1&NAMEQUALIFICATIONINFO(GEN2.SAVFACTOR,TODAYSDATE); 70845000
DHEADER[7]~TODAYSDATE; 70846000
% ENTERUSERFILE(LEB,DHEADER); 70847000
% USERS LABELS 70848000
GO TO BUFFERSL; 70849000
END ELSE 70850000
BEGIN % OLD OUTPUT FILE 70851000
SKLTNSTNDRD~DISKWRITE; 70852000
GO TO DISKCOMMONL; 70853000
END; 70854000
IF REVERSED THEN IOERRMESSL(0,6,PNMS); 70855000
GETUNT; 70856000
UNT.UNITASSIGNED~1; 70857000
IF UTYPE~UNT.UNITTYPE=CARDPUNCH1 OR UTYPE=CARDPUNCH2 THEN 70858000
BEGIN %***************************************% CARD PUNCH 70859000
IF LEBC.EXTFORML=SINGLE THEN LEBC.EXTFORML~INTERNALMODE; 70860000
IF INTERNALMODE=BCL AND LEBC.EXTFORML>BCL THEN % TRANS PROB 70861000
IOERRMESSL(0,1,PNMS); 70862000
SKLTNSTNDRD~0&OUTPUTL(0,REAL(LEBC.EXTFORML=BCL), 70863000
REAL(INTERNALMODE!BCL)); 70864000
UNITYP~UTYPE; 70865000
UNITNUMBER~U; 70866000
IF USASILABEL THEN 70867000
BEGIN 70868000
IF BOOLEAN(WRITEALABEL(LBLEQTN,U,33,0,1,BLOCKCOUNT,RECORDCOUNT)70869000
)THEN 70870000
BEGIN 70871000
% IRRECOVERABLE PUNCH CHECK 70872000
PNCHCKL: 70873000
UNIT[U]~UNT; 70874000
% MESSAGE Q 70875000
PUTUNT(1,1,0,0); 70876000
GO TO RETRYL; 70877000
END; 70878000
UNT.ULABELLED~0; 70879000
END ELSE 70880000
IF NOT UNLABELLED THEN 70881000
BEGIN 70882000
LABELAREA~*&ARRAYDESCL(0,IF INTERNALMODE=3THEN 11 ELSE 15,0); 70883000
LABELAREA[0]~0; 70884000
IF LEBC.EXTFORML!BCL THEN 70885000
REPLACE PLBL:PLBL~POINTER(LABELAREA[1],6) BY 70886000
6"70",6"00", 70887000
6"||M090M0",6"00" 70888000
ELSE 70889000
REPLACE PLBL:PLBL~POINTER(LABELAREA[1],6) BY 70890000
6"70",6"00", 70891000
6"||M090M0K0",6"00"; 70892000
PC~POINTER(CARDCODES,6); 70893000
THRU REAL(PNMS~PNMS+2,1) DO 70894000
REPLACE PLBL:PLBL BY PC+2|REAL(PNMS~PNMS+1,1).MOD64F 70895000
FOR 2; 70896000
IF BOOLEAN(WAITIO(LABELAREA,USAH,ERAH(UNEXP,0)))THEN 70897000
GO TO PNCHCKL; 70898000
FORGETSPACE(LABELAREA.ADDRESSF); 70899000
UNT.ULABELLED~1; 70900000
END ELSE 70901000
UNT.ULABELLED~0; 70902000
UNIT[U]~UNT; 70903000
IF NUMLABELS!0 THEN WRITEUSERSLABELS(REAL(NOT FALSE)); 70904000
END CARD PUNCH ELSE 70905000
IF MAGTAPE(UTYPE) THEN 70906000
BEGIN %***************************************% MAGNETIC TAPE 70907000
TAPETYPE~IF UTYPE=13 OR UTYPE=29 THEN 1 ELSE 70908000
IF UTYPE=14 OR UTYPE=30 THEN 2 ELSE 3; 70909000
SKLTN~0&TAPEIOCWL(, 70910000
T~REAL(TAPETYPE=1 AND NOT BOOLEAN(LEBC.LPARITY)), 70911000
IF TAPETYPE=1THEN REAL(INTERNALMODE=EBCDIC AND BOOLEAN(T))70912000
ELSE 1, 70913000
% LEB DENSITY MAINTAINED CORRECTLY (+4) 70914000
LEBC.DENSITYL, 70915000
LEBC.LPARITY); 70916000
UNITYP~UTYPE; 70917000
UNITNUMBER~U; 70918000
% IF BOOLEAN(UNT.ULABELLED)THEN USERFIB~WORD(NAME(FIB)) 70919000
% ELSE UINFOW[U]~WORD(NAME(FIB)); 70920000
IF USASILABEL THEN 70921000
BEGIN 70922000
IF BOOLEAN(WRITEALABEL(LBLEQTN,U,33,UINFO[U],1,BLOCKCOUNT, 70923000
RECORDCOUNT)) THEN 70924000
BEGIN 70925000
PERR: 70926000
% MESSAGE 70927000
UNIT[U]~UNT; 70928000
PUTUNT(1,1,0,0); 70929000
GO TO RETRYL; 70930000
END; 70931000
UNT.ULABELLED~1; 70932000
END ELSE 70933000
UNT.ULABELLED~0; 70934000
IF NUMLABELS!0 THEN 70935000
BEGIN 70936000
WRITEUSERSLABELS(3"377376"); 70937000
LABELAREA~*&ARRAYDESCL(0,1,0); 70938000
% TAPE MARK 70939000
LABELAREA[0]~SET(SKLTN,35-REAL(SIMULATING)); % TAPE MARK 70940000
IF REAL(BOOLEAN(RSLT~WAITIO(LABELAREA,USAH,ERAH(UNEXP,0) 70941000
).RDERROR)AND BOOLEAN(3"377376"))!0 THEN 70942000
GO TO PERR; 70943000
END; 70944000
UNIT[U]~UNT; 70945000
END TAPE ELSE 70946000
IF PRNTR(UTYPE)THEN 70947000
BEGIN %***************************************% PRINTER 70948000
% ONLY SET UP FOR BCL PRINTER 70949000
IF LEBC.EXTFORML=SINGLE THEN LEBC.EXTFORML~INTERNALMODE; 70950000
SKLTN~0&OUTPUTL(0,1,REAL(INTERNALMODE!BCL)); 70951000
UNITYP~UTYPE; 70952000
UNITNUMBER~U; 70953000
IF NOT UNLABELLED THEN 70954000
BEGIN 70955000
LABELAREA[0]~0&IOCWL(@200,0&IOCWPRINTERL(1)); 70956000
IF BOOLEAN(WAITIO(LABELAREA,USAH,ERAH(UNEXP,0)))THEN 70957000
BEGIN 70958000
PRINTERRL: 70959000
% MESSAGE 70960000
UNIT[U]~UNT; 70961000
PUTUNT(1,1,0,0); 70962000
GO TO RETRYL; 70963000
END; 70964000
LBLDSC[0]~SKLTN&IOCWPRINTERL(0,2); 70965000
IF BOOLEAN(WRITEALABEL(LBLEQTN,1,33,0,1,BLOCKCOUNT, 70966000
RECORDCOUNT)) THEN 70967000
GO TO PRINTERRL; 70968000
IF BOOLEAN(WAITIO(LBLDSC,USAH,ERAH(UNEXP,0)))THEN 70969000
GO TO PRINTERRL; 70970000
END; 70971000
CARRIAGECONTROL~1; 70972000
UNIT[U]~UNT; 70973000
END PRINTER ELSE 70974000
IF UTYPE=PAPERTAPEPNCH THEN 70975000
BEGIN %***************************************% PAPER TAPE PUNCH70976000
IF LEBC.EXTFORML=SINGLE THEN LEBC.EXTFORML~INTERNALMODE; 70977000
SKLTN~0&PPRTIOCWL(0,REAL(LEBC.EXTFORML=BCL), 70978000
REAL(INTERNALMODE!BCL), 70979000
IF LEBC.EXTFORML=BCL THEN 1 ELSE 70980000
IF LEBC.EXTFORML=5 THEN 0 ELSE 2); 70981000
UNITYP~UTYPE; 70982000
UNITNUMBER~U; 70983000
UNIT[U]~UNT; 70984000
% PUNCH LEADER 70985000
% 15 FEET OF LEADER (MINIMUM 4 FEET - PER BURROUGHS SPECS)70986000
% 10 CHARACTERS PER INCH 70987000
LABELAREA~*&ARRAYDESCL(0,2,0); 70988000
LABELAREA[0]~SET(SKLTN,43); 70989000
LABELAREA~*&ARRAYDESCL(2,1800 DIV 70990000
(IF LEBC.EXTFORML!BCL THEN 6 ELSE 8),*); 70991000
IF BOOLEAN(WAITIO(LABELAREA,USAH,ERAH(UNEXP,0)))THEN 70992000
BEGIN 70993000
% MESSAGE 70994000
PUTUNT(1,1,0,0); 70995000
GO TO RETRYL; 70996000
END; 70997000
LABELAREA~*&ARRAYDESCL(0,2,*); 70998000
FORGETSPACE(LABELAREA.ADDRESSF); 70999000
END ELSE 71000000
TRACE(21); 71001000
END ELSE 71002000
TRACE(21); 71003000
END; 71004000
BUFFERSL: 71005000
IF NUMBEROFBUFFERS=0 THEN 71006000
BEGIN % SET UP IOAREAS 71007000
% ALTERNATE AREA 71008000
IF BLOCKSZ=0 THEN BLOCKSZ~(MAXRECSZ+ 71009000
CASE INTERNALMODE OF (0,0,11,7,5,5))DIV 71010000
WORDSTO; 71011000
% CONVERT CHARS TO WORDS 71012000
FILEVENT~EVENTNUMBER; 71013000
FRSLT~REAL((U~BUFFREQ)|(RSLT~IOTANKSZ+BLOCKSZ+ 71014000
(IF RECORDTYPE!0 AND OPENINPUT THEN MAXRECSZ-MINRECSZ 71015000
ELSE 0)){MAGICNUMBER); 71016000
IOADESC~SETUPTANK(U,2,RSLT, 71017000
0&BTL(FRSLT,REAL((UNITYP=DISKFILE OR PRNTR(UNITYP)) AND 71018000
NUMBEROFBUFFERS!1)), 71019000
IOINFO&IOINFOL(*),IOEVENT[FILEVENT],UNITNUMBER); 71020000
NUMBEROFBUFFERS~RSLT~U; 71021000
BFFRD~REAL(U>1); 71022000
END; 71023000
IF CRRGCNTRL AND BUFFERED AND PRNTR(UNITYP) THEN 71024000
BEGIN 71025000
IOAREA~IOADESC; 71026000
IOAREA~*&ARRAYDESCL(,*,IOAREA[IOAL].BL); 71027000
BFRACTN~1 71028000
END; 71029000
IF OPENINPUT THEN 71030000
BEGIN 71031000
IOAREA~IOADESC; 71032000
IOCB~REFERENCE(IOAREA); 71033000
THRU NUMBEROFBUFFERS DO 71034000
BEGIN 71035000
IOREQUEST(IOCB); 71036000
IOCB~REFERENCE(IOAREA~*&ARRAYDESCL(,*,IOAREA[IOAL].FL)); 71037000
END; 71038000
IF NOT ARRAYROW THEN WAITON(IOCB); 71039000
BFFRXHSTD~1; 71039100
IF NOT ARRAYROW THEN 71039200
BEGIN 71039300
LBLDSCW~LBLSW; 71040000
LBLDSCW.SIRWDELTAF~LBLSW.SIRWDELTAF-1; 71041000
TEMPW~LBLSW; 71042000
LBLSW~LBLDSCW; 71043000
FIB~*&STRINGDESCRIPTOR(,1,,,,,EBCDIC,MAXRECSZ, 71044000
IOAREA.ADDRESSF+IOTANKSZ); 71045000
LBLSW~TEMPW; 71046000
END; 71046100
END; 71047000
% BREAK OUT 71048000
XIT: 71049000
IOCBW~0; 71049100
DIVORCEMOM(IOAREA); 71050000
DIVORCEMOM(LBLDSC); 71051000
END OPEN; 71052000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71053000
INTEGER PROCEDURE CALCRECSZ(BUFDESC,FIB);ARRAY BUFDESC,FIB[*]; 71054000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71055000
% USED WITH RECORDTYPES D,V, AND I %71056000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71057000
ARRAY DUMMYA[*]; 71058000
POINTER BUFDESCP=BUFDESC; 71059000
WORD ARRAY FIBW=FIB[*]; 71060000
IF WORDORIENTED THEN 71061000
BEGIN 71062000
IF REVERSED THEN 71063000
BEGIN 71064000
DUMMYA~*&ARRAYDESCL( 71065000
,MAXRECSZ 71066000
,REAL(WORD(AREADESC@REFERENCE(IOADESC))).ADDRESSF+1+ 71067000
BLOCKSZ-MISC@REFERENCE(IOADESC).WORDCOUNTF 71068000
); 71069000
WHILE DUMMYA.ADDRESSF<BUFDESC.ADDRESSF DO 71070000
DUMMYA.ADDRESSF~DUMMYA.ADDRESSF+ 71071000
(CALCRECSZ~CALCRECSZ(DUMMYA,FIB)); 71072000
END ELSE 71073000
CALCRECSZ~ 71074000
IF FORMATD THEN INTEGER(POINTER(BUFDESC,*),4) 71075000
ELSE 71076000
IF FORMATV THEN REAL(IF INTERNALMODE=BCL THEN 71077000
POINTER(BUFDESC,6) ELSE POINTER(BUFDESC,8),2) ELSE 71078000
IF FORMATI THEN 71079000
IF RECORDMODE<DOUBL THEN BUFDESC[RECORDOFF] ELSE 71080000
(INTEGER(POINTER(BUFDESC,*)+RECORDOFF, 71081000
RECORDSZ)+WORDSTORND)DIV WORDSTO 71082000
ELSE 0; 71083000
END ELSE 71084000
BEGIN % CHARACTER ORIENTED 71085000
% SIZE MUST BE IN INTMODES 71086000
% NO REVERSE CHARACTER ORIENTED RECORDS ON FIRST RELEASE 71087000
CALCRECSZ~ 71088000
IF FORMATD THEN INTEGER(BUFDESCP,4) ELSE 71089000
IF FORMATV THEN REAL(BUFDESCP,2) ELSE 71090000
IF FORMATI THEN 71091000
IF RECORDMODE<DOUBL THEN 71092000
REAL(BUFDESCP+WORDSTO|RECORDOFF,WORDSTO) ELSE 71093000
INTEGER(BUFDESCP+WORDSTO|RECORDOFF,RECORDSZ) 71094000
ELSE 0; 71095000
END; 71096000
DIVORCEMOM(DUMMYA); 71097000
END CALCRECSZ; 71098000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71099000
PROCEDURE SETUPRECPTR(LENGTH,ADDRESS,RECPTR,FIB); 71100000
VALUE LENGTH,ADDRESS; 71101000
REAL LENGTH,ADDRESS; 71102000
ARRAY RECPTR[*]; 71103000
ARRAY FIB[*]; 71104000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71105000
% SEVERAL IMPORTANT FUNCTIONS: %71106000
% 1 - FIXES BUFDESC %71107000
% 2 - RETURNS POINTER TO BUFFER %71108000
% 3 - MAINTAINS WORDSLEFT %71109000
% 4 - MAINTAINS BUFFEREXHAUSTED %71110000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71111000
ARRAY DUMMYA[*]; 71112000
POINTER BUFDESCP=ADDRESS; 71113000
POINTER RCPTR=RECPTR; 71114000
REAL FIB0; 71115000
WORD ARRAY FIBW=FIB[*]; 71116000
FIB0~FIBSIZE; 71117000
IF OPENINPUT THEN 71118000
BEGIN 71119000
IF WORDORIENTED THEN 71120000
BUFDESC~ 71121000
DUMMYA&ARRAYDESCL( 71122000
,LENGTH 71123000
,IF REVERSED THEN ADDRESS-LENGTH ELSE 71124000
ADDRESS+REAL(FLINKED) 71125000
) 71126000
ELSE 71127000
BUFDESCP~ 71128000
BUFDESCP+(IF REVERSED THEN -LENGTH ELSE REAL(FLINKED)71129000
|WORDSTO) 71130000
; 71131000
IF BLOCKEDFUNNY THEN 71132000
IF WORDORIENTED THEN 71133000
REPLACE POINTER(ALTDESC,*)BY BUFDESCP 71134000
FOR LENGTH WORDS 71135000
ELSE 71136000
REPLACE POINTER(ALTDESC,*)BY BUFDESCP 71137000
FOR LENGTH; 71138000
IF WORDORIENTED THEN 71139000
IF POINTEREQD THEN 71140000
RCPTR~ 71141000
IF BLOCKEDFUNNY THEN 71142000
POINTER(ALTDESC,*) 71143000
ELSE POINTER(BUFDESC,*) 71144000
ELSE 71145000
RECPTR~*&ARRAYDESCL( 71146000
3 71147000
,LENGTH|WORDSTO 71148000
,IF BLOCKEDFUNNY THEN ALTDESC.ADDRESSF 71149000
ELSE ADDRESS 71150000
) 71151000
ELSE 71152000
IF POINTEREQD THEN 71153000
RCPTR~BUFDESCP 71154000
ELSE 71155000
RECPTR~*&ARRAYDESCL( 71156000
3 71157000
,LENGTH|WORDSTO 71158000
,ADDRESS 71159000
); 71160000
BFFRXHSTD~REAL(UNITSLEFT~*-LENGTH{REAL(FLINKED)); 71161000
END ELSE 71162000
BEGIN 71163000
IF BLOCKEDFUNNY THEN 71164000
IF WORDORIENTED THEN 71165000
REPLACE BUFDESCP BY POINTER(ALTDESC,*) 71166000
FOR LENGTH WORDS 71167000
ELSE 71168000
REPLACE BUFDESCP BY POINTER(ALTDESC,*) 71169000
FOR LENGTH; 71170000
IF WORDORIENTED THEN 71171000
BUFDESC~ 71172000
DUMMYA&ARRAYDESCL( 71173000
,LENGTH 71174000
,ADDRESS 71175000
) 71176000
ELSE 71177000
BUFDESCP~ 71178000
BUFDESCP+LENGTH 71179000
; 71180000
IF FIXEDL THEN BFFRXHSTD~REAL(UNITSLEFT~*-LENGTH{0); 71181000
IF WORDORIENTED THEN 71182000
IF POINTEREQD THEN 71183000
RCPTR~ 71184000
IF BLOCKEDFUNNY THEN 71185000
POINTER(ALTDESC,*) 71186000
ELSE POINTER(BUFDESC,*) 71187000
ELSE 71188000
RECPTR~*&ARRAYDESCL( 71189000
3 71190000
,LENGTH|WORDSTO 71191000
,ADDRESS 71192000
) 71193000
ELSE 71194000
IF POINTEREQD THEN 71195000
RCPTR~BUFDESCP 71196000
ELSE 71197000
RECPTR~*&ARRAYDESCL( 71198000
3 71199000
,LENGTH|WORDSTO 71200000
,ADDRESS 71201000
); 71202000
END; 71203000
DIVORCEMOM(DUMMYA); 71204000
END SETUPRECPTR; 71205000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71206000
PROCEDURE RELEASE(FIB,UNITFEATURE,RECPTR,TYPE); 71207000
VALUE TYPE; 71208000
REAL UNITFEATURE,TYPE; 71209000
ARRAY FIB[*]; 71210000
WORD RECPTR; 71211000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71212000
% RELEASE HANDLES PHYSICAL I/O. IT CALLS IOREQUEST, %71213000
% ROTATES BUFFERS ... %71214000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71215000
ARRAY DUMMYA,IOAREA[*]; 71216000
BOOLEAN LARGESPACE; 71217000
DEFINE 71218000
MAYBEWAIT = IF NOT BOOLEAN(TYPE)THEN WAITON(IOCB)#, 71219000
CARCON=UNITFEATURE#; 71220000
FIELD STACKERF=32:1; 71221000
LABEL CMN,CMNR,EOFL,HR,OUTL,PARL,THR,WHR,XIT; 71222000
POINTER PALT, DUMMYAP=DUMMYA; 71223000
REAL 71224000
NUMLINES, 71225000
TEMPBLOCKSZ, 71226000
T; 71227000
REFERENCE IOCB; 71228000
WORD IOCBW=IOCB; 71229000
WORD TW=T; 71230000
WORD ARRAY FIBW=FIB[*],IOAREAWA=IOAREA[*]; 71231000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71232000
% NOTE: CARD PUNCH I IS NOT INTENDED FOR USE WITH THE %71233000
% B6500 AND WILL GET THE SAME ERROR RECOVERY ACTION %71234000
% AS CARD PUNCH %71235000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71236000
IOCB~REFERENCE(IOAREA~IOADESC); 71237000
IF DISC THEN 71238000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% DISK FILE 71239000
END ELSE 71240000
IF PNCH(UNITYP)THEN IOAREA[IOCWP].STACKERF~UNITFEATURE ELSE 71241000
IF PRNTR(UNITYP)THEN 71242000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% PRINTER 71243000
IF BUFFERED THEN IOCB~REFERENCE(LASTBUFFER); 71244000
IF BEFORE AND BUFFERED THEN 71245000
BEGIN 71246000
IF NOT BEFOREACTION THEN 71247000
BEGIN % LAST WAS AFTER 71248000
IOAREA[IOCWP]~0&IOCWL(SKLTNSTNDRD,0); 71249000
IOREQUEST(IOCB); 71250000
END; 71251000
IOCB~REFERENCE(IOAREA~IOADESC); 71252000
BFRACTN~0; 71253000
END; 71254000
IF CHANNELSKIP THEN 71255000
BEGIN 71256000
HR: 71257000
IOAREA[IOCWP]~0&IOCWL( 71258000
IF BUFFERED THEN 71259000
IF BEFOREACTION THEN PRINTSPACE ELSE SKLTNSTNDRD 71260000
ELSE IF BEFORE THEN SKLTNSTNDRD ELSE PRINTSPACE, 71261000
0&IOCWPRINTERL( 71262000
IF CHANNELSKIP AND BEFORE THEN CHANNELNO ELSE 0, 71263000
IF NOT CHANNELSKIP THEN 71264000
IF LARGESPACE THEN NOLINES MOD 2 ELSE NOLINES 71265000
ELSE 0)); 71266000
IF BEFORE AND BUFFERED THEN BFRACTN~1; 71267000
DUMMYA~IOAREAWA[2]; 71268000
IOAREAWA[2]~REFERENCE(DUMMYA& 71269000
ARRAYDESCL(,DUMMYA.LENGTHF-UNITSLEFT,*)); 71270000
% WORRY ABOUT WRAP-AROUND 71271000
IOREQUEST(IOCB); 71272000
IF BEFORE AND NOT CHANNELSKIP THEN GO TO WHR; 71273000
THR: 71274000
IF AFTER THEN 71275000
IF BUFFERED THEN 71276000
BEGIN 71277000
NEXTBUFFER; 71278000
BFRACTN~0; 71279000
ROTATEBUFFERS; 71280000
END ELSE 71281000
BEGIN 71282000
WAITON(IOCB); 71283000
IOAREA[IOCWP]~0&IOCWL(SKLTNSTNDRD,0); 71284000
IOREQUEST(IOCB); 71285000
END ELSE 71286000
ROTATEBUFFERS; 71287000
GO TO OUTL; 71288000
END ELSE 71289000
BEGIN % SOME TYPE SPACE 71290000
IF LARGESPACE~NOLINES>2 THEN NUMLINES~NOLINES DIV 2; 71291000
IF AFTER THEN 71292000
BEGIN 71293000
WHR: 71294000
IF LARGESPACE THEN 71295000
WHILE NUMLINES~NUMLINES-1}0 DO 71296000
BEGIN 71297000
WAITON(IOCB); 71298000
IOAREA[IOCWP]~0&IOCWL(PRINTSPACE,0&IOCWPRINTERL(0,2)); 71299000
IOREQUEST(IOCB); 71300000
ROTATEBUFFERS; 71301000
END; 71302000
IF BEFORE THEN GO TO THR ELSE WAITON(IOCB); 71303000
END; 71304000
GO TO HR 71305000
END 71306000
END ELSE 71307000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TAPE-LIKE 71308000
IF OPENINPUT THEN 71309000
BEGIN 71310000
IOREQUEST(IOCB); 71311000
ROTATEBUFFERS; 71312000
IF BOOLEAN(TYPE)THEN GO TO XIT ELSE WAITON(IOCB); 71313000
CMN: 71314000
IF NOMORE THEN GO TO EOFL; 71315000
UNITSLEFT~IF UNITYP=CARDREADER THEN BLOCKSZ ELSE 71316000
MISC@(IOCB).WORDCOUNTF|WORDSTO+MISC@(IOCB).RDCHRCNT; 71317000
CMNR: 71318000
IF NOT FORMATU THEN 71319000
BEGIN 71320000
IF WORDORIENTED THEN 71321000
DUMMYA~*&ARRAYDESCL( 71322000
,MAXRECSZ 71323000
,REAL(WORD(AREADESC@IOCB)).ADDRESSF+ 71324000
(IF REVERSED THEN BLOCKSZ+REAL(NOT FLINKED) 71325000
ELSE 1) 71326000
) 71327000
ELSE 71328000
DUMMYA~*& 71329000
INDEXEDSTRINGDESCRIPTOR(,1,1,,,,INTERNALMODE,,1, 71330000
REAL(WORD(AREADESC@IOCB)).ADDRESSF); 71331000
% PROTECTED 71332000
IF WORDORIENTED THEN T~DUMMYA.ADDRESSF ELSE TW~DUMMYAP; 71333000
SETUPRECPTR ( 71334000
RCRDSZ(DUMMYA,DUMMYAP) 71335000
, T 71336000
, RECPTR 71337000
, FIB 71338000
); 71339000
% FIXUP LATER FOR REVERSE 71340000
END; 71341000
END 71342000
ELSE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% OUTPUT 71343000
% ASSUMES SIZE HAS BEEN CHECKED ... 71344000
BEGIN 71345000
DUMMYA~IOAREAWA[2]; 71346000
STOREITEM(AREADESC@IOCB, 71347000
REFERENCE(DUMMYA&ARRAYDESCL(, 71348000
DUMMYA.LENGTHF-UNITSLEFT DIV WORDSTO,*))); 71349000
% WORRY ABOUT WRAP-AROUND ... 71350000
%%%%% FIX AREA DESCRIPTOR 71351000
IOREQUEST(IOCB); 71352000
ROTATEBUFFERS; 71353000
OUTL: 71354000
%%%%% FIX AREA DESCRIPTOR 71355000
IOAREAWA[2]~DUMMYA~*& 71356000
ARRAYDESCL(,BLOCKSZ,IOAREA.ADDRESSF+IOTANKSZ-1); 71357000
IF BOOLEAN(TYPE)THEN GO TO XIT ELSE WAITON(IOCB); 71358000
IF PARITYERROR THEN GO TO PARL; 71359000
IF NOMORE THEN GO TO EOFL; 71360000
% BLOCKSZ IN WORDS 71361000
UNITSLEFT~BLOCKSZ|WORDSTO; 71362000
IF CHARECORD THEN DUMMYA~*& 71363000
INDEXEDSTRINGDESCRIPTOR(,1,1,,,,INTERNALMODE,,1); 71364000
IF WORDORIENTED THEN T~DUMMYA.ADDRESSF+1 ELSE TW~DUMMYAP; 71365000
SETUPRECPTR ( 71366000
MAXRECSZ 71367000
, T 71368000
, RECPTR 71369000
, FIB 71370000
); 71371000
END; 71372000
END; 71373000
GO TO XIT; 71374000
PARL: 71375000
% CHECK FOR DESCRIPTOR ERROR 71376000
PARITYERR~1; 71377000
RECORDSTATUS.EXCEPTION~1; 71378000
GO TO XIT; 71379000
EOFL: 71380000
ENDOV~1; 71381000
RECORDSTATUS.EXCEPTION~1; 71382000
GO TO XIT; 71383000
XIT: 71384000
IOCBW~0; 71385000
DIVORCEMOM(DUMMYA); 71386000
DIVORCEMOM(IOAREA); 71387000
END RELEASE; 71388000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71389000
PROCEDURE LOGICALRECORD=(0,30)(FIB,UNITFEATURE,RECSIZE,RECPTR, 71390000
EOFL,PARL,DATAL,PFOC); 71391000
VALUE PFOC; 71392000
ARRAY FIB[*]; 71393000
REAL PFOC,UNITFEATURE,RECSIZE; 71394000
WORD RECPTR,EOFL,PARL,DATAL; 71395000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71396000
% LOGICALRECORD IS THE GUTS OF THE I/O INTRINSICS. IT %71397000
% CONTROLS THE VARIOUS ACTIVITIES. %71398000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71399000
ARRAY DUMMYA,IOAREA[*]; 71400000
ARRAY ARRAYD=RECPTR[*]; 71401000
BOOLEAN BOOT,DOARETN; 71402000
LABEL HR,CMN,XIT,OWT; 71403000
LABEL ARRAYROWL,LEOF,LPAR; 71404000
LAYOUT PFCL(ORF=3:4,EQVF=5:2); 71405000
POINTER BUFDESCP,DUMMYAP=DUMMYA; 71406000
REAL 71407000
PFC, 71408000
FIB0, 71409000
EOFR=EOFL, 71410000
PARR=PARL, 71411000
T; 71412000
REFERENCE IOCB; 71413000
WORD TW=T; 71414000
WORD IOCBW=IOCB; 71415000
WORD ARRAY FIBW=FIB[*],IOAREAWA=IOAREA[*]; 71416000
PROCEDURE CHECKRECORDSIZE; 71417000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71418000
% HANDLES CERTAIN TYPES OF VARIABLE LENGTH RECORDS %71419000
% INPUT: TYPE U %71420000
% OUTPUT: TYPES D, V, I, U, L %71421000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71422000
ARRAY DUMMYA[*]; 71423000
BOOLEAN SCND; 71424000
LABEL HR; 71425000
POINTER BUFDESCP,DUMMYAP=DUMMYA; 71426000
REAL I,T,P; 71427000
WORD IW=I; 71428000
DUMMYA~BUFDESC; 71429000
BUFDESCP~POINTER(DUMMYA,*); 71430000
IF BUFFEREXHAUSTED THEN RELEASE(FIB,UNITFEATURE,RECPTR,0); 71431000
% RECHECK 71432000
DUMMYA~IF BLOCKEDFUNNY THEN ALTDESC ELSE BUFDESC; 71433000
T~IF FORMATD OR FORMATV OR FORMATI THEN CALCRECSZ(DUMMYA,FIB) 71434000
ELSE RECSIZE; 71435000
IF T>MAXRECSZ OR T<MINRECSZ AND MINRECSZ!0 OR T=0 THEN 71436000
BEGIN TRACE(18);TRACE(21) END; 71437000
IF OPENOUTPUT THEN 71438000
BEGIN 71439000
IF T>UNITSLEFT THEN 71440000
BEGIN 71441000
HR: 71442000
IF FLINKED THEN 71443000
BEGIN % MAKE LINKS 71444000
M[I~REAL(WORD(AREADESC@REFERENCE(IOADESC))).ADDRESSF+1]~ 71445000
REAL(M[I])+ADD1TOBIT32; 71446000
IF WORDORIENTED THEN 71447000
M[BUFDESC.ADDRESSF+BUFDESC.LENGTHF]~ 71448000
0&IOLINKL(M[I].NUMRECSLNK,BUFDESC.LENGTHF) 71449000
ELSE 71450000
REPLACE BUFDESCP+(P~REAL(BUFDESCP,WORDSTO).FRWRDLNK)BY 71451000
0&IOLINKL(M[I].NUMRECSLNK,P); 71452000
END; 71453000
RELEASE(FIB,UNITFEATURE,RECPTR,0); 71454000
IF NOT BLOCKEDFUNNY AND NOT SCND THEN 71455000
IF WORDORIENTED THEN 71456000
REPLACE BUFDESCP BY POINTER(DUMMYA,*) 71457000
FOR T WORDS 71458000
ELSE 71459000
REPLACE BUFDESCP:BUFDESCP BY DUMMYAP FOR T; 71460000
END; 71461000
IF SCND~(WORDSLEFT~*-T<MINRECSZ AND MINRECSZ!0 OR WORDSLEFT{0) 71462000
THEN GO TO HR; 71463000
IF FLINKED THEN 71464000
IF WORDORIENTED THEN 71465000
BEGIN % FIX LINKS 71466000
M[BUFDESC.ADDRESSF-1]~T&IOLINKL(0,*); 71467000
M[BUFDESC.ADDRESSF+T].BCKWRDLNK~T; 71468000
M[I~REAL(WORD(AREADESC@REFERENCE(IOADESC))).ADDRESSF+1]~ 71469000
REAL(M[I])+ADD1TOBIT32; 71470000
END ELSE 71471000
BEGIN 71472000
REPLACE BUFDESCP-WORDSTO BY T&IOLINKL(0,*); 71473000
REPLACE BUFDESCP+T BY 0&IOLINKL(0,T); 71474000
M[I~REAL(WORD(AREADESC@REFERENCE(IOADESC))).ADDRESSF+1]~ 71475000
REAL(M[I])+ADD1TOBIT32; 71476000
END; 71477000
END 71478000
ELSE 71479000
IF T>WORDSLEFT THEN BEGIN TRACE(18);TRACE(21) END 71480000
ELSE 71481000
BFFRXHSTD~REAL(WORDSLEFT~*-T{0); 71482000
IF WORDORIENTED THEN 71483000
I~BUFDESC.ADDRESSF+(IF OPENINPUT THEN IF REVERSED THEN -T 71484000
ELSE BUFDESC.LENGTHF ELSE T) 71485000
ELSE 71486000
IW~BUFDESCP+(IF OPENINPUT THEN IF REVERSED THEN -T 71487000
ELSE LASTLENGTH ELSE T); 71488000
SETUPRECPTR ( 71489000
IF OPENOUTPUT THEN MAXRECSZ ELSE T 71490000
, I 71491000
, RECPTR 71492000
, FIB 71493000
); 71494000
LASTLENGTH~T; 71495000
DIVORCEMOM(DUMMYA); 71496000
END CHECKRECORDSIZE; 71497000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71498000
IOAREA~IOADESC; 71499000
FIB0~FIBSIZE; 71500000
FIBUZZ; 71501000
PFC~0&PFCL(REAL(BOOLEAN(RECORDSTATUS)OR BOOLEAN(PFOC)).ORF, 71502000
REAL(BOOLEAN(RECORDSTATUS)EQV NOT BOOLEAN(PFOC)).EQVF); 71503000
WHILE TRUE DO 71504000
CASE FIRSTONE(PFC) OF 71505000
BEGIN %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71506000
GO TO HR; % OBTAIN 071507000
BEGIN %**********************************% I/O REQUIRED 171508000
IF FILEMTBUF THEN 71509000
IF PFOCMTBUF THEN 71510000
IF ARRAYROW THEN 71511000
IF FORMATTER THEN 71512000
BEGIN % PRE-RELEASE 71513000
RELEASE(FIB,UNITFEATURE,RECPTR,1); 71514000
BLOCKCOUNT~*+1; 71515000
GO TO XIT 71516000
END ELSE 71517000
BEGIN 71518000
IOCB~REFERENCE(IOAREA); 71519000
WAITON(IOCB); 71520000
IF NOMORE THEN GO TO LEOF; 71521000
IF PARITYERROR THEN GO TO LPAR; 71522000
UNITSLEFT~ 71523000
IF OPENINPUT THEN 71524000
IF UNITYP=CARDREADER THEN BLOCKSZ 71525000
ELSE MISC@(IOCB).WORDCOUNTF 71526000
ELSE BLOCKSZ; 71527000
BUFDESC~DUMMYA&ARRAYDESCL( 71528000
,MAXRECSZ 71529000
,REAL(WORD(AREADESC@IOCB)).ADDRESSF+ 71530000
(IF REVERSED THEN BLOCKSZ + 71531000
REAL(NOT FLINKED) ELSE 1)); 71532000
IF CHARECORD THEN 71533000
BEGIN 71534000
DUMMYA~BUFDESC; 71535000
BUFDESC~DUMMYA~*&INDEXEDSTRINGDESCRIPTOR( 71536000
,1,1,1,,,INTERNALMODE,0); 71537000
END; 71538000
ARRAYROWL: 71539000
T~MIN(RECSIZE,ARRAYD.LENGTHF); 71540000
IF CHARECORD THEN T~T|WORDSTO; 71541000
T~MIN(T,WORDSLEFT); 71542000
T~MIN(T,MAXRECSZ); 71543000
DUMMYA~BUFDESC; 71544000
BUFDESCP~POINTER(DUMMYA,*); 71545000
IF OPENINPUT THEN 71546000
IF WORDORIENTED THEN 71547000
REPLACE POINTER(ARRAYD,*) BY 71548000
BUFDESCP FOR T WORDS 71549000
ELSE 71550000
REPLACE POINTER(ARRAYD,*) BY 71551000
BUFDESCP FOR T 71552000
ELSE 71553000
IF WORDORIENTED THEN 71554000
REPLACE BUFDESCP BY 71555000
POINTER(ARRAYD,*) FOR T WORDS 71556000
ELSE 71557000
REPLACE BUFDESCP BY 71558000
POINTER(ARRAYD,*) FOR T; 71559000
RECORDCOUNT~*+1; 71560000
BFFRXHSTD~REAL(WORDSLEFT~*-MAXRECSZ{0); 71561000
IF BUFFEREXHAUSTED THEN 71562000
BEGIN 71563000
RELEASE(FIB,UNITFEATURE,RECPTR,1); 71564000
BLOCKCOUNT~*+1; 71565000
END ELSE 71566000
BEGIN 71567000
IF WORDORIENTED THEN 71568000
DUMMYA~*&ARRAYDESCL( 71569000
,RCRDSZ(BUFDESC,DUMMYAP) 71570000
,BUFDESC.ADDRESSF+(IF REVERSED THEN 71571000
-REAL(FLINKED)ELSE BUFDESC.LENGTHF) 71572000
) 71573000
ELSE 71574000
BEGIN 71575000
DUMMYA~BUFDESC; 71576000
DUMMYAP~DUMMYAP+RCRDSZ(DUMMYA,DUMMYAP) 71577000
END; 71578000
IF WORDORIENTED THEN T~DUMMYA.ADDRESSF 71579000
ELSE TW~DUMMYAP; 71580000
SETUPRECPTR( 71581000
RCRDSZ(DUMMYA,DUMMYAP) 71582000
,T 71583000
,DUMMYA 71584000
% KLUDGE 71585000
,FIB 71586000
); 71587000
END; 71588000
GO TO XIT 71589000
END 71590000
ELSE 71591000
BEGIN 71592000
IF OPENOUTPUT AND BLOCKED THEN 71593000
BEGIN 71594000
CMN: 71595000
IF RECORDTYPE=0 THEN WORDSLEFT~*+MAXRECSZ;71596000
RELEASE(FIB,UNITFEATURE,RECPTR,0); 71597000
GO TO XIT 71598000
END ELSE 71599000
TRACE(21); 71600000
END 71601000
ELSE 71602000
BEGIN 71603000
RELEASE(FIB,UNITFEATURE,RECPTR,0); 71604000
GO TO XIT 71605000
END 71606000
ELSE 71607000
IF FORMATTER THEN GO TO XIT 71608000
ELSE 71609000
IF ARRAYROW THEN GO TO ARRAYROWL 71610000
ELSE 71611000
IF OPENOUTPUT AND BLOCKED THEN GO TO CMN ELSE TRACE(21) 71612000
END; 71613000
BEGIN %**********************************% UNIT FEATURE 271614000
CASE UNITYP OF 71615000
BEGIN 71616000
IOTERMINATE; % 0 BACKUP (Q) 71617000
IOTERMINATE; % 1 DISK 71618000
IOTERMINATE; % 2 DISPLAY 71619000
IOTERMINATE; % 3 REMOTE 71620000
; % 4 PTR 71621000
; % 5 PTP 71622000
BEGIN % 6 PRINTER 71623000
PRINTERL: 71624000
IF BOOLEAN(PFOC.UFEAT) THEN 71625000
BEGIN 71626000
% CHECK DISK CASE 71627000
% CHECK [NO] CASE 71628000
END ELSE 71629000
UNITFEATURE~1; 71630000
END; 71631000
GO TO PRINTERL; % 7 PRINTER 71632000
; % 8 71633000
; % 9 READER 71634000
; % 10 71635000
BEGIN % 11 PUNCH 71636000
% CHECK DISK CASE 71637000
END; 71638000
; % 12 71639000
; % 13 71640000
; % 14 71641000
; % 15 71642000
;;;;;;;;;;;;;;;;; % 16-31 71643000
END; 71644000
PFC.UFEAT~0; 71645000
END; 71646000
BEGIN %**********************************% RECORD SZ REQD 371647000
IF PFOCRCSZ THEN % FORMATTER 71648000
IF PFOCMTBUF THEN % PRE-RELEASE 71649000
PFC.DRCDSIZE~0 71650000
ELSE 71651000
IF FILEMTBUF THEN 71652000
BEGIN % LAST WAS PRE-RELEASE 71653000
IOCB~REFERENCE(IOAREA); 71654000
WAITON(IOCB); 71655000
IF NOMORE THEN GO TO LEOF; 71656000
IF PARITYERROR THEN GO TO LPAR; 71657000
UNITSLEFT~ 71658000
IF OPENINPUT THEN 71659000
IF UNITYP=CARDREADER THEN BLOCKSZ ELSE 71660000
MISC@(IOCB).WORDCOUNTF|WORDSTO+ 71661000
MISC@(IOCB).RDCHRCNT 71662000
ELSE BLOCKSZ; 71663000
BUFDESC~DUMMYA&ARRAYDESCL( 71664000
,MAXRECSZ 71665000
,REAL(WORD(AREADESC@IOCB)).ADDRESSF+1 71666000
); 71667000
IF WORDORIENTED THEN T~BUFDESC.ADDRESSF ELSE 71668000
BEGIN 71669000
DUMMYA~BUFDESC; 71670000
TW~DUMMYA~*&INDEXEDSTRINGDESCRIPTOR(,1,1,1,,, 71671000
INTERNALMODE,,0); 71672000
END; 71673000
SETUPRECPTR( 71674000
RECSIZE~RCRDSZ(BUFDESC,DUMMYAP) 71675000
,T 71676000
,RECPTR 71677000
,FIB 71678000
); 71679000
END ELSE 71680000
BEGIN % NORMAL 71681000
IF WORDORIENTED THEN 71682000
DUMMYA~*&ARRAYDESCL( 71683000
,RCRDSZ(BUFDESC,DUMMYAP) 71684000
,BUFDESC.ADDRESSF+(IF REVERSED THEN 71685000
-REAL(FLINKED)ELSE BUFDESC.LENGTHF) 71686000
) 71687000
ELSE 71688000
BEGIN 71689000
DUMMYA~BUFDESC; 71690000
DUMMYAP~DUMMYAP+RCRDSZ(DUMMYA,DUMMYAP) 71691000
END; 71692000
IF WORDORIENTED THEN T~DUMMYA.ADDRESSF ELSE 71693000
TW~DUMMYAP; 71694000
SETUPRECPTR( 71695000
RECSIZE~RCRDSZ(DUMMYA,DUMMYAP) 71696000
,T 71697000
,RECPTR 71698000
,FIB 71699000
); 71700000
PFC.DRCDSIZE~0 71701000
END 71702000
ELSE 71703000
IF FILEDRCDSIZE THEN 71704000
BEGIN 71705000
CHECKRECORDSIZE; 71706000
PFC.DRCDSIZE~0 71707000
END ELSE 71708000
BEGIN TRACE(18);TRACE(21); END; 71709000
END; 71710000
BEGIN %**********************************% EXCEPTION 471711000
IF ENDOF THEN 71712000
BEGIN 71713000
LEOF: 71714000
IF ENDOFTAKEN THEN IOTERMINATE; 71715000
ATAKEN~1; 71716000
IF OPENINPUT THEN 71717000
IF ENDOFACTION=0 THEN 71718000
IF EOFR!0 THEN GOTOSOLVER(EOFL) ELSE 71719000
ELSE 71720000
IF DOARETN~ENDOFACTION=2 THEN 71721000
ELSE 71722000
IOTERMINATE 71723000
ELSE 71724000
% CLOSE ACTION 71725000
IOTERMINATE 71726000
END ELSE 71727000
IF BOOLEAN(PARITYERR) THEN 71728000
BEGIN 71729000
LPAR: 71730000
IF PARITYACTION=0 AND NOT ACTIONTAKEN THEN 71731000
IF PARR!0 THEN GOTOSOLVER(PARL); 71732000
IOTERMINATE; 71733000
END ELSE 71734000
IOTERMINATE; 71735000
PFC.EXCEPTION~0; 71736000
END; 71737000
BEGIN %**********************************% OPEN OUTPUT 571738000
IF IMPLICITOPEN AND 71739000
(NOTOPEN OR OPENINPUT AND NOT REVERSED) THEN 71740000
BEGIN 71741000
% IF BOOT~OPENINPUT THEN CLOSE(FIB,HERE); 71742000
OPEN(FIB,0); 71743000
IOAREA~IOADESC; 71744000
% SEEK(FIB,IF BOOT THEN RECORDCOUNT ELSE 71745000
% IF REVERSED THEN MAXNO ELSE 0); 71746000
PFC.OPNOUT~0 71747000
END 71748000
ELSE 71749000
TRACE(21) 71750000
END; 71751000
BEGIN %**********************************% OPEN INPUT 671752000
IF IMPLICITOPEN AND NOTOPEN AND NOT BOOLEAN(PFC.OPNOUT) 71753000
THEN BEGIN 71754000
OPEN(FIB,0); 71755000
IOAREA~IOADESC; 71756000
% SEEK(FIB,IF REVERSED THEN MAXNO ELSE 0); 71757000
PFC.OPNIN~0 71758000
END 71759000
ELSE 71760000
TRACE(21) 71761000
END; 71762000
END; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71763000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71764000
% BY THE TIME REACH HERE HAVE DISPOSED OF ALL THE MESSY STUFF %71765000
% AND ARE LEFT WITH ONLY %71766000
% INPUT: TYPES F,D,V,L %71767000
% OUTPUT: TYPE F %71768000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71769000
HR: 71770000
IF WORDORIENTED THEN 71771000
DUMMYA~*&ARRAYDESCL( 71772000
,RCRDSZ(BUFDESC,DUMMYAP) 71773000
,BUFDESC.ADDRESSF+(IF REVERSED THEN -REAL(FLINKED) 71774000
ELSE BUFDESC.LENGTHF) 71775000
) 71776000
ELSE 71777000
BEGIN 71778000
DUMMYA~BUFDESC; 71779000
DUMMYAP~DUMMYAP+RCRDSZ(DUMMYA,DUMMYAP) 71780000
END; 71781000
% FORMAT U 71782000
IF WORDORIENTED THEN T~DUMMYA.ADDRESSF ELSE TW~DUMMYAP; 71783000
SETUPRECPTR ( 71784000
RCRDSZ(DUMMYA,DUMMYAP) 71785000
, T 71786000
, RECPTR 71787000
, FIB 71788000
); 71789000
XIT: 71790000
DIVORCEMOM(DUMMYA); 71791000
DIVORCEMOM(IOAREA); 71792000
IOCBW~0; 71793000
IF ENDOFACTION=2 THEN RETURN(REAL(DOARETN)); 71794000
UNLOCKFIB; 71795000
END OBTAIN; 71796000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71797000
SAVE 80000000
INTEGER PROCEDURE VECTORINSERT(PATH,ENTRY); 80001000
VALUE PATH 80002000
, ENTRY 80003000
; 80004000
REAL PATH 80005000
; 80006000
WORD ENTRY 80007000
; 80008000
COMMENT THE INSERT ALGORITHS OF THE READYQ AND SHEET CONSIST OF CALLS 80009000
UPON THIS PROCEDURE (AND NOTHING ELSE) OTHER PARTS OF THE 80010000
MCP-E.G. INDEPENDENTRUNNER-CALL THIS PROCEDURE TO LINK 80011000
STACKS INTO STACKVECTOR 80012000
PATH = REDY CALL FROM READYQ 80013000
=SHEETI CALL FROM SHEETQ 80014000
= GETIRS GETINDEPENDENTRUNNERSTACK 80015000
= OTHER CALL FROM ELSEWWERE 80016000
ENTRY ENTRY PARAMETER OF THE INSERT ALGORITHM 80017000
THE APPROPRIATE (SHEET OR READY) LOCK IS BUZZED AND THEN THE 80018000
VECTOR IS SEARCHED FOR AN EMPTY ELEMENT 80019000
VECTOR SIZE (EXCEPT WHERE ,IN THE CASE OF THE STACK VECTOR,80021000
THE NUMBER OF ENTRIES EXCEEDS 1024 IN WHICH CASE A RUN-TIME 80022000
ERROR IS NOTED). THIS IS DONE BY GETTING EXTRA SPACE AND MOVING80023000
THE VECTOR OVER. VECTOR SIZE MAY THUS BE INCREASED IN MODULES 80024000
OF SIZE "VECTORMODULE" CORE LOCATIONS 80025000
[NOTE : THE NOTHING TO DO LOOPS IN THE WAIT AND HOLD 80026000
PROCEDURES CHECK THAT (SIZE OF VECTOR)-(INDEX OF HIGHEST IN-USE80027000
ELEMENT) { "ALLOWABLE SLACK". IF THIS IS NOT THE CASE, SPACE 80028000
IS GOTTEN EQUAL TO "SIZE OF VECTOR" -"VECTOR MODULE" AND THE 80029000
VECTOR IS MOVED ACCROSS . THIS INFORMATION HAS NOTHING TO DO 80030000
WITH THIS PROCEDURE BUT IT SEEMS APPROPRIATE TO PUT IT IN HERE]80031000
THE ENTRY DESCRIPTOR IS MOVED INTO THE ACQUIRED VECTOR 80032000
ELEMENT, THE VECTOR IS UNLOCKED THE (READY OR SHEET) QUEUE IS 80033000
BUZZED AND THE PROCEDURE - "INSERTINQUEUE" , WHICH INSERTS THE 80034000
NEWLY ACQUIRED ELEMENT INTO THE QUEUE, IS CALLED. 80035000
; 80036000
BEGIN 80037000
REAL INDEX 80038000
, VECTORSIZE 80039000
, MYSNR 80040000
, NEXTINVECTOR 80043100
, LASTINVECTOR 80043200
; 80044000
WORD ARRAY OLDVECTORDESCRIPTOR[*] 80045000
; 80046000
BOOLEAN READYINDICATOR 80047000
, COMPLETESEARCH 80048000
; 80049000
REFERENCE NEWENTRY=ENTRY 80050000
; 80051000
FIELD FULLWORD = 47:48 80052000
; 80053000
LABEL OUT 80054000
, SCAN0 80054100
, SCAN1 80054200
; 80055000
INTEGER VI=PATH; % ***FOR MONITOR ONLY 80056000
MONITOR JACKMONITOR(VI); 80057000
VI~VI; %*** FOR MONITOR ONLY 80058000
MYSNR~SNR; 80059000
READYINDICATOR ~ PATH ! SHEETI; 80060000
80061000
OLDVECTORDESCRIPTOR ~ IF READYINDICATOR 80062000
THEN STACKVECTOR 80063000
ELSE SHEETVECTOR; 80064000
NEXTINVECTOR~IF READYINDICATOR 80064100
THEN NEXTINREADYVECTOR ELSE NEXTINSHEETVECTOR; 80064200
SCAN1: LASTINVECTOR~VECTORSIZE~OLDVECTORDESCRIPTOR.LENGTHF-1; 80064300
BUZZCONTROL(VECTORLOK[REAL(READYINDICATOR)]); 80064400
SCAN0: NEXTINVECTOR~IF (COMPLETESEARCH~NEXTINVECTOR=0) 80065000
THEN IF PATH=GETIRS OR PATH = SHEETI 80066000
THEN 1 80066200
ELSE FIRSTAVAILABLEINVECTOR 80067000
ELSE NEXTINVECTOR; 80068000
FOR INDEX~NEXTINVECTOR STEP 1 UNTIL LASTINVECTOR DO 80069000
IF OLDVECTORDESCRIPTOR[INDEX].FULLWORD=0 THEN GO OUT ; 80070000
COMMENT WE CAN NOT FIND STACK OR PSEUDO STACK IN THIS PASS; 80071000
IF INDEX=VECTORSIZE 80072000
THEN IF NOT COMPLETESEARCH 80073000
THEN BEGIN %%%MCS000010080074000
LASTINVECTOR~NEXTINVECTOR-1; 80075000
NEXTINVECTOR~0; 80076000
GO SCAN0; 80077000
END; %%%MCS0000010080078000
COMMENT WE CAN NOT GET A STACK OR A PSEUDO STACK SO WE HAVE TO SLEEP; 80079000
UNLOCK(VECTORLOK[REAL(READYINDICATOR)]); 80079100
WAIT (HOLEINVECTOR[REAL(READYINDICATOR)]) ; 80080000
NEXTINVECTOR~0; 80081000
GO SCAN1; 80082000
OUT: MOMTOVECTOR(WORD(NEWENTRY),OLDVECTORDESCRIPTOR, 80095000
VECTORINSERT ~ INDEX); 80096000
NEXTINVECTOR~IF INDEX=VECTORSIZE THEN 0 ELSE INDEX+1; 80097000
IF PATH!GETIRS THEN 80097200
IF READYINDICATOR 80098000
THEN NEXTINREADYVECTOR~NEXTINVECTOR 80098200
ELSE NEXTINSHEETVECTOR~NEXTINVECTOR; 80098400
IF(PATH!OTHER AND PATH!GETIRS) 80099000
THEN INSERTINQUEUE(PATH,INDEX); 80100000
IF PATH !GETIRS THEN UNLOCK(VECTORLOK[REAL(READYINDICATOR 80101000
)]); 80101200
VI~INDEX; 80102000
RETURN(INDEX); 80102100
END VECTORINSERT; 80103000
SAVE 80104000
PROCEDURE INSERTINQUEUE (PATH,STACKINDICATOR); 80105000
VALUE PATH 80106000
, STACKINDICATOR 80107000
; 80108000
REAL PATH 80109000
, STACKINDICATOR 80110000
; 80111000
COMMENT THE ACTION TAKEN BY THIS PROCEDURE DEPENDS UPON THE VALUE OF 80112000
PATH: 80113000
=REDY,SHEET INSERT THE STACK(REDY ) OR PSEUDO-STACK 80114000
(SHEET ) INTO THE READYQ OR SHEETQ 80115000
A.INSERTION IN THE READYQ IS AT THE LOW PRIORITY 80116000
END 80117000
B.INSERTION IN THE SHEETQ IS ACCORDING TO DECLARED80118000
PRIORITY. 80119000
WAITI MOVE THE STACKS IN THE WAITQ ASSOCIATED WITH 80120000
THE EVENT PARAMETER INTO THE LOW PRIORITY END 80121000
OF THE READYQ 80122000
OTHERREDY INSERTION INTO THE READYQ AT THE HIGH PRIORITY 80123000
END 80124000
TERMINATEI INSERTION INTO THE TERMINATEQ AT LOW PRIORITY 80124100
END 80124200
; 80125000
BEGIN 80126000
REAL PRIORITY 80127000
, NEXTENTRY 80128000
, HEAD = NEXTENTRY 80128100
, TI1 80129000
, COUNT 80130000
, CORESIZE 80131000
; 80132000
DEFINE LINK = LINKPLACE # 80133000
; 80134000
INTEGER IQ=PATH; % ***FOR MONITOR ONLY 80135000
IF PATH ! SHEET 80139000
THEN 80140000
BEGIN %%%MCS000000580141000
IF (HEAD~(IF PATH=TERMINATEI THEN TERMINATEQHEAD ELSE READYQHEAD))=080142000
THEN IF PATH = WAITI 80143000
THEN HEAD.DYNAMICLINKSF~STACKINDICATOR 80144000
ELSE BEGIN %%%MCS000001080145000
HEAD.FIRSTREADYF~STACKINDICATOR; 80146000
HEAD.LASTREADYF~STACKINDICATOR; 80147000
END %%%MCS000001080148000
ELSE IF PATH = OTHERREDY 80149000
THEN BEGIN %%%MCS000002080150000
WORDSTACK[HEAD.FIRSTREADYF,LINKPLACE] 80151000
.BACKWARDLINKF ~ STACKINDICATOR; 80152000
WORDSTACK[STACKINDICATOR,LINKPLACE ].FORWARDLINKF80153000
~ HEAD.FIRSTREADYF; 80154000
HEAD.FIRSTREADYF~STACKINDICATOR; 80155000
END %%%MCS000002080156000
ELSE BEGIN %%%MCS000003080157000
WORDSTACK[HEAD.LASTREADYF,LINKPLACE] 80158000
.FORWARDLINKF 80159000
~IF PATH = WAITI 80160000
THEN STACKINDICATOR.WAITQHEADF 80161000
ELSE STACKINDICATOR; 80162000
WORDSTACK[IF PATH=WAITI THEN STACKINDICATOR 80163000
.WAITQHEADF 80164000
ELSE STACKINDICATOR 80165000
,LINKPLACE].BACKWARDLINKF~ HEAD 80166000
.LASTREADYF; 80167000
HEAD.LASTREADYF~IF PATH=WAITI 80168000
THEN STACKINDICATOR.WAITQTAILF 80169000
ELSE STACKINDICATOR; 80170000
END; %%%MCS000003080171000
IF PATH=TERMINATEI THEN TERMINATEQHEAD~HEAD ELSE READYQHEAD~HEAD; 80171100
END %%%MCS000000580172000
ELSE 80173000
BEGIN %%%MCS000004080174000
IF PRIORITYLEVEL[PRIORITY~SHEETREALS[STACKINDICATOR, 80175000
PRIORITYPLACE]] = 0 80176000
THEN BEGIN %%%MCS000005080177000
COMMENT NO PREVIOUS ENTRIES AT THIS PRIORITY LEVEL; 80178000
PRIORITYLEVEL[PRIORITY].FIRSTATLEVEL 80179000
~ STACKINDICATOR; 80180000
PRIORITYLEVEL[PRIORITY].LASTATLEVEL 80181000
~ STACKINDICATOR ; 80182000
SHEETARRAY[STACKINDICATOR,LINKPLACE]. 80183000
DYNAMICLINKSF ~ 0; 80184000
80184100
END %%%MCS000005080185000
ELSE 80186000
IF (CORESIZE~SHEETREALS[STACKINDICATOR,COREPLACE]) 80187000
< SHEETREALS[PRIORITYLEVEL[PRIORITY] 80188000
.FIRSTATLEVEL,COREPLACE] 80189000
THEN 80190000
BEGIN %%%MCS000006080191000
COMMENT CORESIZE LESS THAN FOR FIRST ENTRY; 80192000
SHEETARRAY[PRIORITYLEVEL[PRIORITY] 80193000
.FIRSTATLEVEL ,LINK].BACKWARDLINKSF 80194000
~STACKINDICATOR; 80195000
SHEETARRAY[STACKINDICATOR,LINK] 80196000
.FORWARDLINKSF~PRIORITYLEVEL 80197000
[PRIORITY].FIRSTATLEVEL ; 80198000
PRIORITYLEVEL[PRIORITY].FIRSTATLEVEL 80199000
~STACKINDICATOR; 80200000
END %%%MCS000006080201000
ELSE 80202000
IF CORESIZE>SHEETREALS[PRIORITYLEVEL[PRIORITY].LASTATLEVEL,COREPLACE] 80203000
THEN BEGIN %%%MCS000007080204000
COMMENT IT MUST GO AT END; 80205000
SHEETARRAY[PRIORITYLEVEL[PRIORITY].LASTATLEVEL,LINK]. 80206000
FORWARDLINKSF~STACKINDICATOR; 80207000
SHEETARRAY[STACKINDICATOR,LINK].BACKWARDLINKSF~PRIORITYLEVEL 80208000
[PRIORITY].LASTATLEVEL; 80209000
PRIORITYLEVEL[PRIORITY].LASTATLEVEL ~ STACKINDICATOR; 80210000
END %%%MCS000007080211000
ELSE 80212000
BEGIN %%%MCS000008080213000
COUNT ~ PRIORITYLEVEL[PRIORITY].COUNTATLEVEL; 80214000
NEXTENTRY~SHEETARRAY[PRIORITYLEVEL[PRIORITY].FIRSTATLEVEL 80215000
,LINK].FORWARDLINKSF; 80216000
DO 80217000
IF CORESIZE<SHEETREALS[NEXTENTRY,COREPLACE] 80218000
THEN BEGIN %%%MCS000009080219000
SHEETARRAY[STACKINDICATOR,LINK] ~ * & LINKWORD(NEXTENTRY,*,TI1 ~ 80220000
SHEETARRAY[NEXTENTRY,LINK].BACKWARDLINKSF); 80221000
SHEETARRAY[TI1,LINK].FORWARDLINKSF ~ STACKINDICATOR; 80222000
SHEETARRAY[NEXTENTRY,LINK].BACKWARDLINKSF ~ STACKINDICATOR; 80223000
END %%%MCS000009080224000
ELSE NEXTENTRY ~ SHEETREALS [NEXTENTRY, 80225000
LINK].FORWARDLINKSF 80226000
UNTIL(COUNT ~ COUNT -1) = 0 ; 80227000
END; %%%MCS000008080228000
SHEETARRAY[STACKINDICATOR,LINK]~*&MARKSTACKCW(,*,*, 80229000
STACKINDICATOR,*,*,*); 80229100
PRIORITYLEVEL[PRIORITY].COUNTATLEVEL~PRIORITYLEVEL[PRIORITY] 80229200
.COUNTATLEVEL+1; 80229400
IF PRIORITY ! 0 THEN SHEETQHEAD ~ SHEETQHEAD + 1; 80229500
END ; %%%MCS000004080230000
END INSERTINQUEUE ; 80231000
SAVE 80232000
PROCEDURE STACKQREARRANGE(READYINDICATOR); 80233000
VALUE READYINDICATOR ; 80234000
BOOLEAN READYINDICATOR; 80235000
COMMENT THIS PROCEDURE IS CALLED TO REARRANGE EITHER THE READYQ 80236000
(READYINDICATOR IS TRUE) OR THE SHEETQ AS FOLLOWS : 80237000
A THE READYQ IS REARRANGED ACCORDING TO THE PRIORITY 80238000
FUNCTION DESCRIBED IN "DYNAMIC PRIORITY EVALUATION IN THE 80239000
SELECTION OF PROCESSES" BY J.G. CLEARY 80240000
B THE SHEETQ IS REARRANGED ACCORDING TO THE TIME THAT THE 80241000
VARIOUS ENTRIES HAVE BEEN IN THE OUEUE AND ACCORDING TO 80242000
THE TARGET TIME (IF ANY). HOWEVER, WITHIN ANY GIVEN 80243000
PRIORITY LEVEL, THE ENTRIES REMAIN ORDERED STRICTLY 80244000
ACCORDING TO CORE REQUIREMENTS 80245000
; 80246000
BEGIN 80247000
INTEGER SR; % *** FOR MONITOR ONLY 80248000
MONITOR JACKMONITOR(SR); 80249000
IF SIMULATING THEN 80249500
SR~SR; % *** FOR MONITOR ONLY 80250000
END STACKQREARRANGE ; 80251000
SAVE % *** FOR PRESENCE BIT 80252000
PROCEDURE NEXTPROCESS; 80253000
COMMENT THIS PROCEDURE IS CALLED BY THE MOVETONEXTINREADYQ ALGORITHM .IT80254000
RE-ARRANGES THE READYQ AND/OR BRINGS IN ENTRIES FROM THE SHEETQ 80255000
(IF REQUIRED) AND THEN INITIATES (MOVES STACK TO) THE HIGHEST 80256000
PRIORITY PROCESS IN THE QUEUE 80257000
; 80258000
BEGIN 80259000
OWN REAL PREVIOUSCLOCK 80260000
, STACKNO 80261000
; 80262000
INTEGER NP; % ***FOR MONITOR ONLY 80263000
MONITOR JACKMONITOR(NP); 80264000
BUZZCONTROL(SHEETQ); 80269000
IF NOT EMPTY(SHEETQ) 80269500
THEN SELECTION 80270000
ELSE UNLOCK(SHEETQ); 80270100
IF -PREVIOUSCLOCK+(PREVIOUSCLOCK~SCANIN(TIMEOFDAYWORD)) 80271000
> REARRANGETIME OR MUSTREARRANGE 80272000
THEN STACKQREARRANGE(READYINDICATOR); 80273000
STACKQREMOVE(REDY,STACKNO~READYQHED.FIRSTREADYF); 80275000
UNLOCK(READYQ); 80276000
NP ~ STACKNO; 80276500
SETINTERVALTIMER; % *** KLUDGE TO GIVR ME SOME TIME 80277000
MOVESTACK(STACKNO); 80278000
80279000
END NEXTPROCESS; 80280000
SAVE 80281000
PROCEDURE STACKQREMOVE (PATH,STACKINDICATOR); 80282000
VALUE PATH 80283000
, STACKINDICATOR 80284000
; 80285000
REAL PATH 80286000
; 80287000
INTEGER STACKINDICATOR 80288000
; 80289000
COMMENT USED FOR REMOVING ENTRIES FROM READYQ,SHEETQ AND TERMINATEQ 80290000
; 80291000
BEGIN 80292000
REAL FORWARDLINK 80293000
, BACKWARDLINK 80294000
, HEAD 80295000
, PRIORITY 80295100
; 80296000
REAL LINK 80297000
; 80298000
WORD ARRAY VECTORDESCRIPTOR[*,* ] 80299000
; 80300000
INTEGER SR=PATH; % *** FOR MONITOR ONLY 80301000
COMMENT PULL IF SIMULATING 80301500
MONITOR JACKMONITOR(LINK,FORWARDLINK,BACKWARDLINK,READYQHED);80302000
COMMENT PULL IF SIMULATING 80302500
MONITOR JACKMONITOR(SR); 80303000
SR~SR; %*** FOR MONITOR ONLY 80304000
VECTORDESCRIPTOR~IF PATH=SHEETI THEN SHEETARRAY ELSE 80305000
STACKVECTOR; 80306000
FORWARDLINK~(LINK~VECTORDESCRIPTOR[STACKINDICATOR,LINKPLACE] 80307000
.FULLWORD).FORWARDLINKF; 80308000
BACKWARDLINK~LINK.BACKWARDLINKF; 80309000
HEAD~IF PATH=REDY 80310000
THEN READYQHEAD 80310500
ELSE IF PATH=TERMINATEI 80311000
THEN TERMINATEQHEAD 80311500
ELSE PRIORITYLEVEL[SHEETARRAY[STACKINDICATOR , 80312000
PRIORITYPLACE]]; 80313000
IF BACKWARDLINK = 0 80314000
THEN HEAD.FIRSTREADYF~FORWARDLINK; 80315000
IF FORWARDLINK=0 80316000
THEN HEAD.LASTREADYF~BACKWARDLINK; 80317000
IF PATH = REDY 80318000
THEN READYQHED~ HEAD 80319000
ELSE IF PATH=TERMINATEI 80319200
THEN TERMINATEQHEAD ~ HEAD 80319400
ELSE BEGIN 80320000
PRIORITYLEVEL[PRIORITY~SHEETARRAY[STACKINDICATOR,80320100
PRIORITYPLACE]]~HEAD&LEVELFORMAT(*,*, 80321000
HEAD.COUNTATLEVEL-1); 80321010
IF PRIORITY!0 THEN SHEETQHEAD~SHEETQHEAD-1; 80321100
END ; 80321200
IF BACKWARDLINK!0 80322000
THEN VECTORDESCRIPTOR[BACKWARDLINK,LINKPLACE] 80323000
.FORWARDLINKF~FORWARDLINK; 80324000
IF FORWARDLINK!0 80325000
THEN VECTORDESCRIPTOR[FORWARDLINK,LINKPLACE] 80326000
.BACKWARDLINKF~BACKWARDLINK;80327000
VECTORDESCRIPTOR[LINK.SELFIDENTF,LINKPLACE].STATUSINDICATORF~0;80328000
EXIT; 80328100
END STACKQREMOVE; 80329000
SAVE 80330000
INTEGER PROCEDURE NEXTINSCHEDULE; 80331000
COMMENT THE SHEETQ ALGORITHM NEXTINDEX CONSISTS OF A CALL ON THIS 80332000
PROCEDURE (AND NOTHING ELSE). 80333000
WITHIN THE SHEETQ THEHE ARE A NUMBER OF LEVELS OF PRIORITY80334000
(THE PRIORITIES RANGING FROM 0 TO "PRIORITYRANGE"- A SYSTEM 80335000
PARAMETER). AT EACH LEVEL, THE ENTRIES ARE ARRANGED ACCORDING 80336000
TO CORE SPACE REQUIREMENT. THUS IT IS SUFFICIENT TO LOOK ONLY 80337000
AT THE ENTRIES AT THE HEAD OF EACH PRIORITY LEVEL 80338000
; 80339000
BEGIN 80340000
INTEGER TI1 80341000
, INDEX 80342000
; 80343000
DEFINE ENOUGHCORE = SHEETREALS[INDEX,COREPLACE]}AVAILABLECORE # 80344000
; 80345000
LABEL OUT 80346000
; 80347000
INTEGER NS; % ***FOR MONITOR ONLY 80348000
MONITOR JACKMONITOR(NS); 80349000
NS~NS; %*** FOR MONITOR ONLY 80350000
FOR TI1~PRIORITYRANGE STEP - 1 UNTIL 1 DO 80351000
IF (INDEX~PRIORITYLEVEL[TI1].FIRSTATLEVEL) ! 0 80352000
80353000
THEN BEGIN %%%MCS000010080354000
NEXTINSCHEDULE ~ INDEX ; 80355000
GO OUT ; 80356000
END; %%%MCS000010080357000
NEXTINSCHEDULE ~ -1; 80358000
OUT:END NEXTINSCHEDULE ; 80359000
SAVE 80360000
PROCEDURE INITIATE (DUMMY); 80361000
REAL DUMMY 80362000
; 80363000
COMMENT WHEN A JOB IS MOVED FROM THE SHEETQ,IT IS FIRST REPRESENTED IN 80364000
THE READYQ BY AN INDEPENDENT RUNNER STACK WITH INITIATE AS THE 80365000
PROCEDURE PARAMETER TO RUN. THE PARAMETER DUMMY IS NOT USED. 80366000
INITIATE DOES THE FOLLOWING: 80367000
A. CHECKS FOR A NEW D1 STACK. IF THE DISTACKNO IN THE FILE 80368000
HEADER(POINTED AT BY THE CODEFILEDESCRIPTOR) IS NON ZERO 80369000
THEN THE ASSOCIATED D1 STACK IS TO BE LINKED TO THIS 80370000
PROCESS(I.E. WE HAVE THE RE-ENTRANT PROGRAM CASE). 80371000
OTHERWISE A NEW D1 STACK IS CREATED. 80372000
B. CREATES THE D2 STACK AND LINKS IT IN TO THE D1 STACK 80373000
C. LINKS THE INITIATE STACK INTO THE TERMINATEQ 80374000
D. MOVES STACK TO THE NEWLY CREATED D2 STACK 80375000
; 80376000
BEGIN 80377000
REAL D1STACK 80378000
, D2STACK 80379000
, TI1 80380000
, TI2 80381000
, ADDRESS 80382000
, D1STACKSIZE = TI1 80383000
, MYSNR 80384000
, D2STACKSIZE = TI1 80385000
; 80386000
ARRAY FILEHEADER [*] 80387000
; 80388000
DEFINE D1SPECIFIERPLACE = D1DESCRIPTORPLACE # ; 80389000
DEFINE TOPMSCWPLACE = SECNDMSCWPLACE # 80389100
, TOPRCWPLACE = RETURNCONTROLWORDPLACE # 80389200
, PCWPLACE = IRPCWPLACE # 80389220
; 80389300
WORD ARRAY MYSTACKDESCRIPTOR[*] 80390000
, D1STACKDESCRIPTOR[*] 80391000
, D2STACKDESCRIPTOR = D1STACKDESCRIPTOR[*] 80392000
; 80393000
DEFINE FIXEDD1 = D1MSCWPLACE # 80394000
, D1FIXED = D1INFO # 80395000
, PROCESSD1 = STACK[MYSNR,D1SPECIFIERPLACE].LENGTHF#80396000
, PLACED1INFO = DISKWAIT (STACKVECTOR[D1STACK] 80397000
,D1RCWPLACE 80398000
,PROCESSD1 80399000
, 80400000
FIRSTROWADDRESS(FILEHEADER)+STACK[MYSNR,D1SPECIFIERPLACE].ADDRESSF 80401000
, 4 "122" 80402000
) # 80403000
, FIXEDD2 = 150 # 80404000
, PROCESSD2 = STACK[MYSNR,D2DESCRIPTORPLACE ] # 80405000
80406000
80407000
80408000
, MOVEINSHEETENTRIES=REPLACE POINTER(D2STACKDESCRIPTOR)80409000
BY POINTER(MYSTACKDESCRIPTOR) FOR 80410000
SHEETENTRYSIZE+2 OVERWRITE # 80411000
80412000
80413000
, PUTIND2ZEROES = 80414000
D2STACKDESCRIPTOR[TRPLACE] ~ 0; 80415000
D2STACKDESCRIPTOR[TWPLACE] ~ 0; 80416000
D2STACKDESCRIPTOR[TPPLACE] ~ 0; 80417000
REPLACE POINTER(D2STACKDESCRIPTOR 80418000
[D2DESCRIPTORPLACE]) BY 0 FOR (RETURNCONTROLWORDPLACE+1 80419000
-D2DESCRIPTORPLACE) OVERWRITE 80419010
# 80420000
, FIXTOPOFD2= 80421000
D2STACKDESCRIPTOR[FIRSTMSCWPLACE]~D2MSCW1; 80422000
80423000
D2STACKDESCRIPTOR[FIRSTRCWPLACE]~ D2RCW1; 80424000
COMMENT THE FOLLOWING TWO STATEMEMTS PUT THE D2 MSCW AND80425000
RCW IN THE STACK. 80426000
THE RCW AT THE TOP OF THE STACK IS THE PCW 80427000
FOR THE OUTER BLOCK CODE. WHEN THE PROCESS (I.E.80428000
D2 STACK) WAKES UP, IT WILL IMMEDIATELY EXIT AND80429000
THUS,VIA THE RCW, WILL START EXECUTING OUTER 80430000
BLOCK CODE. FROM THIS POINT ON,COMPILER GENERAT-80431000
ED CODE IS EXECUTED ; 80432000
D2STACKDESCRIPTOR[PCWPLACE]~WORDSTACK[D1STACK, 80432200
FIRSTPCWPLACE]; 80432400
D2STACKDESCRIPTOR[TOPMSCWPLACE]~D2MSCW2& 80433000
MARKSTACKCW(*,*,*,D2STACK,*,*,*); 80434000
D2STACKDESCRIPTOR[TOPRCWPLACE] 80435000
~ RUNRETURNCONTROLWORD 80436000
80437000
# 80438000
, TERMINATEMYSELF = 80439000
FORK(TERMINATE,0); 80440000
# 80441000
, STARTUPJOB= MOVESTACK(D2STACK) # 80442000
; 80443000
LABEL D1L,D2L; 80443100
DEFINE FINDSTACKSLOT(X,Y) = 80444000
Y: TI2~LASTNOTAVAILABLEINVECTOR; 80445000
BUZZCONTROL(VECTORLOK[1]); 80445200
DO UNTIL (TI2~TI2+1)=MAXSTACKS+1 OR STACKVECTOR[X~TI2] 80446000
.FULLWORD=0; 80447000
IF X=MAXSTACKS+1 THEN 80448000
BEGIN UNLOCK(VECTORLOK[1]); 80448200
WAIT(HOLEINVECTOR[1]); 80448400
GO TO Y; 80448600
END 80448800
# 80449000
; 80450000
BOOLEAN FIRSTD1STACK 80450100
; 80450200
INTEGER II; % ***FOR MONITOR ONLY 80451000
MONITOR JACKMONITOR(II); 80452000
II~II; %*** FOR MONITOR ONLY 80453000
BUZZ(PROCESSCHANGELOCK); 80454000
DISABLEOVERLAY; 80455000
MYSTACKDESCRIPTOR ~ STACKVECTOR[MYSNR~SNR]; 80456000
FILEHEADER ~ MYSTACKDESCRIPTOR[CODEFILEDESCPLACE]; 80457000
IF(FIRSTD1STACK~(D1STACK~D1STACKNUMBER(FILEHEADER))=0) 80458000
THEN 80459000
COMMENT WE HAVE TO BUILD A NEW D1 STACK; 80460000
BEGIN %%%MCS000010080461000
FINDSTACKSLOT(D1STACK,D1L); 80462000
ADDRESS~ GETSPACE (D1STACKSIZE~FIXEDD1+PROCESSD1 80463000
,0 80464000
,0&SPACETYPE(1,1,1,0) 80465000
,STACKVECTOR.ADDRESSF+D1STACK 80466000
) ; 80467000
D1STACKDESCRIPTOR~STACKVECTOR[D1STACK] 80468000
~*&DATADESCRIPTOR(*,1,0,0,0,0,0,0,D1STACKSIZE, 80469000
ADDRESS); 80470000
UNLOCK (VECTORLOK[1]); 80470200
D1STACKDESCRIPTOR[FIRSTPLACE] ~ D1TOSCW; 80471000
D1STACKDESCRIPTOR[LINKPLACE] 80472000
~0&MARKSTACKWD(,*,*,D1STACK,*,*,*,*); 80473000
D1STACKDESCRIPTOR[SEGDICTIDENTPLACE] ~ 80474000
MYSTACKDESCRIPTOR[PROCESSNATUREPLACE]; 80475000
D1STACKDESCRIPTOR[PROCESSNATUREPLACE].PROCESSHISTORYF80476000
~AD1STACK; 80477000
D1STACKDESCRIPTOR[D1CODEFILEDESCPLACE] ~ FILEHEADER; 80478000
D1STACKDESCRIPTOR[D1CODEFILENAMEDESCPLACE] ~ 80479000
MYSTACKDESCRIPTOR[CODEFILENAMEDESCPLACE]; 80480000
D1STACKDESCRIPTOR[USERCOUNTNLINKAGEPLACE] 80481000
~0;80482000
80483000
DISKWAIT(STACKVECTOR[D1STACK] 80483100
, D1MSCWPLACE-1 80483200
,PROCESSD1 80483300
, 80483400
FIRSTROWADDRESS(FILEHEADER)+STACK[MYSNR,D1SPECIFIERPLACE].ADDRESSF 80483500
, @442 80483600
); 80483700
D1STACKDESCRIPTOR[D1MSCWPLACE]~D1MSCW; 80483800
D1STACKDESCRIPTOR[D1RCWPLACE] ~ D1RCW; 80484000
D1STACKDESCRIPTOR[FIRSTPCWPLACE]~MYSTACKDESCRIPTOR 80485000
[FIRSTXPLACE]&STUFFEDIRW(,,D1STACK,D1MSCWPLACE);80485100
80485200
COMMENT THE D1 STACK HAS BEEN SET UP. WE MUST NOW MODIFY THE 80486000
FILE HEADER TO TAKE NOTE OF THE NEW D1 STACK. 80487000
; 80488000
D1STACKNUMBER(FILEHEADER) := D1STACK; 80489000
END ; %%%MCS0000100 80490000
COMMENT WE NOW HAVE TO GET A D2STACK; 80491000
FINDSTACKSLOT(D2STACK,D2L); 80492000
ADDRESS ~ GETSPACE (D2STACKSIZE~MYSTACKDESCRIPTOR 80493000
[STACKSIZEPLACE] 80493200
,D1STACK 80494000
,0&SPACETYPE(1,1,1,0) 80495000
,STACKVECTOR.ADDRESSF + D2STACK 80496000
) ; 80497000
D2STACKDESCRIPTOR~STACKVECTOR[D2STACK] 80498000
~*&DATADESCRIPTOR(*,1,0,0,0,0,0,0,D2STACKSIZE,ADDRESS); 80499000
UNLOCK(VECTORLOK[1]); 80499200
MOVEINSHEETENTRIES; 80500000
D2STACKDESCRIPTOR[FIRSTPLACE] ~ D2TOSCW; 80501000
D2STACKDESCRIPTOR[LINKPLACE].SELFIDENTF~D2STACK; 80501100
D2STACKDESCRIPTOR[PROCESSNATUREPLACE].INITIATESTACKF~0; 80501200
COMMENT*** MUST PUT IN REST OF PROCESS STACK HERE . MUST THEN LINK 80502000
INTO D1 STACK, PUT IN MSCW AND RCW, PUT INDEPENDENTRUNNER IN 80503000
TERMINATE QUEUE AND MOVE STACK 80504000
; 80505000
PUTINJOBIDANDTIME(D2STACKDESCRIPTOR,D2STACK); 80506000
PUTIND2ZEROES; 80507000
D2STACKDESCRIPTOR[CURRENTPRIORITYPLACE]~D2STACKDESCRIPTOR 80508000
[PRIORITYPLACE]; 80509000
D2STACKDESCRIPTOR[PROCESSFAMILYLINKPLACE].FATHERF~D1STACK; 80509100
COMMENT *** HOW DOES OLAYFILEDESC GET SET UP 80510000
D2STACKDESCRIPTOR[OLAYFILEDESCRIPTORPLACE] ~ OLAYFILEDESC; 80511000
FIXTOPOFD2; 80512000
TERMINATEMYSELF; 80513000
TI2~STACK[D1STACK,USERCOUNTNLINKAGEPLACE]; 80513100
STACK[D1STACK,USERCOUNTNLINKAGEPLACE]~TI2&USERLINK(*,TI2. 80513200
ACTIVEUSERSF+1,IF FIRSTD1STACK THEN D2STACK ELSE TI2. 80513300
FIRSTD2VALUE); 80513500
COMMENT *** AT PRESENT LATENTUSERSF IS NOT USED FOR ANYTHING; 80513600
UNLOCK(PROCESSCHANGELOCK); 80514000
STARTUPJOB; 80515000
80515100
ENABLEOVERLAY; 80516000
EXIT; 80516100
END INITIATE; 80517000
SAVE 80518000
PROCEDURE SELECTION; 80519000
COMMENT THIS ALGORITHM (ALSO CALLED SELECTION) IS INVOKED BY A SEARCH 80520000
OF THE READYQ WHEN A NEW JOB IS REQUIRED.THE FOLLOWING OCCURS: 80521000
A. THE SHEETQ IS SEARCHED UNTIL THE HIGHEST PRIORITY ENTRY 80522000
HAVING A SUITABLE CORE REQUIREMENT IS ENCOUNTERED. 80523000
B. THE SPACE FOR THE ENTRY IS MADE NON-OVERLAYABLE 80524000
C. THE PSEUDO STACK IS MODIFIED SO THAT WHEN IT RUNS,AS A 80525000
TRUE STACK, IT WILL EXIT TO RUN WHICH WILL CALL ON 80526000
INITIATE TO SET UP THE NEW JOB 80527000
D. VECTORINSERT IS CALLED TO CHANGE THE PSEUDO-STACK INTO A 80528000
REAL STACK BY LINKING IT INTO THE STACK VECTOR 80529000
E. IF APPROPRIATE, STEPS A TO D ARE REPEATED, THUS MORE THAN 80530000
ONE ENTRY MAY BE MOVED FROM THE SHEETQ TO THE READYQ 80531000
; 80532000
BEGIN 80533000
LABEL AGAIN 80534000
; 80535000
REFERENCE SHEETENTRY 80545000
; 80546000
INTEGER INDEX 80547000
, TI1 80548000
; 80549000
WORD ARRAY STACKDESCRIPTOR=SHEETENTRY [*] 80550000
; 80551000
SAVE WORD ARRAY STACKENTRY [INDEPENDENTRUNNERCORE]; 80551100
INTEGER SL; % ***FOR MONITOR ONLY 80552000
MONITOR JACKMONITOR(SL); 80553000
SL~SL; %*** FOR MONITOR ONLY 80554000
AGAIN: 80555000
80555200
IF (INDEX~NEXTINDEX(SHEETQ))<0 THEN GO FINI; 80555300
SHEETENTRY ~ SHEETVECTOR [INDEX]; 80556000
80556100
80556200
STACKQREMOVE(SHEET,INDEX); 80560000
SHEETVECTOR[INDEX].FULLWORD~0; 80560200
CAUSE(HOLEINVECTOR[SHEET]); 80560300
RESET(HOLEINVECTOR[SHEET]); 80560320
UNLOCK(SHEETQ); 80560400
STACKENTRY [0] ~ *; 80560500
INDEX ~ VECTORINSERT (REDY, STACKENTRY); 80561000
REPLACE POINTER (STACKENTRY) 80561100
BY POINTER (STACKDESCRIPTOR) 80561200
FOR STACKDESCRIPTOR.LENGTHF OVERWRITE; 80561300
LOADFIXEDIRSTACK (INDEX); 80561400
FORGETSPACE (STACKDESCRIPTOR.ADDRESSF); 80561450
WORDSTACK[INDEX,IRPCWPLACE]~ NAME(INITIATE); 80561500
WORDSTACK[INDEX,PROCESSNATUREPLACE].INITIATESTACKF~1; 80561600
WORDSTACK[INDEX,SECNDMSCWPLACE]~IRMSCW2& 80563000
MARKSTACKWD(*,*,*,INDEX,*,*,*,*); 80563100
WORDSTACK[INDEX,RETURNCONTROLWORDPLACE]~ 80563200
RUNRETURNCONTROLWORD; 80563300
IF COREFACTOR THEN GO AGAIN; 80564000
80565000
FINI: 80566000
EXIT; 80566100
80566200
END SELECTION; 80567000
SAVE PROCEDURE TERMINATE (PARAMETER); 80600000
REAL PARAMETER 80601000
; 80602000
COMMENT ALL PROGRAMS AND INDEPENDENT RUNNERS EXIT OR RETURN TO RUN 80603000
WHERE THEIR STACKS ARE LINKED INTO THE TERMINATEQ. RUN THEN 80604000
FORKS TO TERMINATE AND GOES INTO HOLD 80605000
TERMINATE RETURNS STACK SPACE AND STACK NUMBERS. DEDICATED 80606000
STACKS ARE RECOGNISED AND THE BIT ARRAY "IRSTACKS" IS MODIFIED 80607000
AS REQUIRED.FOR INDEPENDENT RUNNERS THE ARRAY "STACKINUSE" IS 80608000
MODIFIED WHEN NECESSARY. 80609000
NOTE THAT RUN ATTEMPTS TO TERMINATE TERMINATE BY FORKING 80610000
TO TERMINATE. HOWEVER INDEPENDENTRUNNER RECOGNISES THIS 80611000
INFINITELY RECURSIVE SITUATION AND TAKES SPECIAL ACTION 80612000
NOTE *** MARCH 20. EVENTUALLY WE WILL HAVE TO FORGET SPACE FOR80612100
THINGS LIKE AIT AND OAT DESCRIPTORS IN D2 STACKS AND 80612200
FILE HEADERS AND NAME DESCRIPTORS IN D1 STACKS 80612300
NOTE *** MARCH 20 .WHEN FORGETTING SPACE,NO ALLOWANCE IS MADE 80612400
FOR ABSENT DESCRIPTORS 80612500
; 80613000
BEGIN 80614000
LABEL AGAIN 80615000
, FINI 80616000
; 80617000
ARRAY FINISHEDSTACK [*] 80618000
; 80619000
WORD ARRAY FINISHEDWORDSTACK = FINISHEDSTACK[*] 80619200
, D1STACK = FINISHEDSTACK[*] 80619300
; 80619400
REAL STACKNO 80620000
, TEMPORARY 80620200
,COUNT 80620400
; 80621000
WORD WORDTEMPORARY 80621100
; 80621200
BOOLEAN DEDICATEDSTACK 80622000
, IRFINISH 80622100
; 80623000
DEFINE INSERTINLOGQ(X) = FORGETSPACE (FINISHEDSTACK 80624000
.ADDRESSF) # 80625000
, MAKEENTRYINLOG(X) = ; # 80626000
; 80627000
INTEGER TR; % *** FOR MONITOR ONLY 80627100
MONITOR JACKMONITOR(TR); % *** FOR MONITOR ONLY 80627200
TR~TR; % *** FOR MONITOR ONLY 80627300
AGAIN: BUZZCONTROL(IRPARAMETERLOK[TERMINATEINDICATOR]); 80628000
IF EMPTY(TERMINATEQ) 80629000
THEN BEGIN %%%MCS000050080629100
UNLOCK(IRPARAMETERLOK[TERMINATEINDICATOR]); 80629200
GO FINI; 80629300
END ; %%%MCS000050080629400
FINISHEDSTACK~ STACKVECTOR[STACKNO~NEXTINTERMINATEQ]; 80630000
REMOVE(TERMINATEQ ,STACKNO); 80631000
REPEAT: IF FINISHEDWORDSTACK[FIRSTPLACE].TAG!TOS THEN GO REPEAT;% *** 80631200
UNLOCK(IRPARAMETERLOK[TERMINATEINDICATOR]); 80631400
IF(IRFINISH~((TEMPORARY~FINISHEDSTACK[PROCESSNATUREPLACE]). 80632000
PROCESSHISTORYF=INDEPENDENT OR BOOLEAN(TEMPORARY. 80633000
INITIATESTACKF))) 80634000
THEN BEGIN %%%MCS000100080636000
COMMENT WE ARE TERMINATING AN INDEPENDENT RUNNER; 80637000
COMMENT *** MAYBE SOME OF THIS CODE SHOULD BE IN RUN.MARCH 1969; 80637100
BUZZCONTROL(INDEPENDENTRUNNERLOK); 80638000
IF NOT BOOLEAN(TEMPORARY.INITIATESTACKF) THEN 80638100
IF(TEMPORARY~TEMPORARY.PROCESSCLASSF)} 80639000
ONEONLYINDEX THEN STACKINUSE[TEMPORARY]~0; 80640000
IF (DEDICATEDSTACK~BOOLEAN(FINISHEDWORDSTACK[ 80641000
LINKPLACE].DEDICATEDSTACKF))80642000
THEN IRSTACKS~RESET(IRSTACKS, 80643000
STACKNO); 80644000
UNLOCK(INDEPENDENTRUNNERLOK); 80645000
END ; %%%MCS000100080646000
IF NOT DEDICATEDSTACK 80647000
THEN BEGIN %%%MCS000200080648000
BUZZCONTROL(VECTORLOK [REDY]); 80649000
INSERTINLOGQ(FINISHEDSTACK); 80650000
STACKVECTOR[STACKNO].FULLWORD ~ 0; 80651000
IF NOT IRFINISH 80651010
THEN BEGIN %%%MCS000220080651020
BUZZCONTROL(PROCESSCHANGELOCK); 80651100
D1STACK~STACKVECTOR 80651150
[STACKNO~FINISHEDSTACK 80651200
[PROCESSFAMILYLINKPLACE].FATHERF]; 80651250
IF(TEMPORARY~D1STACK[USERCOUNTNLINKAGEPLACE] 80651300
.ACTIVEUSERSF-1)=0 80651350
THEN 80651400
BEGIN %%%MCS000250080651450
COMMENT WE HAVE TO GET RID OF AD1 STACK; 80651500
FOR COUNT~D1RCWPLACE+1 STEP 1 UNTIL 80651550
D1STACK.LENGTHF-1 DO 80651600
BEGIN %%%MCS002800080651610
WORDTEMPORARY~D1STACK[COUNT]; 80651620
IF WORDTEMPORARY.TAG 80651650
=SEGDESC OR WORDTEMPORARY 80651700
.TAG=DATADESC80651720
THEN FORGETSPACE(WORDTEMPORARY 80651740
.ADDRESSF); 80651760
END ; %%%MCS002800080651765
COMMENT *** MAYBE WE SHOULD USE MASKED SEARCH FOR EQUAL; 80651770
FORGETSPACE(D1STACK.ADDRESSF); 80651775
STACKVECTOR[STACKNO].FULLWORD~0; 80651780
END %%%MCS000250080651800
ELSE D1STACK[USERCOUNTNLINKAGEPLACE]. 80651820
ACTIVEUSERSF~TEMPORARY;80651840
UNLOCK(PROCESSCHANGELOCK); 80651860
END; %%%MCS000220080651880
COMMENT *** 9 MAY INDEXING DOUBLE DOES NOT WORK ON MACHINE 80651990
CAUSE(HOLEINVECTOR[REDY]); 80652000
COMMENT *** INDEXING DOUBLE DOES NOT WORK ON MACHINE 80652010
RESET(HOLEINVECTOR[REDY]); 80652100
UNLOCK (VECTORLOK[REDY]); 80653000
END %%%MCS000200080654000
ELSE MAKEENTRYINLOG(STACKNO); 80655000
GO AGAIN ; 80656000
FINI: 80656500
EXIT; 80656600
END TERMINATE; 80657000
REAL PROCEDURE FINDINPUT(LEB,CODE); VALUE CODE; INTEGER CODE; 81000000
ARRAY LEB[*]; 81001000
BEGIN 81002000
REAL 81003000
STKNO, % STACK NO 81004000
U, % UNIT NO OR FILE HEADER INDEX 81005000
I, % INDEX 81006000
UTYPE, % UNIT TYPE 81007000
UTYPECODE, % QUALIFERS FOR UNIT TYPE 81008000
FILEGENNO, % FILE GENERATION NUMBER 81009000
FILEVERNO, % FILE VERSION NO 81010000
COUNT, % NO OF UNITS FOUND WITH MATCHING FILE81011000
BITNOPOS, % FOR SPECIFYING BIT NO POSITION 81012000
UTYPEMAXUNIT, % MAX UNIT NO FOR A GIVEN UNIT TYPE 81013000
MULTITYPECOUNTER, % COUNT FOR SIMILAR UNIT TYPE 81014000
UTYPESEQ, % THE SEQUENCE OF UNIT TYPES TO BE 81015000
% SEARCHED 81016000
UTABLEENTRY, % UNIT TABLE ENTRY 81017000
FILELEBZERO, % LEB[0] 81018000
FILELEBONE, % LEB[1] 81019000
UFILELEBZERO, % UINFOP[U,0] 81020000
FILENAME, % FIRST 5 CHRS OF FILENAMEPOINTER 81021000
UFILENAME, % FIRST 5 CHRS OF UFILENAMEPOINTER 81022000
FILECHRS, % NO OF CHRS IN FILE NAME STRING 81023000
UFILECHRS, % NO OF CHRS IN UNIT FILE NAME STRING 81024000
T1, % USED FOR SCRATCH 81025000
T2=FILELEBONE, % USED FOR SCRATCH 81026000
USAVE, % SAVED UNIT NO OF LATEST VERSION IF 81027000
% MATCH IS FOUND FOR FILE NAMES 81028000
UFILEGENNO, % LATEST GEN NO OF USAVE 81029000
UFILEVERNO; % LATEST VER NO OF USAVE 81030000
LAYOUT UTYPESEQL(47:6,41:6,35:6,29:6,23:6,17:6,11:6,5:6); 81032000
BOOLEAN ANYTYPETOG, % ANY UNIT TYPE 81033000
MULTIFILETOG, % IF ON ,SEARCH FOR MULTI FILE TAPES 81034000
SEARCHTOG; % ON IF SEARCH IS SUCCESSFUL 81035000
EVENT MYEVENT, 81035500
SOFTWARETIMEREVENT; 81036000
WORD ARRAY DUPFILEUNITS[*]; % TABLE CONTAINING SET BIT 81037000
% POSITION FOR UNIT HAVING FILE 81038000
FIELD UTYPEF=BITNOPOS:6; 81039000
LABEL 81040000
SPINDONOTHINGPROCESS, 81041000
NOFILE,FILEFOUND,START,TRYAGAIN,QUIT; 81042000
POINTER FILENAMEPOINTER, % POINTS TO FIRST CHR OF FILE 81043000
% NAME STRING IN LEB 81044000
UFILENAMEPOINTER; % POINTS TO FIRST CHR OF FILE 81045000
% NAME STRING IN UINFO 81046000
BOOLEAN PROCEDURE SEARCH; 81047000
COMMENT SEARCHES FILE ON A GIVEN UNIT TYPE(IF SPECIFIED) 81048000
OR SEARCHES ALL POSSIBLE UNIT TYPES; 81049000
BEGIN 81050000
LABEL STARTUTYPESEQAGAIN,FINDAGAIN,SIMILARTYPE,ENDOFLOOP, 81051000
QUITSEARCH,SINGLENAMEMATCH,SKIPDO, 81051500
UPDATECOUNT; 81052000
STARTUTYPESEQAGAIN: 81053000
IF UTYPESEQ!0 THEN 81054000
BEGIN % UNIT TYPE NOT SPECIFIED 81055000
BITNOPOS ~53; 81056000
ANYTYPETOG ~ TRUE; 81057000
FINDAGAIN: 81058000
BITNOPOS ~ * -6; 81059000
IF (UTYPE ~ UTYPESEQ.UTYPEF) =0 THEN 81060000
GO ENDOFLOOP; 81061000
UTYPECODE~UTYPE; 81062000
END; 81063000
IF UTYPE=DISKFILE THEN 81064000
BEGIN % DISK FILE 81065000
IF FILENAME.BYTE2F=1 THEN USAVE~-1 ELSE 81066000
USAVE~DIRECTORYSEARCH(FILENAMEPOINTER,LEBONE & 81068000
GENEALOGY1(,,,CODE),FALSE); 81069000
IF USAVE>0 THEN 81070000
BEGIN 81071000
T1~USAVE; 81071400
IF CODE=SEARCHONLY THEN GO QUIT; 81071700
COUNT~* + 1; 81072000
USAVE.REPINFOF~MCPDISKUNITNO; 81073000
END ELSE 81074000
IF USAVE.DCODE3=FILEWITHWRONGGENEALOGY THEN 81074200
BEGIN 81074400
UFILEGENNO~USAVE.DCODE1; 81074600
UFILEVERNO~USAVE.DCODE2; 81074800
END; 81074900
IF ANYTYPETOG THEN 81075000
IF USAVE>0 THEN 81076000
PUTINBITSTABLE(DUPFILEUNITS,MCPDISKUNITNO) 81077000
ELSE GO FINDAGAIN ELSE GO QUITSEARCH; 81078000
END; 81081000
IF MAGTAPE(UTYPE) THEN 81082000
IF UTYPE=MAGTAPE2 THEN MULTITYPECOUNTER ~ 4 81083000
ELSE MULTITYPECOUNTER ~ 2 ; 81084000
COMMENT NOW FIND MAXIMUM UNIT NO FOR A GIVEN UNIT TYPE; 81085000
SIMILARTYPE: 81086000
UTYPEMAXUNIT ~UNITBL(TI(UTYPE + 1) -1, 1); 81089000
IF UNIT[UNITBL((I~TI(UTYPE)),1)].UNITTYPE!UTYPE THEN 81090000
GO SKIPDO ELSE I~*-1; 81090500
DO 81091000
BEGIN 81092000
U ~ UNITBL( (I~I+1),1); 81093000
IF (NOT BOOLEAN((UTABLEENTRY~UNIT[U]).USAVED) 81094000
AND BOOLEAN(UTABLEENTRY.ULABELLED)) THEN 81095000
BEGIN % MATCH FILE NAME WITH ONES ON EACH U 81096000
UFILELEBZERO ~ LCNTRL; % UINFOP[U,0] 81097000
UFILENAMEPOINTER ~POINTER(UINFOP[U, 81098000
(UFILELEBZERO.FXD + ONES( 81099000
UFILELEBZERO.OPTMASK))],8)+1; 81100000
UFILENAME ~REAL(UFILENAMEPOINTER,5); 81101000
UFILECHRS ~ UFILENAME.BYTE3F+2; 81102000
IF NOT (BOOLEAN(UTABLEENTRY.UNITASSIGNED) 81103000
AND MULTIFILETOG) THEN 81104000
BEGIN % SINGLE FILE ON UNIT 81105000
IF FILENAME.BYTE2F=1 THEN 81105200
IF FILECHRS=UFILECHRS THEN 81105400
IF FILENAMEPOINTER=UFILENAMEPOINTER FOR 81105600
FILECHRS THEN GO SINGLENAMEMATCH; 81105800
IF FILENAME IS UFILENAME THEN 81106000
IF FILECHRS=UFILECHRS THEN 81107000
IF (FILECHRS~FILECHRS + REAL( 81108000
FILENAMEPOINTER+FILECHRS,1)+1)= 81109000
(UFILECHRS~UFILECHRS + REAL( 81110000
UFILENAMEPOINTER+UFILECHRS,1)+1) THEN 81111000
IF FILENAMEPOINTER=UFILENAMEPOINTER FOR 81112000
FILECHRS THEN 81113000
BEGIN % FILE NAMES MATCH 81114000
SINGLENAMEMATCH: 81114500
T1 ~(T2 ~LGEN1).CYCLE; 81115000
T2 ~ T2.GENVERSN; 81116000
IF FILEGENNO=0 OR FILEGENNO=T1 THEN 81117000
IF FILEVERNO=0 OR FILEVERNO=T2 THEN 81118000
BEGIN % PERFECT MATCH 81119000
UPDATECOUNT: 81120000
IF COUNT=0 THEN USAVE.REPINFOF~U;81120300
IF CODE=SEARCHONLY THEN GO QUIT; 81120700
COUNT ~ * +1; 81121000
PUTINBITSTABLE(DUPFILEUNITS,U); 81122000
END ELSE 81123000
IF T1>UFILEGENNO THEN 81124000
BEGIN % LATEST GENERATION 81125000
USAVE ~U; 81126000
UFILEGENNO ~T1; 81127000
UFILEVERNO ~T2; 81128000
END ELSE 81129000
IF T1=UFILEGENNO AND 81130000
T2>UFILEVERNO THEN 81131000
BEGIN % LATEST VERSION OF A GEN 81132000
USAVE ~U; 81133000
UFILEVERNO ~T2; 81134000
END; 81135000
END; 81136000
END ELSE 81136500
IF MULTIFILETOG AND MAGTAPE(UTYPE) THEN 81137000
BEGIN % CHECK MULTIPLE FILES ON TAPE 81138000
IF FILENAME.BYTE2F}2 THEN 81139000
FILECHRS~FILENAME.BYTE3F; 81140000
IF (FILENAMEPOINTER + 2) = 81141000
(UFILENAMEPOINTER +2) FOR FILECHRS 81142000
THEN GO UPDATECOUNT; 81143000
END; 81144000
END; 81145000
END UNTIL U=UTYPEMAXUNIT; 81146000
SKIPDO: 81147000
IF COUNT=0 THEN GO ENDOFLOOP; %KLUDGE FOR STEEVE 81147500
IF MULTITYPECOUNTER>1 THEN 81148000
BEGIN 81149000
MULTITYPECOUNTER ~ * - 1; 81150000
IF (MULTITYPECOUNTER MOD 2)=0 THEN 81151000
UTYPE~UTYPECODE+1+REAL(MULTITYPECOUNTER>2) ELSE 81152000
UTYPE~UTYPECODE + 16+REAL(MULTITYPECOUNTER>2);81153000
GO SIMILARTYPE; 81154000
END ELSE 81155000
IF ANYTYPETOG THEN GO FINDAGAIN; 81156000
ENDOFLOOP: 81157000
UTYPE ~UTYPECODE; 81158000
IF COUNT=0 AND (ANYTYPETOG OR MAGTAPE(UTYPE)) 81159000
AND NOT MULTIFILETOG THEN 81160000
BEGIN % CHECK FOR MULTI FILE REEL 81161000
MULTIFILETOG ~TRUE; 81162000
GO STARTUTYPESEQAGAIN; 81163000
END; 81164000
IF COUNT=1 THEN U~(T1~USAVE).REPINFOF; 81165000
QUITSEARCH: 81165500
SEARCH ~SEARCHTOG ~(COUNT>0); 81166000
END SEARCH; 81167000
BOOLEAN PROCEDURE RESEARCH; 81168000
COMMENT CALLS SEARCH AND RETURNS TRUE VALUE IF SEARCH IS 81169000
SUCCESSFUL. IT RESETS DUPFILEUNITS TABLE; 81170000
BEGIN 81171000
SEARCH; 81172000
REPLACE POINTER(DUPFILEUNITS) BY 0 81173000
FOR UBITSTABLESIZE OVERWRITE; 81174000
COUNT ~ 0; 81175000
RESEARCH ~ SEARCHTOG; 81176000
END RESEARCH; 81177000
INTERRUPT I1: ON SOFTWARETIMEREVENT, 81178000
IF RESEARCH THEN 81179000
BEGIN 81180000
DISABLE (I1); 81181000
GO FILEFOUND; 81182000
END ELSE 81183000
GO TRYAGAIN; 81184000
INTERRUPT I2: ON MYEVENT, 81186000
BEGIN 81187000
DISABLE(I1,I2); 81188000
IF (T2~(T1~REPLY[STKNO]).REPVALF)=DSV THEN 81189000
IF STACK[STKNO,PROCESSIDPLACE]="LIBMAIN" 81190000
THEN 81191000
BEGIN 81192000
T1.SIGNBITF~1; 81193000
GO QUIT; 81194000
END ELSE GO SPINDONOTHINGPROCESS;81195000
RESET(MYEVENT); 81195300
REPLY[STKNO]~0; 81195500
IF T2=OKV THEN GO START; 81195700
END; 81196000
T1~UBITSTABLESIZE + 1; 81197000
DUPFILEUNITS ~DUPFILEUNITS & ARRAYDESCL(,GETAREA(T1)); 81198000
FILELEBZERO~LEBZERO; 81199000
FILELEBONE~LEBONE; 81200000
FILEGENNO~ FILELEBONE.CYCLE; 81201000
FILEVERNO~FILELEBONE.GENVERSN; 81202000
FILENAMEPOINTER~POINTER(LEB[FILELEBZERO.FXD + 81203000
ONES(FILELEBZERO.OPTMASK)],8) +1;81204000
DUPFILEUNITS[UBITSTABLESIZE]~FILENAMEPOINTER-1;% 81204500
FILENAME~REAL(FILENAMEPOINTER,5); % 5 IS USED TO SAVE MEM ACC 81205000
FILECHRS~FILENAME.BYTE3F+2; 81206000
STKNO~SNR; 81207000
STOREITEM(REPLYEVENT @ REFERENCE(STACKVECTOR[STKNO]),MYEVENT); 81207500
UTYPECODE~FILELEBZERO.PTYPEL; 81208000
IF (UTYPE~UTYPECODE.PTYPEF)=0 THEN 81209000
IF (UTYPECODE~UTYPECODE.PTYPECODEF)=3 THEN 81210000
UTYPESEQ~0 & UTYPESEQL(MAGTAPE1,MAGTAPE2) ELSE 81211000
IF UTYPECODE=0 THEN 81212000
UTYPESEQ~0 & UTYPESEQL(DISKFILE,MAGTAPE1,MAGTAPE2, 81213000
CARDREADER) ELSE 81214000
UTYPESEQ~0 & UTYPESEQL(MAGTAPE1,MAGTAPE2, 81215000
CARDREADER) ELSE 81216000
UTYPECODE~UTYPE; % SAVES ORIGINAL UNIT TYPE 81217000
START: 81218000
IF NOT SEARCH THEN 81219000
IF UFILEGENNO=0 THEN 81219500
BEGIN 81220000
COMMENT FILEMESS("#NO FIL" FIB); 81221000
REPLY[STKNO]~ILREP + ULREP + DSREP + OKREP 81222000
+FRREP | REAL(FILELEBZERO.LABELTYPEL=1) 81223000
+ OFREP | REAL(BOOLEAN(FILELEBZERO.OPTIONALF)); 81224000
MESSER(0,DUPFILEUNITS); 81225000
ENABLE(I1,I2); 81226000
TRYAGAIN: 81229000
COMMENT 81230000
SLEEP(SEC1 ,SOFTWARETIMEREVENT); 81231000
ENABLE(I1); 81232000
HOLD; 81233000
FILEFOUND: 81234000
IF SEARCHTOG THEN SEARCHTOG~SEARCH ELSE 81235000
IF T2=ILV OR T2=ULV THEN U~T1.REPINFOF; 81236000
END ELSE 81237000
BEGIN % GENEALOGY DONOT MATCH 81237200
REPLY[STKNO]~DSREP + OKREP + USREP; 81237400
DUPFILEUNITS[0]~0 & GENEALOGY1(UFILEGENNO,UFILEVERNO,,); 81238000
MESSER(1,DUPFILEUNITS); 81238300
ENABLE(I2); 81238700
HOLD; 81238800
IF T2=USV THEN 81239000
BEGIN 81239500
T1~DUPFILEUNITS[0]; 81240000
IF T1.CYCLE!UFILEGENNO THEN UFILEGENNO~T1.CYCLE ELSE 81240500
IF T1.GENVERSN!UFILEVERNO THEN UFILEVERNO~T1.GENVERSN; 81241000
FILELEBONE~LEBONE & GENEALOGY1(UFILEGENNO,UFILEVERNO,,); 81241500
FILEGENNO~UFILEGENNO; 81241550
FILEVERNO~UFILEVERNO; 81242000
UFILEGENNO~UFILEVERNO~0; 81243000
GO START; 81244000
END; 81245000
END; 81246000
IF COUNT>1 THEN 81247000
BEGIN % DUP FILE 81248000
REPLY[STKNO]~DSREP + OKREP +ILREP; 81249000
MESSER(2,DUPFILEUNITS); 81250000
ENABLE(I2); 81251000
HOLD; 81252000
IF T2=ILV THEN 81253000
BEGIN 81254000
U~T1.REPINFOF; 81255000
IF UNIT[U].UNITTYPE=DISKFILE THEN T1~USAVE; 81256000
END; 81263000
END; % END OF DUP FILE 81264000
UNIT[U].UNITASSIGNED~1; 81265000
QUIT: 81266000
SPINDONOTHINGPROCESS: 81267000
FINDINPUT~T1; 81268000
END FINDINPUT; 81269000
REAL PROCEDURE FINDOUTPUT(LEB,CODE); VALUE CODE; INTEGER CODE; 81270000
ARRAY LEB[*]; 81271000
BEGIN 81272000
REAL 81273000
STKNO, % STACK NO 81274000
I, 81275000
UTYPEMAXUNIT, 81276000
SAVETYPE, 81277000
U, 81278000
UTABLEENTRY, 81279000
UTYPE, 81280000
UTYPECODE, 81281000
MULTITYPECOUNTER, 81282000
FILECHRS, 81283000
FILENAME, 81284000
UFILENAME, 81285000
FILELEBZERO, % LEB[0] 81286000
UFILELEBZERO, 81287000
T; 81288000
EVENT MYEVENT, % LOCAL EVENT 81289000
SOFTWARETIMEREVENT; 81290000
DEFINE TYFILE =0 #, 81291000
TYBDFILE=1#, 81292000
TYBTFILE=2#, 81293000
TYBDBTFILE=3#, 81294000
BDFILE=4 #, 81295000
BTFILE=5 #, 81296000
BDBTFILE=6 #; 81297000
BOOLEAN BTOPTIONTOG, 81298000
UTYPETOG, 81299000
MAGTAPETOG, 81300000
BACKUPTOG, 81301000
BTTOG; 81302000
POINTER FILENAMEPOINTER, 81303000
UFILENAMEPOINTER; 81304000
LABEL START,TRYAGAIN,UNITFOUND,PROCEND, 81305000
SPINDONOTHINGPROCESS, 81306000
CLAIMMT,CHECKFORMS; 81307000
BOOLEAN PROCEDURE SEARCHUTYPE(TYPE,OPCODE); 81308000
VALUE TYPE,OPCODE; 81309000
REAL TYPE,OPCODE; 81310000
BEGIN 81311000
LABEL SIMILARTYPE,SKIPDO,QUIT; 81312000
IF MAGTAPE(TYPE) THEN 81313000
BEGIN 81314000
SAVETYPE~TYPE; 81315000
MAGTAPETOG~TRUE; 81316000
IF TYPE=MAGTAPE2 THEN MULTITYPECOUNTER ~4 81317000
ELSE MULTITYPECOUNTER~ 2; 81318000
END; 81319000
IF OPCODE=1 THEN 81320000
BEGIN % MAKE UP NAME POINTER FOR A GIVEN TYPE BACK-UP 81321000
FILENAME ~REAL(FILENAMEPOINTER,5); 81322000
FILECHRS ~ FILENAME.BYTE3F +2; 81323000
BTOPTIONTOG ~ TRUE; 81324000
END; 81325000
SIMILARTYPE: 81326000
UTYPEMAXUNIT ~UNITBL(TI(TYPE +1) -1,1); 81327000
IF UNIT[UNITBL((I~ TI( TYPE)),1)].UNITTYPE! TYPE THEN 81328000
GO SKIPDO ELSE I ~ * - 1; 81329000
DO 81330000
BEGIN 81331000
U~UNITBL((I ~I+1),1); 81332000
IF NOT BOOLEAN((UTABLEENTRY ~ UNIT[U]).USAVED) THEN 81333000
IF NOT MAGTAPETOG THEN 81334000
IF NOT BOOLEAN(UTABLEENTRY.UNITASSIGNED) THEN 81335000
UTYPETOG ~ TRUE ELSE 81336000
ELSE 81337000
IF BOOLEAN(UTABLEENTRY.UWRITERING) THEN 81338000
IF BTOPTIONTOG THEN 81339000
BEGIN 81340000
IF NOT(BOOLEAN(UTABLEENTRY.ULABELLED) AND 81341000
BOOLEAN(UTABLEENTRY.UNITASSIGNED)) THEN 81342000
BEGIN % CHECK FOR MULTIPLE BACK-UP FILES 81343000
UFILELEBZERO ~LCNTRL; % UINFOP[U,0] 81344000
UFILENAMEPOINTER ~POINTER(UINFOP[U, 81345000
(UFILELEBZERO.FXD + ONES( 81346000
UFILELEBZERO.OPTMASK))],8) + 1; 81347000
UFILENAME ~REAL(UFILENAMEPOINTER,5); 81348000
IF FILENAME=UFILENAME THEN 81349000
IF (FILENAMEPOINTER +2) = 81350000
(UFILENAMEPOINTER+2) FOR FILECHRS THEN 81351000
BEGIN 81352000
% BACK-UP TAPE MATCH FOR A GIVEN TYPE 81353000
END; 81354000
END; 81355000
END ELSE 81356000
IF NOT BOOLEAN(UTABLEENTRY.USCRATCH) THEN 81357000
UTYPETOG ~TRUE; 81358000
END UNTIL U=UTYPEMAXUNIT OR UTYPETOG; 81359000
SKIPDO: 81360000
IF NOT UTYPETOG AND MULTITYPECOUNTER > 1 THEN 81361000
BEGIN 81362000
MULTITYPECOUNTER ~ * -1; 81363000
IF (MULTITYPECOUNTER MOD 2) = 0 THEN 81364000
TYPE ~SAVETYPE+1+REAL(MULTITYPECOUNTER>2) ELSE 81365000
TYPE ~SAVETYPE +16+REAL(MULTITYPECOUNTER>2); 81366000
GO SIMILARTYPE; 81367000
END; 81368000
IF NOT UTYPETOG AND BTOPTIONTOG THEN 81369000
BEGIN % GO BACK TO FIND A SCRATCH UNIT 81370000
TYPE ~ SAVETYPE; 81371000
BTOPTIONTOG ~FALSE; 81372000
GO SIMILARTYPE; 81373000
END; 81374000
IF UTYPETOG THEN 81375000
BEGIN 81376000
T.REPINFOF ~U; 81377000
IF OPCODE !0 THEN 81378000
BEGIN 81379000
UTYPETOG ~FALSE; 81380000
BTTOG ~TRUE; 81381000
END; 81382000
OPCODE ~NABS(OPCODE) 81383000
END; 81384000
QUIT: 81385000
SEARCHUTYPE ~BOOLEAN(OPCODE.SIGNBITF); 81386000
END SEARCHUTYPE; 81387000
INTERRUPT I1: ON SOFTWARETIMEREVENT, 81388000
BEGIN 81389000
DISABLE(I1); 81390000
IF UTYPECODE{TYBDBTFILE THEN 81391000
IF SEARCHUTYPE(UTYPE,0)THEN GO UNITFOUND; 81392000
IF BACKUPTOG THEN 81393000
IF SEARCHUTYPE(MAGTAPE1,1) THEN 81394000
GO UNITFOUND ELSE GO TRYAGAIN; 81395000
END; 81396000
INTERRUPT I2: ON MYEVENT, 81397000
BEGIN 81398000
DISABLE(I1,I2); 81399000
IF (I~REPLY[STKNO]).REPVALF=DSV THEN 81400000
IF STACK[STKNO,PROCESSIDPLACE]="LIBMAIN" 81401000
THEN 81402000
BEGIN 81403000
T.SIGNBITF~1; 81404000
GO PROCEND; 81405000
END ELSE GO SPINDONOTHINGPROCESS; 81406000
RESET(MYEVENT); 81407000
REPLY[STKNO]~0; 81408000
UTYPE ~(UTYPECODE ~T.REPINFOF).PTYPEF; 81409000
UTYPECODE ~UTYPECODE.PTYPECODEF; 81410000
END; 81411000
FILELEBZERO ~ LEBZERO; 81412000
STKNO ~ SNR; 81413000
UTYPECODE ~ FILELEBZERO.PTYPEL; 81414000
UTYPE ~ UTYPECODE.PTYPEF; 81415000
UTYPECODE ~ UTYPECODE.PTYPECODEF; 81416000
STOREITEM(REPLYEVENT @ REFERENCE(STACKVECTOR[STKNO]),MYEVENT); 81417000
START: 81418000
IF UTYPE!0 THEN 81419000
BEGIN 81420000
IF UTYPE>DISKFILE THEN 81421000
BEGIN % DISK FILE 81422000
END ELSE 81423000
IF UTYPECODE { TYBDBTFILE THEN 81424000
BEGIN % ONE OF THE OPTIONS IS AN ACTUAL UNIT TYPE 81425000
IF SEARCHUTYPE(UTYPE,0) THEN 81426000
IF UTYPE=BUFFPRINTER THEN GO CHECKFORMS 81427000
ELSE 81428000
IF MAGTAPE(UTYPE) THEN GO CLAIMMT; 81429000
END ELSE 81430000
IF UTYPECODE=TYBTFILE OR UTYPECODE=TYBDBTFILE OR 81431000
UTYPECODE=BTFILE OR UTYPECODE=BDBTFILE THEN 81432000
BEGIN % BACK-UP TAPE IS ONE OF THE OPTIONS 81433000
BACKUPTOG~TRUE; 81434000
IF SEARCHUTYPE(UTYPE,1) THEN 81435000
IF NOT BOOLEAN(UTABLEENTRY.USCRATCH) THEN 81436000
CLAIMMT: 81437000
BEGIN 81438000
% CLAIM UNIT AND WRITE LABEL 81439000
% GIVE MESSAGE "NEW PBT ON" 81440000
GO PROCEND; 81441000
END; 81442000
END; 81443000
IF UTYPECODE=TYBDFILE OR UTYPECODE=TYBDBTFILE OR 81444000
UTYPECODE=BDFILE OR UTYPECODE=BDBTFILE THEN 81445000
BEGIN % BACK-UP DISK IS ONE OF THE OPTIONS 81446000
% GET NEXT FILE FOR BACK-UP DISK 81447000
% BUILD A DISK HEADER 81448000
END; 81449000
IF NOT(UTYPETOG OR BTTOG) THEN 81450000
BEGIN % FILE REQUIRED MESSAGE 81451000
REPLY[STKNO] ~ DSREP + OUREP; 81452000
ENABLE(I2); 81453000
TRYAGAIN: 81454000
% TIMER SLEEP MECHANISM 81455000
ENABLE(I1); 81456000
HOLD; 81457000
UNITFOUND: 81458000
IF NOT(UTYPETOG OR BTTOG) THEN GO START; 81459000
IF BTTOG AND NOT BOOLEAN(UTABLEENTRY.USCRATCH) THEN 81460000
GO CLAIMMT; 81461000
CHECKFORMS: 81462000
% IF PRINTER CHECK FORMS HERE 81463000
END; 81464000
END ELSE 81465000
IF UTYPECODE=2 THEN 81466000
BEGIN % DESIGNATED FILE 81467000
END ELSE T.SIGNBITF ~ 1; 81468000
SPINDONOTHINGPROCESS: 81469000
PROCEND: 81470000
FINDOUTPUT ~T; 81471000
END FINDOUTPUT; 81472000
SAVE WORD PROCEDURE MON1TOR(A,V); VALUE A,V; REAL A; WORD V; 99000000
BEGIN 99003000
LAYOUT FIRSTCHR(47:6), SIGNATURE(46:1); 99004000
OWN PICTURE FILL(6P M*E(3)R9); 99004100
POINTER MPTR, FPTR; 99005000
REAL C, FREG, BOS; 99006000
WORD RCWD; 99006800
IF LOCK(MONITORLOCK) THEN STOP; 99007000
REPLACE MPTR ~ POINTER(MONITER[2],6) BY 6" " FOR 14 WORDS; 99008000
MONITER[1] ~ A & FIRSTCHR(6" "); 99009000
REPLACE MPTR:MPTR BY 6" ", V.TAG FOR 1 CORRECTLY, 6" "; 99010000
MONITER[0] := TAGZOT(V); 99011000
REPLACE MPTR:MPTR BY POINTER(MONITER,4) FOR 12 WITH HEXTOBCL,6" ";99012000
FREG ~ F; 99013000
BOS ~ BOSR + 2; 99014000
C ~ 7; 99015000
WHILE C ~ * - 1 } 0 AND FREG ~ * - M[FREG].DFF > BOS DO 99016000
IF BOOLEAN(M[FREG]).EBITF THEN 99016100
BEGIN 99016200
REPLACE MPTR:FPTR:=MPTR BY (RCWD:=M[FREG+1]).REALSDIF FOR 5 99017000
DIGITS, 6":", RCWD.PIRF FOR 4 DIGITS, 6" "; 99018000
XSIGN(0 & SIGNATURE(RCWD.D0D1SEGBIT)); 99018100
REPLACE FPTR BY FPTR+1 WITH FILL; 99018150
END; 99018200
MONITER[0] := DIAGNOSTICIOCW; 99019000
RESET(MONITORFINISH); 99020000
IOREQUEST(REFERENCE(DIAGNOSTICARRAY)); 99020100
WAIT(MONITORFINISH); 99020200
UNLOCK(MONITORLOCK); 99021000
RETURN(V); 99022000
END MONITOR; 99023000
DEFINE CHECKMASK (WHOSE) = 99054000
NOT BOOLEAN (MONITORLOCK) AND ((REAL(BOOLEAN(MONITORVALUE) AND 99055000
BOOLEAN (WHOSE) AND BOOLEAN (MONITORMASK))! 0) OR 99055500
BOOLEAN (MONITORVALUE)) 99056000
#; 99057000
SAVE 99057900
WORD PROCEDURE DONMONITOR(A, V); VALUE A, V; REAL A; WORD V; 99058000
DONMONITOR ~ IF CHECKMASK(DONBIT) THEN MON1TOR(A, V) ELSE V; 99059000
SAVE 99060000
WORD PROCEDURE JACKMONITOR (A, V); VALUE A, V; REAL A; WORD V; 99061000
JACKMONITOR ~ IF CHECKMASK(JACKBIT) THEN MON1TOR(A, V) ELSE V; 99062000
SAVE 99062900
WORD PROCEDURE RAJMONITOR (A, V); VALUE A, V; REAL A; WORD V; 99063000
RAJMONITOR ~ IF CHECKMASK( RAJBIT) THEN MON1TOR(A, V) ELSE V; 99064000
SAVE 99064900
WORD PROCEDURE BOBMONITOR (A, V); VALUE A, V; REAL A; WORD V; 99065000
BOBMONITOR ~ IF CHECKMASK( BOBBIT) THEN MON1TOR(A, V) ELSE V; 99066000
SAVE 99066900
WORD PROCEDURE STEVEMONITOR(A,V); VALUE A,V; REAL A; WORD V; 99067000
STEVEMONITOR ~ IF CHECKMASK(STEVEBIT) THEN MON1TOR(A,V) ELSE V;99068000
SAVE 99069000
WORD PROCEDURE MIKEMONITOR(A,V); VALUE A,V; REAL A; WORD V; 99070000
MIKEMONITOR~IF CHECKMASK(MIKEBIT) THEN MON1TOR(A,V) ELSE V; 99071000
SAVE PROCEDURE MEMDUMP(I,J); VALUE I,J; REAL I,J; %ZEROES OK 99100000
BEGIN 99101000
REAL 99102000
UNIT=(0,2), ADRS=(0,6), IOAD=(0,7); 99103000
ARRAY BFR = (0,5) [*]; 99104000
BOOLEAN MISSING = (0,8); 99105000
FIELD ADRF =19:20, SEVEN48 =7:8,SEVEN44 =7:4, RDUNITF =24:8,99106000
BIT46 =46: 1, FIVE46 =5:6,BIT20 =20:1, MOD32=4:5, 99107000
PSRF =35: 3, PIRF =32:13,SDIF =13:14, 99108000
FORTY7444=47:44, THREE44 =3:4, FORTY746 = 47:6, 99109000
ROT24 = 23:48, ROT42 = 5:48; 99110000
LAYOUT LOW14(13:14), INDXL (39:20), TAGL (TAG), 99111000
SIXTEEN48L(16:8), THIRTY1416(31:16),LL (18:5); 99112000
DEFINE DIDIT = BOOLEAN(UNIT.BIT46)#, 99113000
NT = TAGS.FIVE46#, B6T = TAGS.FORTY746#, 99114000
DONE = BOOLEAN(ADRS.BIT20)#, 99115000
ACTR = CTRS.FORTY7444#, 99116000
FCTR = CTRS.THREE44#, B=BFR#, 99117000
PATH(U)= SCANIN(0 & SIXTEEN48L(U ~ U.SEVEN48))#, 99118000
KIND(U)= SCANIN(192 & SIXTEEN48L(U))#, 99119000
TILT = STOP(4"93C838E049E4", 4"038038E491C0") #, 99120000
FIVE = 3#, 99121000
STATUS(I) = BOOLEAN(SCANIN(32 &(I)[11:7:FIVE])) #, 99122000
DUMMY = REAL#, 99123000
INITIATE = SCANOUT #; 99124000
SAVE PROCEDURE DUMPIT(U,IPCW,SD,BF); VALUE U,IPCW,SD,BF; 99125000
REAL U; 99126000
WORD IPCW,SD,BF; 99127000
BEGIN 99128000
REAL NEXT = (0,9), TAGS =(0,10), CTRS = (0,11),LAD=(0,12);99129000
POINTER P4 = (0,13), P6 = (0,14); 99130000
DUMMY ADR , ADESC ~ BFR.ADRF & INDXL(15), 99131000
MISSNG~-0, NEXXT, TGS, CNTRS, LASTADRS; 99132000
POINTER PTR4 ~ POINTER(BFR[16],4), 99133000
PTR6 ~ POINTER(BFR[1],6); 99134000
REAL SR := 2 + REGISTERS[52], SREG = (0,15); 99135000
WORD SVDESCR := M[NAME(BFR[1])], WUNIT = UNIT, SVDESC = (0,16);99135100
LABEL START, GETAWORD, PAST, ENDADRS, PRINT, FIRST, 99136000
LOOP, ADDRESS, MISS, AROUND; 99137000
COMMENT RECORD THE S-REGISTER FOR POSTERITY. CALLER HAS 99138000
PUT IT IN BFR[16], WHERE P4 POINTS; 99139000
REPLACE P6:P6 BY (6"*** S = ") FOR 1 OVERWRITE; 99140000
REPLACE P6 BY (6" ")FOR 14 OVERWRITE; 99141000
GO TO ADDRESS; 99142000
START: % START A LINE 99143000
IF MISSING.BIT46 THEN BEGIN MISSING~FALSE; GO PRINT END; 99144000
BFR[16] ~ ADRS; 99145000
AROUND: % CLEAR THE BUFFER, ETC. 99146000
REPLACE P6 ~ POINTER(BFR[1],6) BY 6" " FOR 15 WORDS; 99147000
CTRS ~ 0; 99148000
REPLACE P6:P6 BY P4 + 7 FOR 5 WITH BFR[17]; 99149000
GETAWORD: % GET ANOTHER WORD--IF IT IS THERE. 99150000
LAD ~ ADRS; 99151000
IF MISSING THEN GO TO MISS; 99152000
IF NOT MISSING ~ DONE THEN 99153000
BEGIN 99154000
NEXT ~ M[ADRS] & TAGL(0); REGISTERS[52] ~ SREG; 99155000
NT ~ M[ADRS].TAG; 99156000
END; 99157000
IF CTRS ~ CTRS + 16 } 32 THEN % ACTR ~ ACTR + 1 > 1 99158000
IF MISSING THEN GO PAST ELSE 99159000
BEGIN 99160000
IF B[16] IS NEXT THEN 99161000
IF B6T = NT THEN GO TO LOOP; 99162000
PAST: 99163000
IF CTRS } 111 THEN GO TO ENDADRS; % ACTR > 7 99164000
REPLACE P6:P6 BY P6-16 FOR CTRS - 33;%(ACTR-2)|16 99165000
CTRS ~ACTR; % FCTR ~ ACTR; ACTR ~ 0 99166000
IF MISSING THEN GO PRINT; 99167000
GO TO FIRST; 99168000
END; 99169000
IF CTRS = 16 THEN % FIRST WORD OF LINE 99170000
IF NOT MISSING THEN GO TO FIRST ELSE 99171000
BEGIN 99172000
LAD := ADRS; 99172100
MISS: MISSING ~ FALSE; 99173000
REPLACE P6 + 12 BY 6"MISSING." FOR 8; 99174000
ENDADRS: 99175000
B[16] ~ LAD - 1; 99176000
REPLACE P6:P6 BY 6" THRU .." FOR 6; 99177000
ADDRESS: 99178000
REPLACE P6 BY P4 + 7 FOR 5 WITH BFR[17]; 99179000
PRINT: 99180000
WHILE NOT BOOLEAN(TAGS ~ PATH(UNIT)) DO ALLOW; 99181000
DISALLOW; 99182000
INITIATE(IOAD,TAGS); DO PAUSE UNTIL DIDIT; 99183000
IF MISSING THEN BEGIN B[16] ~ LAD; GO AROUND END; 99184000
IF DONE THEN BEGIN WUNIT := SVDESC; EXIT END; 99185000
GO START; 99186000
END; 99187000
IF MISSING THEN GO PRINT; 99188000
CTRS ~ FCTR; % ACTR ~ 0 99189000
FIRST: 99190000
BFR[16] ~ NEXT; 99191000
REPLACE P6 + 1 BY TAGS ~ TAGS.ROT42 FOR 1; 99192000
REPLACE P6 + 3 BY P4 FOR 6 WITH B[17]; 99193000
REPLACE P6:P6+10 BY P4+6 FOR 6 WITH B[17]; 99194000
CTRS ~ CTRS + 1; 99195000
LOOP: ADRS ~ ADRS + 1; 99196000
IF FCTR { 7 THEN GO GETAWORD; 99197000
GO PRINT; 99198000
END DUMPIT; 99199000
SAVE PROCEDURE SPACEATER; % THIS BECOMES THE BUFFER:21 WORDS. 99200000
BEGIN DOUBLE I; I ~ 1@@20 * I * 13END; 99201000
SAVE PROCEDURE DUMPINT; % THE INTERRUPT PROCEDURE. 99202000
BEGIN 99203000
REAL P1=(1,2), P2=(1,3), PW=(0,10), S1~FIRSTONE(P1), 99204000
I =(1,4); WORD WP2 = P2; 99205000
LABEL STOPP, DID, INIT; 99206000
WORD RCW = (1,1); 99207000
LAYOUT PIRL(32:13), PSRL(PSRF); 99208000
FIELD NOTREADY = 3:1; 99209000
BOOLEAN RD = I; 99210000
IF I = 26 THEN % ALARUM 99211000
IF FIRSTONE(P1.ADRF) ! 4 THEN GO STOPP ELSE % INV ADDR 99212000
BEGIN 99213000
MISSING ~ TRUE; 99214000
WP2 ~ SET(SET(REGISTERS[38]-1,47),45) & TAGL(5); 99215000
P2 ~ ADRS ~ ADRS & LOW14(0) + 16384; 99216000
RCW ~ IF I ~ RCW.PSRF < 2 THEN 99217000
SET(RCW & PIRL(RCW.PIRF - 1), 35) ELSE 99218000
RCW & PSRL(I - 2); 99219000
END INV ADDR ELSE 99220000
IF I ! 23 THEN 99221000
IF I ! 21 THEN BEGIN STOPP: TILT; GO STOPP END ELSE 99222000
IF (I ~ SCANIN(P2 - 4"1A0")).RDUNITF = UNIT THEN 99223000
IF RD THEN 99224000
IF RD.NOTREADY THEN GO INIT ELSE 99225000
IF BOOLEAN (BFR[0] ~ M[IOAD].ROT24) THEN 99226000
INIT: INITIATE(IOAD, PW) ELSE 99227000
GO DID ELSE 99228000
DID: 99229000
UNIT ~ -UNIT; % DIDIT ~ TRUE 99230000
END; 99231000
WORD SPCW = SPACEATER, IPCW = DUMPINT, DPCW= DUMPIT, 99232000
SVDESC = (0,2), 99232100
SD ~ M[SPCW.SDIF& TAGL(1)], 99233000
STUFF ~ SET(SPCW.PIRF + 1 + SD.ADRF,47) & TAGL(5) 99234000
& INDXL(24); 99235000
WORD ARRAY A = STUFF [*]; 99236000
LABEL BACK; 99237000
BACK: 99238000
I ~(I + 1).SEVEN48; 99239000
IF SET(KIND(I),0) ! 7 THEN GO BACK; 99240000
IF NOT STATUS[ I ].[I.MOD32 + 1:1] THEN GO BACK; 99241000
A[0]~SET(SET(SET(SET(129,18),32),43),45); 99242000
A[1] := SVDESC; 99242100
A[16] ~ SET(SET(SET(SET(A[17] ~ SET(4"203",16),26),18),10),2); 99243000
A[19] ~ 4"1112" & THIRTY1416(4"0809"); 99244000
A[20] ~ 4"1516" & THIRTY1416(4"1314"); 99245000
A[16] ~ REGISTERS[38] - 1; 99246000
DPCW := DPCW & LL(0) & LOW14(4); 99247000
DUMPIT(I,IPCW& LL(1) & LOW14(4),SD,STUFF); 99248000
EXIT;% IN ORDER NOT TO CALL BLOCKEXIT 99249000
END MEMDUMP; 99250000
D03 := INITIALIZEPCW; 99970000
INITIALIZE(@4000011,PROCSTACKSTARTW); 99980000
END. 99999998
99999999140821PK
Reference in New Issue View Git Blame Copy Permalink