github.com/pkimpel.retro-b5500
1
0
Fork 0
mirror of https://github.com/pkimpel/retro-b5500.git synced 2026-02-13 03:34:29 +00:00
Code Releases Activity
Files
127edd65d528a268f00a5f89ced7986ffc90faab
pkimpel.retro-b5500/SYMBOL/DCMCP.esp_m
paul.kimpel@digm.com 47e5d09ef7 1. Release emulator version 0.07. 
2. Implement interrupt and device status latching in B5500CentralControl to support better UI display.
3. Implement B5500CardPunch device.
4. Implement preliminary and experimental B5500DummyPrinter device; correct printer I/O initiation in IOUnit.
5. Correct the way that Printer Finished interrupts are handled in IOUnit and CentralControl.
6. Implement Card Load Select in B5500Console and B5500SyllableDebugger.
7. Fix lack of presence-bit detection in return ops for returned values.
8. Redesign B5500CardReader UI to show last two cards read; change method of emptying the input hopper.
9. Set CHECK option and rework SYSTEM/LOG initialization in B5500ColdLoader.html.
10. Centralize system memory cycle time setting; change from 6us to 4us memory cycle time.
11. Increase Processor timeslice to 16ms and rework Processor.schedule() internals for more accurate performance throttling in browsers with poor setTimeout() granularity.
12. Reduce Processor syllable overhead from 2 cycles to 1.
13. Change B5500SPOUnit method of output to "paper" to work better in Google Chrome.
14. Make documentation and debugging enhancements in B5500IOUnit.
15. Release initial test website HTML and Unisys license PDF.
16. Commit Mark XVI DCMCP transcription as of 2013-06-21.
2013-06-24 05:04:15 +00:00

23564 lines
2.0 MiB
Raw Blame History

%B 5 7 0 0 M C P M A R K XVI.0.178 05/09/77%179-00001000
% 00002000
COMMENT: * TITLE: B5500/B5700 MARK XVI SYSTEM RELEASE * 00002010
* FILE ID: SYMBOL/MCP TAPE ID: SYMBOL1/FILE000 * 00002011
* THIS MATERIAL IS PROPRIETARY TO BURROUGHS CORPORATION * 00002012
* AND IS NOT TO BE REPRODUCED, USED, OR DISCLOSED * 00002013
* EXCEPT IN ACCORDANCE WITH PROGRAM LICENSE OR UPON * 00002014
* WRITTEN AUTHORIZATION OF THE PATENT DIVISION OF * 00002015
* BURROUGHS CORPORATION, DETROIT, MICHIGAN 48232 * 00002016
* * 00002017
* COPYRIGHT (C) 1965, 1971, 1972, 1973, 1974 * 00002018
* BURROUGHS CORPORATION * 00002019
* AA759915 AA320206 AA393180 AA332366 AA465080 * 00002020
* AA495655 AA496565 *; 00002021
$ SET OMIT = NOT(DEBUGGING) 00002100
BEGIN 00003000
DEFINE MIXMAX= 9#; COMMENT: MIXMAX MAY NOT BE LARGER THAN 29;00004000
DEFINE JOBNUMAX=40#; COMMENT: JOBNUMAX SHOULD BE ABOUT 00005000
2|MIXMAX+30; 00005001
DEFINE MARKLEVEL= % MARK LEVEL IN ALPHA 00005010
"XVI.0" 00005020
#, PATCHLEVEL= % PATCH RELEASE LEVEL IN ALPHA 00005030
"178" %179-00005040
#, LOCALEVEL= % LOCAL LEVEL IN ALPHA 00005050
" " 00005060
#; 00005070
DEFINE MCPTYPE = 63 #, 00005100
DCINTYPE = 63 #, 00005120
TSSINTYPE = 61 #; 00005140
COMMENT THE ESPOL COMPILER APPROPRIATELY TYPES THE MCP & 00005160
INTRINSICS FILE HEADERS SO THAT A VALIDITY CHECK MAY BE MADE 00005180
DURING INITIALIZATION AND AT CI AND CM TIME. HEADER[4].[36:6] 00005185
IS THE FIELD USED TO CONTAIN THE TYPE; 00005190
DEFINE ESAD = [1:15]#, 00005200
UNUM = [16:5]#, 00005210
BYBY(BYBY1,BYBY2)= 00005220
BEGIN STREAM(A:=TYPEDSPACE(10,SPOUTMSGAREAV) : );% %167-00005230
BEGIN DI:= A; DS:=BYBY2 LIT BYBY1; END; 00005240
PUNT(0); 00005250
END#; 00005260
DEFINE RESERVEDISKSIZE=2000#; 00005300
COMMENT TRACESIZE IS THE SIZE OF THE CORE AREA USED TO STORE TRACE 00005500
INFORMATION BEFORE IT IS WRITTEN ON DISK. 00005600
TRACAREASTART IS THE ABSOLUTE DISK ADDRESS OF THE TRACE 00005700
AREA ON DISK. 00005800
TRACAREASIZE IS THE SIZE (IN DISK SEGMENTS) OF THE TRACE 00005900
AREA ON DISK; 00005950
DEFINE TRACESIZE=30#,TRACAREASTART=10000#,TRACAREASIZE=480#; 00006000
DEFINE HANG=DO UNTIL FALSE#; 00006100
DEFINE LEFTARROW = "~"#; 00006150
$ SET OMIT = NOT(SAVERESULTS) 00006200
REAL JUNK=5;% 00007000
DEFINE PSEUDOMAX = 31 #, % MAX NO OF PSEUD-RDRS 0-ORIGIN 00007050
PSEUDOMAX1 = 32 #, % MAX NO OF PSEUD-RDRS 1-ORIGIN 00007055
PSEUDOMAXT = 63 #; % # ENTRIES IN TINU TABLE -2 00007060
COMMENT TO REDEFINE MAX NO. OF PSEUDO RDRS,SIZE AND INITIALIZATION 00007061
OF TINU[*] AT 00241900 MUST ALSO BE MODIFIED ACCORDINGLY; 00007062
COMMENT : PSEUDOMAX MUST BE }0 AND { 31 00007065
PSEUDOMAX1 MUST BE } 0 AND { 32 00007070
PSEUDOMAXT MUST BE } 31 AND { 63;% 00007075
COMMENT TO ADJUST THE PRIORITY, CORE ESTIMATE, AND STACK SIZE 00007200
OF LIBMAIN/DISK, SEE SEQUENCE NUMBER 45075470; 00007210
LABEL GOGOGO,NORMALERROR,P2BUSY,TIMER,EXTERNAL,INQUEST, 00008000
PROCSWIT,P2FAKE,KEYBOARDREQUEST,RETURN,COMINIT,MEMORYPARITY %WE 00009000
; 00010000
DEFINE GETUSERDISK(GETUSERDISK1)=PETUSERDISK(GETUSERDISK1,0)#;% 00012001
$ SET OMIT = NOT(DUMP OR DEBUGGING) 00012159
DEFINE DUMPNOW(DUMPNOW1) = 00012160
DUMPCORE(DUMPNOW1&(GETSPACE(22,0,0) + 3)[15:33:15])#;% 00012165
$ POP OMIT 00012166
INTEGER RRRMECH=@201;% 00013000
DEFINE SPACE(SPACE1) =(GETSPACE(SPACE1,0,0) + 2)#; 00013500
DEFINE MCP=M[1]#; %PRIVILEDGED USERCODE STORED IN M[1] 00013600
DEFINE % KEYIN TABLE DEFINE VALUES FOR "REPLY" 00013700
VAX = 01#, 00013710
VIL = 02#, 00013720
VUL = 03#, 00013730
VQT = 04#, 00013740
VOU = 05#, 00013750
VWY = 06#, 00013760
VRM = 12#, 00013770
VOK = 22#, 00013780
VFM = 23#, 00013790
VFR = 24#, 00013800
VOF = 25#, 00013810
VCC = 21#, 00013820
VIF = 32#; 00013830
DEFINE 00013850
$ SET OMIT = AUXMEM 00013860
SPACESTACKSIZE = 80#; 00013880
$ SET OMIT = NOT(AUXMEM) 00013900
SAVE INTEGER PROCEDURE GETSPACE(SIZE,TYPE,SAVEF);% 00014000
VALUE SIZE,TYPE,SAVEF;% 00015000
INTEGER SIZE,TYPE;% 00016000
BOOLEAN SAVEF; FORWARD;% 00017000
DEFINE %167-00017005
TYPEDSPACE(TYPEDSPACE1,TYPEDSPACE2) = 00017010
(GETSPACE(TYPEDSPACE1,TYPEDSPACE2,0)+2)# % 00017015
,ARRAYDESC(ARRAYDESC1,ARRAYDESC2) = 00017020
([M[GETSPACE(ARRAYDESC1,ARRAYDESC2,0)+2]] & ARRAYDESC1 [SIZE])# %00017025
,SAVEARRAYDESC(SAVEARRAYDESC1,SAVEARRAYDESC2) = 00017030
([M[GETSPACE(SAVEARRAYDESC1,SAVEARRAYDESC2,1)+2]] 00017035
& SAVEARRAYDESC1 [SIZE])# %00017040
; 00017045
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00017100
%**********************************************************************%00017110
%* *%00017120
%* MEMORY AREA TYPES STORED IN 3:6 FIELD OF FIRST MEMORY *%00017130
%* LINK OF ALL MEMORY AREAS *%00017140
%* *%00017150
%**********************************************************************%00017160
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00017170
DEFINE %167-00017180
UNKNOWNAREAV = 0# % %167-00017190
,CODEAREAV = 1# % %167-00017200
,DATAAREAV = 2# % %167-00017210
,IOBUFFERAREAV = 3# % %167-00017220
,ALGOLFIBAREAV = 4# % %167-00017230
,INQUIRYBUFFAREAV = 5# % %167-00017240
,COBOLFIBAREAV = 6# % %167-00017250
,TYPE7INTAREAV = 7# % %167-00017260
,DISKHEADERAREAV = 8# % %167-00017270
,MAINTBUFFAREAV = 9# % %167-00017280
,LBLEQNAREAV = 10# % %167-00017290
,SEGZEROAREAV = 11# % %167-00017300
,STACKAREAV = 12# % %167-00017310
,TYPE13INTAREAV = 13# % %167-00017320
,SCRATCHDIRAREAV = 14# % %167-00017330
,OPSETAREAV = 15# % %167-00017340
,DIRTOPAREAV = 16# % %167-00017350
,SPOUTMSGAREAV = 17# % %167-00017360
,UVROWAREAV = 18# % %167-00017370
,JARROWAREAV = 19# % %167-00017380
,CIDROWAREAV = 20# % %167-00017390
,INQINPUTAREAV = 21# % %167-00017400
,INTARRAYAREAV = 22# % %167-00017410
,RJEINPUTAREAV = 23# % %167-00017420
,DCQUEUEAREAV = 24# % %167-00017430
,DALOCROWAREAV = 25# % %167-00017440
,SHEETAREAV = 26# % %167-00017450
,STAWORDAREAV = 27# % %167-00017460
,KEYINBUFAREAV = 28# % %167-00017470
,FSAREAV = 29# % %167-00017480
,DC19QUEUEAREAV = 30# % %167-00017490
,AVTABLEAREAV = 31# % %167-00017500
,TRACETABLEAREAV = 32# % %167-00017510
,SEGDICTAREAV = 33# % %167-00017520
,STACKPRTAREAV = 34# % %167-00017530
,MCPTABLEAREAV = 35# % %167-00017540
,IRSTACKAREAV = 36# % %167-00017550
,FPBAREAV = 37# % %167-00017560
,CONTROLCARDAREAV = 38# % %167-00017562
,LABELAREAV = 39# % %167-00017564
,MDUMPAREAV = 40# % %167-00017566
,ESPDISKAREAV = 41# % %167-00017568
,LOGAREAV = 42# % %167-00017570
,CANDEINPUTAREAV = 43# % TSS MCP ONLY %167-00017572
,OBJOBINPUTAREAV = 44# % TSS MCP ONLY %167-00017574
,TYPE45 = 45# % %167-00017576
,TYPE46 = 46# % %167-00017578
,TYPE47 = 47# % %167-00017580
,TYPE48 = 48# % %167-00017582
; %167-00017600
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00017700
%**********************************************************************%00017710
%* *%00017720
%* M E M O R Y L I N K S *%00017730
%* *%00017740
%**********************************************************************%00017750
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00017760
% %167-00017762
% FIELDS OF MEMORY LINK 0 OF ALL AREAS %167-00017764
% %167-00017766
FIELD %167-00017770
AREAAVAILF = 01:01 % = 0 FOR IN-USE AREA, = 1 FOR AVAIL. AREA 00017780
,AREASAVEF = 02:01 % = 1 FOR IN-USE SAVE AREA, = 0 FOR OLAY AREA00017790
,AREATYPEF = 03:06 % TYPE OF AREA (SEE ABOVE) %167-00017800
,AREAMIXF = 09:06 % MIX INDEX OF OWNER OF AREA %167-00017810
,AREABACKLINKF = 18:15 % ADDRESS OF PREVIOUS AREA %167-00017820
,AREAFWDLINKF = 33:15 % ADDRESS OF NEXT AREA %167-00017830
; %167-00017840
SAVE REAL PROCEDURE WAITIO(IOD,MASK,U);% 00018000
VALUE IOD,MASK,U; REAL IOD,MASK,U; FORWARD;% 00019000
SAVE PROCEDURE DISKWAIT(CORE,SIZE,DISK); 00019100
VALUE CORE,SIZE,DISK; 00019200
REAL CORE,SIZE,DISK; 00019300
FORWARD; 00019400
PROCEDURE ERRORFIXER(TYPE); VALUE TYPE; REAL TYPE; FORWARD; 00019500
SAVE PROCEDURE SNOOZE(PRYR,ADDRESS,MASK); VALUE PRYR,ADDRESS,MASK; 00020000
REAL PRYR; NAME ADDRESS; ARRAY MASK[*]; FORWARD; 00021000
DEFINE SLEEP(SLEEP1,SLEEP2)=SNOOZE(PRYOR[P1MIX],SLEEP1,SLEEP2)#; 00021500
ARRAY PRYOR[*]; 00021600
REAL P1MIX,P2MIX; % SEE 00105000 00021700
ARRAY SLATE[*];% 00022000
REAL NSLATE,LSLATE;% 00023000
DEFINE SLATESIZE=16#,SLATEND=SLATESIZE-1#;%SIZE MUST BE TWO POWER 00023100
REAL NT1=@160,NT2=@161,NT3=@162,NT4=@163,NT5=@164,NT6=@165,NT7=@166; 00024000
REAL CLOCK = @170; % CLOCK.[9:33] CONTAINS THE NUMBER OF TIME INTERVAL 00024005
% INTERRUPTS PROCESSED SINCE HALT LOAD. CLOCK.[42:6] 00024006
% ALWAYS EQUALS ZERO. %156-00024007
COMMENT NT1 THRU NT7 ARE USED BY THE MCP FOR TEMPORARY STORAGE. 00024010
ALL PROCESSES THAT USE THESE VARIABLES ASSUME THAT IF CONTROL 00024020
IS LOST. THERI CONTENT MAY HAVE BEEN CHANGED BY THE TIME 00024030
THAT CONTROL IS REGAINED. 00024040
END COMMENT; 00024050
ARRAY TSKA = NT3[*]; 00024060
REAL MCPBASE; 00024100
COMMENT MCPBASE CONTAINS THE DISK ADDRESS (OCTAL) OF THE BEGINNING 00024200
OF THE MCP THAT IS CURRENTLY IN USE. THIS ADDRESS IS PASSED TO 00024210
THE MCP BY THE LOADER ROUTINE AT EACH HALT/LOAD IN M[0].[18:30].00024220
WHEN THE ESPBIT ROUTINE IS CALCULATING THE DISK ADDRESS 00024230
OF AN MCP SEGMENT, IT ADDS MCPBASE TO THE ADDRESS THAT 00024240
IS CONTAINED IN THE PRT CELL FOR THAT SEGMENT. 00024250
END COMMENT; 00024260
LABEL NOTHINGTODO,INITIATE,START,STACKOVERFLOW,IOBUSY; 00024270
$ SET OMIT = NOT(AUXMEM OR MONITOR) 00024299
$ SET OMIT = NOT MONITOR 00024590
DEFINE MCPNAMESEG = (DIRECTORYTOP-7)#; 00024610
COMMENT MCPNAMESEG CURRENTLY CONTAINS THE FOLLOWING: 00024620
WORD[ 0]-WORD[15] - FILE IDS OF THE AUXDATA FILES FOR MCP & INTRINCS. 00024630
WORD[16]-WORD[19] - CONTAIN THE WORD "AUXMEM " AS A MARKER. 00024640
WORD[20]-WORD[27] - FILE IDS OF THE MCP"S AT HALT/LOAD. 00024650
WORD[28] - USED BY DISKSQUASH FOR COMM. BETWEEN SHAREDISK SYSTEMS. 00024660
; 00024670
$ SET OMIT = NOT(NEWLOGGING) 00024999
$ SET OMIT = NEWLOGGING 00025299
DEFINE STARTLOG(STARTLOG1)= 00025300
PROCTIME[STARTLOG1]~(*P(DUP))-CLOCK-P(RTR)#, 00025400
STOPLOG(STOPLOG1,STOPLOG2)= 00025500
PROCTIME[STOPLOG1] !(*P(DUP))+CLOCK+P(RTR)#; 00025600
$ POP OMIT 00025601
SAVE PROCEDURE ESPBIT; COMMENT PRESENCE BIT ROUTNE FOR ESP SEGMENTS ;% 00025900
BEGIN INTEGER PRTLOC,SYLLABLE,LOC,SIZE;% 00026000
FIELD MAYBEWORKEDON = [7:1]; % %156-00027000
ARRAY MYSELF=ESPBIT[*];% 00028000
REAL RCW=+0,DISKREAD;% 00029000
LABEL MAKEPRESENT, TRYAGAIN; %156-00030000
$ SET OMIT = NOT(NEWLOGGING) 00030099
PRTLOC~(RCW INX 0)&RCW[30:10:2];% 00031000
STREAM(RLST~[SYLLABLE],CL~PRTLOC);% 00032000
BEGIN SI~CL; SI~SI-2; DI~RSLT; DI~DI+6; DS~2 CHR END;00033000
PRTLOC ~ IF SYLLABLE THEN NT4% 00034000
ELSE SYLLABLE.[36:10];% 00035000
SYLLABLE := @104; % THIS IS THE CODE WE WILL PASS TO 00035500
% GETSPACE THE FIRST TIME. IT REQUESTS00035510
% OVERLAY MEMORY FOR THE MCP AND THAT 00035520
% WE WANT TO BE RETURNED TO ON A NO 00035530
% MEM. %156-00035540
IF MEMORY[PRTLOC].MAYBEWORKEDON THEN% 00036000
MAKEPRESENT: BEGIN MEMORY[PRTLOC].MAYBEWORKEDON~FALSE;% 00037000
SIZE~MEMORY[PRTLOC].[8:10];% 00038000
% %156-00039000
% NOW WE WILL ATTEMPT TO GET SPACE FOR THIS MCP PROC. 00039005
% IF WE FAIL WE WILL WAIT FOR A SECOND AND THEN TRY 00039010
% AGAIN. THIS ENSURES THAT IF WE GET DS-ED WHILE %156-00039015
% SLEEPING WAITING FOR MEMORY WE WILL NOT LEAVE THE 00039020
% TOGGLE LOCKED UP FOR THIS PROCEDURE. %156-00039025
% %156-00039030
IF (LOC:=GETSPACE(SIZE,1,SYLLABLE))=0 THEN % NO MEM 00039035
BEGIN %156-00039040
MEMORY[PRTLOC].MAYBEWORKEDON := TRUE; % UNLOCK I00039045
SYLLABLE.[46:1] := TRUE; % DONT PRINT NO MEM 00039050
SLEEP([CLOCK],NOT CLOCK); % WAIT FOR ONE SECOND.00039055
GO TO TRYAGAIN; %156-00039060
END; %156-00039065
$ SET OMIT = NOT(AUXMEM) 00039099
DISKREAD~(LOC+1)&SIZE[8:38:10]&@14[21:42:6] %E00040000
&((SIZE+29) DIV 30)[27:42:6];% 00041000
STREAM(L:=LOC+1.N:=M[PRTLOC].[18:15]+MCPBASE,D:=0); 00042000
BEGIN SI~LOC N; DI~L; DS~8 DEC END;% 00043000
SYLLABLE~WAITIO(DISKREAD,0,18);% 00044000
$ SET OMIT = NOT(AUXMEM) 00044099
MEMORY[LOC]~MEMORY[LOC]&0[2:47:1]&0[9:42:6];% 00045000
MEMORY[LOC+1]~PRTLOC&SIZE[18:33:15];% 00046000
M[PRTLOC] := M[PRTLOC] & TRUE [MAYBEWORKEDON] %%156-00047000
&(LOC+2)[33:33:15];% 00048000
$ SET OMIT = NOT MONITOR 00048099
END ELSE% 00049000
TRYAGAIN: BEGIN SLEEP([M[PRTLOC]],0&TRUE [MAYBEWORKEDON]);% %156-00050000
IF (MEMORY[PRTLOC] INX 0)=(MYSELF INX 0) THEN% 00051000
GO TO MAKEPRESENT;% 00052000
END;% 00053000
$ SET OMIT = NOT(NEWLOGGING) 00053099
POLISH(0,RDF,0,XCH,FCX,STS);% 00054000
GO TO POLISH(MEMORY[PRTLOC]);% 00055000
GO TO START; % PLACE DESC.IN PRT FOR MCP TO AUXMEM TRANSFER 00055100
END ESPBIT;% 00056000
LABEL FINDIT; 00057100
REAL RESULT=12 ,RESULT2=13 ,RESULT3=14 ,RESULT4=15 ;% 00058000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00060000
%**********************************************************************%00060010
%* *%00060020
%* M I S C E L L A N E O U S F I E L D D E F I N I T I O N S *%00060030
%* *%00060040
%**********************************************************************%00060050
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00060060
%167-00060070
FIELD %167-00060080
FF = 18:15 % %167-00060090
,CF = 33:15 % %167-00060100
,CTF = FF % %167-00060110
,CTC = CF % %167-00060120
,MSFF = 16:01 % %167-00060130
; % %167-00060999
% % %167-00061000
% FIELDS OF AIT ENTRY %167-00061010
% %167-00061020
FIELD %167-00061030
FILEBIT = 01:01 % %167-00061040
,OWNBIT = 02:01 % %167-00061045
,DIMENSIONS = 03:05 % %167-00061050
,BLKCNTR = 08:10 % %167-00061060
,MOM = 18:15 % %167-00061070
; %167-00061999
% %167-00062000
% FIELDS OF DATA DESCRIPTOR %167-00062010
% %167-00062020
FIELD %167-00062030
% FLAGBITF = 00:00 % %167-00062040
% DATABITF = 01:01 % ALWAYS OFF FOR A DATA DESCRIPTOR %167-00062050
PBITF = 02:01 % ON IF DESCRIPTOR POINTS TO AREA OF CORE %167-00062060
,SIZE = 08:10 % SIZE OF ARRAY ROW IF ARRAY DESC. %167-00062070
% 0 FOR INDEXED DATA DESC, OR NAME DESC. %167-00062080
% ,MOMADDRESSF = 18:15 % ADDRESS OF MOTHER DESCRIPTOR. %167-00062090
% ,ADDRESSF =33:15 % IF PBIT IS ON THEN THIS FIELD CONTAINS AN%167-00062100
% ACTUAL CORE ADDRESS. IF THE PBIT IS OFF THEN 00062110
% IF THE VALUE OF THIS FIELD IS GREATER THAN 00062120
% OR EQUAL TO 512 THEN THE FIELD CONTAINS A%167-00062130
% DALOC ADDRESS WHICH CAN BE USED TO LOCATE THE 00062140
% DATA IN THE OVERLAY DISK AREA ASSIGNED TO THE 00062150
% THE PROGRAM. IF THE VALUE OF THE FIELD IS LESS00062160
% THAN 512 THEN THIS FIELD CONTAINS A CODE %167-00062170
% INDICATING THE STATUS OF THE AREA. %167-00062180
% 0 NEVER ACCESSED OVERLAY AREA. %167-00062190
% 1 NEVER ACCESSED SAVE AREA. %167-00062200
% 2 NEVER ACCESSED OVERALY AREA WHICH 00062210
% WHICH IS ASSIGNED TO AUXMEM. 00062220
% 5 INDICATES OVERLAY IS CURRENTLY IN 00062230
% PROCESS FOR THIS AREA. %167-00062240
% 6 INDICATES OLAY HAD IRRECOVERABLE 00062250
% ERROR WHEN OVERLAYING THIS AREA.00062260
% THE NEXT ACCESS TO THE AREA WILL00062270
% CAUSE THE PROGRAM TO BE TERMI- 00062280
% NATED. %167-00062290
; %167-00062999
% %167-00067000
% MISCELLANEOUS DEFINES %167-00067010
% %167-00067020
DEFINE %167-00067030
CURBLKCNTR = 16 # % %167-00067040
,AITINDEX = 6 # % %167-00067050
,FTF = 18:18:15 # % %167-00067060
,FTC = 33:18:15 # % %167-00067070
,DELTA = 11 # % %167-00067080
,TSX = 22 # % %167-00067090
,SFINTX = 27 # % %167-00067100
,INTRPTX = 28 # % %167-00067110
; %167-00067999
INTEGER AVAIL;% 00069000
COMMENT AVAIL CONTAINS THE ADDRESS OF THE STOPPER% 00070000
FOR AVAILABLE STORAGE LINKS ITS VALUE IS% 00071000
THE HIGHEST AVAILABLE ADDRESS-1;% 00072000
DEFINE MSTART = M[0].[CF]#; 00073000
COMMENT MSTART CONTAINS THE ADDRESS OF THE% 00074000
FIRST AREA OF STORAGE AFTER END OF% 00075000
ESP PROGRAM;% 00076000
DEFINE MEND = M[0].[FF]#; 00077000
COMMENT THIS POINTS TO LAST STORAGE LINK IN% 00078000
MEMORY;% 00079000
ARRAY TAR[*]; %CONTAINS TOGLE BITS SET BY EACH JOB 00079100
DEFINE LOCKTOG(LOCKTOG1)= BEGIN TOGLE:=TOGLE AND NOT LOCKTOG1; 00079200
TAR[P1MIX]:=TAR[P1MIX] OR LOCKTOG1; END#; 00079300
DEFINE UNLOCKTOG(UNLOCKTOG1)= BEGIN TOGLE:=TOGLE OR UNLOCKTOG1; 00079400
TAR[P1MIX]:=TAR[P1MIX] AND NOT UNLOCKTOG1; END#; 00079500
REAL TOGLE; 00080000
DEFINE HP2TOG = TOGLE.[47:1]#, HP2MASK = @1# 00080100
,STATUSBIT = TOGLE.[46:1]#, STATUSMASK = @2# 00080200
,SHEETFREE = TOGLE.[45:1]#, SHEETMASK = @4# 00080300
,STACKUSE = TOGLE.[44:1]#, STACKMASK = @10# 00080400
,STOREDY = TOGLE.[43:1]#, STOREMASK = @20# 00080500
,USERDISKREADY= TOGLE.[42:1]#, USERDISKMASK= @40# 00080600
,HOLDFREE = TOGLE.[41:1]#, HOLDMASK = @100# 00080700
,NSECONDREADY = TOGLE.[40:1]#, NSECONDMASK = @200# 00080800
,ABORTABLE = TOGLE.[39;1]#, ABORTMASK = @400# 00080900
,BUMPTUTIME = TOGLE.[38:1]#, BUMPTUMASK =@1000# 00080950
,KEYBOARDREADY = TOGLE.[37:1]#, KEYBOARDMASK =@2000# 00081000
,NOBACKTALK = TOGLE.[36:1]#, NOBACKTALKMASK=@4000# 00081100
,QTRDY = TOGLE.[35:1]#, QTRDYMASK =@10000# 00081200
,INTFREE = TOGLE.[34:1]#, FREEMASK =@20000# 00081300
,SPOEDNULLOG = TOGLE.[33:1]# 00081400
,REMOTELOGFREE = TOGLE.[32:1]#, REMOTELOGMASK = @100000# 00081500
,EGGSELECTSTOPPED = TOGLE.[31:1]# 00081600
,STARTOG = TOGLE.[30:1]# 00081610
,NINETEENNOTREADING=TOGLE.[29:1]#, NINETEENMASK=@1000000# 00081620
,SMWSTOPPED=TOGLE.[28:1]#, SMWSTOPPEDMASK=@2000000# 00081630
,DCWAITING=TOGLE.[27:1]# 00081640
,DCQPTSTOPPED=TOGLE.[26:1]# 00081650
,INQUPTSTOPPED=TOGLE.[25:1]# 00081660
,MCPFREE=TOGLE.[24:1]#, MCPMASK=@40000000# 00081670
% USED TO PROTECT DISK SEGMENT ZERO 00081675
,SCRATCHDIRECTORYREADY = TOGLE.[23:1]#, 00081680
SCRATCHDIRECTORYMASK = @100000000 00081690
% USED TO PROTECT THE SCRATCHDIRECTORY 00081695
,FINDINGADDRESS=TOGLE.[22:1]# 00081700
% SET TRUE WHENEVER THE INDEPENDENT RUNNING ROUTINE 00081705
% "FINDFREEADDRESS" IS STARTED SO THAT ONLY ONE COPY 00081706
% WILL BE RUN AT ONE TIME. 00081707
,CDFREE=TOGLE.[21:1]#,CDMASK=@400000000# 00081710
% SET TRUE WHEN CONTROL DECK QUEUE IS FREE 00081711
,NOMEM=TOGLE.[15:6]# %GETSPACES HANGING 00081950
,BREAKTOG=TOGLE.[14:1]# %BREAKOUT TOG 00081960
,BREAKMASK=@100000000000# 00081970
,SEPTICTANKING = TOGLE.[13:1]# 00081972
,DIRECTORYTOG = TOGLE.[12:1]# 00081974
,DIRECTORYMASK = @400000000000# 00081976
,NOMEMTOG = TOGLE.[11:1]# % ON IF NOMEM SINCE LAST NSECOND 00081980
,MEMNO = [9:3]# % 9:2 = COUNTER FOR NSECOND 00081982
00081999
STREAM PROCEDURE MOVE(N)"WORDS FROM"(HERE)"TO"(THERE);% 00082000
VALUE N,HERE,THERE;% 00083000
COMMENT WILL MOVE 0 TO 4095 WORDS;% 00084000
BEGIN LOCAL NDIV64;% 00085000
SI~LOC N; DI~LOC NDIV64; SI~SI+6; DI~DI+7; DS~1 CHR;00086000
SI~HERE; DI~THERE;% 00087000
NDIV64(DS~32 WDS; DS~32 WDS); DS~N WDS;% 00088000
END MOVE;% 00089000
$ PAGE 00089050
PROCEDURE STOPM(B); VALUE B; BOOLEAN B; FORWARD; 00089100
LABEL DIFFCOM; 00089200
SAVE PROCEDURE FORGETSPACE(LOC);% 00090000
VALUE LOC;% 00091000
REAL LOC;% 00092000
FORWARD;% 00093000
ARRAY BED[*]; % 4MIXMAX+4 00094000
COMMENT ENTRIES IN THE BED HAVE TWO WORDS.% 00095000
THE FIRST WORD HAS THE FOLLOWING FORMAT;% 00096000
0- 2 = 5% 00097000
3- 7 = MIXINDEX% 00098000
8-17 = 0% 00099000
18-32 = F REGISTER SETTING% 00100000
33-47 = ADDRESS OF WORD TO BE TESTED.% 00101000
THE SECOND WORD IS A MASK IF BIT 0 IF OFF.% 00102000
THE SECOND WORD IS AN ACCIDENTAL ENTRY DESCRIPTOR IF BIT 000103000
IS ON;% 00104000
COMMENT P1MIX,P2MIX NOW DECLARED AT 00021700; 00105000
COMMENT P1MIX IS THE MIX INDEX FOR THE JOB BEING CURRENTLY% 00106000
PROCESSED. P1MIX = 0 MEANS NO JOB IS CURRENTLY BEING% 00107000
PROCESSED. P2MIX IS THE MIX INDEX FOR THE JOB BEING% 00108000
CURRENTLY PROCESSED ON PROCESSOR 2. IF PROCESSOR IS IDLE 00109000
THEN P2MIX = 0. IF THERE IS NO PROCESSOR 2 THEN P2MIX=-1;00110000
REAL DATE=@167; 00111000
COMMENT DATE CONTAINS TODAYS DATE;% 00112000
REAL XCLOCK=@171; 00114000
REAL READY=@172; 00121000
COMMENT READY CONTAINS THE CONTENTS OF THE READY REGISTER ON% 00122000
THE LAST READ;% 00123000
COMMENT STATUSBIT IS FALSE IF THE STATUS ROUTINE IS RUNNING AND00125000
TRUE OTHERWISE. THIS PREVENTS TWO COPIES OF STATUS FROM% 00126000
RUNNING TOGETHER;% 00127000
ARRAY PRT[*,*];% 00128000
COMMENT PRT[1,*] CONTAINS A DATA DESCRIPTOR WITH PROPER SIZE% 00129000
FIELD POINTING AT PRT FOR JOB WITH MIX INDEX = 1;% 00130000
ARRAY PRTROW=PRT[*]; % MIXMAX+1% 00131000
COMMENT PRTROW IS DOPE VECTORS FOR PRT;% 00132000
ARRAY JAR[*,*];% 00133000
% JAR HOLDS INFO OF JOBS IN PROCESS (SEE DEFINES AT 20544000) 00134000
DEFINE 00134010
LIBMAINCODE=1#, LDCNTRLCODE=3#, PRNPBTCODE=5#, 00134020
SYSJOBF=[6:3]#, SSYSJOBF=[5:3]#; 00134030
% SEE 20556700 RE SYSJOBF (SYSTEM JOB FIELD) 00134040
% SEE 20515000 RE SSYSJOBF (SHEET SYSTEM JOB FIELD) 00134050
$ SET OMIT = NOT(WORKSET) 00134100
ARRAY STQUE[*]; % QUEUE FOR "STOPPED" JOBS, 16 LONG 00134110
DEFINE STQUEUEMAX = 15#; 00134115
ARRAY OLAYTIME[*]; % USED FOR STORAGE OF OLAY OVERHEAD TIME 00134120
PROCEDURE WORKSET(N); VALUE N; RAEL N; FORWARD; 00134125
ARRAY WKSETDATA[*]; 00134130
% ARRAY USED FOR STORAGE OF WORKSET INFORMATON 00134140
DEFINE WKSETCLOCK = WKSETDATA[0]#, 00134150
% TIME AT WHICH WORKSET ROUTINE HAS STARTED 00134160
% TO RUN 00134170
WKSETRUNNING = WKSETDATA[1].[47:1]#, 00134180
% TOGGLE TO INDICATE THAT WORKSET IS RUNNING 00134190
WKSETNOSELECT = WKSETDATA[1].[46:1]#, 00134200
% TOGGLE TO PREVENT SELECTRUN FROM PLACING 00134210
% ADDITIONAL JOBS IN THE MIX 00134220
WKSETMONITOR = WKSETDATA[1].[45:1]#, 00134230
% TOGGLE USED TO "MONITOR" WORKSETDATA 00134240
WKSETMAXOLAY = WKSETDATA[2]#, 00134250
% MAX. FRACTION OF PROCESS TIME TO COMPUTE 00134260
% MAXIMUM ALLOWABLE OLAY TIME 00134270
WKSETOLERANCE = WKSETDATA[3]#, 00134280
% FRACTION USED TO CMOPARE JOB STATISTICS 00134290
% (ALLOWABLE VARIANCE TO COMPUTE MAX.VALUES) 00134300
WKSETINSTRUCT = WKSETDATA[4]#, 00134310
% INSTRUCTIONS FOR COMPARING JOB STATISTICS 00134320
% FRACTION OF TOTAL SYSTEM CORE WHICH MUST 00134330
% BE KEPT AVAILABLE 00134340
WKSETCYCLETIME = WKSETDATA[5]#, 00134350
% CYCLE TIME (64THS OF A SECOND) FOR WHICH 00134360
% THE WORKSET ROUTINE IS RUN, QUEUED AT 00134370
% "TIME" IN THE OUTER BLOCK 00134380
WKSETSTOPJOBS = WKSETDATA[6]#, 00134390
% BIT INDEX (TWO(MIX)) FOR JOBS WHICH HAVE 00134400
% BEEN "ST-ED" BY THE WORKSET ROUTINE 00134410
STFIRST = WKSETDATA[7].[CF]#, 00134420
% INDEX TO FIRST ENTRY IN THE "STQUE" 00134430
STNEXT = WKSETDATA[7].[FF]#, 00134440
% INDEX T NEXT AVAILABLE SLOT IN "STQUE" 00134450
WKSETSWITCHTIME= WKSETDATA[8]#, 00134460
% TIME OF LAST "JOB" OR "EOJ" EVENT 00134470
WKSETDATASIZE = 9#; % SIZE OF THE WKSETDATA ARRAY 00134480
$ POP OMIT % WORKSET 00134490
ARRAY INTRNSC[*]; REAL INTSIZE;% RE-ENTRANT INTRINSICS ON USER DISK 00135000
ARRAY INTABLE[*,*], INTABLEROW=INTABLE[*];% 00135100
$ SET OMIT = NOT(AUXMEM) 00135199
ARRAY SHEET[*]; % 5% 00136000
ARRAY JARROW=JAR[*]; % MIXMAX+1% 00138000
DEFINE TABCNT[TABCNT1] = JARROW[TABCNT1].[FF]#; 00138100
COMMENT TABCNT IS THE NUMBER OF PROCESSES WHICH HAVE CHECKED 00138110
JARROW AND ARE CURRENTLY ACCESSING MIX TABLES. IT ASSURES 00138120
THAT THE TABLES DONT VANISH BENEATH THOSE PROCESSES; 00138130
COMMENT ENTRIES IN THE SLATE HAVE TWO WORDS. EACH ENTRY% 00140000
DESCRIBES AN INDEPENDENT ROUTINE WHICH NEEDS TO BE STARTED00141000
RUNNING. NOTHING TO DO STARTS THESE ROUTINES.% 00142000
THE FIRST WORD OF AN ENTRY IS A PARAMETER TO THE ROUTINE. 00143000
THE SECOND WORD OF AN ENTRY IS THE PRT ADDRESS OF THE% 00144000
ROUTINE.% 00145000
NSLATE AND LSLATE ARE POINTERS T THE SLATE.% 00146000
NSLATE POINTS AT LAST ENTRY WHICH WAS STARTED.% 00147000
LSLATE POINTS AT LAST ENTRY PLACED IN THE SLATE;% 00148000
REAL JOBNUM;% 00149000
COMMENT JOBNUM POINTS AT LAST ENTRY IN BED;% 00150000
COMMENT STACKUSE IS TRUE IF THE INDEPEDENT STACK IS NOT IN USE.00152000
OTHERWISE FALSE;% 00153000
BOOLEAN NOPROCESSOTOG;% 00154000
COMMENT NOPROCESSTOG IS TRUE IF NORMAL STATE PROCESSING IS% 00155000
ALLOWED, OTHERWISE IT IS FALSE. IT IS USED BY OVERLAY AND00156000
OTHERS TO PREVENT CONFUSION;% 00157000
REAL SOFTI; % NUMBER OF JOBS IN MIX HAVING SOFTWARE INTERRUPTS DECLARED 00157100
REAL WITCHINGHOUR,WORDOFEASE; 00157500
COMMENT THESE USED TO BE CONSTANTS IN THE OUTER BLOCK BUT WERE 00157600
MOVED HERE SO EVERYONE COULD USE THEM. THEY CONTAIN: 00157700
WITCHINGHOUR 5184000 00157800
WORDOFEASE @2525252525252525 00157900
; 00158000
DEFINE NDX=3#; % NUMBER OF ENTRIES PER JOB IN NFO ARRAY 00158100
ARRAY NFO[*]; %MIXMAX|NDX 00158200
COMMENT NFO CONTAINS THE FOLLOWING FOR EACH ACTIVE MIX INDEX; 00158300
% NFO[(MIX-1)|NDX] = FILE PARAMETER BLOCK DATA DESCRIPTOR 00158400
% NFO[(MIX-1)|NDX+1] = SEGMENT DICTIONARY NAME DESCRIPTOR 00158500
% NFO[(MIX-1)|NDX+2].[CF] = LOCATION OF BOTTOM OF STACK (B-WORD) 00158600
% NFO[(MIX-1)|NDX+2].[FF] = ESTIMATED CORE REQUIREMENTS 00158700
% NFO[(MIX-1)|NDX+2].[1:17] = CLOCK TIME AT BOJ 00158800
ARRAY ESTACK[*]; % 128% 00159000
ARRAY PROCTIME[*]; % MIXMAX+1% 00161000
COMMENT PROCTIME[I] CONTAINS PROCESSOR TIME FOR JOB WITH% 00162000
MIX INDEX = I;% 00163000
ARRAY IOTIME[*]; % MIXMAX+1% 00164000
COMMENT IOTIME[I] CONTAINS I-O TIME FOR JOB WITH MIX INDEX =1; 00165000
$ SET OMIT = NOT(NEWLOGGING) 00165009
DEFINE EUIOHOLDER=DIRECTORYTOP-5#, 00165800
EUTAPER=.98#, 00165810
DISKAVAILTABLEMAX=130#; 00165820
INTEGER NEUP; ARRAY EUIO[*]; ARRAY PEUIO[*]; 00166000
$ SET OMIT = NOT(SHAREDISK ) 00166002
$ SET OMIT = SHAREDISK 00166005
ARRAY AVTABLE[*] ; 00166006
$ POP OMIT 00166007
COMMENT NEUP.[CF] CONTAINS THE NUMBER OF EUS ON DKA. 00166010
NEUP.NEUF CONTAINS THE TOTAL NUMBER OF EUS ON THE SYSTEM. 00166025
EUIO AND PEUIO CONTAIN THE I-O TIME USED BY A GIVEN EU. 00166030
THIS INFORMATION IS USED BY GETUSERDISK IN AN ATTEMPT TO 00166040
MINIMIZE EU CONFLICT; 00166050
DEFINE MIXF = [3:5]#;% 00168000
ARRAY CHANIO[*]; 00169000
ARRAY CHANNEL[*]; % 5% 00170000
COMMENT CHANNEL[I] CONTAINS LOGICAL UNIT OF LAST DESCRIPTOR% 00171000
SENT OUT ON CHANNEL I;% 00172000
ARRAY FINALQUE[*]; % 32% 00173000
ARRAY LOCATQUE[*]; % 32% 00174000
COMMENT IOQUE,FINALQUE, AND LOCATQUE TOGETHER WITH UNIT FORM% 00175000
THE I-O QUEUE. AN I-O REQUEST FOR LOGICAL UNIT U REQUIRES00176000
THREE WORDS OF SPACE IN THE I-O QUEUE. IF THE REQUEST% 00177000
OCCUPIES POSITION S IN THE I-O QUEUE, THEN IOQUE[S] )% 00178000
I-O DESCRIPTOR FOR THIS REQUEST, FINAL[S] = I-O DESCRIPTOR00179000
SKELETON TO BE USED AT I-O COMPLETE TIME TO REBUILD% 00180000
I-O DESCRIPTOR, LOCATQUE[S] = LOCATION OF I-O DESCRIPTOR% 00181000
AT TIME OF REQUEST. LOCATQUE[S] CONTAINS SOME ADDITIONAL 00182000
INFORMATION. IN PARTICULAR:% 00183000
0- 2 = 5% 00184000
3- 7 = MIX INDEX OF REQUESTER% 00185000
8 = I/O IS READ LOCK WHICH HAD ERROR (SHAREDISK).00185100
9 = OLAY I/O (IOFINISH PLACES RESULT ON ERROR). 00185500
10 = NO MEM MESSAGE. 00186000
11 = ERROR RECOVERY IN PROCESS ON THIS I-O 00186100
12-17 = LOGICAL UNIT NUMBER% 00187000
18-32 = INDEX OF NEXT REQUEST TO BE DONE ON THIS UNIT00188000
OR @77777 IF NO NEXT REQUEST% 00189000
33-47 = ORIGINAL LOCATION OF I-O DESCRIPTOR.% 00190000
UNIT[U] CONTAINS INFORMATION ABOUT LOGICAL UNIT U.% 00191000
1- 4 = TYPE OF I/O DEVICE% 00192000
5-12 = ERROR FIELD OF LAST I/O DONE ON THIS UNIT% 00193000
13 = UNIT NOT READY BIT% 00194000
14 = ERROR BIT (ON IF ERROR)% 00195000
15 = WAIT BIT (ON IF UNIT IS WAITING FOR A CHANNEL00196000
16-17 = PROCESS BITS (USUALLY BOTH ON IF UNIT IS IN% 00197000
PROCESS OR BOTH OFF. WITH PRINTERS THE% 00198000
I-O FINISH SETS OFF 16 AND THE PRINTER% 00199000
FINISH SETS OFF 17)% 00200000
18-32 = INDEX OF FIRST I-O REQUEST FOR WHICH SERVICE 00201000
IS NOT COMPLETE% 00202000
33-47 = INDEX OF LAST UNSERVICED I-O REQUEST.% 00203000
THE SPACES NOT USED IN THE I-O QUEUE ARE LINKED TOGETHER% 00204000
THROUGH IOQUE. THE FIRST AVAILABLE IS IN IOQUEAVAIL;% 00205000
REAL IOQUESLOTS,IOQUEAVAIL; 00205500
ARRAY IOQUE[*]; 00206000
DEFINE RETURNIOSPACE(RETURNIOSPACE1) = 00206500
BEGIN IOQUESLOTS:=IOQUESLOTS+1; 00207000
IOQUE[RETURNIOSPACE1]:=IOQUEAVAIL; 00207500
IOQUEAVAIL:=RETURNIOSPACE1; 00208000
END#; 00208500
ARRAY UNIT[*]; 00209000
COMMENT UNIT NOW FILLED IN INITIALIZE; 00210000
ARRAY TINU[*]; 00241700
COMMENT TINU NOW FILLED IN INITIALIZE; 00241800
ARRAY WAITQUE[*]; % 8% 00278000
REAL NEXTWAIT,FIRSTWAIT;% 00279000
COMMENT WAITQUE IS A QUEUE OF UNITS FOR WHICH THERE ARE% 00280000
REQUESTS BUT NO CHANNEL IS AVAILABLE. NEXTWAIT AND% 00281000
FIRSTWAIT ARE POINTERS AT THE WAITQUE. NEXTWAIT IS THE% 00282000
NEXT AVAILABLE SLOT IN WAITQUE AND FIRSTWAIT POINTS AT% 00283000
NEXT UNIT TO BE USED WHEN A CHANNEL IS AVAILABLE;% 00284000
ARRAY LABELTABLE[*]; % 32% 00285000
ARRAY MULTITABLE[*]; % 32% 00286000
ARRAY RDCTABLE[*]; % 32% 00287000
ARRAY PRNTABLE[*];% 00288000
ARRAY REPLY[*];% 00289000
COMMENT LABELTABLE, MULTITABLE, AND RDCTABLE CONTAIN LABEL INFORMATION% 00290000
BY LOGICAL UNIT NUMBER AS FOLLOWS:% 00291000
LABELTABLE[I] CONTAINS THE FILE ID FOR LOGICAL UNIT I.% 00292000
MULTITABLE[I] CONTAINS THE CORRESPONDING MULTI-FILE ID.% 00293000
RDCTABLE[I] CONTAINS THE CORRESPONDING REEL NUMBER (IN [14:10]),00294000
CREATION DATE (IN [24:17]), AND CYCLE (IN [41:7]);% 00295000
$ SET OMIT = NOT(SHAREDISK) 00295999
REAL OPTION;% 00297000
REAL ILL,INQCT; 00299000
REAL PINGO; 00301000
REAL READQ,RRNCOUNT; DEFINE PUT=SET#; 00301100
$ SET OMIT = NOT(DATACOM ) 00301200
ARRAY TRANSACTION[*]; % 32% 00304000
DEFINE ETRLNG = 5#; % LENGTH OF ENTRY IN FILE BLOCK% 00305000
SAVE REAL PROCEDURE TWO(N); VALUE N; INTEGER N; 00306000
BEGIN REAL T=+1; 00307000
STREAM(N:=N:=47-N,T:=[T]); 00308000
BEGIN SKIP N DB; DS:=SET; END; 00308500
END TWO; 00309000
REAL SYLLABLE;% 00310000
$ SET OMIT = NOT(SHAREDISK) 00310099
$ SET OMIT = SHAREDISK 00310199
DEFINE SYSNO=0#, SYSMAX=1#; 00310200
$ POP OMIT 00310201
COMMENT ANALYSIS PLACES THE SYLLABLE THAT CAUSED THE INTERRUPT 00311000
IN SYLLABLE. THIS IS USED BY PRESENCE BIT, FLAG BIT, AND 00312000
VARIOIUS ERRORS;% 00313000
PROCEDURE FORGETUSERDISK(A,L);VALUE A,L;REAL A,L;FORWARD;% 00316000
REAL PROCEDURE PETUSERDISK(N,T);VALUE N,T;REAL N,T;FORWARD ; 00316100
$ SET OMIT = NOT DEBUGGING 00316999
$ SET OMIT = NOT DEBUGGING 00330999
ARRAY DALOC[*,*], DALOCROW[*]; 00333000
$ SET OMIT = NOT(BREAKOUT) 00333099
REAL OLAYMASK;% FOR LOCKING OUT GETMOREOLAYDISK BY MIX INDEX 00336000
PROCEDURE USERDISKSPECIALCASE(Q,R,U,J);VALUE Q,J;REAL Q,R,J; 00336100
ARRAY U[*]; FORWARD ; 00336110
DEFINE BASE=30268#,% 00338000
CHUNKSIZE=500#;% 00339000
REAL LEFTOFF; COMMENT POINTER TO CYCLE FOR OLAY;% 00341000
SAVE PROCEDURE DISKRTN(SEGNO, SIZE); 00363000
VALUE SEGNO, SIZE; 00363100
INTEGER SEGNO, SIZE; 00363200
FORWARD; 00363300
PROCEDURE FORGETSPDISK(SEG);VALUE SEG;REAL SEG;FORWARD; 00364000
SAVE INTEGER PROCEDURE DISKSPACE(NWORDS,P1MIX,AUX);% 00365000
VALUE NWORDS,P1MIX,AUX; 00366000
INTEGER NWORDS,P1MIX;REAL AUX; 00367000
FORWARD; 00368000
PROCEDURE STATUS;% 00369000
FORWARD;% 00370000
PROCEDURE INTERRUPT(TYPE);VALUE TYPE;REAL TYPE; FORWARD; 00370500
REAL PROCEDURE FINDOUTPUT(MID,FID,TYPE,FORMS,REEL,CDATE,CYCLE,KIND);% 00371000
VALUE MID,FID,TYPE,FORMS,REEL,CDATE,CYCLE,KIND;% 00372000
REAL MID,FID,TYPE,FORMS,REEL,CDATE,CYCLE,KIND; FORWARD;% 00373000
REAL PROCEDURE FINDINPUT(MID,FID,REEL,CDATE,CYCLE,COBOL,UL,OF,MODE,FN); 00374000
VALUE MID,FID,REEL,CDATE,CYCLE,COBOL,UL,OF,MODE,FN);% 00375000
REAL MID,FID,FEEL,CDATE,CYCLE,COBOL,UL,OF,MODE,FN; FORWARD;00376000
PROCEDURE STARTIMING(FN,U); VALUE FN,U; REAL FN,U; FORWARD;% 00377000
PROCEDURE FILEOPEN(X,A); VALUE X,A; INTEGER X,A; FORWARD; 00379000
SAVE PROCEDURE SAVEOPEN(A); VALUE A; REAL A; 00379100
BEGIN FILEOPEN(2,A) END; 00379200
PROCEDURE MIXPRINT(Q); VALUE Q REAL Q; FORWARD; 00379400
% TYPES <JOB SPECIFIERS> FOR EACH ACTIVE MIX INDEX 00379500
PROCEDURE JOBMESS(MIX,Q,A,B,C,D); VALUE MIX,Q,A,B,C,D; 00379600
REAL MIX,Q,A,B,C,D; FORWARD; 00379700
PROCEDURE SETNOTINUSE(U,RWL); VALUE U,RWL; REAL U,RWL; FORWARD; 00380000
DEFINE STOPTIMING=STARTTIMING#; 00382000
PROCEDURE FILLBUFFERS(CURRENT,FINAL,COBOL,NR); 00385000
VALUE CURRENT,FINAL,COBOL,NR; REAL CURRENT,FINAL,COBOL,NR; 00385500
FORWARD; 00386000
DEFINE GETBUFFERS=FILLBUFFERS#; 00387000
PROCEDURE REALFILECLOSE(A); VALUE A; REAL A; FORWARD; 00389000
SAVE PROCEDURE FILECLOSE(A); VALUE A; REAL A; 00389100
BEGN REALFILECLOSE(A) END; 00389200
REAL PROCEDURE DISKADDRESS(MID,FID,FPB3,A,H,IO); % (SHM)00390000
VALUE MID,FID,FPB3,A,H,IO; % (SHM)00390100
REAL MID,FID,FPB3,A,IO; ARRAY H[*]; % (SHM)00390200
FORWARD;% 00391000
PROCEDURE BLASTQ(U); VALUE U; REAL U; FORWARD;% 00392000
REAL PROCEDURE FILEHEADER(MID,FID,NROWS,SIZE,BLEN,RLEN,S);% 00393000
VALUE MID,FID,NROWS,SIZE,BLEN,RLEN,S;% 00394000
REAL MID,FID;% 00395000
INTEGER NROWS,SIZE,BLEN,RLEN,S; FORWARD;% 00396000
PROCEDURE PURGEIT(U); VALUE U; INTEGER U; FORWARD;% 00397000
REAL ESPTAB,ESPCOUNT; 00399000
REAL DIRDSK=@177; 00400500
REAL ESPDISKBOTTOM; % LOWEST ADDRESS OF ESPDISK 00401000
REAL ESPDISKTOP; % HIGHEST ADDRESS OF ESPDISK 00401100
REAL MESSAGEHOLDER;% 00402000
DEFINE USEDRA = OPTION.[47:1]#,% 00403000
USEDRB = OPTION.[46:1]#,% 00404000
BOJMESS =OPTION.[45:1]#,% 00405000
EOJMESS =OPTION.[44:1]#,% 00406000
OPNMESS =OPTION.[43:1]#,% 00407000
TERMGO =OPTION.[42:1]#,% 00408000
GIVEDATE = OPTION.[41:1]#,% 00409000
GIVETIME = OPTION.[40:1]#,% 00410000
SAMEBREAKTAPE=OPTION.[39:1]#, % NOT CURRENTLY USED, 3/73 00411000
AUTOPRINT=OPTION.[38:1]#, 00412000
CLEARWRS=OPTION.[37:1]#, 00413000
NOTIFYOP=OPTION.[36:1]#,% 00414000
DISCONDC = OPTION.[36:1]#, 00414100
COPNMESS=OPTION.[35:1]#,% 00415000
CLOSEMESS=OPTION.[34:1]#,% 00416000
ERRORMSG=OPTION.[33:1]#, 00416050
RETMSG=OPTION.[32:1]#, 00416100
LIBMSG=OPTION.[31:1]#, 00416200
SCHEDMSG=OPTION.[30:1]#, 00416300
SECMSG=OPTION.[29:1]#, 00416400
DSKTOG=OPTION.[28:1]#, 00416500
RELTOG=OPTION.[27:1]#, 00416520
PBDREL=OPTION.[26:1]#, 00416550
CHECKLINK = OPTION.[25:1]#, 00416560
DISKMSG=OPTION.[24:1]#, 00416570
LIBERR =(OPTION.[22:1] OR (SPOUTUNIT.[CF]=0))#, % FROM SPO%589-00416590
USEPRD=OPTION.[21:1]#,% %DS00416600
SVPBT =OPTION.[20:1]#,% 00416610
RSTOG=OPTION.[19:1]#, 00416620
AUTOUNLD=OPTION.[18:1]#, 00416630
AUTORN = OPTION.[17:1]#, %902-00416710
CODEOLAY=OPTION.[16:1]#, 00416730
COREST=OPTION.[15:1]#, 00416740
DATAOLAY=OPTION.[14:1]#, 00416750
HALTSET=OPTION.[13:1]#, 00416751
STOPTEST= OPTION.[8:1]#, 00416760
PUNCHLCK=OPTION.[7:1]#, 00416770
CDONLY=OPTION.[6:1]#, 00416780
PRTONLY=OPTION.[5:1]#, 00416790
SEPARATE=OPTION.[4:1]#, 00416800
MOD3IOS=OPTION.[2:1]#, 00416990
AUTOMESS = OPTION.[1:1]#, 00416992
AUTODS = OPTION.[1:1]#, % ACTS FOR OPERATOR %747-00416995
XXXXXX= OPTION.[0:1]#;% 00417000
DEFINE BOJBIT = 45[18:42:6]#, 00417010
EOJBIT = 44[18:42:6]#, 00417020
OPNBIT = 43[18:42:6]#, 00417030
COPNBIT = 35[18:42:6]#, 00417040
CLOSEBIT=34[18:42:6]#, 00417050
ERRRBIT = 33[18:42:6]#, 00417052
LIBBIT = 31[18:42:6]#, 00417060
SCHEDBIT=30[18:42:6]#, 00417070
SECBIT = 29[18:42:6]#, 00417075
RSBIT = 19[18:42:6]#, 00417080
NEVERBIT=62[18:42:6]#, 00417090
ALWAYSBIT=63[18:42:6]#; 00417100
REAL USERDISKBOTTOM; 00418000
% DISK ADDRESS OF USER DISK AVAILABLE TABLE 00418010
REAL DIRECTORYTOP; 00418050
% DISK ADDRESS OF DIRECTORYTOP SEGMENT--STORED IN M[1] 00418060
%BY MCP LOADER AND STORED IN MCP PRT(DIRECTORYTOP) 00418070
REAL DISKBOTTOM; 00418100
% DISK ADDRESS OF TOP FO BYPASS DIRECTORY, USED IN SCRAMBLE. 00418200
$ SET OMIT = NOT(SHAREDISK) 00418799
$ SET OMIT = SHAREDISK 00418849
REAL HOLDER,NEXTSLOT,BYPASS; 00418850
$ SET OMIT = NOT STATISTICS OR OMIT 00418859
DEFINE HOLDMAX = 30#; % MAXIMUM NUMBER OF ENTRIES IN HOLDLIST 00418900
COMMENT THE HOLDLIST CONTAINS A ONE WORD ENTRY FOR EACH PROCESS 00418910
THAT IS WAITING TO USE A FILE THAT IS ALREADY IN USE. 00418915
HOLDLIST[I].[FF]=THE CORE ADDRESS OF THE WORD THAT THE 00418920
WAITING PROCESS IS SLEEPING ON. 00418925
HOLDLIST[I].[CF]=THE DISK ADDRESS OF THE FILE HEADER 00418930
THAT IS BEING WAITED FOR. 00418935
HOLDLIST[I].[10:8]=MIX INDEX OF THE PROCESS THAT MADE THE 00418937
ENTRY. (TSSMCP ONLY) 00418938
HOLDLIST[I].[2:2]=THE SYSTEM NUMBER (SYSNO) OF THE SYSTEM 00418940
THAT MADE THE ENTRY (SHAREDISK ONLY). 00418945
HOLDLIST[I].[1:1] IS SET BY A SYSTEM TO NOTIFY ANOTHER 00418950
SYSTEM TO AWAKEN THE PROCESS THAT MADE THE ENTRY. 00418955
THE NSECOND ROUTINE EXAMINES THE HOLDLIST IN 00418960
ORDER TO CHECK FOR THIS CONDITION (SHAREDISK ONLY). 00418965
DIRECTORYSEARCH, NSECOND, AND CLEANOUT ARE THE PROCEDURES 00418970
THAT MANIPULATE THE HOLDLIST. 00418975
00418980
THE WORDS ASSOCIATED WITH DIRECTORY HANDLING ARE: 00418985
HOLDER.[CF] = DISK ADDRESS OF HOLDLIST. 00418990
.[FF] = NUMBER OF ENTRIES IN HOLDLIST. 00418995
NEXTSLOT = DISK ADDRESS OF FIRST HEADER IN QUEUE OF 00419000
EMPTY SLOTS IN DIRECTORY (NEXTSLOT QUEUE). 00419005
BYPASS.[CF] = LOWEST ADDRESS OF THE BYPASS DIRECTORY. 00419010
.[FF] = HIGHEST ADDRESS OF THE MAIN DIRECTORY. 00419015
ON SHAREDISK, HOLDER, NEXTSLOT AND BYPASS ARE KEPT IN THE FIRST 00419020
THREE WORDS OF THE DISK SEGMENT LOCATED AT DIRECTORYTOP+2. A 00419025
READ LOCK MUST BE DONE BEFORE ACCESSING THE HOLDLIST OR NEXTSLOT00419030
QUEUE OR EXPANDING EITHER THE MAIN OR BYPASS DIRECTORIES. 00419035
END COMMENT; 00419040
INTEGER RESTARTING; %PASSLEVEL CONTROL (RS) 00419100
$ SET OMIT = NOT(BREAKOUT) 00419104
DEFINE SCRAMBLE(SCRAMBLE1,SCRAMBLE2)=(-2| 00419110
((SCRAMBLE1.[6:18]+SCRAMBLE1.[24:24]) MOD MODULUS|MODULUS+ 00419120
(SCRAMBLE2.[6:18]+SCRAMBLE2.[24:24]) MOD MODULUS) + 00419130
DISKBOTTOM)#, 00419140
MODULUS=13#, DIRMOD=169#; 00419150
COMMENT 00419210
THE RELATIONSHIP BETWEEN MODULUS AND DIRMOD IS: 00419220
DIRMOD := MODULUS | MODULUS, WHERE MODULUS IS A LOW 00419230
ODD PRIME. (THE RECOMMENDED VALUE OF MODULUS IS 13). 00419240
FOR SYSTEMS WITH ONLY 4 MEMORY MODS, MODULUS MUST BE 00419250
SET TO A SMALLER VALUE SO THAT DIRECTORYBUILDER WILL 00419260
NOT GET A NO-MEM, MAKING IT IMPOSSIBLE TO HALT/LOAD. 00419270
IT IS SUGGESTED THAT MODULUS BE SET TO 11, DIRMOD TO 121 00419280
FOR A SYSTEM WITH 4 MODS. IT MAY BE NECESSARY TO SET IT 00419290
SMALLER, DEPENDING UPON DISK CONFIGURATION; 00419300
ARRAY FS[*,*]; ARRAY FSROW=FS[*]; 00419400
ARRAY USERDISK[*]; 00419900
$ SET OMIT = NOT DEBUGGING %763-00419999
$ SET OMIT = SHAREDISK 00421099
DEFINE LOCKDIRECTORY = 00421100
BEGIN IF NOT DIRECTORYTOG THEN SLEEP([TOGLE].DIRECTORYMASK);00421200
LOCKTOG(DIRECTORYMASK); 00421300
END#, 00421400
UNLOCKDIRECTORY = 00421500
BEGIN 00421600
UNLOCKTOG(DIRECTORYMASK); 00421700
END#; 00421800
$ POP OMIT 00421801
BOOLEAN OKSEGZEROWRITE; %20A-00422100
$ SET OMIT = NOT SHAREDISK 00422490
REAL LOGFREE,IOMASK,SAVEWORD; 00425000
REAL CORE; 00426000
COMMENT 00426100
CORE.[4:14] = MULTIPROCESSING FACTOR (|100) 00426200
CORE.[18:15] = SUM OF CORE ESTIMATES FOR ALL JOBS 00426300
NOW ACTIVE IN THE MIX (DIV 64) 00426400
CORE.[33:15] = ACMOUNT OF CORE MEMORY INITIALLY AVAILABLE FOR 00426500
PROCESSING NORMAL STATE JOBS (DIV 64) 00426600
PROCEDURE SELECTRUN(F); VALUE F; REAL F; FORWARD; 00426700
DEFINE SELECTION = INDEPENDENTRUNNER(P(.SELECTRUN),0,160)#; 00426800
PROCEDURE CONTROLCARD(A);VALUE A;REAL A; FORWARD;% 00427000
REAL PROCEDURE DIRECTORYSEARCH(A,B,C);VALUE A,B,C;% 00428000
REAL A,B,C; FORWARD;% 00429000
DEFINE HEADERUNLOCK=HU#, 00430000
HU(HU1,HU2,HU3)= 00430100
P(MKS,HU3,HU1,HU2,9,DIRECTORYSEARC,DEL)#; 00430200
REAL DIRECTORYSEARC=DIRECTORYSEARCH; 00430225
%%HEADERUNLOCK CAN BE USED TO WRITE IN THE DIRECTORY A CHANGED 00430250
%% HEADER, TURN OFF THE INTERLOCK BIT AND DO THE FORGETSPACE 00430275
%% IT MAY BE CALLED ONLY AFTER A DIRECTORYSEARCH(A,B,4) 00430300
%% THE PARAMETERS PASSED MUST BE (A,B,DS): 00430400
%% WHERE A,B ARE THE SAME AS PASSED TO THE DIRECTORYSEARCH 00430500
%% AND DS IS THE RESULT OF THAT DIRECTORYSEARCH 00430600
REAL OLDIDLETIME; 00430900
PROCEDURE ARTN(A,N); VALUE A,N; ARRAY A[*]; INTEGER N; FORWARD;% 00431000
SAVE PROCEDURE DISKIO(L,C,S,D); VALUE C,S,D; REAL L; INTEGER C,S,D;% 00432000
FORWARD;% 00433000
ARRAY MESSAGETABLE[*]; 00435000
DEFINE MESSAGETABLESIZE = 5#; % NUMBER OF MESSAGETABLE ENTRIES 00436000
DEFINE 00437000
OPTIONSZ = (MESSAGETABLE[0].[8:10])#, 00438000
TERMSGSZ = (MESSAGETABLE[1].[8:10])#, 00439000
KEYMSGSZ = (MESSAGETABLE[2].[8:10])#, 00440000
CCTABLSZ = (MESSAGETABLE[3].[8:10])#, 00441000
$ SET OMIT = PACKETS 00449999
$ SET OMIT = NOT(PACKETS) 00451499
DEFINE 00451500
SPOUT(SPOUT1)=SPOUTER(SPOUT1,0,1)#, 00451600
SPOUTIT(SPOUTIT1.SPOUTIT2)=SPOUTER(SPOUTIT1,0,SPOUTIT2)#; 00451700
PROCEDURE SPOUTER(MESSAGE,UNITNO,TYPE); 00451800
VALUE MESSAGE,UNITNO,TYPE; 00451900
REAL MESSAGE,UNITNO,TYP; 00452000
FORWARD; 00452100
DEFINE 00452200
FILEMESS=FMS#, 00452300
FMS(FMS1,FMS2,FMS3,FMS4,FMS5,FMS6,FMS7)= 00452400
FILEMESSAGE(FMS1,FMS2,FMS3,FMS4,FMS5,FMS6,FMS7,1)#; 00452500
PROCEDURE FILEMESSAGE(1,K,M,F,R,D,C,TYPE); 00452600
VALUE I,K,M,F,R,D,C,TYPE; 00452700
REAL I,K,M,F,R,D,C,TYPE; 00452800
FORWARD; 00452900
$ POP OMIT 00452901
PROCEDURE LBMESS(FN,SN,I1,I2,F,UNITNO,X); 00454000
VALUE FN,SN,I1,I2,F,UNITNO,X; 00454100
REAL FN,SN,I1,I2,E,UNITNO,X; 00454200
FORWARD; 00454300
PROCEDURE TERMINATE(MIX); VALUE MIX; REAL MIX; FORWARD; 00463100
SAVE PROCEDURE TERMNALMESSAGE(N); VALUE N; REAL N; FORWARD; 00463200
BOOLEAN PROCEDURE SYSTEMFILE(A,B);VALUE A,B; REAL A,B; FORWARD; 00463300
PROCEDURE ENTERSYSFILE(N); VALUE N; REAL N; FORWARD; 00464000
PROCEDURE COM5; FORWARD;% 00469000
$ SET OMIT = NOT(STATISTICS) 00469099
PROCEDURE ASR; FORWARD;% 00474000
PROCEDURE COM11; FORWARD;% 00475000
PROCEDURE COM13; FORWARD;% 00476000
PROCEDURE COMMUNICATE0; FORWARD; 00478000
PROCEDURE COMMUNICATE1; FORWARD; 00478500
PROCEDURE LIBRARYZERO; FORWARD; 00479500
PROCEDURE LIBRARYCOPY; FORWARD; 00480000
PROCEDURE FORMTIME(W,T); VALUE W,T; REAL W,T; FORWARD; 00480010
$ SET OMIT = NOT(DUMP OR DEBUGGING) 00480099
PROCEDURE DUMPCORE(B); VALUE B; REAL B; FORWARD; 00480199
$ POP OMIT 00480200
PROCEDURE COM19; FORWARD;% 00483000
PROCEDURE COM23; FORWARD;% 00487000
PROCEDURE INTRINSICTAABLEBUILDER(FH); 00489000
VALUE FH; REAL FH; FORWARD; 00490000
PROCEDURE MESSAGETABLEBUILDER; FORWARD; 00491000
$ SET OMIT = AUXMEM 00492000
DEFINE INVLDAUXIO = 11#, 00492100
LQOVFLOW = 13#, 00492200
$ SET OMIT = NOT (AUXMEM AND SHAREDISK) 00492300
ARRAY PUNTER[*]; 00493000
DEFINE PUNTSIZE = 11 00493100
$ SET OMIT = NOT SHAREDISK 00493200
+ 2 % INVLD AUXMEM IO 00493320
$ SET OMIT = NOT AUTODUMP 00493400
+ 19 % DUMP CARD 00493500
$ POP OMIT OMIT OMIT 00493600
#; 00493700
$ SET OMIT = NOT AUTODUMP 00644000
$ SET OMIT = NOT (SHAREDISK EQV AUXMEM) OR OMIT 00644100
DEFINE DUMPCRD = 13#, 00644200
DUMPADR = 26#; 00644300
$ POP OMIT 00644350
$ SET OMIT = (SHAREDISK OR NOT AUXMEM) OR OMIT 00644400
$ SET OMIT = NOT SHAREDISK OR AUXMEM OR OMIT 00644750
COMMENT THIS IS THE CODE ON THE DUMP CARD (ALL NUMBERS ARE OCTAL):00645000
:20: 20,20,NOP,NOP TELLS ANALYZER ALL I/O RES ARE OK00645010
:21: STD,5,BFW BRANCH TO 23 00645020
:22: INI,0,LFU TIMER - LOOP UNTIL INTERRUPTED 00645030
:23: 10,LOD,21,STD SAVE M[8], RESTORED BY 2ND CARD 00645040
:24: 25,IIO,2,LBU START I/O THEN WAIT AT TIMER 00645050
:25: 0140000007700035 I/O DESC FOR 77 SEG WRITE FROM 3500645060
:26: 0140000047400157 I/O DESC FOR 74 SEG READ OF CODE 00645070
:27: OPDC 14,DIA 26,10,BFW I/O 1 - PICK UP RES DESC. 00645080
:30: OPDC 15,DIA 26,6,BFW I/O 2 - DIAL TO ERR FIELD. 00645090
:31: OPDC 16,DIA 26,2,BFW I/O 3 - BRANCH INTO I/O 4 00645100
:32: OPDC 17,DIA 26, I/O 4 00645110
DESC 24,CBD 7 BRANCH TO 24 FOR RETRY IF ERRORS 00645120
:33: DESC 37,BFW GO TO 37 1ST TIME, SEE 41 FOR 2ND00645130
:34: INI,0,LFU DATACOM - LOOP UNTIL INTERRUPTED 00645140
:35: 0000000000000501 DISK ADDRESS FOR WRITE 00645150
:36: INI,0,LFU FREEADDRESS - LOOP ON INTERRUPT 00645160
:37: 200,157,SND,240 STORE DISK ADDR FOR READ. SET 24000645170
TO OPERAND FOR DESC AT 41 00645180
:40: STD,OPDC 26,25,STD PUT I/O DESC INTO 25 00645190
:41: DESC 240,37,STD,NOP SET 37 FOR BRANCH TO 240 FROM 33 00645200
:42: 16,LBU BRANCH TO 24 TO START THE READ; 00645210
$ POP OMIT 00645900
SAVE PROCEDURE RESULT; 00646900
BEGIN 00647000
GO TO P([18]); % TIMER IS A LOOP ON INTERRUPTS 00648000
END; 00649000
00649999
SAVE PROCEDURE PUNT(I); VALUE I; REAL I; 00650000
BEGIN REAL T=-3; 00650250
REAL TMB, RSLT=RESULT; 00650500
LABEL HA,HB; 00650750
I:=IF I=0 THEN T ELSE PUNTER INX I; 00651000
STREAM(Q:=P(0,RDF): I, 00651800
A:=18, D:=I:=PUNTER INX 0); 00652000
BEGIN DS:= 16 LIT"-SYSTEM HANG, F="); %104-00652400
SI:=LOC Q; SI:=SI+3; 00652600
5(DS:=3 RESET; 00652800
3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB)); 00653000
DSD:=2 LIT": "; SI:=1; 00653200
63(IF SC!"~" THEN DS:=CHR); DS:=LIT"~"; 00653400
DI:=A; DS:=8 LIT"29290+JI"; % INI,INI,4,BBW 00653600
SI:=A; DS:=44 WDS; 00653800
DI:=A; DI:=DI+8; % IOBUSY- 00654000
DS:=4 LIT"002("; % 0,RTN 00654200
DI:=DI+28; % IOCOMPLETE-LOD R,RTN 00654400
DS:=32 LIT"0 +A+:2(OU+A+:2(0Y+A+:2(0!+A+:2("; 00654600
END; 00654800
P(HP2); 00655000
HA: TMB:=I&60[3:42:6]; 00655200
P([TMB],IIO); 00655400
HB: DO IF (TMB:=P(MKS,RSLT)) = 0 THEN % IO BUSY 00655600
BEGIN P(MKS,RSLT,DEL); GO HA END 00655800
UNTIL TMB.[3:6]=60; 00656000
IF TMB.[CF]<I THEN GO TO HB; 00656200
IF TMB.[FF]!0 THEN GO TO HA; 00656400
$ SET OMIT = NOT AUTODUMP 00656500
IF NOT HALTSET AND PUNTER[DUMPADR]=@501 THEN 00656600
BEGIN 00656800
STREAM(S:=[PUNTER[DUMPCRD]], D:=@20); 00657000
BEGIN SI:=S; DS:=19 WDS; END; 00657200
GO TO P(0,STS,0,STF,[M[@20]]); 00657400
END; 00657600
$ POP OMIT 00657700
DO UNTIL FALSE; 00657800
END; 00662000
$ SET OMIT = DATACOM 00689990
$ RESET SEPTICTANK 00690000
$ POP OMIT 00699990
$ SET OMIT = NOT DATACOM 00699999
$ SET OMIT = NOT(DFX) 00999999
SAVE PROCEDURE STARTIO(U); VALUE U; REAL U; FORWARD; 01165000
SAVE PROCEDURE COMPLEXSNOOZE(PRI,CODE); VALUE PRI; REAL PRI,CODE; 01240000
BEGIN SNOOZE(PRI,1,P(.CODF,LOD)); END; 01240100
DEFINE COMPLEXSLEEP(COMPLEXSLEEP1)=COMPLEXSNOOZE(PRYOR[P1MIX], 01240200
COMPLEXSLEEP1)#; 01240300
PROCEDURE USASITAPE(AREA,TYPE,FROM,U,DIR); %RHR 01250100
VALUE AREA,FROM,U,DIR; REAL AREA,TYPE,FROM,U,DIR; 01250200
BEGIN REAL PIN,Y; 01250300
ARRAY ULAB[*]; 01250400
LABEL EXIT,ERROR,VOL,BAD,WAIT,TIP,ETIP; 01250500
SUBROUTINE LABELSPACE; 01250600
BEGIN ULAB:=[M[SPACE(11)]]&10[8:38:10]; 01250700
MOVE(10,ULAB.[CF]-1,ULAB,[CF]); 01250800
END LABELSPACE; 01250900
SUBROUTINE VOL1FILL; 01251000
BEGIN STREAM(AREA,ULAB); 01251100
BEGIN DS:=8 LIT " LABEL "; DI:=DI+1; SI:=AREA; 01251200
SI~SI+11;IF SC=" " THEN DS~7LIT"0" ELSE DS~7CHR; 01251300
DI~DI+37; %MID 01251310
SI:=AREA; SI:=SI+5; DS:=5 CHR; %PHYSICAL TAPE NO. 01251400
END; 01251500
END VOL1FILL; 01251600
SUBROUTINE HDR1CHK; 01251700
BEGIN STREAM(Y:=0:AREA,X:=0); 01251800
BEGIN DI:=LOC X; DS:=4 LIT "HDR1"; 01251900
SI:=AREA; DI:=LOC X; 01252000
IF 4 SC=DC THEN TALLY:=1; 01252100
Y:=TALLY; 01252200
END; 01252300
Y:=P; 01252350
END HDR1CHK; 01252400
SUBROUTINE HDR1FILL; 01252500
BEGIN STREAM(AREA,ULAB); 01252600
BEGIN SI:=AREA; SI:=SI+4; 01252700
DI:=DI+17; DS:=7 CHR; %FID 01252800
SI:=SI+17; DS:=3 CHR; %REEL 01252900
SI:=SI+11; DS:=5 CHR; %C-DATE 01253000
SI:=SI-8; DS:=2 CHR; %CYCLE 01253100
SI:=SI+7; DS:=5 CHR; %P-DATE 01253200
DI:=DI+1; SI:=SI+2; 01253300
DS:=5 CHR; %BLOCK COUNT 01253400
DS:=7 CHR; %RECORD COUNT 01253500
END; 01253600
END HDR1FILL; 01253700
SUBROUTINE HARDFILL; 01253800
BEGIN RTN:=PRNTABLE[U].[30:18]; 01253900
STREAM(PTN,AREA,ULAB); 01254000
BEGIN SI:=LOC PIN; DI:=DI+53; 01254100
DS:=5 DEC; DI:=ULAB; %PHYSICAL TAPE NO. 01254200
DS:=8 LIT " LABEL "; 01254300
END; 01254600
ULAB[1]:=MULTITABLE[U]; 01254650
END HARDFILL; 01254700
LABELSPACE; 01254800
IF FROM=1 THEN 01254900
BEGIN VOL1FILL; 01255000
P(WAITIO(@140000005,@377,U);DEL); 01255100
P(WAITIO(AREA INX @120540000000,@377,U),DEL); 01255200
HDR1CHK; 01255300
IF Y THEN HDR1FILL ELSE GO TO ERROR; 01255400
P(WAITIO(@340000005,@55,U),DEL); 01255450
P(WAITIO(@340000005,@55,U),DEL); 01255500
GO TO WAIT; 01255600
END; 01255700
IF FROM =2 THEN 01255800
BEGIN IF TYPE=1 THEN 01255900
BEGIN VOL1FILL; 01256000
VOL: P(WAITIO(AREA INX @120540000000,@377,U),DEL); 01256100
HDR1CHK; 01256200
IF Y THEN HDR1FILL ELSE GO TO ERROR; 01256300
P(WAITIO(@340000005,@377,U),DEL); 01256400
GO TO WAIT; 01256500
END; 01256600
IF TYPE=2 THEN 01256700
BEGIN HDR1FILL; 01256800
HARDFILL; 01256900
GO TO EXIT; 01257000
END; 01257100
END; 01257200
IF FROM=3 OR FROM=4 THEN 01257300
BEGIN IF TYPE=1 THEN 01257400
BEGIN VOL1FILL; 01257500
GO TO VOL; 01257600
END; 01257700
IF TYPE=2 OR TYPE=4 THEN 01257800
BEGIN HDR1FILL; 01257900
HARDFILL; 01258000
GO TO EXIT; 01258100
END; 01258200
IF TYPE=3 OR TYPE=5 THEN 01258300
BEGIN IF DIR=0 THEN 01258400
BEGIN P(WAITIO(@340000005,@377,U),DEL); 01258500
P(WAITIO(@340000005,@377,U),DEL); 01258600
P(WAITIO(AREA INX @120540000000,@377,U),DEL); 01258700
END ELSE 01258800
P(WAITIO(AREA INX @120740000000,@377,U),DEL); 01258900
HDR1CHK; 01259000
IF Y THEN HDR1FILL ELSE GO TO ERROR; 01259100
HARDFILL; 01259200
GO TO WAIT; 01259300
END; 01259400
IF TYPE=6 THEN 01259500
BEGIN HDR1FILL; 01259600
HARDFILL; 01259700
STREAM(ULAB); 01259800
BEGIN DI:=ULAB; DI:=DI+39; 01259900
DS:=1 LIT "1"; 01260000
END; 01260100
GO TO EXIT; 01260200
END; 01260300
END; 01260400
WAIT: PTN:=0; 01260425
TIP: IF((TWO(U) AND P(RRR)) !0) THEN 01260450
GO TO EXIT ELSE SLEEP([CLOCK], NOT CLOCK); 01260455
PTN:=PTN+1; 01260460
IF(PTN>120)THEN GO TO EXIT ELSE GO TO TIP; 01260465
ERROR: P(WAITIO(@4200000000,@377,U),DEL); 01260500
STREAM(T:=TINU[U],ULAB); 01260600
BEGIN SI:=LOC T; SI:=SI+5; 01260700
DS:=LIT "#"; DS:=3 CHR; 01260800
DS:=22 LIT " INVALID USASI. RW/L~"; 01260900
END; 01261000
SPOUT(ULAB.[CF]); LABELTABLE[U]:=@314;; 01261100
TYPE~0; PTN~0; 01261150
ETIP: IF((TWO(U) AND P(RRR)) !0) THEN 01261160
GO TO BAD ELSE SLEEP([CLOCK], NOT CLOCK); 01261170
PTN:=PTN+1; 01261180
IF(PTN>120) THEN GO TO BAD ELSE GO TO ETIP; 01261200
EXIT: MOVE(10,ULAB.[CF],AREA.[CF]); 01261300
FORGETSPACE(ULAB.[CF]); 01261400
BAD: 01261450
END USASITAPE; %RHR 01261500
SAVE PROCEDURE SNOOZE(NEWPRI,ADDRESS,MASK); 02000000
VALUE NEWPRI, ADDRESS, MASK; 02001000
REAL NEWPRI; 02002000
NAME ADDRESS; 02002500
ARRAY MASK[*]; 02003000
BEGIN 02004000
REAL TRYHERE=NT1; 02004500
$ SET OMIT = NOT(NEWLOGGING) 02004599
LABEL BEDENTER; 02004900
IF (JOBNUM:=JOBNUM+2) GEQ JOBNUMAX THEN PUNT(9); 02005000
PRYOR[P1MIX].[FF]~ NEWPRI~ NEWPRI+1; 02006000
FOR TRYHERE~JOBNUM STEP -2 UNTIL 2 DO 02007100
BEGIN 02007200
IF PRYOR[(BED[TRYHERE]~BED[TRYHERE-2]).[3:5]].[FF] 02007300
< NEWPRI THEN GO TO BEDENTER; 02007400
BED[TRYHERE+1] ~ BED[TRYHERE-1]; 02007500
END; 02007600
BEDENTER: 02008000
BED[TRYHERE] ~ P(ADDRESS & P1MIX[3:43:5], RDF); 02008100
BED[TRYHERE+1] ~ MASK; 02008200
STOPLOG(P1MIX,1); 02008300
GO TO NOTHINGTODO; 02008400
END SLEEP; 02009000
SAVE PROCEDURE INDEPENDENTRUNNER(ROUTINE,PARAMETER,SSZ); 02012000
VALUE ROUTNE,PARAMETER,SSZ; 02013000
ARRAY PARAMETER[*]; 02014000
REAL ROUTINE,SSZ; 02015000
BEGIN LSLATE:= LSLATE+2 AND SLATEEND;% 02016000
IF NSLATE=LSLATE THEN PUNT(7); 02017000
SLATE[LSLATE] ~ PARAMETER;% 02018000
SLATE[LSLATE+1]:=ROUTINE&SSZ[CTF]; 02019000
END; 02020000
REAL KEYBOARDCOUNTER; 02020500
REAL PROCEDURE KEYIN(B); VALUE B; BOOLEAN B; FORWARD;% 02021000
$ SET OMIT = NOT(DCSPO AND DATACOM ) 02021099
BOOLEAN PROCEDURE WHYSLEEP(MASK); VALUE MASK; REAL MASK; FORWARD;% 02022000
LABEL P1PROCESS,P2PROCESS;% 02023000
REAL ONEOHONE = @101,ONEOHTWO = @102;% 02024000
SAVE PROCEDURE RUN(MIX); VALUE MIX; REAL MIX; 02025000
BEGIN P1MIX ~ MIX;% 02026000
$ SET OMIT = NEWLOGGING 02026999
STARTLOG(MIX); 02027000
$ POP OMIT 02027001
STACKUSE ~ TRUE;% 02028000
GO TO EXTERNAL;% 02029000
END;% 02030000
REAL NUMESS;% 02031000
SAVE PROCEDURE SAVEMIX(MIX); VALUE MIX; REAL MIX;% 02032000
BEGIN INDEPENDENTRUNNER(P(.RUN),MIX,0); 02033000
$ SET OMIT = NEWLOGGING 02033999
STOPLOG(MIX,0); 02034000
$ POP OMIT 02034001
END;% 02035000
SAVE PROCEDURE HALT;% 02036000
BEGIN NOPROCESSTOG ~ NOPROCESSTOG+1;% 02037000
IF P2MIX > 0 THEN% 02038000
BEGIN P(HP2);% 02039000
$ SET OMIT = NOT(NEWLOGGING) 02039099
SNOOZE(-1,1,1); 02040000
IF P2MIX > 0 THEN% 02041000
BEGIN SAVEMIX(P2MIX);% 02042000
P2MIX~0; TOGLE~TOGLE AND NOT HP2MASK; 02043000
END;% 02044000
END;% 02045000
END;% 02046000
SAVE PROCEDURE KILL(A); VALUE A; ARRAY A[*];% 02047000
BEGIN P(64,STS);% 02048000
FORGETSPACE(A);% 02049000
GO TO NOTHINGTODO;% 02050000
END;% 02051000
REAL PBCOUNT; 02052200
BOOLEAN PROCEDURE OLAY(LOC); VALUE LOC; REAL LOC; FORWARD; 02052500
PROCEDURE SEEKNAME(A,B,C,D,E,N,XLST); VALUE A,B; 02052700
REAL A,B,C,D,E,N; ARRAY XLST[*]; FORWARD; 02052800
PROCEDURE UNHOOQUE(MIX);% 02053000
VALUE MMIX;% 02054000
INTEGER MIX;% 02055000
BEGIN% 02056000
REAL U,S,SN,T,X,I,PROCE;% 02057000
NAME OLDQ=X; 02057500
LABEL DOLP,DELINKIT; 02058000
FOR U~0 STEP 1 UNTIL 31 DO% 02059000
BEGIN% 02060000
IF(S~UNIT[U].[FF])!@77777 THEN 02061000
BEGIN% 02062000
WHILE (SN~LOCATQUE[S].[FF])!@77777 DO% 02063000
BEGIN IF (T~NFLAG(LOCATQUE[SN])).[3:5] =% 02064000
MIX THEN% 02065000
IF LOCATQUE[SN].[11:1] THEN S~SN ELSE 02065100
BEGIN% 02066000
LOCATQUE[S]~LOCATQUE[S]&T[FTF];% 02067000
RETURNIOSPACE(SN); 02068000
END ELSE% 02070000
S~SN;% 02071000
END% 02072000
END 02072100
END; 02072200
$ SET OMIT = NOT DFX; 02072490
DOLP: FOR U~0 STEP 1 UNTIL 31 DO% 02075000
BEGIN% 02076000
IF (S~(T~UNIT[U]).[FF])!@77777 THEN 02077000
BEGIN% 02078000
IF LOCATQUE[S].[3:5]=MIX THEN% 02079000
BEGIN% 02080000
IF (X~T.[13:5])=0 OR X=16 THEN 02081000
GO DELINKIT; 02082000
IF X=4 THEN% 02087000
BEGIN% 02088000
IF LOCATQUE[S].[FF]=@77777 THEN% 02089000
BEGIN% 02090000
I~FIRSTWAIT;% 02091000
WHILE WAITQUE[I]!U% 02092000
DO I ~ I+1 AND 32;% 02093000
WAITQUE[I]~% 02094000
WAITQUE[NEXTWAIT~NEXTWAIT% 02095000
+31 AND 31];% 02096000
UNIT[U]~T&@77777[13:28:20]; 02097000
END ELSE 02097200
DELINKIT: UNIT[U]:=T&LOCATQUE[S][FTF]; 02097400
$ SET OMIT = NOT DFX 02097590
RETURNIOSPACE(S); 02100000
END ELSE 02100400
PROCE~((U!23 AND U!24) OR X=3) 02101000
AND X!25 OR PROCE; 02101100
END% 02102000
END$ 02103000
END ;% 02104000
IF PROCE THEN% 02105000
BEGIN% 02106000
SLEEP([CLOCK],NOT CLOCK); PROCE~0; GO TO DOLP; 02107000
END;% 02108000
END UNHOOQUE;% 02109000
DEFINE PSF-3:4#, 02110050
TERMSET(TERMSET1)=(PRTROW[TERMSET1].[6:1]=1)#, 02110100
NOTERMSET(NOTERMSET1)=(PRTROW[NOTERMSET1].[6:1] NEQ 1)#, 02110200
TERMGOING(TERMGOING1)=(PRTROW[TERMGOING1].[PSF]=3)#, 02110250
BREAKSET(BREAKSET1)=(PRTROW[BREAKSET1].[PSF]=4)#, %139-02110260
STOPSET(STOPSET1)=(PRTROW[STOPSET1].[PSF]=2)#; 02110300
REAL PROCEDURE GETESPDISK;FORWARD;% 02111000
PROCEDURE CHANGEMCP(KTR); VALUE KTR; REAL KTR; FORWARD; 02111100
PROCEDURE CHANGEINTRINSICFILE(KTR); VALUE KTR; REAL KTR; FORWARD; 02111200
$ SET OMIT = NOT(DEBUGGING) 02111299
REAL PROCEDURE ANALYSIS; FORWARD; 02111400
PROCEDURE SHORTCOMMUNICATE; FORWARD; 02111500
PROCEDURE CONTINUITYBIT; FORWARD; 02111600
REAL CCTBLWORD; 02112000
DEFINE CCCOUNT = CCTBLWORD.[FF]#, 02112100
CCTBLADDR = CCTBLWORD.[CF]#; 02112200
REAL READERA,READERB; 02112500
$ SET OMIT = NOT(PACKETS) 02113079
ARRAY PSEUDO[*]; %PSEUDOMAX; 02113080
ARRAY PSEUDOMIX[*], NYLONZIPPER[*]; %MIXMAX 02113085
DEFINE PACKETPAGE[PACKETPAGE1]=PSEUDO[PACKETPAGE1].[22:26]#; 02113086
DEFINE PACKETREC[PACKETREC1]=PSEUDO[PACKETREC1].[18:3]#; 02113087
DEFINE PACKETPBD[PACKETPBD1]=PSEUDO[PACKETPBD1].[8:10]#; 02113088
DEFINE PACKETACT[PACKETACT1]=PSEUDO[PACKETACT1].[2:6]#; 02113089
DEFINE PACKETERR[PACKETERR1]=PSEUDO[PACKETERR1].[1:1]#; 02113090
DEFINE PAGESIZE=300#; % SAME AS PBDROWSZ AT 08699100 %732-02113091
DEFINE PAGEFULL=(PAGESIZE DIV 3)|5-40#; % ALLOW FOR 8 INFO RECORDS 02113092
$ POP OMIT 02113099
PROCEDURE MESSAGEWRITER;% 02114000
BEGIN REAL RWC=+0, MSCW=-2; 02115000
REAL T=+1;% 02116000
LABEL L;% 02117000
P(0); 02118000
$ SET OMIT = NOT(DCSPO AND DATACOM ) 02119009
$ SET OMIT = DCSPO 02119019
L: 02119020
$ POP OMIT 02119021
P(WAITIO(MESSAGEHOLDER INX 1,0,0,25)); 02120000
P(DEL);% 02121000
NUMESS ~ NUMESS-1;% 02122000
T ~ M[MESSAGEHOLDER].[18:15]; 02123000
FORGETSPACE(MESSAGEHOLDER INX 1); 02124500
IF T ! 0 THEN% 02125000
BEGIN MESSAGEHOLDER.[33:15] ~ T;% 02126000
GO TO L% 02127000
END;% 02128000
MESSAGEHOLDER ~ 0;% 02129000
KILL([MSCW]); 02130000
END;% 02131000
$ SET OMIT = NOT(DCSPO AND DATACOM ) 02131005
$ SET OMIT = PACKETS 02131999
$ SET OMIT = NOT(PACKETS) 02132299
PROCEDURE SPOUTER(MESSAGE,UNITNO,TYPE); 02132300
VALUE MESSAGE,UNITNO,TYPE; 02132400
REAL MESSAGE,UNITNO,TYPE; 02132500
$ POP OMIT 02132501
BEGIN REAL MKSCW=MESSAGE-1; 02133000
INTEGER MIX; 02133010
$ SET OMIT = NOT(DATACOM AND DCSPO ) 02133011
$ SET OMIT = (DATACOM AND DCSPO) %950-02133122
INTEGER LFT; %950-02133123
$ POP OMIT %950-02133124
$ SET OMIT = NOT(PACKETS) 02133129
DEFINE PACKETFREE=PSEUDO[UNITNO].[21:1]#, 02133130
PACKETMASK=#400000000#; 02133140
REAL PSD,PWS,X,Z,BB; 02133150
INTEGER NT1,R,S,T; ARRAY BUF[*]; 02133200
$ SET OMIT = NOT(DATACOM AND DCSPO) OR OMIT %203-02133279
R:=UNITNO.[CF]; UNITNO:=0; 02133300
IF R=0 THEN IF P1MIX!0 THEN R:=PSEUDOMIX[P1MIX]; 02133350
IF R>31 AND R<64 THEN UNITNO:=R; 02133380
$ POP OMIT 02133381
$ SET OMIT = NOT(DATACOM AND DCSPO) 02133499
MESSAGE ~ P(.MESSAGE,LOD).[33:15]-1;% 02134000
MIX ~ M[MESSAGE-1].[9:6]; 02134005
$ SET OMIT = NOT(DATACOM AND DCSPO ) 02134008
$ SET OMIT = NOT(PACKETS) 02134889
IF TYPE THEN 02134890
$ POP OMIT 02134891
$ SET OMIT = NOT(DATACOM AND DCSPO ) 02134899
BEGIN 02134906
IF MESSGEHOLDER = 0 THEN% 02135000
BEGIN MESSAGEHOLDER ~ MESSAGE;% 02136000
INDEPENDENTRUNNER(P(.MESSAGEWRITER),0,64); 02137000
END% 02138000
ELSE M[MESSAGEHOLDER.[18:15]].[18:15] ~ MESSAGE; 02139000
M[MESSAGE]~0&MIX[4:43:5]; 02140000
MESSAGEHOLDER.[18:15] ~ MESSAGE;% 02141000
END; 02141020
M[MESSAGE-1].[9:6] ~ 0;% 02142000
M[MESSAGE-1].[AREATYPEF] := SPOUTMSGAREAV;% %167-02142100
IF P(MKSCW.[33:15],DUP) = 0 THEN% 02143000
BEGIN ; 02143050
STREAM(N~9:X~MESSAGE+1); 02144500
BEGIN SI ~ X;% 02145000
L: IF SC ! "~" THEN% 02146000
BEGIN IF SC= " " THEN% 02147000
BB: BEGIN SI~ SI+1; 02148000
IF SC=" " THEN GO BB; 02149000
IF SC = ALPHA THEN% 02150000
BEGIN SI ~ SI-1;% 02151000
DS ~ CHR;% 02152000
END ELSE GO TO L;% 02154000
END;% 02155000
IF SC = @14 THEN% 02156000
BEGIN DS ~ CHR;% 02157000
Q: IF SC = @14 THEN% 02158000
BEGIN SI ~ SI+1;% 02159000
GO TO Q; 02160000
END;% 02162000
GO TO L;% 02163000
END;% 02164000
DS ~ CHR;% 02165000
GO TO L;% 02167000
END;% 02168000
DS ~ CHR;% 02169000
N ~ DI; 02171000
END;% 02172000
NT1~P;NT1~((NT1.[33:15]-(MESSAGE+1))|8+NT1.[30:3])|6; 02173000
END ELSE NT1 ~ P | 6; 02173050
$ SET OMIT = NOT(PACKETS) 02173069
IF UNITNO!0 THEN IF PACKETPAGE[UNITNO-32]>1 THEN 02173075
BEGIN UNITNO:=UNITNO-32; 02173080
IF NOT PACKETFREE THEN SLEEP([PSEUDO[UNITNO]],PACKETMASK);02173085
IF (PSD:=PACKETPAGE[UNITNO])>1 THEN 02173087
BEGIN % JUST TO BE SURE 02173088
PACKETFREE:=FALSE; 02173090
Z:=IF (PSW:=PACKETREC[UNITNO]) THEN 60 ELSE 30; 02173095
S:=((Y:=IF NT1>725 THEN 120 ELSE NT1 DIV 6)+7) DIV 8; 02173100
BUG:=[M[T:=SPACE(Z+S)]]&Z[8:38:10]; 02173110
M[BUF-2].[9:6]:=0; 02173120
STREAM(N:=S,AA:=MESSAGE+1,BUF:=BUF INX Z); 02173150
BEGIN SI:=AA; DS:=N WDS END; 02173160
DISKWAIT(-T,Z,PSD+PSW DIV 2); 02173210
R:=(PSW|18) MOD 30; 02173220
IF (BB:=BUF[R+17].[CF]) GEQ PAGEFULL THEN 02173230
BEGIN STREAM(BUF:=[BUF[R]]); 02173240
BEGIN DS:=12LIT" "; 02173245
DS:=28LIT"ALL FURTHER MESSAGES LOST "; 02173250
2(DI:=DI+48); DS:=6LIT":|5908"; 02173255
END; 02173260
PACKETPAGE[UNITNO]:=1; % TO MARK OVERFLOW 02173265
END 02173270
ELSE BEGIN P(@1540005000100000&(RB+1)[CTC]); % PBDSTOPPER 02173275
IF PSW=0 THEN 02173280
BEGIN P(BUF[29],XCH); 02173282
P([BUF[29]],STD); 02173284
DISKWAIT(T,30,PSD+5); 02173286
P([BUF[29]],STD); 02173288
END ELSE 02173290
P([BUF[R-1]],STD); 02173292
BUF[R+17]:=@1540000104000000&BB[CTC]& 02173294
(S+2+(M[BUF INX Z].[1:5]!">"))[8:38:10]; 02173296
FORMTIME([LFT],XCLOCK~P(RTR)); %154-02173297
STREAM(N:=S-1,CL:=S|8-Y,AA:=BUF INX Z,BB := LFT,%154-02173300
BUF:=[BUF[R]]); 02173301
BEGIN DS := 7 LIT " "; SI := LOC BB; DS := 8 CHR; 02173305
DS := 9 LIT " "; SI := AA; %154-02173306
IF SC!">" THEN DS:=8 CHR ELSE 02173310
BEGIN DI:=DI-8; 8(IF SC!">" THEN DS:=CHR ELSE 02173315
BEGIN DI:=DI+1; SI:=SI+1; END); 02173320
END; N(DS:= 8 CHR); DI:=DI-CL; AA:=DI; 02173325
SI:=AA; SI:=SI-1; 02173330
IF SC="~" THEN BEGIN DI:=DI-1; DS:=LIT" "; END; 02173335
CL(DS:=LIT" "); 02173340
END;END; 02173345
DISKWAIT(T,Z,PSD+PSW DIV 2); 02173350
IF PACKETPAGE[UNITNO]>1 THEN 02173360
IF PSW=0 THEN 02173362
BEGIN PACKETPAGE[UNITNO]:=PSD+3; 02173364
PACKETREC[UNITNO]:=4; 02173366
END ELSE 02173368
PACKETREC[UNITNO]:=PSW-1; 02173370
PACKETFREE:=TRUE; 02173375
FORGETSPACE(BUF); 02173380
END; % JUST TO BE SURE 02173383
END; 02173385
IF NOT TYPE THEN BEGIN FORGETSPACE(MESSAGE+1); P(XIT); 02173389
END; 02173390
$ POP OMIT 02173391
IOTIME[P1MIX] ~ *P(DUP)+NT1;% 02174000
$ SET OMIT = NOT(DCSPO AND DATACOM ) 02174005
$ SET OMIT = DCSPO 02175002
IF (NUMESS~ NUMESS+1)>0 THEN 02175003
$ POP OMIT 02175004
BEGIN 02175010
$ SET OMIT = NOT(DATACOM AND DCSPO ) 02175020
SLEEP([NUMESS],-0);% 02176000
END; 02176100
END;% 02177000
PROCEDURE ENDOFDECK(R,TUSTA);VALUE R,TUSTA; REAL R,TUSTA; FORWARD; 02177100
PROCEDURE PBIO(A,B); VALUE A; REAL A,B; FORWARD; 02178500
REAL TERMINALCLOCK; 02179000
PROCEDURE TERMINATE(MIX); VALUE MIX; REAL MIX;% 02180000
BEGIN IF MIX LEQ 0 THEN BYBY("MCP DS-ED~",10); 02181000
IF JARROW[MIX] NEQ 0 THEN 02182000
BEGIN 02183000
IF NOTERMSET(MIX) THEN 02184000
BEGIN 02185000
TERMINALCLOCK:=CLOCK+P(RTR); 02185900
PRTROW[MIX].[FF]:=MIX.[FF]; 02186000
PRTROW[MIX].[PSF]:=1; 02186050
END; 02186100
END; 02186300
END;% 02187000
REAL PROCEDURE PLACEFINDER(S, A, L); 02187100
VALUE S, A; 02187200
REAL S, A, L; 02187300
FORWARD; 02187400
ARRAY CIDROW[*],CIDTABLE=CIDROW[*,*]; 02187500
PROCEDURE TERMINALMESSAGA(N); VALUE N; REAL N; 02188000
BEGIN LABEL FOUND,DOIT,OWT,TOIT; 02189000
REAL A,T,S,ADR;% 02190000
NAME B;% 02191000
ARRAY FIB[*]; 02191500
REAL BLEN,NBUF; 02191600
REAL MIXER,TOPIO,LUN,L;% 02192000
INTEGER I=S; LABEL QZ;% 02193000
LABEL STT;% 02194000
SUBROUTINE SLAPITOFF;% 02195000
IF LUN GEQ 32 THEN 02195100
$ SET OMIT = PACKETS 02195199
ELSE 02195300
BEGIN SLEEP([TOGLE],STATUSMASK); 02196000
READY ~ NOT (I ~ TWO(LUN)) AND READY;% 02197000
RRRMECH ~ NOT I AND RRRMECH OR I AND SAVEWORD;% 02198000
LABELTABLE[LUN] ~ @114;% 02199000
MULTITABLE[LUN] ~ RDCTABLE[LUN] ~ 0;% 02200000
END;% 02201000
LABEL LB,LBI;% 02202000
$ SET OMIT = NOT(NEWLOGGING) 02202049
NOMEM:=NOMEM-TAR[P1MIX].[20:1]; %IF THIS JOB HAD A NOMEM 02202100
TAR[P1MIX].[20:1]:=0; %CONDITION - CLEAR IT 02202200
UNLOCKTOG(TAR[P1MIX]); 02202500
REPLY[P1MIX]~0;% 02203000
PRTROW[P1MIX].[PSF]:=3; % IN PROCESS OF DSING 02205000
PRYOR[P1MIX]~-1; 02205100
A ~ IF N < 0 THEN ABS(N) ELSE SPACE(10);% 02206000
IF N=32 THEN JAR[P1MIX,6].[1;1]~1; % MEM PAR %949-02206100
B ~ PRT[P1MIX,4];% 02207000
IF P(M[L~PRT[P1MIX,8].[CF]],TOP,XCH,DEL)THEN %TR02208000
S~ADR~0 ELSE %TR02209000
DO BEGIN IF P(M[L],TOP,XCH,0,INX,.ADR,~) THEN% OVERLAID RCWTR02210000
BEGIN IF NOT M[L].[33:1] THEN%NOT TYPE 13 INT 02211000
BEGIN S~ADR; %SEGNO IN RCW 02211010
T~0;ADR~M[M[L].MOM].[CF]; % AND THE MSCW %TR02212000
END ELSE S~-1; 02212100
END ELSE % ITS PRESENT: WDVE GOT TO WORK %TR02213000
BEGIN T~0; 02214000
WHILE (S:=M[T].[CF]) LSS ADR DO 02215000
IF S>T THEN T:=S ELSE PUNT(3); 02215500
S~IF M[T].[AREATYPEF]=CODEAREV THEN% %167-02216000
M[T+1].[CF] ELSE 0;% %167-02216010
T~T+2; END; %TR02216100
IF PRT[P1MIX,8].[CF]!L OR M[L-1].MSFF%STACK IS MARKED02216200
THEN DO L~M[L].MOM UNTIL NOT M[L].MSFF;%GET LAST MSCW02216300
L~M[L].MOM;%POINT L TO NEXT RCW,JUST IN CASE. %TR02216400
END UNTIL (IF S!0 THEN IF S=(-1) THEN 0 ELSE 02216500
(B[0]<S OR NOT B[S].PBIT) 02216510
ELSE (P(M[T-2].[3:12],DUP)!@700 AND P(XCH)!@1500)); 02216600
FOUND: ADR ~ ADR-T;% 02217000
T:=PLACEFINDER(S,ADR,S); 02217100
IF N GTR 0 THEN 02217200
BEGIN 02217300
B ~ [M[SPACE(TERMMSGSZ)]]; 02218000
DISKWAIT(-(B INX 0),TERMSGSZ,MESSAGETABLE[1].[22:26]); 02219000
END ELSE N:=0; 02220000
STREAM(Z:=N!0,X:=T,T:=6,J:=JAR[P1MIX,0]], 02221000
P1MIX,INDX~PRT[P1MIX,8] INX NOT 2 INX 0, 02222000
DSZE~IF P(M[P(DUP)+1],TOP) THEN P ELSE P.[8:10], 02222200
TOG~(N=7), Q~[B[N]], A); 02223000
BEGIN CI ~ CI+Z; GO TO L1;% 02224000
DS:=LIT "-"; SI:=Q; 02225000
L: SI:=SI+1; 02226000
IF SC = "8" THEN SI:=SI+1 ELSE 02227000
BEGIN A:=DI; DI:=LOC T; 02228000
DS:=OCT; DI:=A; 02229000
END; 02230000
DS:=T CHR; 02231000
IF TOGGLE THEN GO TO L; 02232000
DS ~ LIT " "; GO TO L2;% 02234000
L1: SI ~ A;% 02235000
IF SC ! "~" THEN% 02236000
BEGIN SI ~ SI+1; A ~ SI;% 02237000
GO TO L1;% 02238000
END;% 02239000
DI ~ A;% 02240000
L2:% 02241000
SI ~ J; SI ~ SI+1; DS ~ 7 CHR; DS ~ LIT "/";% 02242000
SI ~ SI+1; DS ~ 7 CHR; DS ~ LIT "=";% 02243000
SI~LOC P1MIX; DS~2DEC; A~DI; 02244000
DI~DI-2; DS~FILL; DS~A; 02244500
SI:=X; DS:=20 CHR; A:=DI; 02245000
TOG(DI~A; DS~2 LIT ". "; A~DI; SI~INDX; 02251010
SKIP SB; IF SB THEN BEGIN DI~INDX; 02251020
SKIP DB; DS~RESET; DI~A; TOG~TALLY; 02251030
DS~12 LIT "EFF INX IS -"; END; 02251040
A~DI; DI~INDX; DI~LOC Q; DS~8 DEC; 02251050
SI~LOC Q; 7(IF SC>"0" THEN JUMP OUT; 02251060
TALY~TALY+1; SI~SI+1); DI~A; 02251070
T~TALLY; DS~8 CHR; DI~DI-T; 02251080
T(DS~LIT " "); DI~DI-T; A~DI); 02251090
TOG(SI~LOC DSZE; DI~LOC Q; DS~4 DEC; 02251100
DI~A; DS~5 LIT " GEQ "; SI~LOC Q; 02251110
TALLY~0; 3(IF SC>"0" THEN JUMP OUT); 02251120
TALLY~TALLY+1; SI~SI+1); 02251130
T~TALLY; DS~4 CHR; DI~DI-T; 02251140
T(DS~LIT " "); DI~DI-T; A~DI); 02251150
DI ~ A; DS ~ LIT "~";% 02252000
END;% 02253000
IF N!0 THEN FORGETSPACE(B); 02253050
S~A; 02254000
STREAM(B~S,A~A~SPACE(17));% 02255000
BEGIN 17(DS~8 LIT"#"); SI~B;DI~A;DI~DI+8;DS~2 LIT" ";% 02255100
17(8(IF SC!"~" THEN DS~CHR ELSE JUMP OUT 2 TO L1)) ; 02255200
L1: DS~2 LIT" ";% 02255500
END;% 02256000
SPOUT(S); 02256500
IF NOT TERMGO THEN BEGIN HALT;% 02257000
COMPLEXSLEEP(-100=NUMESS);% 02258000
DO UNTIL KEYIN(0)=1; 02258100
NOPROCESSTOG ~ NOPROCESSTOG-1; END;% 02258200
JAR[P1MIX,1] ~-JAR[P1MIX,1];% 02259000
UNHOOQUE(P1MIX);% 02260000
MIXER~ @300+P1MIX;% 02261000
IF N=35 THEN % ES-ED 02261050
IF JAR[P1MIX,9].SYSJOBF = PRNPBTCODE THEN 02261100
IF (L:=PRT[P1MIX,@25]) !0 THEN 02261200
BEGIN %675-02261250
IF (LUN~L.[41:5])<16 THEN SLAPITOFF; %675-02261300
LUN~L.[46:2]+19; % LPA, LPB, OR CPA %675-02261350
SLAPITOFF; %675-02261400
END; % PRNPBT/DISK ES-ED: TO CLEAR UNITS. 02261750
STT: T~MSTART;% 02262000
WHILE(L~T.[CF])!0 DO% 02263000
IF (T~M[L]).[3:12]=MIXER AND T>0% 02264000
THEN% 02265000
BEGIN LUN ~ (TOPIO ~ NFLAG(M[L+2])).[12:6]; 02266000
IF LUN }32 THEN 02266100
BEGIN 02266200
FILECLOSE(TOP10 INX 0); 02266300
GO TO STT; 02266400
END; 02266500
IF UNIT[LUN].[13:5] = @20 02267000
THEN BEGIN% 02268000
QZ:% 02269000
SLAPITOFF; 02270000
UNIT[LUN].[13:5]:=@20;% MARK IT NOT READY ANYWAYS 02270500
FORGETSPACE(L INX 2);% 02271000
GO TO STT;% 02272000
END ELSE 02273000
BEGIN T ~ 0; 02274000
FIB ~ M[TOPIO INX NOT 2]; 02275000
ADR ~ NBUF ~ FIB[13].[1:9]-1; 02275100
IF P(M[TOPIO].[3:5],DUP)=22 OR P(XCH)=26 THEN 02275150
BEGIN FOR S ~ 1 STEP 1 UNTIL ADR DO 02275200
TOIT: IF NOT M[TOPIO INX S].[19:1] THEN 02275250
DOIT: IF LUN{18 THEN 02275300
BEGIN M[TOPIO INX S].[20:1] ~ 0; 02275350
M[M[TOPIO INX S] INX 17] ~ M[TOPIO INX S]02275400
& FIB[5] [FTC]; 02275450
FIB[5] ~ P(DUP,LOD,0,1,CFX,+); 02275500
IF NOT PRTROW[P1MIX].[17:1] THEN 02275550
IF FIB[14].[CF]=FIB[14].[FF] THEN 02275600
BEGIN PBIO(TOPIO INX S,FIB[14]); 02275650
SLEEP([M[TOPIO INX S]],IOMASK);02275700
END ELSE 02275750
BEGIN STREAM(C~M[TOPIO INX S], 02275800
Z~FIB[14].[FF]); 02275850
BEGIN SI ~ C; DS ~ 18 WDS; END;02275900
FIB[14].[FF] ~ P(DUP).[FF]-18; 02275950
END; 02276000
END ELSE 02276050
BEGIN IF WAITIO(M[TOPIO INX S],@357,LUN).[45:1]02276100
THEN GO OWT; 02276150
FIB[6] ~ *P(DUP)+1; 02276200
END; 02276250
IF ADR<0 THEN 02276260
BEGIN IF ADR THEN F[17] ~ BLEN; GO OWT; 02276270
END; 02276280
S ~ 0; 02276290
IF FIB[17] < (BLEN~FIB[18].[3:15]) THEN 02276300
BEGIN IF NOT FIB[13] THEN 02276350
FIB[17] ~ *P(DUP)-(FIB[5].[46:2]=3); 02276360
M[TOPIO] ~ FLAG(FIB[16]); 02276370
STREAM(N~FIB[17],D~M[TOPIO].[CF]); 02276400
BEGIN N(DS ~ 8 LIT " "); END; 02276450
ADR ~ -1; GO DOIT; 02276500
END ELSE ADR ~ -2; 02276550
GO TOIT; 02276600
END ELSE 02276700
OWT: FOR NT1 ~ 0 STEP 1 UNTIL NBUF DO 02276750
M[TOPIO INX N[1] ! *P(DUP) OR IOMASK;% 02277000
IF LUN{22 AND LUN}20 OR (LUN{18 AND % LP OR CP BK-UP 02278000
(P(M[TOPIO].[3:5],DUP)=22 OR P(XCH)=10)) 02278100
THEN 02278500
BEGIN IF LUN { 18 THEN % UNIT IS BACKUP 02279000
BEGIN S~17;% 02280000
STREAM(A,D~L+4); 02281000
BEGIN SI~A; DS~17 WDS END;% 02282000
NT4~M[TOPIO INX NOT 2] INX 0;% 02283000
NT1~M[NT4+14];% 02284000
NT2~NT1.[FF]; NT1~NT1.[CF];% 02285000
IF M[TOPIO].[3:5]=22 THEN % NOT CP BK-UP 02285100
IF NT1=NT2-72 THEN% 02286000
BEGIN NT1~M[NT4+5].[FF];% 02287000
M[NT4+5].[FF]~NT1+1;% 02287100
M[NT2+17]~ @154000400200000 &NT1[CTC];% 02287110
M[NT4+14].[FF]~NT2-18;% 02287120
END ELSE% 02287130
IF M[NT2+35].[27:6]=0 THEN M[NT2+35].[28:1]~1; 02287140
FIB[17] ~ -1; 02287200
M[TOPIO] ~ FLAG(FIB[16]&0[20:47:1]&S[8:38:10]); 02287210
END ELSE % 02287230
BEGIN T~(A INX @540000000000000)&17[8:38:10]; %150-02287240
IF SEPARATE THEN T~T&(LUN!22)[32:47:1] %150-02287245
ELSE T~T&(LUN!22)[28:47:1]; 02287250
IF LUN!22 THEN %IF PUNCH FILE, IGNORE 02287254
IF WAITIO(@4002000000,@357,LUN).[45:1] THEN TO QZ; 02287255
T~WAITIO(T,@357,LUN);% 02287260
IF T.[45:1] THEN TO GO QZ;% 02287270
END; 02287280
END ELSE% 02290000
IF LUN=23 OR LUN=24 THEN% 02291000
BEGIN ADR~L+4;% 02292000
LB: IF(T~UNIT[LUN]).[13:5]=25 THEN% 02293000
BEGIN ADR ~ IOQUE[S~T.[FF]].[33:15];% 02294000
STREAM (A~"END":ADR); BEGIN SI ~ ADR;% 02295000
L:SI ~ SI +1; IF SC = " " THEN TO TO L;% 02296000
$ SET OMIT = PACKETS 02296999
$ SET OMIT = NOT(PACKETS) 02297009
DI:=LOC A;DI:=DI+5; IF 3SC=DC THEN TALLY:=0 ELSE 02297010
BEGIN DI~LOC A; DS~4 LIT "PACK"; DI~LOC A; 02297100
SI~SI-3; IF 4SC=DC THEN TALLY~0 ELSE 02297200
TALLY:=1 END; A:= 02297300
$ POP OMIT 02297301
TALLY END; IF P THEN BEGIN% 02298000
RETURNIOSPACE(S); 02300000
UNIT[LUN]~@7777777777% 02301000
END 02302000
ELSE BEGIN M[TOPIO]~M[TOPIO]OR@2004000000; T~0;% 02303000
M[M[TOPIO]]~"END. "&@14[1:43:5]; END;% 02304000
END; 02305000
IF T!0 THEN% 02306000
BEGIN% 02307000
LBI:T~WAITIO(@40000000+ADR,@367,LUN);% 02308000
IF T.[45:1] THEN GO TO QZ;% 02309000
IF T.[42:1] THEN GO TO LB ELSE% 02310000
GO TO LBI% 02311000
END END;% 02312000
IF T=0 THEN 02313000
IF FIB[5].[42:1] 02313500
THEN FORGETSPACE(L INX 2) 02313600
ELSE FILECLOSE(TOPIO INX 0); 02314000
GO TO SIT 02315000
END; END; 02316000
FORGETSPACE(A);% 02317000
T~MSTART;MIXER~@400+P1MIX;% 02318000
WHILE(L~T.[CF])!0 DO% 02319000
IF(T~M[L]).[3:12]=MIXER AND T>0 THEN% 02320000
IF M[M[L+4].[CF]+5].[41:1] THEN FILECLOSE(L+7); 02321000
T~MSART;MIXER~@600+P1MIX;% 02322000
WHILE(L~T.[CF])!0 DO% 02323000
IF(T~M[L]).[3:12]=MIXER AND T>0 THEN% 02324000
IF M[L+7].[41:1] THEN FILECLOSE(M[L+1] INX 3);% 02325000
FOR LUN ~ 0 STEP 1 UNTIL 31 DO% 02326000
IF RDCTABLE[LUN].[6:6] = P1MIX THEN% 02327000
SLAPITOFF;% 02328000
PRT[P1MIX,8]:=T:=NFO[(P1MIX-1)|NDX+2]INX 2; 02328100
M[T]:=-FLAG(0);M[T-1]:=-FLAG(0&(PRT)[6:33:9]); 02328200
P(.COM5); GO TO DIFFCOM; 02329000
END;% 02330000
SAVE PROCEDURE TERMINALMESSAGE(N); VALUE N; REAL N; 02330100
BEGIN NT1 ~ N; 02330200
P(0,STF); 02330300
TERMINALMESSAGE(NT1); 02330400
END; 02330500
$ SET OMIT = NOT(DEBUGGING OR CHECKLINK) 02330599
ARRAY UNITCODE[*]; 02347100
INTEGER PSEUDOCOPY;% USED BY STARTADECK TO EXERCISE SOME CONTROL %541-02347110
% OVER THE NO. OF "COPIES" OF CONTROLCARD %541-02347120
% SERVICING PSEUDO-READERS. %541-02347130
BOOLEAN PROCEDURE READEMFROMDISK(H,IB); 02347150
VALUE H,IB; ARRAY H[*],IB[*]; FORWARD; 02347160
$ SET OMIT = NOT(PACKETS) 02347199
PROCEDURE DRAINO(UNIT,BUMP,ERROR); 02347200
VALUE UNIT,BUMP,ERROR; REAL UNIT; BOOLEAN BUMP,ERROR; 02347210
BEGIN REAL T; 02347220
LABEL NEXT; 02347222
UNIT~UNIT-32; 02347230
IF BUMP THEN 02347240
PACKETACK[UNIT]:=PACKETACT[UNIT]-1; 02347250
IF ERROR THEN PACKETERR[UNIT]:=TRUE; 02347260
IF PACKETACT[UNIT]=0 THEN 02347280
IF LABELTABLE[UNIT+32]}0 THEN 02347290
IF CIDTAABLE[UNIT,3]<CIDTABLE[UNIT,7] THEN 02347300
BEGIN 02347310
LABELTABLE[UNIT+32]~-@14; 02347315
T~SPACE(13)+2; M[T-4].[9:6]~0; 02347320
M[T INX 10]~UNITCODE[UNIT+9]; 02347325
NEXT: DO UNTIL READEMFROMDISK(CIDROW[UNIT], 02347330
[M[T]]&10[8:38:10]); 02347335
IF PACKETERR[UNIT] THEN BEGIN; 02347340
STREAM(E~"END": Q~@14,D~T); 02347350
BEGIN SI~LOC Q; SI~SI+7; IF SC!DC THEN DI~DI+1; 02347360
Q~DI; S1~Q; 02347370
L: IF SC=" " THEN BEGIN SI~SI+1; GO TO L END; 02347380
DI~LOC E; DI~DI+5; IF 3 SC!DC THEN TALLY+1; 02347390
E~TALLY; END; 02347400
IF P THEN GO TO NEXT; END; 02347410
INDEPENDENTRUNNER(P(.CONTROLCARD),T&(UNIT+32)[2:42:6] 02347430
&ERROR[1:1:1],192); 02347435
PSEUDOCOPY~PSEUDOCOPY+1;% %541-02347437
END ELSE 02347440
ENDOFDECK(UNIT,(UNIT+32)&ERROR[1:1:1]); 02347450
END DRAINO; 02347460
$ POP OMIT 02347461
REAL PROCEDURE UNITIN(TINU,WHAT); VALUE WHAT; REAL WHAT; 02348000
ARRAY TINU[*]; 02348500
BEGIN REAL HOLD; INTEGER T;% 02349000
STREAM(A~0:WHAT);% 02350000
BEGIN SI ~ WHAT;% 02351000
L: IF SC = " " THEN 02352000
BEGIN SI ~ SI + 1; GO TO L; END;% 02353000
DI ~ LOC A; DI ~ DI + 5; DS ~ 3 CHR;% 02353500
END STREAM;% 02354000
HOLD ~ POLISH;% 02355000
$ SET OMIT = NOT(SHAREDISK) 02355999
$ SET OMIT = SHAREDISK 02356499
FOR I~0 STEP 1 UNTIL 64 DO 02356500
$ POP OMIT 02356501
IF TINU[I].[30:18]=HOLD.[30:18] THEN 02357000
BEGIN 02357500
HOLD~I; 02357600
I~70; 02357700
END; 02357800
UNIT~IF I<70 THEN 69 ELSE HOLD; 02358000
END UNITIN; 02359000
PROCEDURE IDLETIME;% 02360000
BEGIN REAL C,N;% 02361000
INTEGER T;% 02362000
HALT;% 02363000
C ~ ((P2MIX}0)+1)|(CLOCK+P(RTR));% 02364000
FOR T ~ 1 STEP 1 UNTIL MIXMAX DO% 02365000
IF JAR[T,*] ! 0 THEN% 02366000
BEGIN N ~ N+1;% 02367000
C ~ -JAR[T,3]-PROCTIME[T]+C; 02368000
END;% 02369000
IF N ! 0 THEN% 02370000
T ~ (C-OLDIDLETIME)/N);% 02371000
OLDIDLETIME ~ C;% 02372000
FOR N ~ 1 STEP 1 UNTIL MIXMAX DO% 02373000
IF JAR[N,*] ! 0 THEN% 02374000
JAR[N,7] ~ *P(DUP)+T;% 02375000
NOPROCESSTOG ~ NOPROCESSTOG-1;% 02376000
END;% 02377000
DEFINE ENTERUSERFILE(ENTERUSEFILE1,ENTERUSERFILE2,ENTERUSERFILE3)= 02378000
P(EUF(ENTERUSERFILE1,ENTERUSERFILE2,ENTERUSERFILE3),DEL);% 02378500
REAL PROCEDURE FUF(A,B,L); VALUE A,B,L; REAL A,B,L; FORWARD; 02379000
INTEGER PROCEDURE CALCULATEPURGE(PURGE);% 02380000
VALUE PURGE; REAL PURGE;% 02381000
BEGIN REAL Y,D;% 02382000
REAL J;% 02383000
REAL C=+1;;% 02384000
STREAM(A~[DATE],B~[Y]);% 02385000
BEGIN S1~A; SI~SI+3; DS ~ 2 OCT; DS ~ 3 OCT END;% 02386000
J ~ (D ~ ( Y+3) DIV 4|1461+(Y+3) MOD 4 | 365 +D+PURGE-% 02387000
1) DIV 1461;% 02388000
IF (Y ~ (D ~ D MOD 1461) DIV 365) = 4 THEN% 02389000
BEGIN Y ~ 3; D ~ 365 END ELSE D ~ D MOD 365;% 02390000
CALCULATEPURGE ~ (4|J+Y-3)|1000+D+1;% 02391000
STREAM(C~[C]); BEGIN SI~C; DS ~ 8 DEC END;% 02392000
END;% 02393000
PROCEDURE CHANGEDATE(BUFF); VALUE BUFF; REAL BUFF; FORWARD; 02393100
DEFINE MIDNIGHT = BEGIN XCLCK:=XCLOCK-WITCHINGHOUR; 02393200
DATE:=CALCULATEPURGE(1); 02393225
CHANGEDATE(SPACE(10)); 02393250
END#; 02393300
REAL PROCEDURE TAPELABEL(M,F,R,C,P); VALUE M,F,R,C,P; %AI02393400
REAL M,F,R,C,P; FORWARD; %AI02393500
$ SET OMIT = NOT (DUMP OR DEBUGGING OR BREAKOUT) 02393790
REAL MFMASK; 02393800
$ POP OMIT 02393810
$ SET OMIT = NOT DEBUGGING %763-02393999
$ SET OMIT = NOT (DEUBGGING OR DUMP) %763-02434051
PROCEDURE DUMPCODE(BUFF); %AI02434100
VALUE BUFF; REAL BUFF; %AI02434110
BEGIN REAL B,S,N,TM,TA,U,D; %AI02434120
INTEGER I; REAL MASK,PARITY; 02434125
ARRAY TP[*]; ARRAY TL[*]; %AI02434130
LABEL X,L1,ERR; 02434135
SUBROUTINE CHECK; 02434162
BEGIN 02434164
IF P(XCH)=@20 THEN 02434166
BEGIN 02434168
STREAM(B~BUFF~BUFF.[15:15]-1); 02434170
DS~32LIT"-DPMT ABORTED, TRY ANOTHER TAPE~"; 02434172
P(WAITIO(@4740000020,@377,U),DEL); % SPACEBACK 02434174
PARITY~1; 02434176
GO ERR; 02434178
END; 02434180
END; 02434182
FOR U~0 STEP 1 UNTIL 15 DO 02434185
IF (MULTITABLE[U] EQV "MEMORY ")=NOT 0 THEN 02434190
IF (LABELTABLE[U].[5:25]="1DUMP") THEN GO L1; 02434195
FOR U~0 STEP 1 UNTIL 15 DO IF LABELTABLE[U]=0 %AI02434200
AND PRNTABLE[U].[1:1] THEN TO GO TO L1; %AI02434210
BUFF:=BUFF.[15:15]-1; %AI02434215
STREAM(BUFF); %AI02434220
DS:=17LIT"#NO MEMDUMP TAPE~"; 02434230
GO TO X; %AI02434240
L1: MULTITABLE[U]:="MEMORY "; %AI02434250
LABELTABLE[U].[1:29]:=@1024644447; %AI02434260
STREAM(A:="001",B:=[LABELTABLE[U]]); %AI02434270
BEGIN SI := LOC A; SI := SI + 5; %AI02434280
DI:=DI+5; DS:=3ADD; %AI02434290
END; %AI02434300
RRRMECH := TWO(U) OR RRRMECH; %AI02434310
B~(SPACE(20))&20[8:38:10]&5[21:45:3]; 02434320
STREAM(LTT~BUFF.[33:15]<100,BUFF~BUFF.[33:15],B); 02434330
BEGIN %AI02434340
DS:=8LIT" "; SI:=B; DS:=19WDS; %AI02434350
DI ~ B; 02434360
LTT(SI ~ LOC BUFF; DS ~ 2 DEC; JUMP OUT 1 TO L);02434365
SI ~ BUFF; 02434367
20(8(IF SC!"~" THEN DS~CHR ELSE JUMP OUT 2 %AI02434370
TO L)); L: %AI02434380
END; 02434390
LABELTABLE[U].[1:5]:=@20; %AI02434400
TL:=[M[TAPELABEL("MEMORY ",LABELTABLE[U].[6:42], %AI02434410
1,1,100]]710[8:28:10]&5[21:45:3]; 02434420
STREAM(A~PRNTABLE[U],[30:18],TL); 02434424
BEGIN SI~LOC A; DI~DI+53; DS~5 DEC END; %AI02434426
TP:=[M[TA:=TYPEDSPACE(513,MDUMPAREAV)]]&513[8:38:10]&02434430
5[21:45:3];% %167-02434435
TM:=0&@1737[1:37:11]; %AI02434440
MASK~@40 & @20[CTF]; %AI02434445
S:=0; %AI02434470
HALT; SLEEP([TOGLE],STOREMASK); %AI02434480
LOCKTOG(STOREMASK); 02434490
WHILE (S:=M[S]).[33:15] NEQ 0 DO %AI02434500
IF M[S].[1:17]=@1000 THEN %AI02434510
D:=OLAY(S.[33:15]); %AI02434520
UNLOCKTOG(STOREMASK); 02434530
P(WAITIO(TL,MASK,U),DEL); 02434532
P(WAITIO([TM],MASK,U),DEL); 02434534
S:=0; %AI02434540
DO BEGIN %AI02434550
N:=S.[33:3]; %AI02434560
IF(MEMASK AND TWO(N))NEQ 0 THEN S:=-S 02434570
ELSE MOVE(512,S,TA+1); %AI02434580
TP[0] := S; %AI02434590
P(WAITIO(TP,MASK,U)); CHECK; 02434600
IF S LSS 0 THEN S := 3584 - S; %AI02434610
END UNTIL (S:=S+512).[18:15]; %AI02434620
P(WAITIO(B,MASK,U)); CHECK; 02434630
LABELTABLE[U].[1:5]~@01; %AI02434690
BUFF:=BUFF.[15:15-1; %AI02434695
STREAM(U~TINU[U],L~LABELTABLE[U],BUFF); %AI02434700
BEGIN %AI02434710
SI:=LOC U; SI := SI + 5; %AI02434720
DS:=1LIT" "; DS:=3CHR; %AI02434730
SI~LOC L; SI~SI+1; DS~ 1 LIT " "; DS~7 CHR; %AI02434735
DS:=7LIT" DP-ED~"; %AI02434740
END; %AI02434750
ERR: P(WAITIO([TM],MASK,U),DEL); 02434760
P(WAITIO(TL,MASK,U),DEL); 02434770
IF PARITY HEN SETNOTINUSE(U,1) ELSE 02434780
BEGIN 02434790
P(WAITIO([TM],MASK,U),DEL); 02434800
P(WAITIO(@4740000020,@377,U),DEL); 02434810
END; 02434820
FORGETSPACE(TP); 02434830
FORGETSPACE(TL); 02434840
FORGETSPACE(B); 02434850
NOPROCESSTOG!NOPROCESSTOG-1; 02434860
X: SPOUT(BUFF); 02434870
END DUMPCORE; 02434880
$ POP OMIT 02434890
$ SET OMIT = NOT(DEBUGGING) 02434999
$ SET OMIT = NOT(DATACOM AND DCSPO ) 02522099
PROCEDURE NAMEIO(A,KTR);% 02603000
REAL A,KTR;% 02604000
BEGIN;% 02605000
STREAM(A~[A]:KTR);% 02606000
BEGIN DI ~ A; DS ~ 8 LIT "0 ";% 02607000
DI ~ DI-7; SI ~ KTR;% 02608000
L: IF SC = " " THEN% 02609000
BEGIN SI ~ SI+1; GO TO L END;% 02610000
IF SC = """ THEN% 02611000
BEGIN SI ~ SI+1;% 02612000
7(IF SC = "~" THEN JUMP OUT TO EXIT;% 02613000
DS ~ CHR;% 02614000
IF SC = """ THEN JUMP OUT TO LQ;);% 02615000
LS: IF SC ! """ THEN IF SC ! LEFTARROW THEN %152-02615100
BEGIN SI := SI + 1; GO TO LS; END; %152-02615200
IF SC = LEFTARROW THEN GO TO EXIT; %152-02615300
LQ: SI ~ SI+1;% 02616000
GO TO EXIT;% 02617000
END;% 02618000
IF SC = ALPHA THEN% 02619000
BEGIN 7(DS ~ CHR;% 02620000
IF SC = ALPHA THEN GO TO LA;% 02621000
JUMP OUT TO EXIT;% 02622000
LA: );% 02623000
LE: IF SC = ALPHA THEN % 02623500
BEGIN SI~SI+1; GO TO LE; END; % 02623501
GO TO FIXIT;% 02624000
END;% 02625000
IF SC = "~" THEN% 02626000
BEGIN DS ~ CHR; SI ~ SI-1; GO TO EXIT END;% 02627000
IF SC = "=" THEN% 02628000
BEGIN DS~2 LIT"~~"; SI~SI+1; GO TO EXIT END; 02629000
DS ~ CHR;% 02630000
EXIT:A ! SI;% 02631000
END;% 02632000
KTR ~ P(XCH);% 02633000
END;% 02634000
REAL PROCEDURE TAPELABEL(MULFID,FID,REELNO,CYCLE,PURGE);% 02635000
VALUE MULFID,FID,REELNO,CYCLE,PURGE;% 02636000
REAL MULFID,FID,REELNO,CYCLE,PURGE;% 02637000
BEGIN REAL LBL;% 02638000
LBL:=TYPEDSPACE(10,LABELAREAV);% %167-02639000
STREAM(% 02640000
DATE, MULFID,FID,REELNO,CYCLE,PU~CALCULATEPURGE(PURGE),% 02641000
LBL);% 02642000
BEGIN% 02643000
DS~8 LIT" LABEL ";% 02644000
SI~LOC MULFID;% 02645000
DS~WDS;% 02646000
DS~WDS;% 02647000
DS~3 DEC;% 02648000
SI ~ LOC DATE; SI ~ SI+3;% 02649000
DS ~ 5 CHR;% 02650000
SI~LOC CYCLE;% 02651000
DS~ 2 DEC; 02652000
SI~LOC PU; SI~SI+3;% 02653000
DS~5 CHR; DS~1 LIT"0";% 02654000
5(DS~8 LIT"00000000")% 02655000
END;% 02656000
TAPELABEL~LBL;% 02657000
END;% 02658000
REAL PROCEDURE LABELASCRATCH(LBL); VALUE LBL; REAL LB;% 02659000
BEGIN% 02660000
REAL LUN,TM,REEL,T; 02661000
LBL ~ P(.LBL,LOD).]CF] & 10[8:38:1]; & 02662000
(IF P(.LBL,LOC).[7:1] THEN 1 ELSE 5)[21:45:3]; 02662050
STREAM(L~LBL+3,R~[REEL]); 02662100
BEGIN SI~L; DSD~3 OCT END; 02662200
LUN~FINDOUTPUT(M[LBL+1],M[LBL+2],REEL,0,0,2,0,TM); 02663000
IF LUN}0 THEN 02663100
BEGIN; 02663200
STREAM(A~PRNTABLE[LUN].[30:18]],T~[T],L~LBL+6); 02664000
BEGIN DI~DI+5; SI~LOC A; DS~5DEC; SI~SI-8; DI~T; 02664100
DS~8DEC; DI~DI-7; DS~6FILL; END; 02665000
RDCTABLE[LUN].[8:6]~P1MIX; 02665100
M[LBL+1].[1:5]:=0; %148-02665110
MULTITABLE[LUN]~M[LBL+1]; 02665150
RRRMECH~TWO(LUN) OR RRRMECH; 02665200
P(WAITIO(LBL,0,LUN),DEL); 02666000
TM~0&"}~"[1:37:11];% 02667000
P(WAITIO([TM],0,LUN),DEL);% 02668000
$ SET OMIT = PACKETS 02668099
FILEMESSAGE(" OUT"&TINU[LUN][6:30:18],T, 02668500
M[LBL+1],M[LBL+2],REEL,0,0,OPNMESS); 02668600
END; 02668800
LABELASCRATCH~LUN% 02669000
END LABELASCRATCH;% 02670000
PROCEDURE NSECOND;FORWARD;% 02692000
DEFINE CHECKSTACKSPACE = IF P(PRT[P1MIX,*] INX 0)-P(0,RDS)<128 %WF 02693000
THEN BEGIN P(64,STS); GO TO STACKOVERFLOW; END#; %WF 02694000
ARRAY USERCODE[*]; 02695000
REAL PROCEDURE SECURITYCHECK(M,F,U,H); 02696000
VALUE M,F,U; REAL M,F,U,H; FORWARD; 02696100
PROCEDURE MAKEPRESENT(C); VALUE C; REAL C; FORWARD; 02696200
PROCEDURE SIGNOFF(V,F,W);VALUE V,F,W;ARRAY V[*],F[*];REAL W;FORWARD; 02696300
SAVE PROCEDURE IOREQUEST(F,I,L); VALUE F,I,L; ARRAY F,L[*]; REAL I; 02696500
FORWARD; 02696600
BOOLEAN PROCEDURE MTXIN(I,UMB); REAL U,B; INTEGER I; FORWARD; 02696700
$ SET OMIT = NOT(BREAKOUT AND AUXMEM) 02697299
DEFINE CODEADDRESS(CODEADDRESS1,CODEADDRESS2)= 02697710
ACTUALOVERLAYADDRESS(1,CODEADDRESS1,CODEADDRESS2)#, 02697720
DATAADDRESS(DATAADDRESS1,DATAADDRESS2)= 02697730
ACTUALOVERLAYADDRESS(0,DATAADDRESS1,DATAADDRESS2)#; 02697740
SAVE INTEGER PROCEDURE ACTUALOVERLAYADDRESS(TYPE,MIX,LOC); 02697750
VALUE TYPE,MIX,LOC); INTEGER TYPE,MIX,LOC; FORWARD; 02697770
$ SET OMIT = NOT(BREAKOUT) 02700000
$ SET OMIT = NOT(DATACOM AND DCSPO ) 03500099
SAVE PROCEDURE INITIATEIO(IODESC,MIX,U);% 04000000
VALUE IODESC,MIX,U;% 04001000
REAL MIX,U;% 04002000
REAL IODESC;% 04003000
BEGIN REAL C=+1;LABEL EXIT; 04004000
$ SET OMIT = NOT(STATISTICS) 04004099
IF (P(IODESC.[3:5] %204-04004110
$SET OMIT = DKBNODFX %204-04004119
,DUP)= @14 OR P(XCH %204-04004120
$ POP OMIT %204-04004121
) = @6) AND %204-04004130
NOT IODESC.[24:1] AND %204-04004140
(((P(M[IODESC.[CF]],DUP) EQV 0)=NOT 0) OR %204-04004150
((P(XCH) EQV 32)=NOT 0)) AND %204-04004155
NOT OKSEGZEROWRITE THEN %204-04004160
BYBY("SEGMENT ZERO OVERWRITE~",23); %204-04004170
P(TIO); 04004200
CHANNEL[P(DUP)]*U; 04005000
P([IODESC],TIO); 04006000
CNANIO[C]~CLOCK+P(RTR); 04007000
$ SET OMIT = NOT(STATISTICS AND AUXMEM) 04007099
IF U < 16 THEN 04008000
BEGIN 04008100
IF IODESC.[22:1] THEN% 04009000
BEGIN TRANSACTION[U] ! IF IODESC.[18:1] THEN 0% 04010000
ELSE TRANSACTION[U]-1;% 04011000
GO TO EXIT;% 04012000
END; 04013000
$ SET OMIT = NOT(STATISTICS) 04013009
END 04013100
ELSE 04013200
IF (U OR 1)=19 THEN 04013300
BEGIN 04014000
FUIO[C]~CLOCK+P(RTR); 04014002
$ SET OMIT = NOT(STATISTICS) 04014009
END; 04014100
$ RESET OMIT 04014105
TRANSACTION[U] := P(DUP,LOD)+1; 04014500
EXIT:END;% 04015000
SAVE PROCEDURE QUEUEUP(U); VALUE U; REAL U;% 04016000
BEGIN IF U=30 THEN 04016100
WAITQUE[FIRSTWAIT:=(FIRSTWAIT+31) AND 31]:=U ELSE 04016200
BEGIN WAITQUE[NEXTWAIT] ~ U;% 04017000
NEXTWAIT ~ NEXTWAIT+1 AND 31;% 04018000
END;% 04019000
END; 04019100
$ SET OMIT = NOT(DFX) 04019499
SAVE PROCEDURE STARTIO(U); VALUE U; REAL U; 04020000
BEGIN REAL T=NT1,R=NT2, S=NT3;% 04021000
$ SET OMIT = NOT(DFX) 04021099
IF (T ~ UNIT[U]).[13:5] = 0 THEN% 04022000
IF (S ~ T.[18:15]) < @1777 THEN% 04023000
$ SET OMIT = NOT(DFX) 04023099
BEGIN IF P(TIO) ! 0 THEN% 04024000
BEGIN INITIATEIO(IOQUE[S],LOCATQUE[X].[3:5]04025000
,U);% 04026000
P(3);% 04027000
END% 04028000
ELSE BEGIN QUEUEUP(U);% 04029000
P(4);% 04030000
END;% 04031000
P(T&P(XCH)[15:45:3],UNIT[U],~);% 04032000
$ SET OMIT = DFX 04032999
END;% 04033000
$ POP OMIT 04033001
$ SET OMIT = NOT(DFX) 04033049
END;% 04034000
SAVE PROCEDURE PRINTERFINISHED(U); VALUE U; REAL U;% 04035000
BEGIN 04036000
$ SET OMIT = NOT(NEWLOGGING) 04036099
IF NOT UNIT[U].[16:1] THEN UNIT[U].[17:1] ~ 0; 04036200
STARTIO(U);% 04037000
GO TO EXTERNAL;% 04038000
END;% 04039000
SAVE PROCEDURE IOREQUEST(FINAL,IODESC,LOCATION);% 04040000
VALUE FINAL,IODESC,LOCATION;% 04041000
ARRAY FINAL,LOCATION[*];% 04042000
REAL IODESC;% 04043000
BEGIN REAL U=NT1,T=NT2,S=NT3,R=+1;% 04044000
$ SET OMIT = NOT(DFX) 04044099
IF IOQUESLOTS LEQ 04045000
(U:=IF LOCATION.[9:1] OR P1MIX=0 THEN 0 ELSE 7) THEN 04045100
SLEEP([IOQUESLOTS],@77-U); 04045200
IOQUEAVAIL ~ IOQUE[S:=IOQUEAVAIL]; 04046000
$ SET OMIT = NOT(STATISTICS) 04047009
$ SET OMIT = NOT(DFX) 04047099
$ SET OMIT = NOT(DKBNODFX AND NOT DFX) 04048701
$ SET OMIT = DFX 04048799
IF (T ~ UNIT[U ~ LOCATION.[12:6]]).[13:5] = 0 THEN 04048800
$ POP OMIT 04048801
BEGIN IF P(TIO) ! 0 THEN% 04049000
BEGIN INITIATEIO(IODESC,P1MIX,U);% 04050000
P(3);% 04051000
END ELSE BEGIN QUEUEUP(U);% 04052000
P(4);% 04053000
END;% 04054000
T ~ T&P(XCH)[15:45:3]&S[18:33:15];% 04055000
END ELSE% 04056000
IF T.[18:6] = @77 THEN% 04057000
T.[18:15] ~ S ELSE% 04058000
LOCATQUE[P(T.[33:15],DUP)]~LOCATQUE[R]&% 04059000
S[18:33:15];% 04060000
$ SET OMIT = NOT(DFX) 04060099
IOQUESLOTS:=IOQUESLOTS-1; 04060500
LOCATQUE[S] ~ LOCATION&P1MIX[3:43:5] OR @7777700000;% 04061000
$ SET OMIT = DFX 04061999
UNIT[U] ~ T&S[33:33:15];% 04062000
$ POP OMIT 04062001
IOQUE[S] ~ IODESC;% 04063000
FINALQUE[S] ~ FINAL;% 04064000
END;% 04065000
SAVE PROCEDURE FINISHOFFIO(U); VALUE U; REAL U;% 04067000
BEGIN REAL T=NT1, FIN=NT3, V=NT4, IOD=NT6; 04068000
LABEL ON,OFF,C0,C1,C2,C3,C4,C5,C6,C7;% 04069000
SWITCH CSW ~ C0,C1,C2,C3,C4,C5,C6,C7;% 04070000
IF FIN > 0 THEN% 04071000
IF FIN.[25:1] THEN% 04072000
BEGIN T ~ FIN.[3:5];% 04073000
FIN ~ FIN&IOD[3:3:5]&0[25:25:1];% 04074000
GO TO CSW[T];% 04075000
END ELSE GO ON ELSE GO ON;% 04076000
C0: GO TO C0;% 04077000
C1: FIN.[8:10] ~ V;% 04078000
GO TO C2;% 04079000
C3: FIN.[8:10] ~ V;% 04080000
C4: FIN ~ NOT V INX 1 INX FIN;% 04081000
GO TO C5;% 04082000
C6: STREAM(A~0:IOD);% 04083000
BEGIN DI ~ LOC A; SI ~ IOD; SI ~ SI+4; DS~4 OCT END; 04084000
T ~ P DIV 8-1;% 04085000
OFF: FIN.[8:10] ~ T;% 04086000
GO TO C2;% 04087000
C7: STREAM(A~0:IOD);% 04088000
BEGIN DI ~ LOC A; SI ~ IOD; DS ~ 4 OCT END;% 04089000
T ~ P DIV 8-1;% 04090000
FIN ~ (NOT T INX 1 INX FIN)&T[8:38:10];% 04091000
GO TO C5;% 04092000
ON: IF U < 16 THEN% 04093000
IF IOD.[22:1] THEN% 04094000
C5: M[IOD INX 1] ~ M[NOT V INX IOD INX 1] ~ V% 04095000
ELSE% 04096000
C2: M[IOD INX NOT 0] ~ V;% 04097000
END;% 04098000
PROCEDURE PROGRAMRELEASE;% 04099000
BEGIN NAME T; REAL FSX=JUNK; 04100000
ARRAY R=-4[*];% 04101000
REAL IOD=NT1;% 04102000
ARRAY LOCN[*];% 04103000
REAL S; 04103050
CHECKSTACKSPACE;% %WF 04103100
LOCN~M[S~(IF(IOD~NFLAG(M[P(T~[M[PRT[P1MIX,9]]],DUP,PRL)])) 04104000
.[22:1] THEN 2 ELSE NOT 1) INX IOD); 04105000
IF IOD.[3:5]= 6 THEN 04105100
BEGIN; STREAM(S:=M[PRT[P1MIX,8]] INX P(DUP,0,XCH,DIA 10, 04105200
DIB 30,TRB 2),D~@600005); 04105300
BEGIN SI~S; DS~2 CHR END; 04105400
$ SET OMIT = NOT(STATISTICS) 04105409
IF JUNK.[36:12]!45 AND RELTOG 04105500
OR M[IOD].[3:6] = 0 AND M[IOD] LSS (DIRDSK | DSKTOG) THEN 04105510
IF (USERCODE[P1MIX] EQV MCP) ! NOT 0 THEN % 04105550
BEGIN TERMINATE(P1MIX); TERMINALMESSAGE(30) END; 04105600
IF(FS[P1MIX,(FSX~P(*(NOT 2 INX LOCN),4,COC).[13:11] 04105650
DIV 5).[40:4]] 04105700
AND TWO(IOD.[24:1]&FSX[43:44:4]))!0 THEN 04105750
BEGIN T[0]:=T[0]&1[19:47:1]&0[26:40:7]; 04105800
M[(*((NOT 2)INX LOCN))INX 5 ]:= NABS(*P(DUP)); 04105850
GO TO RETURN; 04105890
END; 04105900
IF NOT IOD.[24:1] THEN M[S].[11:1]~1; 04105950
END DISK BUSINESS; 04105990
IF IOD.[3:5]=30 THEN GO RETURN; % SPO %846-04105998
IOREQUEST(R,IOD,LOCN);% 04106000
T[0].[19:1] ~ 0; 04107000
IF (NT1~P(*(NOT 2 INX LOCN),13,COC).[10:9]-1)!0 THEN% 04108000
STREAM(NT1,C~T[0],T); 04109000
BEGIN SI ~ T; SI ~ SI+8; DS ~ NT1 WDS;% 04110000
SI ~ LOC C; DS ~ WDS;% 04111000
END;% 04112000
GO TO RETURN;% 04113000
END;% 04114000
SAVE PROCEDURE NEWIO;% 04115000
BEGIN REAL S=NT3,U=NT4;% 04116000
S ~ UNIT[U~WAITQUE[FIRSTWAIT]].[18:15];% 04117000
INITIATEIO(IOQUE[S],LOCATQUE[S].[3:5],U);% 04118000
FIRSTWAIT ~ FIRSTWAIT+1 AND 31;% 04119000
UNIT[U].[13:5] ~ 3;% 04120000
END;% 04121000
REAL MDELTA = @11;% 04121050
REAL MLOG = @12;% 04121100
REAL MROW = @13;% 04121150
REAL LOGSIZE = @43;% 04121170
REAL LOGHOLDER = @56;% 04121200
REAL NUMAINTMESS = @57;% 04121250
REAL LOGENTRY = @63;% 04121300
REAL NXDISK = @76;% 04121350
ARRAY MAINTLOGARRAY = @77[*];% 04121400
PROCEDURE DISKORAUXERROR(R); VALUE R; REAL R; FORWARD; 04121410
PROCEDURE ACTUALIOERR(R); VALUE R; REAL R; FORWARD; 04121425
PROCEDURE LINKUP(TYPE,KEY); VALUE TYPE,KEY; REAL TYPE,KEY; FORWARD;% 04121450
PROCEDURE CHECKJOBORFILEMESS(MIX,FIB,U);% 04121500
VALUE MIX,FIB,U; REAL MIX,FIB,U; FORWARD;% 04121550
PROCEDURE LOGOUTMAINT(B); VALUE B; REAL B; FORWARD;% 04121600
PROCEDURE MAINTLOGGER(B); VALUE B; REAL B; FORWARD;% 04121650
DEFINE 04121700
LOGVERSION=( % VERSION NUMBER ON NEXT CARD 04121710
2 04121720
& % CURRENT ENTRIES ON NEXT CARD 04121730
21 04121740
[30:42:6])#, 04121750
TAPEBUFFERSIZE = 200#; 04121850
ARRAY MAINTBUFFER[*]; 04121950
SAVE PROCEDURE IOFINISH(C,R); VALUE R,C; REAL R,C; 04122000
BEGIN BOOLEAN STOP; 04123000
COMMENT 04123010
WHEN E!0, STOP TAKES THE FOLLOWING VALUES: 04123020
0 DISK ERROR (OTHER THAN NOT READY ON A DFX SYSTEM). 04123030
1 ANY ERROR OTHER THAN THOSE LISTED FOR 0, 2 OR 3. 04123040
2 LOCKED ADDRESS (SHAREDISK). 04123050
3 ANY ERROR OCCURRING WHEN UNIT[U].[5:8]!0 (A RETRY). 04123060
WHEN E=0, STOP TAKES THESE VALUES: 04123070
-2 IO FOR WHICH COMPLETE SHOULD NOT BE SET (DATACOM OR 04123080
DISK WRITE BEFORE READ WITH UNIT OR EU SWITCH). 04123090
1 PRINTER IO. 04123100
0 NORMAL IO. 04123110
END COMMENT; 04123120
REAL TIM=STOP+1, U=TIM+1; 04123500
LABEL TEST,NOWAIT,PROC,NEW,QUP,INCR; 04124000
LABEL ERRORS,DISKERR,DS,X,SW,LP,DK,DX,DX1,DC,OK,L1; %111-04125000
REAL T=NT1,S=NT2,S1=NT3,V=NT4,E=NT5,I=NT7;% 04126000
NAME LOCN=E; REAL IOD=NT6, FIN=S1; 04127000
SWITCH TYPE := OK,LP,OK,OK,DK,OK,OK,OK,OK,OK,DC; %111-04128000
04128010
$ SET OMIT = NOT(DFX) 04128099
$ SET OMIT = NOT(NEWLOGGING) 04128799
P(CHANIO[C]); % INITIALIZES TIM04128900
S:=(T:=UNIT[P(CHANNEL[C],DUP)]).[18:15]; % INITIALIZES U 04129000
$ SET OMIT = NOT SEPTICTANK 04129490
% %111-04129520
% CHECK FOR A PARTIAL WORD BINARY READ WITH NO PARITY ERRORS. THIS IS 04129530
% ILLEGAL AND IS MARKED AS BEING A PARITY ERROR. %111-04129540
% %111-04129550
IF U LEQ 15 THEN % TAPE I/O %111-04129560
IF (R.[18:12] AND @4462) = @0440 THEN % BIN READ-NO PAR %111-04129570
IF R.[15:3] ! ((8-R.[22:1]) AND 7) THEN % PART WD XFER%111-04129580
R.[28:1] := MOD3IOS; % MARK AS PARITY ERROR IF MOD III I/04129590
ERRORS: 04129900
IF (E ~ R.[26:7])+(V ~ T.[5:8] ) ! 0 THEN% 04130000
BEGIN IF(S1 ~ FINALQUE[S]) < 0 THEN% 04131000
IF (E ~ S1.[25:8] AND E) = 0 THEN% 04132000
IF V = 0 THEN 04133000
GO TO SW; 04133100
IF (U AND @774) ! 16 THEN 04134000
BEGIN 04134050
RDCTABLE[U]:=(*P(DUP))& (C-1)[1:46:2]& R[3:3:5];04134060
IF U=30 THEN 04134300
BEGIN 04134400
IF (R.[28:5] AND @25 ! 0 THEN 04134500
BEGIN 04134600
IF ( NOT R.[32:1] AND R.[28:1]) THEN 04134700
GO TO DC; 04134800
GO TO X; 04134900
END 04134950
ELSE GO TO DC; 04134955
END ELSE GO TO X; 04134960
END; 04134990
IF E = 0 THEN 04135000
BEGIN % RECOVERED MASS STORAGE % 04137000
MAINTBUFFER[NXDISK:=NXDISK+4 AND 15] 04137100
:= -0 & U[2:46:2] & LOCATQUE[S][4:3:5] & 04137110
(LOIGENTRY:=LOGENTRY+1)[CTF] & 04137120
RDCTABLE[U]{18:1:2]; 04137130
IF FINALQUE[S] GTR 0 THEN 04137140
BEGIN 04137150
MAINTBUFFER[XNDISK]:=(*P(DUP)) & 04137160
((M[M[S1:=LOCATQUE[S] INX NOT 2] INX 4]04137170
.[13:11] DIV ETRLNG)+1)[9:39:9]; 04137180
M[S1].[7:1] := 1; 04137190
END; 04137200
P(MAINTBUFFER[NXDISK+2]:=IOQUE[S]); 04137202
$ SET OMIT = NOT(AUXMEM) 04137203
P(NFLAG(M[P])); 04137212
P(P&V[1:44:4],[MAINTBUFFER[NXDISK+1]],STD); 04137215
MAINTBUFFER[NXDISK+3]:=MAINTBUFFER[U]; 04137220
IF (LOGHOLDER INX 0) = 0 THEN 04137230
BEGIN 04137240
LOGHOLDER.[CF]:=[MAINTBUFFER[NXDISK]]; 04137250
INDEPENDENTRUNNER(P(.MAINTLOGGER),0,100); 04137260
END ELSE M[LOGHOLDER.[FF]].[CF]:= 04137270
[MAINTBUFFER[NXDISK]]; 04137275
LOGHOLDER.[FF]:=[MAINTBUFFER[NXDISK]]; 04137280
NUMAINTMESS:= NUMAINTMESS+1; 04137290
T.[5:8] ~ 0; 04142000
GO TO SW; 04142500
END;% 04143000
IF V = 0 THEN% 04144000
$ SET OMIT = NOT(SHAREDISK) 04144099
BEGIN % ORIGINAL ERROR ON MASS STORAGE% 04145000
TINU[U].[18:2] ~ P(DUP).[18:12]+1;% 04146000
MAINTBUFFER[U]:=R&TWO(C)[18:43:4]; 04146100
RDCTABLE[U]:=(*P(DUP))&(C-1)[1:46:2]; 04146200
V:=129; 04147000
$ SET OMIT = NOT(SHAREDISK) 04147399
END% 04148000
ELSE BEGIN % RECURRENT ERROR ON MASS STORAGE% 04149000
P(MAINTBUFFER[U]:=P(DUP,LOD) OR 04150100
R&TWO(C)[18:43:4]); 04150200
IF (V ~ V+1) > 137 THEN% 04151000
BEGIN R:=P; 04151200
IF LOCATQUE[S].[9:1] THEN % OLAY I/O 04151220
M[LOCATQUE[S]:=R OR IOMASK; 04151230
$ SET OMIT = NOT(AUXMEM) 04151235
DISKERR: 04151300
$ SET OMIT = NOT(DFX) 04151399
T.[5:10]:=0; 04151400
GO TO DX; 04152600
END; 04152800
P(DEL); 04152900
END;% 04153000
UNIT[U] ~ T&V[5:40:8];% 04154000
DS:% 04155000
CHANNEL[P(TIO)] ~ U;% 04156000
P([IOQUE[S]],IIO);% 04157000
GO TO EXTERNAL ;% 04158000
X: STOP ~ (V!0)|2+1;% 04159000
T.[5:13] ~ 32|E+8;% 04160000
GO TO TEST; 04161000
END; 04161500
SW:: GO TO TYPE[T.[1:4]];% 04162000
LP: 04163000
IF STOP := (T := T&0[16:16:1]).[17:1] THEN 04164000
TEST: IF FIRSTWAIT = NEXTWAIT THEN GO TO INCR ELSE% 04165000
GO TO NEW ELSE GO TO NOWAIT;% 04166000
DK: 04167900
IF NOT (I:=IOQUE[S]).[24:1] THEN 04168000
IF FINALQUE[S].[24:1] THEN% 04169000
$ SET OMIT = DFX 04169090
BEGIN 04169100
$ SET OMIT = NOT DKBNODFX OR OMIT 04169190
$ SET OMIT = DKBNODFX OR OMIT 04170750
M[IOQUE[S]:=I&1[24:47:1]]:=*(P(DUP) INX P(0,LNG,XCH)); 04170800
$ POP OMIT 04170900
GO TO DS; 04171000
END ELSE GO TO OK ELSE GO TO OK; 04171200
$ POP OMIT 04171250
$ SET OMIT = NOT DFX 04171350
DC: 04174000
$ SET OMIT = NOT(DATACOM ) 04174999
04176000
$ SET OMIT = DFX 04176899
DX: DX1: 04176900
$ POP OMIT 04176901
OK: IF FIRSTWAIT = NEXTWAIT THEN 04177000
NOWAIT: IF (S1 := LOCATQUE[S].[18:15]) LSS @1777 THEN 04178000
INITIATEIO(IOQUE[S1],LOCATQUE[S1].[3:5],U)% 04180000
ELSE 04181000
PROC: T := T&0[16:16:2] 04182000
ELSE 04183000
BEGIN% 04187000
NEW: NEWIO;% 04188000
IF STOP THEN GO TO INCR;% 04189000
QUP: IF LOCATQUE[S].[FF] GTR @1777 THEN GO TO PROC; 04190000
QUEUEUP(U);% 04191000
T ~ T&4[13:43:5];% 04192000
END;% 04193000
INCR: 04194000
IF (TIM~CLOCK+P(RTR)-TIM) LSS THEN THEN TIM~0; 04194050
IOD:=IOQUE[S]; 04194100
IF (U OR 1 )=19 THEN 04194200
BEGIN 04194300
IF (JUNK:=M[IOD].[5:7])>9 THEN 04194400
JUNK:=NEUP.[CF]+(JUNK AND @17); 04194500
IF JUNK<NEUP.[FF] THEN 04194550
PEUIO[JUNK]:=P(DUP,LOD)+CLOCK+P(RTR)-EUIO[C]; 04194600
END; 04194650
I~(S1~LOCATQUE[S]).[3:5]; % FIND MIX INDEX 04194700
$ SET OMIT = NOT(NEWLOGGING) 04194799
IOTIME[I]~(*P(DUP))+TIM; 04195000
IF P(.S1,LOD).[10:1] THEN FORGETSPACE(IOD); % NO MEM MESSAGE 04195100
IF F!0 THEN 04196200
IF STOP THEN 04196400
P(T) 04196600
ELSE GO TO L1 04196800
ELSE BEGIN 04197000
RETURNIOSPACE(S); 04199000
L1: P(T&P(.L1,LOD)[FTF]); 04201000
END; 04202000
P([UNIT[U]],STD); 04203000
FIN ~ FINALQUE[S] AND NOT MEMORY;% 04205000
IF (U OR 1) NEQ 17 THEN 04205012
IF IOD.[24:1] THEN% 04206000
BEGIN V ~ ABS(IOD.[33:15]-R.[33:15]);% 04207000
IF IOD.[8:10] < V THEN% 04208000
IF IOD.[23:1] THEN% 04209000
V ~ IOD.[8:10];% 04210000
IF U < 16 THEN% 04211000
IF IOD.[21:2] = 0 THEN% 04212000
BEGIN; STREAM(A!0:B~M[S1.[33:15]+V-1]);% 04213000
BEGIN SI ~ LOC B;% 04214000
IF SC = "~" THEN TALLY ~ 1;% 04215000
A ~ TALLTY;% 04216000
END;% 04217000
V ~ -P+V;% 04218000
END;% 04219000
IF U ! 30 THEN % NOT DCA 04219100
FINISHOFFIO(U);% 04220000
END;% 04221000
IF E ! 0 THEN% 04222000
$ SET OMIT = NOT(SHAREDISK) 04222499
BEGIN IF STOP LEQ 1 THEN 04223000
BEGIN 04223500
INDEPENDENTRUNNER( 04224000
P(.DISKORAUXERROR)+((U AND @774) NEQ 16), 04224010
R&S[3:43:5],240); 04224100
LOCATQUE[S].[11:1]:=1; 04224500
END 04224750
ELSE IF FIN < 0 THEN P(LOCATQUE[S],R,XCH,~);% 04225000
END% 04226000
$ SET OMIT = NOT(SHAREDISK) 04226499
ELSE BEGIN% 04227000
IF FIN < 0 THEN P(R OR IOMASK,LOCATQUE[S],~)% 04228000
ELSE 04229000
$ SET OMIT = NOT (DATACOM OR DFX OR DKBNODFX) 04229099
BEGIN 04229200
LOCN ~ [M[LOCATQUE[S]]];% 04230000
IOD ~ IOD.[33:15];% 04231000
WHILE LOCN[0].[33:15] ! IOD DO% 04232000
LOCN ~ 1 INX LOCN;% 04233000
LOCN[0] ~ M OR FIN;% 04234000
END END;% 04235000
IF P1MIX = 0 THEN GO TO NOTHINGTODO;% 04236000
IF I = P1MIX THEN GO TO RETURN;% 04237000
GO TO INITIATE;% 04238000
END IOCOMPLETE;% 04239000
SAVE REAL PROCEDURE WAITIO(IOD,MASK,U);% 04240000
VALUE MASK,U,IOD;% 04241000
REAL MASK,U,IOD;% 04242000
BEGIN% 04243000
REAL T; 04243100
DEFINE OCTADE= DS~3 RESET;3(IF SB THEN DS!SET ELSE 04243200
DS~RESET;SKIP SB)#; 04243300
IOD ~ NFLAG(P(.IOD,LOC))&TINU[U][3:3:5];% 04244000
MASK ~ NOT MASK;% 04245000
IOREQUEST(NABS(IOD)&MASK[25:40:8],IOD, 04246000
[IOD]&U[12:42:6]);% 04247000
IOD ~ IOD&0[25:25:8]&0[19:19:1];% 04248000
SLEEP([IOD],IOMASK);% 04249000
IF ((WAITIO~IOD.[26:7]) AND MASK AND MAKS.[18:15])!0 THEN 04250000
BEGIN 04251000
T~SPACE(12); 04251100
STREAM(IOD~IOD.[26:7],MASK~(NOT MASK).[41:7], 04251200
Z~[TINU[U]],T~T); 04251300
BEGIN DS~20 LIT" UNEXP I-O ERROR ON ";SI~Z; 04251400
SI~SI+5;DS~3 CHR;DS~8 LIT":RESULT="; 04251500
SI~LOC IOD;SI~SI+6;SKIP 3 SB;3(OCTADE); 04251600
DS~6 LIT",MASK=" ;SI~SI+6;SKIP 3 SB; 04251700
3(OCTADE);DS~2 LIT".~"; 04251800
END; 04251900
IF P1MIX = 0 THEN BEGIN P(T); PUNT(0) END; 04252000
IF NOTERMSET(P1MIX) THEN 04252100
BEGIN 04252200
TERMINATE(P1MIX&19[18:33:15]); 04252300
IF JAR[P1MIX,9].SYSJOBF THEN %SYSTEM JOB 04252500
BEGIN 04252600
SPOUT(T); 04252700
BLASTQ(U); 04252800
END ELSE 04252900
TERMINALMESSAGE(-T); 04253000
END; 04253100
END; 04253200
END; 04253300
REAL PROCEDURE TAPEPARITYRETRY(R,U,KEY);% 04254000
VALUE R,U,KEY; REAL R,U,KEY; FORWARD; 04255000
REAL PROCEDURE WRITEPARITYREELSWITCH(OIOD,RC); 04255100
VALUE OIOD,REC; REAL OIOD,RC; FORWARD; 04255200
PROCEDURE DISKORAUXERROR(R); VALUE R; REAL R; 04256000
04256200
BEGIN 04256400
REAL MSCW = -2, 04256600
U = +1, 04256800
S = +2, 04257000
E = +3, 04257200
T = +4, 04257400
MK = +5, CELL = MK, 04257600
IOD = +6, 04257800
MIX = +7, 04258000
FIN = +8, PARITY= FIN, 04258200
KEY1 = +9, 04258400
KEY2 = +10, 04258600
DISC = +11, 04258800
MASK = +12, 04259000
AREA = +13, U1 = AREA, 04259200
RLST = +14, MSG = RSLT, 04259400
PRTMAX = +15, T1 = PRTMAX, 04259600
DISKCELL= +16, T2 = DISKCELL, 04259800
TERMNATE = +17, 04260000
OLAYIO = +18, 04260200
DSKADRS = +19; 04260400
04260600
NAME LOCN = +16; 04260800
04261000
LABEL DSIT, START, QUIT, RETRY, KILLL, KILLER; 04261200
$ SET OMIT = NOT(PACKETS) 04261299
DEFINE UNITNO = PSEUDOMIX[MIX]#; 04261300
$ POP OMIT 04261301
04261400
$ SET OMIT = NOT(AUXMEM) 04261600
04271200
SUBROUTINE DISKMESSAGE; 04271400
BEGIN 04271600
STREAM(MSG, MK, A:=TINU[U], MIX, B:=DSKADRS, 04271800
S:=IOQUE[S].[27:6], R, KEY1:=KEY1:=SPACE(10)); 04272000
BEGIN 04272200
SI:= LOC MK; SI:=SI+7; DS:= CHR; 04272400
SI:=SI+5; DS:=3CHR; DS:=LIT" "; 04272600
CI:=CI+MSG; 04272800
GO L0; GO L1; GO L2; GO L3; GO L4; GO L5; GO L6; GO L7; 04273000
L0: DS:= 9LIT"NOT READY"; GO TO MX; 04273200
L1: DS:= 4LIT"BUSY"; GO TO MX; 04273400
L2: DS:= 8LIT"I/O MEM "; 04273600
L3: DS:= 6LIT"PARITY"; GO TO MX; 04273800
L4: DS:=12LIT"I/O INV ADDR"; GO TO MX; 04274000
L5: DS:= 3LIT"EU "; GO TO L0; 04274200
L6: DS:=13LIT"INV DISK ADDR";GO TO MX; 04274400
L7: DS:=10LIT"WRITE LOCK"; 04274600
MX: DS:= 6LIT", MIX="; DS:=2DEC; 04274800
MSG:=DI; DI:=DI-2; DS:=FILL; DI:=MSG; 04275000
DS:=5LIT", DA="; DS:=8CHR; 04275200
DS:=7LIT", SEGS="; DS:=2DEC; 04275400
DS:=4LIT", R="; 04275600
16(DS:=3RESET; 3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB)); 04275800
SI:=SI-5; DS:=5LIT", IO="; 04276000
IF SB THEN DS:=2LIT"4,"; SKIP SB; 04276200
IF SB THEN DS:=2LIT"3,"; SKIP SB; 04276400
IF SB THEN DS:=2LIT"2,"; SKIP SB; 04276600
IF SB THEN DS:=2LIT"1,"; 04276800
DI:=DI-1; DS:=LIT"~"; 04277000
END STREAM STATEMENT; 04277200
END SUBROUTINE DISKMESSAGE; 04277400
04277600
SUBROUTINE DETAILRECORDENTRY; 04277800
BEGIN 04278000
KEY2 := TYPEDSPACE(6,MAINTBUFFAREAV);% %167-04278200
M[KEY2] := 0 & RDCTABLE[U][18:1:2]; 04278400
IF MIX NEQ 0 THEN 04278600
BEGIN 04278800
M[KEY2] := (*P(DUP)) & MIX[20:43:5] & 04279000
(IF FINALQUE[S] LSS 0 THEN 0 ELSE 04279200
(M[M[LOCATQUE[S] INX NOT 2] INX 4].[13:11] DIV ETRLNG)+1)[9:39:9];04279400
END; 04279600
M[KEY2+1] := TRANSACTION[U]; 04279800
IF NOT DISC THEN 04280000
BEGIN 04280200
STREAM(S:=IOD.[FF], D:=KEY2+2); 04280400
BEGIN 04280600
SI:=LOC S; DS:=8DEC; 04280800
END; 04281000
END 04281200
ELSE M[KEY2+2] := DSKADRS; 04281400
M[KEY2+3] := IOQUE[S]; 04281600
M[KEY2+4] := R & RDCTABLE[U][3:5:5]; 04281800
M[KEY2+5] := IF FINALQUE[S] LSS 0 THEN 0 ELSE LOCATQUE[S] INX NOT 2; 04282000
END DETAILRECORDENTRY; 04282200
04282400
SUBROUTINE FINISHDETAIL; 04282600
BEGIN 04282800
IF MIX NEQ 0 THEN CHECKJOBORFILEMESS(MIX,M[KEY2+5],U); 04283000
LINKUP(4+DISK,KEY2); 04283200
END; 04283400
04283600
P(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); 04283800
04284000
DISC:=(U:=LOCATQUE[S:=R.[3:5]].[12:6]).[46:1]; 04284200
MIX:=LOCATQUE[S].[3:5]; 04284400
IF (OLAYIO := ((FINALQUE[S] LSS 0) AND (LOCATQUE[S].[9:1]))) THEN 04284600
BEGIN 04284800
STREAM(S:=0&FINALQUE[S][CTC]&FINALQUE[S][21:8:12], D:=[DSKADRS]); 04285000
BEGIN 04285200
SI:=LOC S; DS:=8DEC; % DISK ADDRESS IN FINALQUE FOR OLAY I/O 04285400
END; 04285600
END ELSE DSKADRS := M[IOQUE[S]]; 04285800
MK:="*"; MSG:=(-1); 04286000
R:=R&IOQUE[S][3:3:5]; % RESTORE HARDWARE UNIT TYPE 04286200
IOD := IOQUE[S]; 04286400
IF DISC THEN 04286600
BEGIN 04286800
IF R.[30:1] THEN % DISK NOT READY 04287000
BEGIN 04287200
$ SET OMIT = NOT(DFX) 04287400
UNIT[U]:=(*P(DUP))&@77777[5:20:28]; 04295400
MSG:=0; MK:="#"; % NOT READY 04295600
DISKMESSAGE; 04295800
DETAILRECORDENTRY; 04296000
READY := NOT TWO(U) AND READY; 04296200
RRRMECH := NOT TWO(U) AND RRRMECH; 04296400
UNIT[U].[5:10] := 2; 04296600
GO TO KILLL; 04298800
END; % IF NOT READY 04299000
LOCATQUE[S].[FF] := NOT 0; 04299200
IF R.[26:7] NEQ 1 AND NOT OLAYIO THEN % NOT BUSY OR SPECIAL I/O 04299600
BEGIN 04299800
PARITY := (IOD.[24:1] AND (R.[26.7]=16)); % PARITY CONDITION 04300000
IF FINALQUE[S] GTR 0 THEN % OBJECT JOB ERROR 04300200
BEGIN 04300400
IF PARITY THEN GO TO START; % RECOVERABLE ERROR 04300500
DSIT: TERMINATE(MIX&20[CTF]); 04300600
END % OBJECT ERROR 04301000
ELSE 04301200
BEGIN % MCP I/O 04301400
IF MIX NEQ 0 THEN 04301600
BEGIN 04302000
IF JAR[MIX,9].SYSJOBF THEN % "SYSTEM" JOB 04302200
IF PARITY THEN GO TO START; 04302600
% DONT DS LIBMAIN/DISK ON PARITY ERROR 04302800
GO TO DSIT; 04303000
END; % NON-ZERO MIX 04303200
END; % MCP I/O 04303400
END; % NOT BUSY OR SPECIAL I/O 04303600
04303800
START: 04304000
04304200
TRANSACTION[U] := TRANSACTION[U]-1; 04304400
MASK := IF (FIN := FINALQUE[S]) LSS 0 THEN FIN.[25:8] ELSE @377; 04304600
IF (E := R.[25:8] AND MASK) = 0 THEN % ERRORS ARE ACCEPTABLE 04304800
BEGIN % FIX UP IOQUE 04305000
QUIT: 04305200
IF MSG NEQ (-1) AND DISC THEN DISKMESSAGE; 04305400
DETAILRECORDENTRY; 04305600
$ SET OMIT = NOT(AUXMEM); 04305800
RETURNIOSPACE(S); 04309200
04309400
FIN:=FINALQUE[S] AND NOT MEMORY; 04309600
IF (T1:=FIN) LSS 0 THEN % MCP I/O 04309800
BEGIN 04310000
IF NOT OLAYIO THEN % I/O FINISH PLACES RESULT DESC. FOR OLAY04310200
M[LOCATQUE[S]]:=R&E[25:40:8]&IOD[3:3:5] OR IOMASK; 04310400
END % IF MCP I/O 04310600
ELSE 04310800
BEGIN 04311000
IF E NEQ 0 THEN % ERRORS 04311200
BEGIN 04311400
P(.T1,PRL); 04311600
T1 := T1&E[25:40:8]; 04311800
END 04312000
ELSE P(.T1,IOR); 04312200
LOCN := [M[LOCATQUE[S]]]; 04312400
IOD := IOD.[33:15]; 04312600
WHILE LOCN[0].[33:15] NEQ IOD DO LOCN := 1 INX LOCN; 04312800
LOCN[0] := P(.T1,LOD); 04313000
END; 04313200
GO TO KILLL; 04313600
END; 04313800
IF E THEN % BUSY 04314000
BEGIN 04314200
MSG:=1; % BUSY 04314400
RETRY: 04314600
$ SET OMIT = NOT(AUXMEM) 04314790
DISKMESSAGE; 04314820
DETAILRECORDENTRY; 04315000
$ SET OMIT = NOT(AUXMEM) 04315190
T1:=(IF DISC THEN IOQUE[S]&6[3:43:5] ELSE IOQUE[S]; 04315400
RETURNIOSPACE(S); 04315600
04315800
P1MIX:=MIX; 04316000
IF NOT OLAYIO THEN % RETRIES ARE OK 04316400
IOREQUEST(FINALQUE[S], T1, 04316600
(IF DISC THEN LOCATQUE[S]&@22[12:42:6] ELSE 04316800
LOCATQUE[S])); 04317000
P1MIX:=0; 04317200
GO TO KILLER; 04317400
END; % IF BUSY 04317600
IF E.[46:1] THEN % I/O MEMORY PARITY 04317800
BEGIN 04318000
MSG:=2; 04318200
E:=@1537; 04318400
GO TO QUIT; 04318600
END; 04318800
IF E.[41:1] THEN % INVALID ADDRESS 04319000
BEGIN 04319200
MSG:=4; 04319400
E:=@1537; 04319600
GO TO QUIT; 04319800
END; 04320000
$ SET OMIT = NOT(SHAREDISK) 04320200
IF NOT E.[43:1] THEN % NOT PARITY,CHECK DISK ADDRESS 04325400
BEGIN 04325600
STREAM(DA:=MASK:=DSKADRS : EU:=MASK.[6:6], A:=0, 04325800
EUA:=[MULTITABLE[16+2|MAXK.[5:1]]]); 04326000
BEGIN 04326200
SI:=LOC DA; 04326400
IF SC GTR "1" THEN GO TO BAD; 04326600
IF SC LSS "0" THEN GO TO BAD; 04326800
$ SET OMIT = SHAREDISK 04327000
7( 04327200
$ POP OMIT 04327400
$ SET OMIT = NOT(SHAREDISK) 04327600
IF SC LSS "0" THEN JUMP OUT TO BAD; SI:=SI+1; 04328200
IF SC GTR "9" THEN JUMP OUT TO BAD); 04328400
$ SET OMIT = SHAREDISK 04328600
SI:=SI-5; 04328800
$ POP OMIT 04329000
$ SET OMIT = NOT(SHAREDISK) 04329200
DI:=LOC DA; DS:=2 OCT; 04329800
SI:=EUA; SI:=SI+14; SKIP EU SB; 04330000
DI:=LOC A; DI:=DI+7; SKIP 2 DB; 04330200
IF SB THEN SKIP DB; 04330400
SI:=LOC DA; SI:=SI+6; 04330600
IF SC NEQ "0" THEN GO TO BAD; SI:=SI+1; 04330800
4(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB); 04331000
SI:=LOC A; SI:=SI+7; IF SC GTR "4" THEN GO TO BAD; 04331200
IF SC LSS "0" THEN GO BAD; 04331400
SI:=EUA; SI:=SI+EU; SKIP SB; SKIP A SB; 04331600
IF SB THEN GO TO OK; 04331800
BAD: TALLY:=1; 04332000
OK: DA:=TALLY; 04332200
END; 04332400
IF (MASK:=P) OR E.[42:1] THEN % BAD ADDRESS OR EU NOT READY 04332600
BEGIN 04332800
MSG:=5+MASK; % 5=EU NOT READY, 6=INVALID DISK ADDRESS 04333000
IF NOT MASK THEN MK:="#"; 04333200
IF (MIX NEQ 0) OR OLAYIO THEN 04333400
BEGIN 04333600
E:=@1537; GO TO QUIT; 04333800
END; 04334000
DISKMESSAGE; 04334200
DETAILRECORDENTRY; 04334400
GO TO KILLER; % LET IT HANG 04334600
END 04334800
ELSE 04335000
BEGIN % MUST BE E.[44:1], MEM.PAR. 04335200
MSG:=2; E:=@1537; GO TO QUIT; 04335400
END; 04335600
END; % IF NOT PARITY 04335800
IF IOQUE[S].[24:1] THEN % DISK PARITY ON READ 04336000
BEGIN 04336200
MSG:=3; % PARITY 04336400
E:=@20; 04336600
GO TO QUIT; 04336800
END; 04337000
MSG:=7; % WRITE LOCK 04337200
E:=@1537; 04337400
GO TO QUIT; 04337600
END; % IF DISK 04337800
04338000
$ SET OMIT = NOT(AUXMEM) 04338200
KILLL: 04351600
LOCATQUE[S].[11:1]:=0; 04351800
KILLER: 04352000
IF KEY1 NEQ 0 THEN SPOUTER(KEY1,UNITNO,35); 04352200
IF KEY2 NEQ 0 THEN FINISHDETAIL; 04352400
IF TERMINATE THEN TERMINATE(MIX&20[CTF]); 04352600
KILL([MSCW]); 04352800
END PROCEDURE DISKORAUXERROR; 04353000
PROCEDURE ACTUALIOERR(R); VALUE R; REAL R; 04353200
BEGIN 04353400
REAL MSCW = -2, 04353600
E = +1, 04353800
T = +2, 04354000
S = +3, 04354200
F = +4, 04354400
U = +5, 04354600
T1 = +6, 04354800
T2 = +7, 04355000
T3 = +8, 04355200
KEY = +9, 04355400
FIN = NT3, 04355600
IOD = NT6, 04355800
MASK = +10, 04356000
DISC = +11, 04356200
TYPE = +12, 04356400
MIX = +13; 04356500
04356600
NAME LOCN = T3; 04356800
$ SET OMIT = NOT(PACKETS) 04356899
DEFINE UNITNO = PSEUDOMIX[MIX]#; 04356900
$ POP OMIT 04356901
04357000
LABEL L1, L2, D17, D19, D22, START, NOTREADYMESS, NTRDY, 04357200
EOF, REALEOF, TAPERETRY, SIX, SEVEN, FIX, LEAVE, 04357400
REWINDING, NOCODE, CLEAR, KILLL, KILLER; 04357600
LABEL READER, PRINTER, TAPE, DRUM, DISK, SPO, PUNCH, 04357800
PAPERPUNCH, PAPER, DATACOM; 04358000
04358200
SWITCH W := READER,PRINTER,TAPE,DRUM,DISK,SPO,PUNCH,NOCODE, 04358400
PAPERPUNCH,PAPER,DATACOM; 04358600
04358800
SUBROUTINE MAKEMESS; 04359000
BEGIN 04359200
STREAM(S1:=F.[43:5], S2:=F.[38:5], A:=TINU[U], 04359400
MX~MIX, KEY~KEY~SPACE(10)); 04359600
BEGIN 04359800
SI:=LOC A; SI:=SI+5; 04360000
DS:=LIT"*"; DS:=3 CHR; DS:=LIT" "; 04360200
CI:=CI+S1; GO TO LL; 04360400
GO L1; GO L2; GO L3; GO L4; GO L5; GO L6; GO LL; GO LL; 04360600
DS:=19 LIT"BLANK TAPE ON WRITE"; GO TO MXX; 04360800
L1: DS:= 4 LIT"BUSY"; GO TO MXX; 04361000
L2: DS:= 8 LIT"I/O MEM "; 04361200
L3: DS:= 6 LIT"PARITY"; GO TO MXX; 04361400
L4: DS:=12 LIT"I/O INV ADDR"; GO TO MXX; 04361600
L5: DS:= 9 LIT"I/O ERROR"; GO TO MXX; 04361800
L6: DS:=10 LIT"WRITE LOCK"; GO TO MXX; 04362000
LL: GO TO PS; 04362200
MXX: GO TO MIXIT; 04362400
PS: DI:=DI-5; DS:=LIT"#"; DI:=DI+4; 04362600
CI:=CI+S2; GO TO LL0; GO TO LL1; GO TO LL2; 04362800
NR: DS:= 9 LIT"NOT READY"; GO TO MIXIT; 04363000
LL0: DS:= 5 LIT"PRINT"; GO TO CHK; 04363200
LL1: DS:= 4 LIT"READ"; GO TO CHK; 04363400
LL2: DS:= 5 LIT"PUNCH"; 04363600
CHK: DS:= 5 LIT"CHECK"; 04363800
MIXIT: DS:= 6 LIT", MIX="; DS:=2 DEC; DS:=LIT"~"; 04364000
DI:= DI-3; DS:=FILL; 04364200
END; 04364400
END OF MAKEMESS; 04364600
04364800
SUBROUTINE DETAILRECORDENTRY; 04365000
BEGIN 04365200
KEY := TYPEDSPACE(ABS(T2),MAINTBUFFAREAV);% %167-04365400
M[KEY] := (ABS(T2) DIV 5 -1) & RDCTABLE[U][18:1:2]; 04365600
IF MIX NEQ 0 THEN 04365800
BEGIN 04366000
M[KEY] ~ (*P(DUP)) & MIX[20:43:5] & 04366200
(IF FINALQUE[S] LSS 0 THEN 0 ELSE 04366400
(M[M[LOCATQUE[S] INX NOT 2] INX 4].[13:11] DIV ETRLNG)+1)[9:39:9];04366600
CHECKJOBORFILEMESS(MIX, 04366800
(IF FINALQUE[S] LSS 0 THEN 0 ELSE LOCATQUE[S] INX NOT 2), 04367000
U); 04367200
END; 04367400
M[KEY+1] := TRANSACTION[U]; 04367600
M[KEY+2]:=IF TYPE=2 THENRDCTABLE[U] & U[3:43:5] ELSE 0; 04367800
M[KEY+3] := IOQUE[S]; 04368000
M[KEY+4] := R & RDCTABLE[U][3:3:5]; 04368200
IF TYPE=2 THEN 04368400
BEGIN 04368600
M[KEY+5] := MULTITABLE[U]; 04368800
M[KEY+6] := LABELTABLE[U]; 04369000
M[KEY+7] := PRNTABLE[U]; 04369200
M[KEY+8] := 0; 04369400
M[KEY+9] := 16; 04369600
END; 04369800
IF T2 GTR 0 THEN LINKUP(TYPE+1,KEY); 04370000
END DETAILRECORDENTRY; 04370200
04370400
DEFINE MAKEMLOG(MAKEMLOG1) = 04370600
BEGIN 04370800
T2:=MAKEMLOG1; DETAILRECORDENTRY; 04371000
END#; 04371200
04371400
P(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); 04371600
04371800
$ SET OMIT = DATACOM 04371900
% THIS CODE WAS PLACED HERE FROM OUTER BLOCK TO AVOID CAUSING 04371910
IF R=0 % OVERFLOW OF INTERRUPT STACK 04371920
THEN BEGIN STREAM(B:=T:=SPACE(10)); 04371930
DS:=42LIT"#DATACOM/INQUIRY INTERRUPT IGNORED BY MCP~"; 04371940
SPOUT(T); 04371950
GO KILLER; 04371955
END; 04371960
$ POP OMIT 04371970
U:=LOCATQUE[S:=R.[3:5]].[12:6]; 04372000
MIX~LOCATQUE[S].[3:5]; 04372050
R:=R&IOQUE[S][3:43:5]; % RESTORE UNIT DESIGNATE 04372100
START: 04372200
T:=UNIT[U]&0[13:13:2]; 04372400
TRANSACTION[U] := TRANSACTION[U]-1; 04372600
TYPE := T.[1:4]; 04372800
MASK:=IF (T2:=FINALQUE[S]) LSS 0 THEN T2.[25:8] ELSE @377; 04373000
IF (E:=T.[5:8] AND MASK) = 0 THEN % ACCEPTABLE 04373200
BEGIN 04373400
F:=1; % RETAIN ERROR FIELD 04373600
GO TO FIX; 04373800
END; 04374000
IF E THEN % BUSY 04374200
BEGIN 04374400
T3:=1 & (U=30)[43:47:1]; % BUSY/INCOMPLETE MASK 04374600
IF U LSS 16 AND TRANSACTION[U] LEQ 0 THEN 04374800
BEGIN 04375000
P(0); % DONT SPOUT MESSAGE 04375200
GO TO REWINDING; 04375400
END; 04375600
IF U NEQ 25 THEN % NOT SPO 04375800
BEGIN 04376000
F:=1; % BUSY 04376200
MAKEMESS; 04376400
SPOUTER(KEY,UNITNO,35); 04376600
END; 04376800
MAKEMLOG(IF TYPE=2 THEN 10 ELSE 5); 04377000
L1: DO BEGIN 04377200
SLEEP([CLOCK],NOT CLOCK); 04377400
UNIT[U]:=(*P(DUP))&P(T,XCH)[CTC]; 04377600
STARTIO(U); 04377800
SLEEP([UNIT[U]],@100000000000); 04378000
TRANSACTION[U] := TRANSACTION[U]-1; 04378200
END UNTIL (UNIT[U].[5:8] AND T3) = 0; 04378400
TRANSACTION[U] := TRANSACTION[U]+1; 04378600
IF (UNIT[U].[5:8] AND MASK) = 0 THEN GO TO CLEAR; 04378800
GO TO START; 04379000
END; 04379200
04379400
IF E.[45:1] THEN % NOT READY 04379600
BEGIN 04379800
IF E.[43:1] THEN 04380000
BEGIN 04380200
IF TYPE=0 THEN GO TO READER; % READ CHECK 04380400
IF TYPE=1 THEN GO TO PRINTER; % PRINT CHECK 04380600
IF TYPE=6 THEN GO TO PUNCH; % PUNCH CHECK 04380800
END; 04381000
IF U NEQ 25 THEN % NOT SPO. 04381200
BEGIN 04381400
NOTREADYMESS: 04381600
F:=96; % NOT READY 04381800
MAKEMLOG(IF TYPE=2 THEN 10 ELSE 5); 04382000
MAKEMESS; 04382200
P(1); % SPOUT MESSAGE 04382400
REWINDING: 04382600
READY := NOT TWO(U) AND READY; 04382800
NTRDY: 04383000
RRRMECH:=NOT TWO(U) AND RRRMECH; 04383200
IF P THEN SPOUTER(KEY,UNITNO,35); 04383400
END; 04383600
UNIT[U].[5:10] := 2; 04383800
RRRMECH ~ NOT TWO(U) AND RRRMECH; % LET STATUS FIND IT %115-04383900
GO TO KILLL; 04385400
END; 04385600
D17: 04385800
IF E.[46:1] THEN % I/O MEMORY PARITY 04386000
BEGIN 04386200
F:=2; % I/O MEM PARITY 04386400
L2: MAKEMESS; 04386600
SPOUTER(KEY,UNITNO,35); 04386800
MAKEMLOG(IF TYPE=2 THEN 10 ELSE 5); 04387000
P(@1537); % ACCEPT EOF/EOT/EOP 04387200
GO TO SIX; 04387400
END; 04387600
IF E.[41:1] AND TYPE NEQ 2 THEN % I/O INVALID ADDRESS 04387800
BEGIN % [41:1] FOR TAPE = BACKUP DRIVE 04388000
D22: F:=4; % I/O INVALID ADDRESS 04388200
GO TO L2; 04388400
END; 04388600
04388800
GO TO W[TYPE]; 04389000
04389200
D19: E := 1023; GO TO D17; 04389400
04389600
SPO: 04389800
IF E.[43:1] THEN GO TO L1; % ERROR BUTTON 04390000
GO TO D19; 04390200
04390400
PRINTER: 04390600
IF E.[42:1] THEN % END OF PAGE 04390800
BEGIN 04391000
IF IOQUE[S].[27:6]=0 THEN GO TO FIX; % NOT SPACING 04391200
COMMENT IGNORE EOP IF NO SPACE OR SKIP; 04391400
IF RDCTABLE[U] OR MULTITABLE[U]="FULLPAGE" %724-04391550
THEN IF IOQUE[S].[28:1] THEN IOQUE[S].[FF]~@40013 %DBL-CH 11 04391560
ELSE IOQUE[S].[FF]~@40012 % DBL SINGLE - SKIP TO CH 10 04391570
ELSE % SKIP TO CHAN 1 ON EOP IF NOT 66 LINES %724-04391580
IOQUE[S].[18:15] := @4000; % INHIBIT DATA XFER, SKIP TO CHANNEL 04391600
GO TO CLEAR; 04391800
END; 04392000
IF E.[43:1] THEN 04392200
BEGIN 04392400
E:=0; % PRINT CHECK 04392600
MAKEMESS; 04392800
SPOUTER(KEY,UNITNO,35); 04393000
IF E.[45:1] THEN GO TO NOTREADYMESS; % PRINTER NOT READY 04393200
MAKEMLOG(IF TYPE=2 THEN 10 ELSE 5); 04393400
P(0); % CLEAR ERROR FIELD 04393600
TINU[U].[18:12] := P(DUP).[18:12]+1; 04393800
GO TO SIX; 04394000
END; 04394200
GO TO D19; % PARITY 04394400
04394600
READER: 04394800
IF E.[43:1] THEN % READ CHECK 04395000
BEGIN 04395200
TINU[U].[18:12] := P(DUP).[18:12]+1; 04395400
F:=32; % READ CHECK 04395600
MAKEMLOG(5); 04395800
MAKEMESS; 04396000
P(1); % SPOUT MESSAGE 04396200
GO TO NTRDY; 04396400
END; 04396600
IF E.[42:1] THEN % EOF CARD READER-TREAT AS NOT READY 04396800
BEGIN 04397000
UNIT[U].[5:8] := 4; % ERROR FIELD=NOT READY 04397200
R.[25:8] := 4; % RESLT.DESC.=NOT READY 04397400
TRANSACTION[U] := TRANSACTION[U]+1; 04397600
GO TO START; 04397800
END; 04398000
COMMENT MUST BE D19 - USUALLY INVALID CHARACTOR; 04398200
STREAM(A:=0 : B:=IOQUE[S]); 04398400
BEGIN 04398600
DI := A; SI := B; DI := DI+8; 04398800
IF SC = @14 THEN A := DI; 04399000
2(40(DI:=DI+8; SI:= SI+1; 04399200
IF SC = @14 THEN JUMP OUT 2 TO L); 04399400
DI := DI-8; SI := SI-1;); 04399600
DI := A; 04399800
L: A := DI; 04400000
END; 04400200
IF (T1 := P) = 0 THEN GO TO D19; % NOT INVALID CHARACTER 04400400
IF T1 NEQ 1 THEN % NOT IN COLUMN 1 04400600
BEGIN 04400800
STREAM(a:=TINU[U],T1,KEY:=KEY:=SPACE(10)); 04401000
BEGIN 04401200
DS := LIT "#"; SI := LOC A; SI := SI+5; 04401400
DS := 3 CHR; 04401600
DS := 16 LIT " INV CHR IN COL "; 04401800
DS := 2 DEC; DS := LIT "~"; 04402000
END; 04402200
P(1); % SPOUT MESSAGE 04402400
GO TO NTRDY; 04402600
END; 04402800
E := @40; 04403000
F := @3100001; 04403200
GO TO LEAVE; 04403400
04403600
PUNCH: 04403800
IF E.[43:1] THEN 04404000
BEGIN 04404200
F:=64; % PUNCH CHECK 04404400
MAKEMESS; 04404600
SPOUTER(KEY,UNITNO,35); 04404800
% NEW PUNCH DOES NOT GO NOT-READY ON PUNCH CHECK 04405000
IF E.[45:1] THEN GO TO NOTREADYMESS; % NOT READY 04405200
MAKEMLOG(5); 04405400
TINU[U].[18:12]:=P(DUP).[18:12]+1; 04405600
F:=0; % ZERO ERROR FIELD 04405800
GO TO CLEAR; 04406000
END; 04406200
GO TO D19; % PARITY 04406400
04406600
PAPERPUNCH: 04406800
IF R.[27:1] THEN % EOR 04407000
BEGIN 04407200
P(@40); 04407400
GO TO SIX; 04407600
END; 04407800
GO TO D19; % PARITY 04408000
04408200
PAPER: 04408400
IF R.[27:2] NEQ 0 THEN GO TO EOF; % BOT/EOT 04408600
IF E.[44:1] THEN % PARITY 04408800
BEGIN 04409000
P(@20); 04409200
GO TO SIX; 04409400
END; 04409600
GO TO NOCODE; 04409800
04410000
DATACOM: 04410200
IF(T3:=1&E[43:43:1])=@21 THEN GO TO L1; 04410400
NOCODE: 04410600
F := 5; % I/O ERROR 04410800
GO TO L2; 04411000
04411200
DRUM: % DRUM NOW HANDLED IN DISKORAUXERROR 04411400
DISK: % DISK NOW HANDLED IN DISKORAUXERROR 04411600
DO UNTIL FALSE; 04411800
04412000
TAPE: 04412200
TRANSACTION[U] := TRANSACTION[U]+1; 04412400
IF E.[44:1] THEN 04412600
IF R.[2:1] THEN % MOD III DESCRIPTOR 04412800
BEGIN % COULD BE MEM.PAR.,BLANK TAPE,BOT,EOT 04413000
IF R.[11:1] THEN GO TO D19; % MEMORY PARITY 04413200
OPTION:=OPTION OR M; % MEANS MOD3IOS:=TRUE 04413400
IF R.[24:1] THEN % READING 04413600
BEGIN 04413800
IF R.[13:1] THEN R.[27:1]:=1; BOT, SET EOF 04414000
IF R.[14:1] THEN % EOT 04414200
IF (E AND @367)=0 THEN % PARITY 04414400
IF R.[27:1]=0 THEN % NOT EOF 04414600
GO TO FIX; % FINISH I/O 04414800
END; 04415000
ELSE 04415200
BEGIN % WRITING 04415400
IF R.[2:1] THEN % BLANK TAPE ON WRITE 04415600
BEGIN 04415800
F:=9; % BLANK TAPE ON WRITE 04416000
MAKEMESS; 04416200
SPOUTER(KEY,UNITNO,35); 04416400
MAKEMLOG(10); 04416600
P(16); 04416800
GO TO SIX; 04417000
END; 04417200
IF R.[14:1] THEN R.[27:1]:=1 ELSE GO FIX; % EOT,SET EOF BIT 04417400
END; 04417600
END % MOD III DESCRIPTOR 04417800
ELSE GO TO D19; % PARITY 04418000
IF R.[24:1] THEN 04418200
BEGIN 04418400
IF E.[41:1] THEN GO TO D22; % INVALID ADDRESS 04418600
IF R.[27:1] THEN % EOT 04418800
EOF: IF MASK.[42;1] THEN % EOF OK 04419000
BEGIN 04419200
REALEOF: F:=1&(IF R.[24:1] THEN @31 ELSE 0)[CTF]; 04419400
T.[5:8] := @40; 04419600
GO TO FIX; 04419800
END 04420000
ELSE 04420200
BEGIN % EOF NOT ACCEPTABLE 04420400
P(@40); 04420600
GO TO SIX; 04420800
END; 04421000
TAPERETRY: 04421200
MAKEMLOG(-TAPEBUFFERSIZE); 04421400
IF (T:=TAPEPARITYRETRY(R,U,KEY)).[5:8]=32 AND 04421600
LOCATQUE[S].[3:5] NEQ 0 THEN GO TO REALEOF; 04421800
U~IOQUE[T.[FF]].[3:4]; 04421900
P(T.[5:8]); 04422000
GO TO SIX; 04422200
END; 04422400
IF E.[41:1] THEN % WRITE RING 04422600
IF E.[43:1] THEN % PARITY,WRITE RING 04422800
BEGIN 04423000
F:=6; % WRITE LOCK 04423200
GO TO L2; 04423400
END 04423600
ELSE GO TO D22; % INVALID ADDRESS 04423800
IF E.[43:1] THEN GO TO TAPERETRY; % PARITY,WRITE RING ONLY 04424000
P(@40); 04424200
SIX: 04424400
T := T&P(XCH)[5:40:8]; 04424600
F := 1; 04424800
FIX: 04425000
E := T.[5:8]|F; 04425200
FIN := S; 04425400
IOD := IOQUE[S]; 04425600
SEVEN: 04425800
RETURNIOSPACE(S); 04426000
04426200
T.[FF]:=S:=LOCATUE[S].[FF]; 04426600
IF F = @3100001 THEN 04426800
IF S NEQ @77777 THEN GO TO SEVEN; 04427000
S:=FIN; 04427200
IF FALSE THEN 04427400
LEAVE: 04427600
IOD := IOQUE[S]; 04427800
FIN := FINALQUE[S] AND NOT MEMORY; 04428000
IF IOD.[24:1] THEN 04428200
BEGIN 04428400
NT4 := M[IOD INX ( IF IOD.[22:1] THEN 1 ELSE NOT 0)]; 04428600
FINISHOFFIO(U); 04428800
END; 04429000
IF ( T1:= FIN) LSS 0 THEN 04429200
P(R&E[25:40:8]&IOD[3:3:5] OR IOMASK,LOCATQUE[S],~); 04429400
ELSE 04429600
BEGIN 04429800
IF E NEQ 0 THEN 04430000
BEGIN 04430200
P(.T1,PRL); 04430400
T1 := T1&E25:40:8]; 04430600
END 04430800
ELSE P(.T,IOR); 04431000
LOCN := [M[LOCATQUE[S]]; 04431200
IOD := IOD.[33:15]; 04431400
WHILE LOCN[0].[33:15] NEQ IOD DO LOCN := 1 INX LOCN; 04431600
LOCN[0] := P(.T1,LOD); 04431800
END; 04432000
UNIT[U] := T; 04432200
CLEAR: 04432400
UNIT[U] := (*P(DUP))&F[5:20:13]; 04432600
STARTIO(U); 04432800
KILLL: 04433000
LOCATQUE[S].[11:1]:=0; 04433200
KILLER: 04433400
KILL([MSCW]); 04433600
END; 04433800
$ SET OMIT = NOT DEBUGGING 04544999
REAL PROCEDURE TAPEPARITYRETRY(R,U,KEY);% 04548000
VALUE R,U,KEY;% 04549000
REAL R,U,KEY;% 04550000
BEGIN REAL T1,T2,T3; INTEGER I= T1;% 04551000
REAL RESULT,IOD,OIOD,SPACEMASK,SPACEIOD,M,N,W,MODE;% 04552000
REAL J,K;% 04553000
REAL ERASEIOD=SPACEMASK;% 04554000
REAL Z,Y,MIX,BSIZE; 04554100
LABEL XIO,GIVEUP; 04554200
LABEL RP,LX; 04554300
REAL SIZE,T4,LIMIT; 04554500
REAL PTR,BUFFER,BUFFERSIZE,% 04554600
PATTERN,PATTERN1,PATTERN2,PATTERNWORD;% DON"T CHANGE ORDER04554700
BOOLEAN TESTING,SPACING,FLAGGER; 04554800
$ SET OMIT = NOT(PACKETS) 04554899
DEFINE UNITNO = PSEUDOMIX[MIX]#; 04554900
$ POP OMIT 04554901
LABEL XXIT,EXIT,ENDIT,XEXIT; 04555000
SUBROUTINE RECORDRETRY;% 04555050
BEGIN% 04555100
IF PTR-KEY = TAPEBUFFERSIZE-1 THEN% 04555150
BEGIN% 04555200
T4 := TYPEDSPACE(TAPEBUFFERSIZE,MAINTBUFFAREAV);% %167-04555250
MOVE(10,KEY,T4);% 04555300
MEMORY[KEY+8]:= TAPEBUFFERSIZE-10;% 04555350
MEMORY[KEY+9]:= 1023;% 04555400
LINKUP(3,KEY);% 04555450
KEY:= T4; PTR:= KEY+9;% 04555500
END;% 04555550
MEMORY[PTR:=PTR+1]:= IOD;% 04555600
MEMORY[PTR:=PTR+1]:= RESULT & RDCTABLE[U][19:1:2];% 04555650
END RECORDRETRY;% 04555700
SUBROUTINE DOIONOW;% 04556000
BEGIN FOR Y~1 STEP 1 UNTIL 18 DO 04556100
BEGIN IF R.[24:1]THEN 04557000
BEGIN % WAIT 1/15 SEC BETWEEN READ RETRIES 04557100
WHILE T4>CLOCK+P(RTR) DO SLEEP(1,1); 04557200
T4~CLOCK+P(RTR+4); 04557300
END; 04557400
IF IOQUESLOTS=0 THENSLEEP([IOQUESLOTS],83); 04558000
IOQUESLOTS:=IOQUESLOTS-1; 04558500
IOQUEAVAIL:=IOQUE[T1:=IOQUEAVAIL]; 04559000
IOQUE[T1]~ IOD;% 04560000
LOCATQUE[T1]~LOCATQUE[T2 ~(T3~UNIT[U]).[18:15]]&RESULT]% 04561000
[33:33:15]&T2[18:33:15];% 04562000
UNIT[U] ~ T3&T1[18:33:15]&64[5:35:13];% 04563000
STARTIO(U);% 04564000
FINALQUE[T1] ~ NABS(IOD)& 0 [25:40:8] OR IOMASK;% 04565000
RESULT ~ 0;% 04566000
SLEEP([UNIT[U]],@100000000000);% 04567000
IF RESULT.[30:1] THEN % NOT READY 04567010
BEGIN 04567020
MODE := (-16); 04567030
GO TO EXIT; 04567040
END; 04567050
IF RESULT.[29:1] AND RESULT.[2:1] THEN 04567100
BEGIN 04567150
IF RESULT.[12:1] THEN % BLANK TAPE 04567200
IF IOD.[24:1] THEN % READ 04567250
TRANSACTION[U]~TRANSACTION[U]-1&IOD[1:22:1] ELSE04567300
BEGIN; % WRITE 04567310
STREAM(A~TINU[U],T~T2~SPACE(3)); 04567320
BEGIN SI~LOC A; SI~SI+5; DS~3 CHR; 04567400
DS!21 LIT" BLANK TAPE ON WRITE~"; 04567500
END; 04567550
SPOUTER(T2,UNITNO,35); 04567600
GO TO XXIT; 04567700
END; 04567750
IF RESULT.[11:1] THEN % MEM PARITY 04567770
BEGIN; 04567780
STREAM(A~TINU[U],T~T2~SPACE(3)); 04567790
BEGIN SI~LOC A; SI~SI+5; DS~3 CHR; 04567800
DS~13 LIT" I/O MEM PAR~"; 04567810
END; 04567820
SPOUTER(T2,UNITNO,35); 04567830
XXIT: MODE := 16; 04567840
IF TESTING THEN GO XIO; 04567845
RECORDRETRY; 04567850
GO TO EXIT; 04567855
END; 04567860
IF RESULT.[13:21]!0 THEN Y~18; 04567870
END ELSE GO TO XIO; 04567900
END;% 04568000
RESULT.[27:1]~1; MODE~32; 04568100
XIO: IF NOT SPACING THEN RECORDRETRY; 04568200
END DOIONOW;% 04568250
SUBROUTINE SPACEBACK; 04568300
BEGIN 04568310
IF TRANSACTION[U]=1 THEN 04568320
BEGIN 04568330
IOD:=@4200000000&IOD[3:3:5]; 04568340
DOIONOW; 04568350
I:=TWO(U); 04568360
T2:=CLOCK+P(RTR)+600; 04568364
COMPLEXSLEEP((P(RRR) AND I)!0 OR T2<CLOCK+P(RTR)); 04568366
IF (P(RRR) AND I)=0 THEN % TIME OUT => NOT READY04568370
BEGIN MODE:=16; 04568372
GO TO EXIT; 04568374
END; 04568376
END ELSE 04568380
BEGIN 04568390
M:=W; 04568400
IOD:=SPACEIOD; 04568410
J:=0; 04568420
SPACING:= TRUE;% 04568425
DO BEGIN 04568430
DOIONOW; 04568440
TRANSACTION[U]:=(*P(DUP))+1); 04568450
J:=J+1; 04568460
END UNTIL ((M:=RESULT.[CF]-SPACEIOD.[CF]+M) LSS 0 04568470
OR RESULT.[27:1] AND J GTR 1; 04568480
IF NOT TESTING THEN SPACING:= FALSE; 04568485
TRANSACTION[U]:=(*P(DUP))-2; 04568490
IOD:=SPACEIOD&0[22:47:1]; 04568500
DOIONOW; 04568510
IF N=0 THEN BSIZE:=RESULT.[CF]-IOD.[CF] ELSE 04568520
IF BSIZE!RESULT.[CF]-IOD.[CF] THEN 04568530
BEGIN 04568540
STREAM(A:=TINU[U],D:=T2:=SPACE(10)); 04568550
BEGIN SI:=LOC A;SI:=SI+5;DS:=3 CHR; 04568560
DS:=13 LIT" ERASE ERROR~"; 04568570
END; 04568580
SPOUTER(T2,UNITNO,35); 04568590
FLAGGER ~ 1; 04568595
GO GIVEUP; 04568600
END; 04568610
END; 04568620
END; % OF SPACEBACK 04568630
TINU[U].[18:12] ~ P(DUP).[18:12]~1;% 04569000
MIX ~ LOCATQUE[UNIT[U].[FF]].[3:5]; 04569100
FLAGGER ~ FINALQUE[UNIT[U].[FF]] < 0; % NOT OBJECT JOB 04569200
OIOD ~ NFLAG(IOQUE[UNIT[U].[18:15]]);% 04570000
PTR:= KEY+9; 04570100
IF R.[24:1] THEN% 04571000
BEGIN COMMENT READ RETRY;% 04572000
SPACEMASK ~ OIOD.[21:2]|@1111 EQV NOT @0123;% 04573000
SPACEIOD ~ OIOD&1[8:38:10]&1[23:47:1];% 04574000
FOR M ~ 1 STEP 1 UNTIL 3 DO% 04575000
BEGIN SPACEIOD ~ SPACEIOD&SPACEMASK[21:46:2];% 04576000
FOR N ~ 1 STEP 1 UNTIL 5 DO% 04577000
BEGIN IOD ~ SPACEIOD;% 04578000
IF N!1 OR M!1 THEN DOIONOW ELSE 04579000
IF NOT(R.[29:1]AND R.[2:1] AND R.[12:1]) 04579100
THEN DOIONOW; 04579200
IF RESULT.[28:1] THEN% 04580000
BEGIN MODE ~ 0;% 04581000
IOD ~ OIOD;% 04582000
END% 04583000
ELSE BEGIN MODE ~ 8;% 04584000
IOD ~ OIOD&SPACEMASK[21:43:2];% 04585000
END;% 04586000
DOIONOW;% 04587000
IF NOT RESULT.[28:1] THEN GO TO EXIT;% 04588000
IF MOD3IOS THEN IF OIOD.[23:1] THEN 04588010
BEGIN Z~IOD~OIOD&SPACEMAKS[21:40:2] 04588020
&(OIOD.[33:15]+(OIOD.[8:10]-1) 04588030
&OIOD[1:22:1]])[33:33:15]; 04588040
DOIONOW; MODE~0; 04588050
IF RESULT.[28:1] THEN 04588060
BEGIN IOD~OIOD; DOIONOW; 04588070
IF NOT RESULT.[28:1] THEN 04588080
GO TO EXIT; 04588090
IOD~Z&SPACEMASK[21:46:2]; 04588100
DOIONOW; MODE~8; 04588110
IF RESULT.[28:1] THEN 04588120
BEGIN IOD~OIOD&SPACEMASK 04588130
[21:43:2]; 04588140
RP: DOIONOW; 04588150
IF RESULT.[28:1] THEN 04588160
GO TO LX; 04588170
GO TO EXIT; 04588180
END; 04588190
END; 04588200
Z~ABS(IOD.[33:15]-RESULT.[33:15]); 04588210
IF IOD.[21:2]=0 THEN 04588220
Z~Z-(RESULT.[15:3]=0); 04588230
IF IOD.[8:10]<Z THEN 04588240
BEGIN IOD~OIOD; MODE~0; GO TO RP END;04588250
IF IOD.[22;1] THEN 04588260
STREAM(Z,Y~Z DIV 64, 04588270
S~RESULT.[33:15]+1, 04588280
SK~(RESULT.[15:3]+1).[45:3], 04588290
GM~(IF IOD.[2:1] THEN 0 04588300
ELSE "~"), 04588310
D~OIOD.[33:15]); 04588320
BEGIN SI~S; SI~SI+SK; 04588330
Y(16(DS~32 CHR)); 04588340
Z(DS~8 CHR); 04588350
SK(DS~LIT "0"); 04588360
DI~DI-SK; SI~LOC GM; 04588370
SI~SI+7; DS~CHR; 04588380
END ELSE 04588390
STREAM(Z,Y~Z DIV 64, 04588400
S~RESULT.[33:15]-1, 04588410
SK~(RESULT.[15:3]+7).[45:3], 04588420
FL~(IF IOD.[21:1] THEN 0 04588430
ELSE @14), 04588440
FK~(8-RESULT.[15:3]).[45:3], 04588450
D~OIOD.[33:15]); 04588460
BEGIN SI~S; SI~SI+SK; DI~DI+7; 04588470
Y(16(32(DS~CHR); SI~SI-2; 04588480
DI~DI-2))); 04588490
Z(8(DS~CHR; SI~SI-2; DI~DI-2));04588500
SI~LOC FL; SI~SI+7; 04588510
FK(DS~CHR; SI~SI-1; DI~DI-2); 04588520
END; 04588530
IOD~@140000005&OIOD[22:22:1] 04588540
&OIOD[3:3:5]; 04588550
DOIONOW; GO TO EXIT; 04588560
LX: END; 04588570
END;% 04589000
N ~ IF TRANSACTION[U] < 15 THEN% 04590000
TRANSACTION[U] ELSE 15;% 04591000
IOD ~ SPACEIOD&SPACEMASK[21:40:2];% 04592000
SPACING:= TRUE; 04592100
FOR W ~ 1 STEP 1 UNTIL N DO% 04593000
BEGIN DOIONOW;% 04594000
IF RESULT.[27:1] THEN N~0;% 04595000
END;% 04596000
IOD ~ SPACEIOD&SPACEMASK[21:37:2];% 04597000
FOR N ~ 3 STEP 1 UNTIL W DO DOIONOW;% 04598000
IOD ~ OIOD;% 04599000
MODE ~ 0;% 04600000
SPACING:= FALSE; 04600100
DOIONOW;% 04601000
IF NOT RESULT.[28:1] THEN GO TO EXIT;% 04602000
END;% 04603000
MODE ~ 16;% 04604000
END ELSE BEGIN COMMENT WRITE RETRY;% 04605000
LIMIT ~ @15000; 04605500
ERASEIOD ~ (SPACEIOD ~ OIOD&0[8:38:10]&7[22:45:3]&[T2]% 04606000
[33:33:15])&@112[18:47:7];% 04607000
W ~ R.[33:15]-OIOD.[33:15]+2;% 04608000
WHILE TRUE DO 04609000
BEGIN 04610000
SPACEBACK; 04611000
IF MIX!0 THEN IF TERMSET(MIX) THEN GO XEXIT; 04626000
IF (N~N+W+128) GTR LIMIT THEN GO GIVEUP; 04627000
IOD ~ ERASEIOD&N[9:39:9];% 04628000
SPACING:= TRUE;% 04628100
FOR J ~ 0 STEP 512 UNTIL N DO% 04629000
BEGIN TRANSACTION[U] ~ TRANSACTION[U]-1;% 04630000
DOIONOW;% 04631000
IOD ~ ERASEIOD&1[8:47:1];% 04632000
IF RESULT.[27:1] THEN 04633000
BEGIN 04633100
IF NOT R.[27:1] THEN LIMIT~J+3000; 04633200
R.[27:1]~1; 04633300
END; 04633400
END;% 04634000
SPACING:= FALSE;% 04634100
IOD:= IOD & N[CTC];% 04634200
RECORDRETRY;% 04634300
IOD ~ OIOD;% 04635000
DOIONOW;% 04636000
IF RESULT.[27:1] THEN R.[27:1] ~ 1;% 04637000
IF NOT RESULT.[28:1] THEN% 04638000
BEGIN 04638100
SIZE~RESULT.[CF]-OIOD.[CF]; 04638200
SPACEBACK; 04638300
IOD~SPACEIOD&0[22:47:1]; 04638650
DOIONOW; 04638700
IF NOT(RESULT.[28:1] OR (OIOD.[2:1] AND 04638800
(RESULT.[CF]-SPACEIOD.[CF]!SIZE))) THEN 04638900
BEGIN 04639000
MODE~0&R[42:27:1]; 04639100
GO TO EXIT; 04639200
END; 04640000
END; 04641000
END;% 04642000
GIVEUP: 04642900
STREAM(A~TINU[U], T~T2~SPACE(6)); 04644000
BEGIN SI ~ LOC A; SI ~ SI+5; DS ~ 3 CHR;% 04645000
DS ~ 11 LIT " WR PARITY~";% 04646000
END;% 04647000
IF MIX!0 THEN IF (NOT OIOD).[21:1] THEN % ALPHA TAPE 04647050
BEGIN STREAM(T~0: S~OIOD.[CF], QM~@14); 04647100
BEGIN SI ~ S; DI ~ LOC QM; DI ~ DI+7; 04647150
ST: IF SC="~" THEN GO F; 04647200
IF SC=DC THEN GO L; 04647250
DI ~ DI-1; 04647300
GO ST; 04647350
L: TALLY~1; T~TALLY; 04647400
F: END; 04647450
IF P THEN 04647500
BEGIN STREAM(T2); 04647550
BEGIN DI ~ DI+13; 04647600
DS ~ 29LIT", TRIED TO WRITE INVALID CHR~"; 04647650
END; 04647700
FLAGGER ~ 1; 04647750
END; END; 04647800
SPOUTER(T2,UNITNO,25); 04648000
IF MIX!0 AND NOT FLAGGER THEN 04648050
BEGIN 04648100
TAPEPARITYRETRY ~ Y ~ WRITEPARITYREELSWITCH(OIOD,0); 04648150
MODE ~ Y.[5:8]; 04648200
R.[27:1] ~ 0; 04648250
GO ENDIT; 04648300
END; 04648350
XEXIT: 04648400
MODE ~ 16;% 04649000
END;% 04650000
EXIT: TAPEPARITYRETRY:= UNIT[U] & MODE[5:40:8]; 04651000
ENDIT: 04651010
MEMORY[KEY+8] := PTR-KEY-9; 04651050
MEMORY[KEY+9]:=ABS(MODE); 04651100
MEMORY[KEY] := P(DUP,LOD) & ((PTR-KEY) DIV 5)[39:39:9]; 04651200
IF (MODE!16) OR (R.[24:1]) THEN LINKUP(3,KEY) ELSE 04651300
BEGIN 04651400
BUFFER:= OIOD INX 0; 04651500
BUFFERSIZE:= OIOD.[8:10]; 04651600
IF NOT OIOD.[21:1] THEN % ALPHA WRITE - CHECK Q-MARKS 04651700
BEGIN 04651800
STREAM(T:=0: 04651900
TEMP:=0, SVSI:=0, 04652000
BUFFSTART:=BUFFER, 04652100
BUFFEND:=BUFFER+BUFFERSIZE); 04652200
BEGIN 04652300
SI:=BUFFEND; DI:=LOC TEMP; DS:= CHR; 04652400
DI:=BUFFEND; DS:=LIT"-"; DI:=DI-1; DS:=RESET; %Q-MARK 04652500
SI:=BUFFSTART; 04652600
IF SC > 9 THEN 04652700
BEGIN 04652800
L1: SI:=SI+1; IF SC>9 THEN GO L1; 04652900
END; 04653000
L2: SI:=SI+1; IF SC{9 THEN GO L2; 04653100
SVSI:=SI; 04653200
SI:=LOC SVSI; SI:=SI+5; 04653300
DI:=LOC BUFFEND; DI:=DI+5; 04653400
IF 3 SC!DC THEN TALLY:=1; 04653500
SI:=BUFFEND; SI:=LOC TEMP; DS:= CHR; 04653600
T:=TALLY; 04653700
END; 04653800
I:=POLISH; 04653900
MEMORY[KEY+2]:= P(DUP,LOD) & 1[1:47:1]; 04654000
END; 04654100
IF STOPTEST OR FLAGGER THEN LINKUP(3,KEY) ELSE 04654200
BEGIN 04654300
MEMORY[KEY] := NABS(P(DUP,LOD)); 04654400
LINKUP(3,KEY); 04654500
TESTING:= SPACING:= TRUE; N:=0; 04654600
BUFFERSIZE:= BUFFERSIZE-1; 04654700
OIOD:= OIOD & 1[18:42:6]; 04654800
PTR:= KEY+8; 04654900
STREAM(MOD2IOS:=NOT(MOD3IOS+62), D:=[PATTERN]); 04655000
BEGIN 04655100
DS:=13 LIT"01248+|~<(.G{"; 04655200
MOD2IOS(DI:=DI-6; DS:=LIT"""; DI:=DI+5); 04655300
DS:= LIT"""; DS:= LIT"""; 04655400
DS:=3 LIT"]$("; 04655500
END; 04655600
SLEEP([MEMORY[KEY]],@1000000000000000); 04655700
MEMORY[PTR]:= 0; MOVE(191,PTR,PTR+1); 04655800
FOR K:=0 STEP 1 UNTIL 15 DO 04655900
BEGIN 04656000
STREAM(A:=[PATTERN], 04656100
K:=K+(K=15), M:=4+4|(K<14), N:=1+(K>13), 04656200
SIZEDIV64:=BUFFERSIZE.[36:6], BUFFERSIZE, 04656300
BUFFER); 04656400
BEGIN 04656500
SI:=A; SI:=SI+K; 04656600
M(DS:=N CHR; SI:=SI-N); 04656700
SI:=BUFFER; 04656800
SIZEDIV64(DS:=32 WDS; DS:=32 WDS); DS:=BUFFERSIZE WDS; 04656900
DI:=A; DI:=DI+24; DS:=WDS; 04657000
END; 04657100
IOD:= OIOD:= OIOD & ((K<7) OR (K>13))[21:47:1]; 04657200
DOIONOW; 04657300
MEMORY[PTR]:= RESULT & RDCTABLE[U][19:1:2]; 04657400
SPACEBACK; 04657500
STREAM(SIZEDIV64:=BUFFERSIZE.[36:6],BUFFERSIZE, 04657600
BUFFER); 04657700
BEGIN 04657800
DS:=8 LIT" "; SI:=BUFFER; 04657900
SIZEDIV64(DS:=32 WDS; DS:=32 WDS); DS:=BUFFERSIZE WDS; 04658000
END; 04658100
IOD:= OIOD & 1[24:47:1]; 04658200
DOIONOW; 04658300
MEMORY[PTR+1]:= RESULT & RDCTABLE[U][19:1:2]; 04658400
STREAM(A:=[PATTERN] INX 3, 04658500
CHERR:=0, WRDERR:=0, WRDCNT:=0, 04658600
LOOP:=0, FORSEVEN:=1, LEAPFROG:=0, 04658700
WDSLEFT:=I:=(J:=IF (SIZE:=ABS(BUFFER-(RESULT INX 0))) 04658800
LEQ BUFFERSIZE THEN SIZE ELSE BUFFERSIZE+1) MOD 63, 04658900
V:=IF J<64 THEN J ELSE 63, 04659000
N:=IF J<64 THEN 1 ELSE J DIV 63, 04659100
RECYCLE:= IF J<64 THEN 0 ELSE IF I=0 THEN 0 ELSE 1, 04659200
TEMP:=0, SVDI:=0, 04659300
BITLOCN:=PTR+3, WRDLOCN:=PTR+5, 04659400
BUFFER); 04659500
BEGIN; 04659600
LEAPFROG:= CI; TALLY:=0; % USED ONLY FOR LEAPFROG RETURN 04659700
N(V(SI:=A; IF 8 SC!DC THEN 04659800
BEGIN 04659900
SI:=WRDERR; SI:=SI+8; WRDERR:=SI; 04660000
FORSEVEN(SVDI:=DI; DI:=BITLOCN; LOOP(DI:=DI+2); 04660100
SI:=LOC WRDCNT; SI:=SI+6; DS:=2 CHR; 04660200
DI:=WRDLOCN; LOOP(DI:=DI+8); 04660300
SI:=WVDI; SI:=SI-8; DS:= WDS; 04660400
TALLY:=LOOP; TALLY:=TALLY+1; LOOP:=TALLY; 04660500
SI:=LOC LOOP; SI:=SI+7; 04660600
IF SC="7" THEN 04660700
BEGIN TALLY:=0; FORSEVEN:=TALLY; END; 04660800
DI:=SVDI); 04660900
SI:=A; DI:=DI-8; TALLY:=0; 04661000
8(IF SC!DC THEN TALLY:=TALLY+1); 04661100
TEMP:=TALLY; 04661200
SI:=CHRERR; TEMP(SI:=SI+8); CHRERR:=SI; 04661300
END; 04661400
SI:=WRDCNT; SI:=SI+8; WRDCNT:=SI; 04661500
)); 04661600
RECYCLE(TALLY:=1; N:=TALLY; 04661700
TALLY:=WDSLEFT; V:=TALLY; 04661800
TALLY:=0; RECYCLE:=TALLY; 04661900
JUMP OUT TO TADPOLE); 04662000
GO TO FROG; 04662100
TADPOLE: CI:=LEAPFROG; 04662200
FROG: DI:=BITLOCN; DI:=DI-5; 04662300
SI:=LOC CHRERR; SI:=SI+5; DS:=3 CHR; 04662400
SI:=LOC WRDERR; SI:=SI+6; DS:=2 CHR; 04662500
END; 04662600
IF MEMORY[PTR].[27:1] THEN SPACEBACK; 04662700
PTR:=PTR+12; 04662800
END; 04662900
MEMORY[KEY]:= P(DUP,LOD) & 0[1:1:2] & 39[39:39:9]; 04663000
MEMORY[KEY+2]:= P(DUP,LOD) & OPTION[2:2:1]; 04663100
LINKUP(20,KEY); 04663200
END;END; 04663300
END TAPEPARITYRETRY;% 04666000
REAL PROCEDURE WRITEPARITYREELSWITCH(OIOD,RC); 04667000
VALUE OIOD,RC; REAL OIOD,RC; 04667050
% 04667100
% THE PURPOSE OF THIS ROUTINE IS TO ALLOW OBJECT PROGRAMS 04667150
% TO CHANGE MAG TAPE UNITS WHEN ENCOUNTERING A WRITE PARITY 04667200
% ERROR. THIS ROUTINE IS CALLED FROM EITHER TAPEPARITYRETRY 04667250
% IN RESPONSE TO A FATAL WRITE PARITY ERROR OR FROM 04667300
% REELCHANGER AFTER AN "RC" KEYBOARD REQUEST BY THE OPERATOR. 04667350
% 04667400
% BASICALLY, THIS ROUTINE READS INTO CORE THE LAST TWO 04667450
% SUCESSFULLY WRITTEN BLOCKS ON THE TAPE, CLOSES THE FILE 04667500
% (MARKING THE TAPE AS AN END OF REEL), OBTAINS ANOTHER 04667550
% TAPE UNIT, RE-WRITES THE TWO BLOCKS IN CORE FOLLOWED 04667600
% BY THE BLOCK IN WHICH THE PARITY ERROR OCURRED, AND 04667650
% ALLOWS THE PROGRAM TO CONTINUE WRITING ON THE NEW TAPE. 04667700
% 04667750
% WHEN THIS ROUTINE IS CALLED DUE TO AN OPERATOR "RC" 04667800
% MESSAGE, THERE IS NO FATAL PARITY ERROR AT THIS POINT. 04667850
% SO THE SAVING OF THE LAST TWO RECORDS IS UNNECESSARY 04667900
% AND ONLY THE CLOSING OF THE FILE AND OBTAINING OF A NEW 04667950
% UNIT ARE REQUIRED. 04668000
% 04668050
% THE PARAMETERS ARE USED AS FOLLOWS: 04668100
% OIOD THE ORIGINAL I/O DESCRIPTOR ON WHICH 04668150
% A FATAL ERROR OCCURRED 04668200
% 04668250
% RC 1 IF CALLED FROM REELCHANGER, 0 OTHERWISE 04668300
% 04668350
BEGIN 04668400
INTEGER I,LOGICLRC; 04668450
REAL BSIZE,FNUM,NUMBUFFS,NUMRECS,REEL); 04668500
REAL S,Y,U,OLDU,SAVEU,MIX; 04668550
REAL TEMP,T1,T2,T3,T4; 04668600
REAL IOD,RESULT,MODE,TOPIOD,TM,HOLDCT; 04668650
REAL FIRSTREC,SECREC,FIRSTRECIO,SECRECIO; 04668700
BOOLEAN TOGGLES; 04668750
ARRAY FIB[*],FPB[*],LABELA[*],TANK[*]; 04668800
% 04668850
% THE LOCAL VARIABLES ARE USED AS FOLLOWS: 04668900
% INTEGERS 04668950
% I TEMPORARY 04669000
% LOGICLRC CONTAINS THE LOGICAL RECORD COUNT 04669050
% REALS 04669100
% BSIZE BLOCK SIZE OF FILE 04669150
% FNUM FILE NUMBER WITHIN FPB 04669200
% NUMBUFFS TOTAL NUMBER OF BUFFERS DECLARED FOR FILE 04669250
% NUMRECS RECORDS PER BLOCK (BSIZE DIV RECORD SIZE) 04669275
% REEL CONTAINS THE CURRENT REEL NUMBER +1 04669300
% S INDEX INTO IOQUE OF UNSUCCESSFUL I/O 04669350
% Y TEMPORARY 04669400
% U LOGICAL UNIT NUMBER OF TAPE UNIT BEING WRITTEN 04669450
% OLDU HARDWARE UNIT NUMBER OF TAPE UNIT 04669500
% SAVEU LOGICAL UNIT OF ORIGINAL TAPE UNIT WITH ERROR 04669550
% MIX MIX INDEX OF JOB FOR WHICH RECOVERY IS ATTEMPTED 04669600
% TEMP 04669650
% T1,T2,T3,T4 TEMPORARY 04669700
% IOD HOLDS THE I/O DESCRIPTOR FOR EACH I/O ATTEMPTED 04669750
% RESULT RECEIVES THE LAST I/O RESULT DESCRIPTOR 04669800
% MODE USED TO INDICATE A SUCCESSFUL RECOVERY ATTEMPT 04669850
% TOPIOD LOCATION OF TOP I/O DESCRIPTOR IN TANK 04669900
% TM TEMPORARY, USED FOR WRITING TAPE MARK 04669950
% HOLDCT CONTAINS THE NUMBER OF FILLED BUFFERS 04670000
% FIRSTREC 04670050
% SECREC ADDRESSES OF AREAS TO HOLD LAST TWO BLOCKS 04670100
% FIRSTRECIO 04670150
% SECRECIO VARIABLE LENGTH BLOCK I/O DESCRIPTORS 04670200
% BOOLEAN 04670250
% TOGGLES USED TO HOLD VARIOUS BOOLEANS (SEE DEFINES) 04670300
% ARRAYS 04670350
% FIB FIB ARRAY, USED FOR CLOSEING THE FILE 04670400
% FPB FPB ARRAY, USED FOR OPENING NEW FILE 04670450
% LABELA ARRAY DESCRIPTOR FOR IN-CORE LABEL RECORD 04670500
% TANK TANK ARRAY, CONTAINING I/O DESCRIPTORS 04670550
% 04670600
LABEL L1,RETRY,PROB,KAPUT,RESETUNITS,ARN,ERROROUT,XIO,EXIT; 04670650
DEFINE ALFA = TOGGLES.[47:1]#, 04670700
DSED = TOGGLES.[46:1]#, 04670750
LABELED = TOGGLES.[45:1]#, 04670800
NORMALPROCESS = TOGGLES.[44:1]#, 04670850
PBT = TOGGLES.[43:1]#; 04670900
$ SET OMIT = NOT(PACKETS) 04670950
DEFINE UNITNO = PSEUDOMIX[MIX]#; 04671000
$ POP OMIT 04671050
SUBROUTINE DOIONOW; 04671100
BEGIN 04671150
% DOIONOW IS COPIED FROM TAPEPARITYRETRY 04671200
FOR Y ~ 1 STEP 1 UNTIL 18 DO 04671250
BEGIN IF IOD.[24:1] THEN 04671300
BEGIN % WAIT 1/15 SECOND BETWEEN READ RETRIES 04671350
WHILE T4 > CLOCK+P(RTR) DO SLEEP(1,1); 04671400
T4 ~ CLOCK+P(RTR)+4; 04671450
END; 04671500
IF IOQUESLOTS=0 THEN SLEEP([IOQUESLOTS],63); 04671550
IOQUESLOTS ~ IOQUESLOTS-1; 04671600
IOQUEAVAIL ~ IOQUE[T1~IOQUEAVAIL]; 04671650
IOQUE[T1] ~ IOD; 04671700
IF (T2~(T3~UNIT[U]).[FF])=@77777 THEN T3.[CF]~T1; 04671750
LOCATQUE[T1] ~ [RESULT] & MIX[3:43:5] & 04671800
U[12:42:6] & T2[CTF]; 04671850
UNIT[U] ~ T3 & T1[CTF] & 100[5:35:13]; 04671900
STARTIO(U); 04671950
FINALQUE[T1] ~ NABS(IOD) & 0[25:40:8] OR IOMASK; 04672000
RESULT ~ 0; 04672050
SLEEP([UNIT[U]],@100000000000); 04672100
IF RESULT.[30:1] THEN GO ERROROUT; % NOT READY 04672150
IF RESULT.[29:1] AND RESLT.[2:1] THEN 04672200
BEGIN 04672250
IF RESLT.[12:1] THEN % BLANK TAPE 04672300
IF IOD.[24:1] THEN % READ 04672350
TRANSACTION[U] ~ (*P(DUP))-(1 & IOD[1:22:1]) ELSE 04672400
BEGIN % WRITE 04672450
STREAM(A~TINU[U], T~T2~SPACE(3)); 04672500
BEGIN SI~LOC A; SI~SI+5; DS~3 CHR; 04672550
DS~21 LIT" BLANK TAPE ON WRITE~"; 04672600
END; 04672650
SPOUTER(T2,UNITNO,35); 04672700
GO ERROROUT; 04672750
END; 04672800
IF RESULT.[11:1] THEN % MEM PARITY 04672850
BEGIN 04672900
STREAM(A~TINU[U], T~T2~SPACE(3)); 04672950
BEGIN SI~LOC A; SI~SI+5; DS~3 CHR; 04673000
DS~13 LIT" I/O MEM PAR~"; 04673050
END; 04673100
SPOUTER(T2,UNITNO,35); 04673150
GO ERROROUT; 04673200
END; 04673250
IF RESULT.[13:2]!0 THEN Y ~ 18; 04673300
END ELSE 04673350
GO XIO; 04673400
END; 04673450
RESULT.[27:1] ~ 1; MODE ~ 32; 04673500
XIO: END DOIONOW; 04673550
% 04673600
U ~ SAVEU ~ OIOD.[3:4]; 04673650
% SAVE OFF ORIGINAL UNIT FOR DS-ING. 04673700
OLDU ~ UNIT[U]; 04673750
% SAVE OFF ORIGINAL UNIT TABLE ENTRY 04673800
MIX ~ RDCTABLE[U].[8:6]; 04673850
MODE ~ 16; 04673900
% SET MODE TO FLAG PARITY, MODE WILL BE SET TO ZERO IF CHANGE OK 04673950
LABELA ~ M[(TOPIOD~PRNTABLE[U].[15:15])-2] & @05000[CTF]; 04674000
FIB ~ M[TOPIOD-3]; 04674050
PBT ~ FIB[4].[8:4]=7; 04674100
FNUM ~ FIB[4].[13.11]; 04674150
BSIZE ~ IF PBT THEN 90 ELSE FIB[18].[3:15]; 04674200
NUMRECS ~ IF PBT THEN 5 ELSE BSIZE DIV FIB[18].[33:15]; 04674225
REEL ~ FIB[13].[28:10]+1; 04674250
ALFA ~ (NOT FIB[13]).[24:1]; 04674300
LABELED ~ (NOT FIB[4]).[2:1]; 04674350
NUMBUFFS ~ FIB[13].[10:9]; 04674400
TANK ~ [M[TOPIOD]] & NUMBUFFS[8:38:10]; 04674450
HALT; 04674500
% STOP NORMAL STATE PROCESSING. 04674550
IF RC THEN 04674600
IF TANK[0].[24:1] THEN 04674650
BEGIN 04674700
STREAM(T~T2~SPACE(5)); 04674750
DS ~ 40 LIT"#REEL SWITCH NOT POSSIBLE ON INPUT FILE~"; 04674800
SPOUTER(T2,UNITNO,1); 04674850
GO EXIT; 04674900
END; 04674950
STREAM(A~TINU[U], T~T2~SPACE(5)); 04675000
BEGIN 04675050
DS ~ 34 LIT"#REEL SWITCH TO BE ATTEMPTED FROM "; 04675100
SI ~ LOC A; SI ~ SI+5; DS ~ 3 CHR; DS ~ LIT"~"; 04675150
END; 04675200
SPOUTER(T2,UNITNO,1); 04675250
IF PBT THEN 04675300
BEGIN 04675350
LABELA.[8:10] ~ 8; % PRINTER LABELS ARE 15 WORDS 04675400
LABELA[1] ~ MULTITABLE[U].[3:45]; 04675450
LABELA[2] ~ LABELTABLE[U].[3:45]; 04675500
END; 04675550
IF RC THEN GO L1; 04675600
FIRSTREC ~ GETSPACE(BSIZE+4,0,1)+4; 04675650
SECREC ~ GETSPACE(BSIZE+4,0,1)+4; 04675700
% GETSPACE ON TWO BUFFERS FOR BACKWARD READ. 04675750
IF ALFA THEN 04675800
BEGIN 04675850
IOD ~ @340000000 & OIOD[3:3:5] & [T2][CTC]; 04675900
DOIONOW; DOIONOW; 04675950
IOD ~ OIOD & 1[24:47:1] & FIRSTREC[CTC]; 04676000
DOIONOW; 04676050
IF RESULT.[27:2]!0 THEN GO ERROROUT; 04676100
IOD ~ IOD & SECREC[CTC]; 04676150
DOIONOW; 04676200
IF RESULT.[27:2]!0 THEN GO ERROROUT; 04676250
IOD ~ @340000000 & OIOD[3:3:5] & [T2][CTC]; 04676300
DOIONOW; DOIONOW; 04676350
GO L1; 04676400
END; 04676450
IOD ~ OIOD & (SECREC+BSIZE-1)[CTC] & 5[22:45:3]; 04676500
DOIONOW; 04676550
% BUILD BACKWARD DESCRIPTOR AND EXECUTE FIRST BACKWARD READ. 04676600
IF RESULT.[27:2]!0 THEN GO ERROROUT; 04676650
IF (TEMP ~ M[IOD INX 1])!BSIZE THEN 04676700
% VARIABLE LENGTH BLOCK. 04676750
SECRECIO ~ ((IOD INX 1)-TEMP) & TEMP[8:38:10]; 04676800
IOD ~ IOD & (FIRSTREC+BSIZE-1)[CTC]; 04676850
DOIONOW; 04676900
% NEXT BACKWARD READ. 04676950
IF RESULT.[27:2]!0 THEN GO ERROROUT; 04677000
IF (TEMP ~ M[IOD INX 1])!BSIZE THEN 04677050
% VARIABLE LENGTH BLOCK. 04677100
FIRSTRECIO ~ ((IOD INX 1)-TEMP) & TEMP[8:38:10]; 04677150
L1: 04677200
FOR I ~ 0 STEP 1 UNTIL NUMBUFFS-1 DO 04677250
IF (NOT TANK[I]).[19:1] THEN HOLDCT ~ HOLDCT+1; 04677300
% SCAN FOR THE NUMBER OF FILLED BUFFERS. 04677350
FIB[6] ~ FIB[6]-((RC=0)|2)-HOLDCT; 04677400
LOGICLRC ~ FIB[7] MOD NUMRECS; 04677450
% DETERMINE THE NUMBER OF LOGICAL RECORDS WRITTEN. 04677500
FIB[7] ~ FIB[6] | NUMRECS; 04677550
% LOAD FIB WITH RECORD COUNT FOR TRAILER LABEL. 04677600
IF HOLDCT=NUMBUFFS THEN 04677650
BEGIN 04677700
NOPROCESSTOG ~ NOPROCESSTOG-1; 04677750
NORMALPROCESS ~ 1; 04677800
END; 04677850
% IF THERE ARE NO UNFILLED BUFFERS THEN ALLOW NORMAL STATE 04677900
% PROCESSING TO CONTINUE. 04677950
% FLAG THE RELEASE OF NORMAL STATE. 04678000
% THE CHANCE OF UNFILLED BUFFERS IS VERY REMOTE, BUT JUST IN CASE 04678050
P1MIX ~ MIX; 04678100
% LOAD P1MIX FOR CONSOLE MESSAGES. 04678150
TEMP ~ U; 04678200
% SAVE OFF CURRENT UNIT IN CASE DS CALLED AT THIS POINT. 04678250
RETRY: 04678300
IF TERMSET(MIX) THEN 04678350
BEGIN 04678400
U ~ (-1); 04678450
GO ERROROUT; 04678500
END; 04678550
TEMP ~ U; 04678600
TM ~ @ 1737000000000000; 04678650
% TAPE MARK. 04678700
IOD ~ NFLAG([TM]) & OIOD[3:3:5]; 04678750
DOIONOW; 04678800
% WRITE TAPE-MARK. 04678850
FIB[13].[28:10] ~ REEL; 04678900
IF LABELED THEN 04678950
BEGIN 04679000
STREAM(BC~FIB[6], RC~FIB[7], BKUP~PBT, D~LABELA); 04679050
BEGIN 04679100
DI ~ DI+39; DS ~ LIT"1"; 04679150
% END OF REEL FLAG. 04679200
BKUP(DI ~ DI+12; JUMP OUT TO OWT); 04679250
SI ~ LOC BC; DS ~ 5 DEC; DS ~ 7 DEC; 04679300
OWT: DS ~ LIT"1"; 04679350
% SPECIAL FLAG FOR SORT AND USE PROCEDURES 04679400
END; 04679450
IOD ~ NFLAG(LABELA) & OIOD[3:3:5]; 04679500
IF NOT PBT THEN IF ALFA THEN 04679550
IOD.[21:1] ~ 0; 04679600
DOIONOW; 04679650
% BUILD I/O DESCRIPTOR AND WRITE THE TRAILER LABEL. 04679700
IOD ~ NFLAG([TM]) & OIOD[3:3:5]; 04679750
DOIONOW; 04679800
END; 04679850
IOD ~ IOD & @42[18:42:6]; 04679900
% BUILD THE REWIND DESCRIPTOR. 04679950
DOIONOW; 04680000
STOPTIMING(FNUM,1023); 04680050
FPB ~ PRT[MIX,3]; 04680100
LABELTABLE[U] ~ @214; % RW/L 04680150
MULTITABLE[U] ~ RDCTABLE[U] ~ PRNTABLE[U] ~ 0; 04680200
IF LABELED THEN 04680250
BEGIN 04680300
STREAM(R~REEL, BKUP~PBT, D~LABELA); 04680350
BEGIN 04680400
SI ~ LOC R; DI ~ DI+24; DS ~ 3 DEC; 04680450
% LOAD REEL NUMBER INTO LABEL. 04680500
DI ~ DI+12; DS ~ LIT"0"; 04680550
BKUP(DI ~ DI+12; JUMP OUT TO OWT); 04680600
DS ~ 12 LIT"0"; 04680650
OWT: DS ~ LIT "0"; 04680700
% CLEAN OUT OLD TRAILER LABEL INFO. 04680750
END; 04680800
IF NOT PBT THEN IF ALFA THEN 04680850
LABELA.[7:1] ~ 1; 04680900
U ~ LABELASCRATCH(LABELA); 04680950
% FIND TAPE FOR LABELED OUTPUT. 04681000
IF U=(-1) THEN GO ERROROUT; 04681050
% OPERATOR DS-ED. 04681100
END ELSE 04681150
BEGIN 04681200
U ~ FINDOUTPUT(FPB[FNUM],FPB[FNUM+1],REEL,0,0,2,0,TM); 04681250
% FIND UNLABELED OUTPUT TAPE. 04681300
IF U=(-1) THEN GO ERROROUT; 04681350
T2 ~ 0; 04681400
STREAM(PRN~PRNTABLE[U].[30:18], D~[T2]); 04681450
BEGIN SI ~ LOC PRN; DS ~ 8 DEC; 04681500
DI ~ DI-7; DS ~ 6 FILL; 04681550
END; 04681600
$ SET OMIT = PACKETS 04681650
FILEMESSAGE(" OUT" & TINU[U][6:30:18],T2, 04681800
FPB[FNUM],FPB[FNUM+1],REEL,0,0,OPNMESS); 04681850
END; 04681900
RDCTABLE[U] ~ (*P(DUP)) & MIX[8:42:6]; 04681950
PRNTABLE[U] ~ (*P(DUP)) & TOPIOD[15:33:15]; 04682000
FPB[FNUM+3].[36:6] ~ U+1; 04682050
% LOAD LOGICAL UNIT NUMBER +1 INTO FPB. 04682100
TEMP ~ OIOD.[3:4]; 04682150
% LUN OF OLD UNIT. 04682200
S ~ UNIT[TEMP].[FF]; 04682250
% SAVE OFF INDEX INTO IOQUE 04682300
UNIT[TEMP] ~ (*P(DUP)) & @77777[14:29:19]; 04682350
% CLEAR UNIT TABLE ON OLD UNIT. 04682400
UNIT[U] ~ OLDU; 04682450
% LOAD NEW UNIT TABLE ENTRY. 04682500
OIOD ~ OIOD & TINU[U][3:3:5]; 04682550
% LOAD OIOD WITH NEW UNIT NUMBER. 04682600
FOR I ~ 0 STEP 1 UNTIL NUMBUFFS-1 DO 04682650
IF TANK[I].[7:1] THEN 04682700
TANK[I] ~ (*P(DUP)) & OIOD[3:3:5]; 04682750
% LOAD NEW UNIT DESIGNATE INTO I/O DESCRIPTOR TANK. 04682800
TINU[U] ~ (*P(DUP)) & TINU[TEMP][24:24:6]; 04682850
TINU[TEMP] ~ (*P(DUP)) & 0[24:42:6]; 04682900
IF RC THEN GO KAPUT; 04682950
IF FIRSTRECIO!0 THEN IOD ~ OIOD&FIRSTRECIO[8:8:10]&FIRSTRECIO[CTC] 04683000
% TEST FOR BLOCK LESS THAN MAX LENGTH--VARIABLE LENGTH--. 04683050
ELSE IOD ~ OIOD & FIRSTREC[CTC]; 04683100
DOIONOW; 04683150
% WRITE FIRST RECORD 04683200
IF RESULT.[28:1] THEN % CHECK FOR WRITE ERROR 04683250
BEGIN 04683300
PROB: 04683350
FIB[13].[28:10] ~ REEL-1; 04683400
% DECREMENT REEL COUNT. 04683450
STREAM(A~TINU[U], T~T2~SPACE(6)); 04683500
BEGIN 04683550
DS ~ 23 LIT"#REEL SWITCH FAILED ON "; 04683600
SI ~ LOC A; SI ~ SI+5; DS ~ 3 CHR; 04683650
DS ~ 22 LIT", ANOTHER REEL PLEASE~"; 04683700
END; 04683750
SPOUTER(T2,UNITNO,1); 04683800
GO RETRY; 04683850
END; 04683900
IF SECRECIO!0 THEN IOD ~ OIOD&SECRECIO[8:8:10]&SECRECIO[CTC] 04683950
% CHECK FOR LESS THAN MAX LENGTH BLOCKS--VARIABLE LENGTH-- 04684000
ELSE IOD ~ OIOD & SECREC[CTC]; 04684050
% STANDARD LENGTH 04684100
DOIONOW; 04684150
% WRITE SECOND RECORD. 04684200
IF RESULT.[28:1] THEN GO PROB; 04684250
IOD ~ OIOD; 04684300
% ORIGINAL BAD IO ON NEW UNIT 04684350
DOIONOW; 04684400
IF RESULT.[28:1] THEN GO PROB; 04684450
KAPUT: 04684500
IF NOT DSED THEN 04684550
BEGIN 04684600
MODE ~ 0; 04684650
STARTIMING(FNUM,U); 04684700
END; 04684750
% CHANGE OVER SUCCESSFUL. 04684800
FIB[15].[24:6] ~ U; 04684850
% NEW LUN INTO FIB. 04684900
OLDU ~ TINU[U].[3:5]; 04684950
% OLDU LOADED WITH NEW PHYSICAL UNIT NUMBER. 04685000
IF NOT RC THEN 04685050
BEGIN 04685100
RESETUNITS: 04685150
IOQUE[S] ~ (*P(DUP)) & OLDU[3:43:5]; 04685200
FINALQUE[S] ~ (*P(DUP)) & OLDU[3:43:5]; 04685250
LOCATQUE[S] ~ (*P(DUP)) & U[12:42:6]; 04685300
% RESET DESCRIPTORS IN IOQUE. 04685350
IF (S ~ LOCATQUE[S].[FF]!@77777 THEN GO RESETUNITS; 04685400
END; 04685450
FIB[16] ~ (*P(DUP)) & OLDU[3:43:5]; 04685500
FIB[19] ~ (*P(DUP)) & OLDU[3:43:5]; 04685550
% CHANGE UNIT FIELD OF DESCRIPTORS IN FIB. 04685600
FIB[6] ~ ((RC=0)|2)+HOLDCT; 04685650
% LOAD NEW BLOCK COUNT INTO FIB 04685700
FIB[7] ~ (((RC=0)|2) | NUMRECS)+HOLDCT | NUMRECS+LOGICLRC; 04685750
% LOAD NEW RECORD COUNT 04685800
TINU[U].[24:6] ~ 0; 04685850
UNIT[U].[5:10] ~ 0; 04685900
% RESET ERROR FLAGS. 04685950
IF NOT DSED THEN 04686000
BEGIN 04686050
STREAM(A~TINU[U], T~T2~SPACE(4)); 04686100
BEGIN 04686150
DS ~ 26 LIT"#REEL SWITCH COMPLETED ON "; 04686200
SI ~ LOC A; SI ~ SI+5; DS ~ 3 CHR; DS ~ LIT"~"; 04686250
END; 04686300
SPOUTER(T2,UNITNO,1); 04686350
END; 04686400
TOPIOD ~ TEMP ~ (IF RC THEN FIB[19] ELSE OIOD).[CF]-2; 04686450
% MUST RESET LUN IN I/O BUFFER FOR PROGRAM RELEASE 04686500
ARN: M[TEMP] ~ (*P(DUP)) & U[12:42:6]; 04686550
IF M[TEMP].[FF]-2!TOPIOD THEN 04686600
BEGIN 04686650
TEMP ~ M[TEMP].[FF]-2; 04686700
GO ARN; 04686750
END; 04686800
GO EXIT; 04686850
ERROROUT: 04686900
STREAM(T~T2~SPACE(3)); 04686950
DS ~ 21 LIT"#REEL SWITCH ABORTED~"; 04687000
SPOUTER(T2,UNITNO,1); 04687050
IF U < 0 THEN % JOB BEING DS-ED AT MT REQ 04687100
BEGIN 04687150
U ~ TEMP; 04687200
% SET U TO LAST UNIT. 04687250
IF U=SAVEU THEN GO EXIT; 04687300
DSED ~ 1; 04687350
GO KAPUT; 04687400
% GO TO KAPUT TO COUNTINUE HOUSE-KEEPING 04687450
END; 04687500
EXIT: 04687550
P1MIX ~ 0; 04687600
IF FIRSTREC!0 THEN 04687650
BEGIN 04687700
FORGETSPACE(FIRSTREC-2); 04687750
FORGETSPACE(SECREC-2); 04687800
END; 04687850
IF NOT NORMALPROCESS THEN NOPROCESSTOG ~ NOPROCESSTOG-1; 04687900
% WAS UNABLE TO FREE NORMAL PROCESS DUE TO UNFILLED BUFFERS. 04687950
% THIS SITUATION MAY NEVER OCCUR, BUT JUST IN CASE 04688000
WRITEPARITYREELSWITCH ~ UNIT[U] & MODE[5:40:8]; 04688050
END WRITEPARITYREELSWITCH; 04688100
REAL PROCEDURE PLACEFINDER(S, A, L); 04700000
VALUE S, A; 04701000
REAL S, A, L; 04702000
BEGIN INTEGER I; ARRAY B[*]; 04703000
REAL T, W, E, J, AA; 04704000
LABEL NULL, FOUND, EXIT; 04705000
LABEL SANDA; REAL SS; 04705500
W ~ -1; 04706000
B ~ [M[T ~ SPACE(30)]]&30[8:38:10]; 04707000
SS:=S; 04707500
IF S=0 THEN 04708000
NULL: BEGIN STREAM(T); DS:=20 LIT " "; GO EXIT; END; 04709000
DISKWAIT(-T,30,JAR[P1MIX,10]); 04710000
IF (JAR[P1MIX,10]=0) OR (AA~B[0].[FF])=0 THEN 04711000
SANDA: BEGIN STREAM(S:=SS,A,K:=M[PRT[P1MIX,8]].[10:2],T); 04712000
BEGIN DS~5 LIT ", S ="; 04713000
SI~LOC S; DS~4 DEC; 04714000
DS~5 LIT ", A ="; 04715000
DS~4 DEC; 04716000
DS:=LIT ":"; SI:=SI+7; DS:=CHR; 04716100
DI~T; DI~DI+5; DS~3 FILL; 04717000
DI~T; DI~DI+14; DS~3 FILL; 04718000
END STREAM; 04719000
GO EXIT; 04720000
END; 04721000
DISKWAIT(-T,30,I:=JAR[P1MIX,AA DIV JAR[P1MIX,8]+10+ 04722000
AA MOD JAR[P1MIX,8]+S DIV 30); 04723000
IF (J~B[S MOD 30])<0 THEN GO TO NULL; 04725000
AA ~ I ~ JAR[P1MIX,J.[CF] DIV JAR[P1MIX,8]+10]+ 04726000
J.[CF] MOD JAR[P1MIX,8]; 04727000
I~0; J~J.[FF]; 04728000
DO BEGIN S~(I+J).[36:11]; 04729000
IF W!(W:=S DIV 30) THEN DISKWAIT(-T,30,AA+W); 04731000
IF (E ~ B[S-W|30].[38:10])=A THEN GO TO FOUND; 04732000
IF E<A THEN I~S ELSE J~S; 04733000
END UNTIL J-I=1; 04734000
S~I; 04735000
FOUND: L ~ -B[S MOD 30].[28:10]; 04736000
IF L=0 THEN GO TO SANDA; 04736500
STREAM(L~ABS(L),T); 04737000
BEGIN DS:=11 LIT ",NEAR LINE "; 04738000
SI~LOC L; DS~8 DEC; 04739000
DS:=LIT " "; DI:=DI-9; DS:=7 FILL; 04740000
END STREAM; 04741000
EXIT: PLACEFINDER ~ T; 04742000
END PLACEFINDER; 04743000
$ SET OMIT = NOT(DATACOM ) 04999999
PROCEDURE LOGOUT(A); VALUE A; REAL A; FORWARD; %154-05606900
PROCEDURE FORMTIME(W,T); VALUE W,T; REAL W,T; %154-05607000
BEGIN INTEGER S,M; %154-05608000
T~(T+60) DIV 60; %154-05609000
S~T MOD 60; %154-05610000
T~T DIV 60; %154-05611000
M~T MOD 60; %154-05612000
T~T DIV 60; %154-05613000
STREAM(T,M,S,W~[W]); %154-05614000
BEGIN SI~LOC T; DS~2 DEC; %154-05615000
2(DS~LIT ":"; DS~2 DEC); %154-05616000
DI~W; DS~7 FILL; %154-05617000
END; %154-05618000
END; %154-05619000
PROCEDURE LOGSPACE(W,L); % THIS MAY ZIP 05700000
VALUE W,L; NAME W; INTEGER L; % FIRST WORD,WORD COUNT 05701000
COMMENT THIS WILL CLOBBER WORDS AROUND THOSE LOGGED; 05701010
BEGIN INTEGER B,I,J,K,N; ARRAY A[*]; LABEL OK; DEFINE Z=LOGFREE#; 05702000
N~L DIV 5; %NO REMAINDER ALLOWED 05702500
A:=[M[B:=SPACE(30)]]&30[8:38:10]; 05703000
IF Z>0 THEN SLEEP([Z],-0); Z~-Z; 05703500
$ SET OMIT = NOT(SHAREDISK) 05703699
DISKWAIT(-B,30,Z); 05704000
IF (I~A[0])+6+N}(J~A[1]) THEN BEGIN I~0; K~1 END %WRAP AROUND 05705000
ELSE IF I+N+100 GEQ J THEN 05706000
BEGIN INDEPENDTRUNNER(P(.LOGOUT),1,128); 05706100
K:=2; 05706200
END 05706300
ELSE IF I<J DIV 2 AND J DIV 2<I+N THEN K~3 % HALF FULL 05707000
ELSE GO TO OK; 05708000
STREAM(K:=K-1, J:=J:=SPACE(3)); 05709000
BEGIN CI:=CI+K; GO TO L2; GO TO L1; 05710000
DS:=14 LIT"#LOG HALF FULL"; GO TO L3; 05710500
L1: DS:=19 LIT" LOG FULL - AUTO LN"; GO TO L3; 05711000
L2: DS:=17 LIT"**LOG WRAP AROUND"; 05711500
L3: DS:=LIT"~"; 05712000
END; 05713000
SPOUT(J); 05714000
OK: A[0]~N+I; A[3]~K; A[2]~I~I+1; %WE NOW PUT THE WORDS IN I 05715000
W[L]~4; % END OF LOG 05715100
J~(I MOD 6)|5; %SIZE OF NEIGHBORHOOD (NBD) 05716000
$ SET OMIT = NOT(SHAREDISK) 05716999
IF (I~I DIV 6)!0 THEN DISKWAIT(B,30,Z); %DUMP RECORD ZERO 05722000
IF J!0 THEN % GET NBD 05723000
BEGIN IF I!0 THEN DISKWAIT(-B,30,Z+I); 05724000
MOVE(30-J,W INX 0,A INX J) 05725000
END 05726000
ELSE B:=W INX 0; 05727000
DISKWAIT(B,30,Z+I); 05728000
IF (L+J) GEQ 30 THEN 05728100
BEGIN K:=L-(J:=30-J)+1; 05728120
I:=I+1; 05728140
DO 05728160
BEGIN DISKWAIT(W INX J,IF K>1020 THEN 1020 ELSE K,Z+I); 05728180
J:=J+1020; 05728200
I:=I+34; 05728220
END UNTIL (K:=K-1020) LEQ 0; 05728240
END; 05728260
$ SET OMIT = NOT(STATISTICS) 05728299
FORGETSPACE(A); 05729000
$ SET OMIT = NOT(SHAREDISK ) 05729199
Z:=-Z; 05729300
END OF LOGSPACE; 05730000
DEFINE 05780000
MAXSIZ[1:20]#, TOMAXSIZ=1:28:20#, 05780010
SPEED = [23:3]#, TOSPEED= 23:45:3#, 05780020
EUNP = [21:1]#, TOENUP = 21:47:1#, 05780025
STARTWRD=[26:12]#, TOSTARTWRD=26:36:12#, 05780030
NUMENT=[38:10]#, TONUMENT=38:38:10#, NUMENTM=1023#, 05780040
DSIZE=[2:20]#, TODSIZE=2:28:20#, 05780100
DENT=[22:26]#, TODEND=22:22:26#, 05780200
TOSIZE=8:38:10#, NEUF=[18:15]#, 05780300
EUIOFFSET=4 #, % ONE WORD FOR EACH I/O CHANNEL. 05780310
AVDIFFMIN=15#, AVDIFFMAX=50#, % AVDIFFMAX GTR AVDIFFMIN GTR 14. 05780400
AVTMAX=3900#, % MAX # WORDS ALLOWED FOR AVAILABLE TABLE ON DISK. 05780500
% IS REFLECTED IN USERDISKBOTTOM & DISKAVAILTABLEMAX05780505
AVSMIN=90# , AVSMAX=300#, % MIN AND MAX # WORDS TO READ IN @ 1 TIM05780600
% AVSMAX GTR AVSMIN GTR 85 05780605
% BOTH MUST BE MULTIPLES OF 30 05780610
FIXARRAY(FIXARRAY1,FIXARRAY2,FIXARRAY3)=FIXARRAY1~[M[FIXARRAY2~ 05780700
SPACE(FIXARRAY3)]]&FIXARRAY3[TOSIZE]# ; 05780800
$ SET OMIT = NOT (SHAREDISK ) 05800000
REAL PROCEDURE PETUSERDISK(N,T); VALUE N,T; REAL N,T ; 05839400
% N IS THE NUMBER OF SEGMENTS REQUESTED, AND T IS THE EU# OR THE SPEED#.05839600
% GETUSERDISK WILL RETURN -1, 0, OR THE ABSOLUTE DISK SEGMENT ADDRESS OF05839700
% THE RESULTANT AREA. SEE T.[2:1] FOR THE -1, AND N.[2:1] FOR THE 0. 05839800
% T>0 => T IS A PREFERRED SPEED#: T=1,2,3,4,..., OR 31. 05840000
% T<0 => -T IS A PREFERRED EU#: T=-1,-2,-3,-4,..., OR -20. 05840100
% T=0 => DONT CARE ABOUT SPEED# OR EU#, USE EU WITH LEAST EU I/O. 05840200
% T.[2:1]=1 => IF CANT GET PREFERRED SPEED# OR EU#, RETURN -1. 05840300
% T.[2:1]=0 => IF CANT GET PREFERRED SPEED# OR EU#, TREAT AS T=0 (ABOVE)05840400
% N>0 => MAKE A SCRATCHDIRECTORY ENTRY. 05840500
% N<0 => DONT MAKE A SCRATCHDIRECTORY ENTRY. 05840600
% N=0 => IMMEDIATELY RETURN WITH A 0. 05840700
% N.[2:1]=0 => IF CANT FIND ANY USERDISK, AND T.[2:1]=0, NO-USER-DISK. 05840800
% N.[2:1]=1 => IF CAND FIND ANY USERDISK, ANT T.[2:1]=0, RETURN 0. 05840900
BEGIN 05841200
INTEGER K=+1, % K IS ALSO "GETUSERDISK"; DONT USE K ABOVE LABEL D. 05841300
Z=K+1, NS=Z+1, I=NS+1, 05841350
$ SET OMIT = NOT(SHAREDISK ) 05841380
$ SET OMIT = SHAREDISK 05841610
R=I+1, AVS=R+1, H=NT6, L=AVS ; 05841615
REAL M1=NT5 M2=NT4,; ARRAY UT=J+1[*]; DEFINE U=AVTABLE # ; 05841620
$ POP OMIT 05841621
LABEL A,B,C,D,E,F,G,W ; 05841650
DEFINE GETUSERDISK=PETUSERDISK#;%***************************************05841700
IF N=0 THEN GO W ; 05842100
P(T.[2:1],ABS(N),1,0,0,0,0) ; 05842200
$ SET OMIT = NOT(SHAREDISK ) 05842205
A: SLEEP([TOGLE],USERDISKMASK); LOCKTOG(USERDISKMASK); 05842300
$ SET OMIT = NOT(SHAREDISK ) 05842390
$ SET OMIT = SHAREDISK 05842405
M1:=M2:=P(D) ; 05842410
$ POP OMIT 05842411
L:=NEUP.NEUF ; 05842450
IF T LSS 0 THEN IF U[J:=IF -T GTR L THEN L+1 ELSE -T].MAXSIZ GEQ NS 05842475
THEN GO E ELSE IF Z THEN GO C ; 05842500
B: IF U[I].MAXSIZ}NS THEN 05842700
BEGIN 05842800
P(EUIO[(NT1:=I-1)+EUIOFFSET]+PEUIO[NT1],.NT2,SND,DUP) ; 05842900
IF P LSS M1 THEN BEGIN M1:=NT2; H:=NT1 END ; 05842930
IF P LSS M2 THEN IF UPI[.SPPED=T THEN BEGIN M2:=NT2;J:=NT1 END;05843000
END; 05843100
IF (I:=I+1) LEQ L THEN GO B ; 05843200
IF P(D)!M1 THEN 05843300
BEGIN 05843400
IF M2=M2:=P(D) THEN IF Z AND T!0 THEN 05843500
C: BEGIN GETUSERDISK~-1; GO G END 05843600
ELSE J~H ; 05843700
J:=J+1; GO E ; 05843800
END; 05843900
IF Z THEN GO C ; 05843950
IF N.[2:1] THEN GO G ; 05844000
$ SET OMIT = NOT(SHAREDISK ) 05844050
$ SET OMIT = SHAREDISK 05844090
FIXARRAY(UT,R,30); USERDISKSPECIALCASE(I:=1,R,UT,NS); GO A ; 05844110
$ POP OMIT 05844111
D:::@0777777777777777 ; 05844200
$ SET OMIT = NOT(SHAREDISK ) 05844290
$ SET OMIT = SHAREDISK 05844915
E: IF (AVS:=(K:=(T:=U[J] AND NUMENTM)+I:=(Z:=U[J].STARTWRD) MOD 30) MOD05844920
30) NEQ 0 THEN AVS:=30-AVS; AVS:=AVS+K; P(M2) ; 05844925
FIXARRAY(UT,R,AVS); DISKWAIT(-R,AVS,Z~Z DIV 30+USERDISKBOTTOM) ; 05844930
M2:=P; P(K-1); NT2:=0; NT3:=K:=U[J].MAXSIZ ; 05844935
$ POP OMIT 05844936
E: IF (NT1~UT[I].DSIZE)>NT2 THEN IF NT1!K THEN NT2~NT1 ELSE K:=0; 05845000
IF NT1}NS THEN IF NT1<M2 THEN BEGIN M2~NT1; H~I END ; 05845100
IF P(DUP) GTR I:=I+1 THEN GO F ; 05845200
UT[H].DSIZE~NS~M2-NS ; 05845300
IF M1:=M2=NT3 THEN U[J].MAXSIZ:=IF NT2>NS THEN NT2 ELSE NS ; 05845400
GETUSERDISK~UT[H].DEND-M2; I:=P ; 05845500
$ SET OMIT = NOT(SHAREDISK ) 05845590
IF N~NS=0 THEN BEGIN MOVE(I-H,[UT[H+1]],[UT[H]]);U[J].NUMENT~T-1END;05845700
$ SET OMIT = NOT(SHAREDISK ) 05845790
$ SET OMIT = SHAREDISK 05846350
DISKWAIT(R,AVS,Z); 05846360
$ POP OMIT 05846361
$ SET OMIT = NOT(SHAREDISK ) 05846370
$ SET OMIT = SHAREDISK 05846385
FORGETSPACE(R) ; 05846390
G: UNLOCKTOG(USERDISKMASK); 05846395
$ POP OMIT 05846396
W: END OF GETUSERDISK ; 05846500
PROCEDURE FORGETUSERDISK(A,N); VALUE A,N; REAL A,N ; 05846600
% A IS THE ABSOLUTE DISK SEGMENT ADDRESS OF AN AREA N SEGMENTS LONG 05846800
% WHICH IS TO BE MADE AVAILABLE AGAIN. 05846900
% N<0 => MAKE A SCRATCHDIRECTORY DELETION. 05847000
% N>0 => DONT MAKE A SCRATCHDIRECTORY DELETION. 05847100
% N=0 => IMMEDIATELY GO AWAY ; 05847200
BEGIN 05847400
$ SET OMIT = NOT(SHAREDISK ) 05847490
$ SET OMIT = SHAREDISK 05847590
INTEGER AVS,F=AVS; ARRAY UT[*]; DEFINE U=AVTABLE #; 05847600
$ POP OMIT 05847601
REAL E; INTEGER B,C,D,I,J,R,S,H=NT7,K=NT6,L=NT5,G=NT4,T=NT3,Q=JUNK;05847700
LABEL V,W,X,Y,Z,AZ,BZ,CZ,DZ ; 05847800
SUBROUTINE SETSHIFT ; 05847900
BEGIN 05848000
S:=P(XCH) ; 05848100
$ SET OMIT = NOT(SHAREDISK ) 05848190
$ SET OMIT = SHAREDISK 05848250
U[J].STARTWRD:=I+S; G:=D+S; 05848255
$ POP OMIT 05848256
K:=G+C-1; 05848300
END OF SETSHIFT; 05848500
IF N=0 OR (J:=A DIV 1000000) GEQ NEUP.NEUF 05848900
OR A LSS USERDISKBOTTOM+DISKAVAILTABLEMAX THEN GO BZ ; 05849000
SLEEP([TOGLE],USERDISKMASK); LOCKTOG(USERDISKMASK); 05849300
$ SET OMIT = NOT(SHAREDISK ) 05849390
IF (D:=U[0].MAXSIZ) NEQ 0 AND N GTR 0 THEN IF (TWO(J) AND D) NEQ 0 05849420
THEN BEGIN USERDISKSPECIALCASE(3,N,U,A); IF NOT P THEN GO DZ END ; 05849460
J:=J+1 ; 05849480
V: D~(I~(E~U[J]).STARTWRD) MOD 30 ; 05849500
$ SET OMIT = NOT(SHAREDISK ) 05849590
$ SET OMIT = SHAREDISK 05850105
AVS:=30-(S:=(C:=E AND NUMENTM)+D) MOD 30+S ; 05850110
FIXARRAY(UT,R,AVS); DISKWAIT(-R,AVS,B:=I DIV 30+USERDISKBOTTOM) ; 05850120
K:=S; L:=D; S:=I+C ; 05850130
$ POP OMIT 05850131
G~I-(NT2:=(P(U[J-1],DUP) AND NUMENTM)+P(XCH).STARTWRD) ; 05850200
S~U[J+1].STARTWRD-S; H~K~K-1; IF UT[T~L].DEND}A THEN GO X ; 05850300
W: IF UT[T~(H+L+1)DIV 2].DEND}A THEN IF UT[H~T-1].DEND}A THEN GO W ELSE05850400
ELSE IF UT[T~T+1].DEND<A THEN BEGIN L~T+1; GO W END ; 05850500
X: IF (L:=A+ABS(N)) GEQ H:=P(UT[Q:=T],DUP).DEND-P(XCH).DSIZE THEN GO Z;05850600
IF S=0 THEN 05850700
BEGIN 05850800
$ SET OMIT = NOT(SHAREDISK ) 05850890
$ SET OMIT = SHAREDISK 05851215
IF G=0 OR D=0 THEN GO Y; IF P((G+1)DIV 2,DUP)>0 THEN P(DEL,D);05851220
$ POP OMIT 05851221
P(SSN);SETSHIFT;MOVE(C,[UT[G-S]],[UT[G]]);T~Q~T+S; 05851300
END; 05851400
FOR H~K STEP -1 UNTIL T DO UT[H+1]~UT[H]; H~ABS(N); GO AZ ; 05851500
Y: USERDISKSPECIALCASE(2,E,UT,J) ; 05851600
$ SET OMIT = NOT(SHAREDISK ) 05851650
GO V ; 05851675
Z: IF P(UT[Q~Q+1],DUP).DEND=P(XCH).DSIZE{L THEN GO Z ; 05851700
IF P(UT[NT1:=Q-1].DEND,DUP) LSS L THEN P(DEL,L) ; 05851800
H:=(L:=P)-(IF A LSS H THEN A ELSE H) ; 05851850
IF NT1 GTR T THEN MOVE(K-NT1,[UT[Q]],[UT[T+1]]) ; 05851900
AZ: UT[T]~L&H[TODSIZE]; C~(Q~T-Q+1)+C ; 05852000
IF(S~S-Q)>T~IF AVDIFFMAX>T~C DIV 2 THEN AVDIFFMAX ELSE T THEN IF J=105852100
OR S+G>T+(IF AVDIFFMAX>T~NT2 DIV 2 THEN AVDIFFMAX ELSE T) THEN GO Y 05852200
ELSE BEGIN 05852300
IF (NT1~F-1-K)=0 THEN GO Y; 05852350
IF P((S+G) DIV 2,DUP) GTR NT1 THEN P(DEL,NT1);SETSHIFT; 05852400
FOR NT1~K STEP -1 UNTIL G DO UT[NT1]~UT[NT1-S] ; 05852500
END ; 05852600
U[J]~(NT1~U[J])&C[TONUMENT]&(IF E~(NT1~NT1.MAXSIZ)<H THEN H ELSE 05852700
NT1)[TOMAXSIZ] ; 05852800
$ SET OMIT = NOT(SHAREDISK ) 05852890
$ SET OMIT = SHAREDISK 05853420
DISKWAIT(R,AVS,B) ; 05853425
$ POP OMIT 05853426
$ SET OMIT = NOT(SHAREDISK ) 05853490
$ SET OMIT = SHAREDISK 05853593
FORGETSPACE(R) ; 05853595
DZ: UNLOCKTOG(USERDISKMASK); 05853600
$ POP OMIT 05853601
BZ: END OF FORGETUSERDISK ; 05853700
PROCEDURE DKBUSINESS(BUFF); VALUE BUFF; REAL BUFF; 05950000
BEGIN 05950200
REAL RCW=+0, 05950400
MSCW=-2, 05950500
MID=RWC+1, 05950600
FID=MID+1, 05950800
TMID=FID+1, 05950900
IFID=TMID+1, 05950950
A=TFID+1, 05951000
B=A+1; 05951200
INTEGER N=B+1; 05951400
ARRAY HD=N+1[*]; 05951600
BOOLEAN RDT=HD+1; 05951700
INTEGER C=RDT+1,D=C+1,I=D+1,J=I+1,R=J+1,S=R+1, 05951800
LA=S+1,SA1=NT2, 05951900
H=NT7,K=NT6,L=NT5,G=NT4,T=NT3,Q=JUNK; 05952000
REAL E=LA+1; 05952200
REAL KTR=B; 05952210
REAL TYPE=C; 05952220
REAL WORD=D; 05952230
REAL HA=J; 05952240
REAL HEADER=R; 05952250
ARRAY HDR=E[*]; 05952260
BOOLEAN FILTOG=E+1; 05952270
REAL SEGS=FILTOG+1; 05952300
$ SET OMIT = SHAREDISK 05952399
ARRAY UT=HD[*]; INTEGER AVS=SEGS+1; DEFINE U=AVTABLE#; 05952400
INTEGER SLEEPER=AVS+1; 05952500
$ POP OMIT 05952501
$ SET OMIT = NOT(SHAREDISK) 05952505
LABEL V,W,X,Y,Z,AZ,BZ,CZ,INUSE,EXIT; 05952600
LABEL FILEID,XDFILE,CONFLICT,FOUND,MSG,FINIS; 05952620
$ SET OMIT = NOT(SHAREDISK) 05952690
REAL SUBROUTINE DECWORD; 05952705
BEGIN 05952710
STREAM(T~0:W~[WORD]); 05952715
BEGIN 05952720
SI~W; DI~LOC T; DS~8DEC; 05952725
END STREAM; 05952730
DECWORD~P; 05952735
END DECWORD; 05952740
SUBROUTINE SCAN; 05952745
BEGIN 05952750
STREAM(KTR,TYPE~0:T~0,W~[WORD]); 05952755
BEGIN 05952760
SI~KTR; 05952765
L0: IF SC=" " THEN BEGIN SI~SI+1; GO L0; END; 05952770
IF SC=""" THEN % STRING IDENTIFIER 05952775
BEGIN 05952780
SI~SI+1; DS~LIT"0"; 05952785
IF SC=""" THEN 05952790
BEGIN 05952795
SI~SI+1; 05952800
IF SC=""" THEN DS~CHR ELSE DS~LIT" "; 05952805
DS~6LIT" "; 05952810
END ELSE 05952815
BEGIN 05952820
7(IF SC!""" THEN DS~CHR ELSE DS~LIT" "); 05952825
L1: IF SC~""" THEN BEGIN SI~SI+1; GO L1; END; 05952830
S1~SI+1; 05952835
END; 05952840
GO T1; 05952845
END; 05952850
IF SC=ALPHA THEN IF SC LSS "0" THEN 05952855
BEGIN % IDENTIFIER 05952860
ID: DS~LIT"0"; 05952865
7(IF SC=ALPHA THEN DS~CHR ELSE DS~LIT" "); 05952870
L2: IF SC=ALPHA THEN BEGIN SI~SI+1; GO L2; END; 05952875
T1: TALLY~1; 05952880
GO EXT; 05952885
END; 05952890
IF SC=ALPHA THEN IF SC LEQ "9" THEN 05952895
BEGIN % NUMBER 05952900
SI~SI+1; TALLY~1; 05952905
7(IF SC=ALPHA THEN IF SC LSS "0" THEN 05952910
BEGIN T~TALLY; SI~SI-T; JUMP OUT TO ID; END 05952915
ELSE IF SC LEQ "9" THEN 05952920
BEGIN SI~SI+1; TALLY~TALLY+1; END); 05952925
T~TALLY; SI~SI-T; DS~T OCT; 05952930
TALLY~2; 05952935
GO EXT; 05952940
END; 05952945
IF SC!"~" THEN TALLY~3 ELSE TALLY~5; 05952950
DS~7 LIT"0"; DS~CHR; 05952955
EXT: TYPE~TALLY; 05952960
KTR~SI; 05952965
END STREAM; 05952970
P(.TYPE,STD,.KTR,STD); 05952975
END SCAN; 05952980
SUBROUTINE MLOGIT; 05952985
BEGIN 05952990
S~TYPEDSPACE(15,MAINTBUFFAREAV);% %167-05952995
STREAM(B:DATE,D~S+1); 05953000
BEGIN 05953005
SI~LOC DATE; DS~8 OCT; DI~DI+8; 05953010
SI~B; 05953015
2(63(IF SC!"~" THEN DS~CHR ELSE JUMP OUT 2 TO LL)); 05953020
LL: DS~LIT"~"; DI~DI-1; B~DI; 05953025
END STREAM; 05953030
LA~ P INX 0; 05953035
M[S]~ (LA-S) DIV 5; 05953040
M[S+2]~IF FILTOG THEN -N ELSE SEGS; 05953045
LINKUP(18,S); 05953050
END MLOGIT; 05953055
SUBROUTINE ENTERFILE; 05953060
BEGIN 05953065
FIXARRAY(HD,B,30); 05953070
MOVE(30,HD-1,HD); 05953075
HD[0]~@3600036000101; 05953080
STREAM(DATE,XCLOCK,H~HD INX 3); 05953085
BEGIN 05953090
SI~LOC DATE; DS~8OCT; 05953095
DI~DI-20; SI~SI+4; DS~4CHR; 05953100
DI~DI-7; SI~H; SI~SI+5; DS~3CHR; 05953105
DI~H; DS~2LIT"+#"; SI~SI-3; DS~3CHR; 05953110
END STREAM; 05953115
HD[4].[42:1]:=1; % MAKE FILE NON-MOVEABLE 05953117
HD[7]~(HD[8]~N)-(HD[9]~1); 05953120
HD[10]~A; 05953125
ENTERUSERFILE(MID,FID.[6:42],B-1); 05953130
STREAM(MID,FID,N,TMID,TFID,FILTON, 05953135
B~IF FILTOG THEN B ELSE BUFF); 05953140
BEGIN 05953145
SI~LOC N; DI~LOC N; DS~8DEC; 05953150
DI~LOC N; DS~7FILL; DI~B; 05953155
DS~LIT" "; SI~LOC MID; SI~SI+1; DS~7CHR; 05953160
DS~LIT"/"; SI~SI+1; DS~7CHR; 05953165
DS~6LIT" SEGS="; DS~8CHR; DS~8LIT" CREATED"; 05953170
FILTOG(DS~6LIT" FROM "; DI~SI+1; DS~7CHR; 05953175
DS~LIT"/"; SI~SI+1; DS~7CHR); 05953180
DS~LIT"~"; 05953185
END STREAM; 05953190
IF FILTOG THEN 05953195
BEGIN 05953200
MLOGIT; 05953205
SPOUT(B); 05953210
END ELSE 05953215
FORGETSPACE(B); 05953220
END ENTERFILE; 05953225
P(0,0,0,0,0,BUFF,DUP); BUFF~P.[15:15]-1; P(0,0,B LSS 0); 05953250
P(0,0,0,0,0,0,0,0,0,0,0); 05953260
$ SET OMIT = NOT(SHAREDISK); 05953269
IF B.[CF]=0 THEN% MAKE RESERVE/DISK 05953400
BEGIN MID:="RESERVE"; FID:="DISK "; 05953600
IF (A:=DIRECTORYSEARCH(-MID,FID,5))!0 THEN 05953800
BEGIN STREAM(BUFF); 05954000
DS:=30LIT" RESERVE/DISK ALREADY PRESENT~"; 05954200
GO TO EXIT; 05954400
END; 05954600
IF (A~GETUSERDISK((N~RESERVEDISKSIZE)&1[2:47:1]))=0 THEN 05954800
BEGIN STREAM(BUFF); 05955000
DS:=32LIT"**NO USER DISK FOR RESERVE/DISK~"; 05955200
GO TO EXIT; 05955400
END; 05955600
GO TO CZ; 05955800
END; 05956000
IF RDT THEN 05956250
BEGIN P(B); A:=M[BUFF INX 0]; N:=M[BUFF INX 1]; END ELSE 05956300
BEGIN 05956350
SCAN; 05956400
IF TYPE=1 THEN % IDENTIFIER 05956450
BEGIN 05956500
TMID~WORD; 05956550
SCAN; IF WORD!"/" THEN GO EXIT; 05956600
FILEID: 05956650
SCAN; IF NOT TYPE=1 OR TYPE=2) THEN GO EXIT; 05956700
IF ID~IF TYPE=2 THEN DECWORD ELSE WORD; 05956750
FILTOG~TRUE; 05956800
SCAN; 05956850
END; 05956900
IF TYPE=2 THEN % NUMBER 05956950
BEGIN 05957000
A~WORD; 05957050
SCAN; 05957100
IF TYPE=3 THEN IF WORD="/" THEN 05957150
BEGIN 05957200
WORD~A; 05957250
A~0; 05957300
TMID~DECWORD; 05957350
GO FILEID; 05957400
END ELSE SCAN; 05957450
IF TYPE=2 THEN N~WORD; 05957500
END; 05957550
END; 05957600
SEGS~N~N+(N=0); 05957650
IF (A!0) THEN 05957700
BEGIN 05957750
STREAM(A,D:=[FID]); 05958600
BEGIN SI:=LOC A; DS:=8 DEC; END; 05958800
IF (J:=A DIV 1000000) GEQ NEUP.NEUF OR A LSS DIRECTORYTOP+4 THEN 05959000
V: BEGIN STREAM(FID,BUFF); 05959200
BEGIN DS:=22LIT" INVALID DISK ADDRESS "; 05959400
SI:=LOC FID; DS:=8CHR; DS:=LIT"~"; 05959600
DI:=DI=9; DS:=7 FILL; 05959800
END; 05960000
GO TO EXIT; 05960200
END; 05960400
IF WAITIO([FID]INX@100000000,@64,18+FID.[5:1]).[42:1] THEN GO TO V; 05960600
IF (R:=FID.[12:6]) GEQ 2 THEN % CHECK FOR 40 MIL ADDRESS 05960650
IF NOT WAITIO([FID]INX @140000000,@64,18+FID.[5:1]).[43:1] 05960660
THEN GO TO V ELSE IF R GEQ 4 THEN GO TO V;% INV ADD 05960670
END; 05960675
IF FILTOG THEN GO XDFILE; 05960680
IF A=0 THEN GO EXIT; 05960685
SLEEP([TOGLE],USERDISKMASK); LOCKTOG(USERDISKMASK); 05960700
$ SET OMIT = NOT(SHAREDISK) 05960705
J~J+1; 05960800
BZ: D:=(I:=(E:=U[J]).STARTWRD) MOD 30; 05961000
$ SET OMIT = NOT(SHAREDISK) 05961005
$ SET OMIT = SHAREDISK 05961199
AVS:=30-(S:=(C:=E AND NUMENTM)+D)MOD 30+S; 05961200
FIXARRAY(UT,R,AVS); DISKWAIT(-R,AVS,B:=I DIV 30+USERDISKBOTTOM); 05961400
K:=S; I:=D; S:=I+C; 05961600
$ POP OMIT 05961601
G:=I-(NT2:=(P(U[J-1],DUP) AND NUMENTM)+P(XCH).STARTWRD); 05961800
S:=U[J+1].STARTWRD-S; H:=K:=K-1; IF UT[T:=L].DEND GTR A THEN GO X; 05962000
W: IF UT[T+(H+L+1) DIV 2].DEND > A THEN IF UT[H~T-1].DEND > A THEN GO W05962200
ELSE ELSE IF UT[T~T+1].DEND { A THEN BEGIN L~T+1; GO W END; 05962400
X: IF A GEQ L:=(H:=UT[T].DEND)-(Q:=UT[T].DSIZE) THEN 05962600
IF (LA:=(A+N)) LEQ H THEN GO AZ%AREA AVAILABLE 05962700
ELSE IF LA LEQ SA1:=(UT[T+1].DEND-UT[T+1].DSIZE) THEN 05962800
N:=LA-A:=H ELSE N:=SA1-A:=H ELSE IF (LA:=A+N) GTR L THEN 05962900
N:=L-A ELSE RDT:=RDT OR @100000; 05963000
GO INUSE; 05963100
Y: TMID:=IF RDT THEN "DKTEST " ELSE "BADISK "; 05963800
$ SET OMIT = NOT(DKBNODFX AND NOT DFX) 05963809
STREAM(TMID,FID,N,MID,B,BUFF); 05964000
BEGIN DS:=LIT "."; SI:=LOC TMID; SI:=SI+1; DS:=7 CHR; 05964200
DS:=LIT "/"; SI:=SI-1; DS:=7 CHR; 05964400
DS:=13 LIT " NOT CREATED("; SI:=SI+8; SKIP SB; 05964500
IF SB THEN ELSE 05964600
BEGIN SI:=LOC N; DS:=7 DEC; N:=DI; DI:=DI-7; DS:=7 FILL; 05964800
DI:=N; DS:=5 LIT " SEGS"; SI:=SI+1; 05964900
END; DS:=11 LIT " IN USE BY "; DS:=7 CHR; DS:=LIT"/"; 05965000
SI:=SI+1; DS:=7 CHR; 05965200
DS:=2 LIT")~"; 05965400
END; 05965600
FORGETSPACE(R); 05966100
GO EXIT; 05966110
INUSE: % SEARCH THE DIRECTORY TO FIND THE NAME OF THE CONFLICTING05966200
% FILE. SINCE USERDISK REMAINS LOCKED, DISK ALLOCATION 05966210
% CANNOT CHANGE. HENCE, THE DIRECTORY NEED NOT BE LOCKED.05966220
FORGETSPACE(R); 05966400
FIXARRAY(UT,R,480); 05966600
FOR J:=DIRECTORYTOP+4 STEP 16 WHILE TRUE DO 05967000
BEGIN DISKWAIT(-R,480,J); 05967200
FOR I:=14 STEP -1 UNTIL 0 DO 05967400
BEGIN E:=UT[450+2|I]; 05967600
IF(E EQV @114)=NOT 0 THEN 05967800
BEGIN MID:="SYSTEM "; B:=FID; GO Z; END; 05967900
IF (E EQV @14) NEQ NOT 0 THEN 05968000
BEGIN B:=UT[30|I+9] AND 31; 05968200
FOR K:=1 SETP 1 UNTIL B DO 05968400
IF (C:=UT[30|I+9+K))NEQ 0 THEN 05968600
IF A GEQ C THEN IF A LSS 05968800
SA1:=(C+D:=UT[30|I+8]) THEN 05968900
BEGIN MID:=E&((LA LEQ SA1) AND 05969000
(RDT.[18:15]))[1:47:1]; 05969100
IF A+N GTR SA1 THEN N~SA1-A; 05969150
B:=UT[451+2|I]; 05969200
GO TO Z; 05969400
END; 05969600
END; 05969800
END; 05970000
END; 05970200
Z: 05970300
$ SET OMIT = NOT SHAREDISK 05970390
UNLOCKTOG(USERDISKMASK); 05970500
GO TO Y; 05970600
AZ: IF A NEQ L AND LA NEQ H THEN 05970800
BEGIN IF S=0 THEN 05971000
$ SET OMIT = NOT (SHAREDISK) 05971005
$ SET OMIT = SHAREDISK 05971095
BEGIN IF G=0 OR D=0 THEN 05971200
BEGIN USERDISKSPECIALCASE(2,E,UT,J); GO TO BZ END; 05971400
S:=IF P((G+1) DIV 2,DUP) > D THEN P(DEL,D) ELSE P; 05971600
U[J].STARTWRD:=I-S; G:=D-S; K:=G+C-1; 05971800
$ POP OMIT 05971801
MOVE(C,[UT[D]],[UT[G]]); T:=T-S; 05972000
END; 05972200
FOR G:=K STEP -1 UNTIL T DO UT[G+1]:=UT[G]; 05972400
UT[T]:=A&(A-L)[TODSIZE]; 05972600
UT[T+1]:=H&(H-LA)[TODSIZE]; 05972800
C:=C+1; 05973000
K ~ K+1; 05973100
END ELSE 05973200
IF A=L AND LA=H THEN 05973400
BEGIN C:=C-1; MOVE(K-T,[UT[T+1]],[UT[T]]); K:=K-1 END 05973600
ELSE UT[T]:=(IF A=L THEN H ELSE A)&(Q-N)[TODSIZE]; 05973800
U[J].NUMENT:=C; 05974000
IF Q=U[J].MAXSIZ THEN 05974200
BEGIN Q:=UT[H:=K-C+1].DSIZE; 05974400
FOR H:=H STEP 1 UNTIL K DO 05974600
IF P(UT[H].DSIZE,DUP) GTR Q THEN Q:=P ELSE P(DEL); 05974800
U[J].MAXSIZ:=Q; 05975000
END; 05975200
MID:=IF RDT THEN "DKTEST " ELSE "BADISK "; 05975400
$ SET OMIT = NOT(DKBNODFX AND NOT DFX) 05975404
$ SET OMIT = NOT(SHAREDISK) 05975410
$ SET OMIT = SHAREDISK 05975595
DISKWAIT(R,AVS,B); 05975600
$ POP OMIT 05975601
UNLOCKTOG(USERDISKMASK); 05975610
FORGETSPACE(R); 05975620
CZ: ENTERFILE; 05975630
GO EXIT; 05975640
XDFILE: 05975700
IF (HEADER:=DIRECTORYSEARCH(TMID,NFLAG(-TFID OR M),4)) LSS 64 THEN 05975750
BEGIN 05975800
TYPE:=HEADER; 05975850
GO MSG; 05975900
END; 05975950
HA~HEADER.[FF]; 05976000
HDR~[M[HEADER~HEADER INX 0]) & 30[8:38:10]; 05976050
MID~-"BADISK "; 05976100
S~HDR[8]; % SEGMENTS PER ROW 05976150
IF A!0 THEN 05976200
BEGIN 05976250
FOR I!HDR[9] STEP -1 UNTIL 1 DO 05976300
IF (LA~HDR[I+9])!0 THEN 05976350
IF A GEQ LA AND A LSS LA+S THEN % FOUND ROW 05976400
IF A+N LEQ LA+S THEN GO FOUND ELSE GO CONFLICT; 05976450
TYPE~4; 05976500
IF FALSE THEN 05976550
BEGIN 05976600
CONFLICT: TYPE~3; 05976650
SEGS~A+N-LA-S; 05976700
END; 05976750
HEADERUNLOCK(TMID,TFID,HEADER&HA[CTF]); 05976800
GO MSG; 05976850
FOUND: 05976900
HDR[I+9]~0; 05976950
DISKWAIT(HEADER,30,HA); 05977000
IF (I~A-LA) GTR 0 THEN FORGETUSERDISK(LA,I); 05977050
IF (I~LA+S-(LA~A+N)) GTR 0 THEN FORGETUSERDISK(LA,I); 05977100
$ SET OMIT = NOT(DKBNODFX AND NOT DFX) 05977124
ENTERFILE; 05977150
GO FINIS; 05977200
END; 05977250
N~S; SEGS~0; 05977300
FOR I~HDR[9] STEP -1 UNTIL 1 DO 05977350
IF (A~HDR[I+9])!0 THEN 05977400
BEGIN 05977450
HDR[I+9]~0; 05977500
DISKWAIT(HEADER,30,HA); 05977550
WORD~A; FID~DECWORD; 05977600
$ SET OMIT = NOT(DKBNODFX AND NOT DFX) 05977624
ENTERFILE; 05977650
SEGS~SEGS+N; 05977700
END; 05977750
FINIS: 05977800
FORGETSPACE(HEADER); 05977850
P(DIRECTORYSEARCH(-TMID,TFID,6),DEL); 05977900
TYPE~5; 05977950
MSG: 05978000
STREAM(TMID,TFID,SEGS,A,TYPE,BUFF); 05978050
BEGIN 05978100
SI~LOC SEGS; DI~LOC SEGS; DS~8DEC; DS~8DEC; 05978150
DI~LOC SEGS; DS~8FILL; DI~LOC A; DS~8 FILL; DI~BUFF; 05978200
DS~LIT","; SI~LOC TMID; SI~SI+1; DS~7CHR; 05978250
DS~LIT"/"; SI~SI+1; DS~7CHR; 05978300
DS~11 LIT" NOT XD-ED("; 05978350
CI~CI+TYPE; 05978400
GO T0; GO T1; GO T2; GO T3; GO T4; GO T5; 05978450
T0: DS~11 LIT"NOT ON DISK"; GO EXT; 05978500
T3: DS~8 CHR; DS~6 LIT" SEGS "; 05978550
T1: DS~6 LIT"IN USE"; GO EXT; 05978600
T2: DS~11 LIT"SYSTEM FILE"; GO EXT; 05978650
T4: SI~SI+8; DS~8 CHR; 05978700
DS~12 LIT" NOT IN FILE"; GO EXT; 05978750
T5: DI~DI-11; 05978800
DS~6 LIT" SEGS="; DS~8 CHR; DS~7 LIT" XD-ED~"; 05978850
TYPE~DI; DI~BUFF; DS~LIT" "; DI~TYPE; GO EXT; 05978900
EXT: DS~2 LIT")~"; 05978950
END STREAM; 05979000
A~1; N~SEGS; % FOR LOGGING 05979050
GO EXIT; 05979100
EXIT: 05979310
IF A!0 THEN 05979320
BEGIN 05979330
B~BUFF; 05979340
MLOGIT; 05979350
END; 05979360
IF RDT THEN M[SLEEPER INX 0] :=1 ELSE SPOUT(BUFF); 05979400
BUFF:=0; IF MSCW NEQ 1 THEN KILL([MSCW]); % CALLED AS IND. RUNNER 05979500
END; 05979600
SAVE PROCEDURE DISKIO(LOCIOD,CORE,SIZE,DISK);% 06000000
VALUE CORE,SIZE,DISK;% 06001000
REAL LOCIOD;% 06002000
INTEGER CORE,SIZE,DISK;% 06003000
BEGIN REAL IOD, OLAYIO, FIN; 06004000
OLAYIO := SIZE.[3:1]; SIZE.[3:1] := 0; 06004010
CORE:=CORE; SIZE:=SIZE; DISK:=DISK; % INTEGERIZE %645-06004100
IF DISK.[1:1] THEN 06005000
BEGIN % AUXILIARY MEMORY 06006000
$ SET OMIT = NOT(AUXMEM) 06006999
$ SET OMIT = AUXMEM 06009200
PUNT(NVLDAUXIO); 06009300
$ POP OMIT 06009400
END 06009500
ELSE BEGIN IOD := ABS(CORE) & SIZE[8:38:10] 06010000
& ((SIZE INX 29) DIV 30 +@1000)[CTF] 06011000
& CORE[24:1:1] & 3[5:46:2]; 06012000
$ SET OMIT = NOT(SHAREDISK) 06012499
STREAM(DISK,D:=CORE.[CF]); 06013000
BEGIN SI ~ LOC DISK; DS ~ 8 DEC END;% 06014000
SIZE ~ 2;% 06015000
END;% 06016000
FIN:=IF OLAYIO THEN IOD&DISK[CTC]&DISK[8:21:12] ELSE IOD; 06016100
% ACTUAL DISK ADDRESS IN FINALQUE FOR OLAY I/O-S 06016200
IOREQUEST(NABS(FIN)&@377[25:40:8],IOD,[LOCIOD]&% 06017000
(SIZE+16)[12:42:6]&OLAYIO[9:47:1]); 06018000
LOCIOD ~ 0;% 06019000
END DISKIO;% 06020000
PROCEDURE FORGETESPDISK(SEGMENT); VALUE SEGMENT; REAL SEGMENT; FORWARD; 06020500
REAL PROCEDURE GETESPDISK;% 06021000
BEGIN REAL T=NT1; 06022000
IF ESPCOUNT=0 THEN 06022100
BEGIN 06022200
STREAM(D:=T:=SPACE(2)); 06022300
DS~12 LIT " NO ESPDISK~"; 06022400
SPOUT(T); 06022500
SLEEP([ESPCOUNT],NOT 0); 06022600
END; 06022700
STREAM(T~0,A~ESPTAB:X~0); 06023000
BEGIN SI~A; 06024000
L1: IF SC=""" THEN BEGIN SI~SI+1; GO TO L1 END; 06025000
A~SI; DI~A; 06026000
L2: IF SB THEN 06027000
BEGIN TALLY~TALLY+1; SKIP SB; SKIP DB; GO TO L2 END; 06028000
T~TALLY; DS~SET; 06029000
END; 06030000
GETESPDISK~((P(DUP).[CF]-ESPTAB)|8 06031000
+P(XCH).[30:3])|6+P+ESPDISKBOTTOM; 06032000
ESPCOUNT~ESPCOUNT-1; 06033000
END; 06033100
PROCEDURE FORGETESPDISK(SEGMENT); VALUE SEGMENT; REAL SEGMENT;% 06036000
BEGIN REAL S,T; 06037000
IF SEGMENT LSS ESPDISKBOTTOM OR 06037100
SEGMENT GTR ESPDISKTOP THEN 06037200
BYBY("ESPDISK ERROR~",14); 06037300
T:=(S:=(T:=SEGMENT-ESPDISKBOTTOM) DIV 6)|6-T; 06037700
S~S.[30:15]&S[30:45:3]|ESPTAB; 06038000
STREAM(T,S); BEGIN SKIP T DB; DS~RESET END; 06038100
ESPCOUNT~ESPCOUNT+1; 06038200
END;% 06039000
$ SET OMIT = NOT(DEBUGGING) 06045999
REAL SCHEDULEIDS; % A BIT IN POSITION X MEANS THAT THERE IS A JOB IN THE06056099
% SCHEDULE(SHEET) WITH SCHEDULE-ID X. USED BY COM5, 06056100
% SELECTRUN AND CCFINISH. 06056200
$ SET OMIT = NOT(SHAREDISK) 06057000
SAVE PROCEDURE DISKWAIT(CORE,SIZE,DISK); 06061500
VALUE CORE,SIZE,DISK; 06062000
REAL CORE,SIZE,DISK; 06063000
BEGIN REAL T; 06064000
DISKIO(T,(ABS(CORE)-1)&CORE[1:1:1],SIZE,DISK); 06065000
SLEEP([T],IOMASK); 06066000
END; 06067000
PROCEDURE DISKSQUASH(BUFF); 06068000
VALUE BUFF; REAL BUFF; 06068100
BEGIN 06068200
REAL RCW=+0, B=+1, E=B+1, F=E+1, R=F+1, HI=R+1, LO=HI+1, 06068300
MSCW=-2, 06068350
CNT=LO+1, USE=CNT+1, TOG=USE+1, IOD=TOG+1; 06068400
REAL T=IOD+1, SUM=T; 06068500
REAL A1= T+1, A2=A1+1, A3=A2+1, A4=A3+1, A5=A4+1; % ARRAY VARIABLES 06068600
REAL X1=A5+1, X2=X1+1, X3=X2+1, X4=X3+1, X5=X4+1; % SCRATCH VARIABLES 06068700
REAL LOCIOD=X4, HICNT=X4, LSTCNT=X5; 06068800
BOOLEAN CONFLICT=X5+1, PASTWO=CONFLICT+1, EUNOTSQUASHED=PASSTWO+1, 06068900
FILEOK=EUNOTSQUASHED+1, SQALL=FILEOK+1; 06069000
INTEGER C=SQALL+1, D=C+1, I=D+1, S=I+1, EU=S+1, AV=EU+1, 06069100
AVSIZE=AV+1, DISKAV=AVSIZE+1, SQSIZE=DISKAV+1; 06069200
ARRAY UT=SQSIZE+1[*], MV=UT+1[*], DIR=MV+1[*], EUS=DIR+1[*]; 06069300
REAL PRTADDR=EUS+1, PRTVALUE=PRTADDR+1; 06069400
$ SET OMIT = NOT SHAREDISK 06069500
LABEL SCAN, SPOUTER,CK,OKINUSE,NOTOK,OKBOUNDS,MVEMORE,MVE, 06069900
ENDMVE,AGAIN,OK,NEXT,SQIT,STOPSQ,STOPIT,SDXIT,OUT,FIXMV; 06070000
DEFINE 06070100
$ SET OMIT = SHAREDISK 06070200
U = AVTABLE#, 06070300
$ POP OMIT 06070400
LINK = [12:10]#, 06070500
ASIZE = [3:19]#, 06070600
LOCKED = [2:1]#, 06070700
FACTOR = 10000#, 06070800
MINSIZE = 10#, 06070900
MAXMVSIZE = 900#, 06071000
KEYINMASK = [18:15]#; 06071100
COMMENT 06071200
FACTOR: THE MAXIMUM SEPARATION, IN SEGMENTS, ALLOWED 06071300
BETWEEN TWO AVAILABLE AREAS WHICH ARE TO BE 06071400
SQUASHED. IN GENERAL, FACTOR SHOULD NOT BE MADE 06071500
LARGER THAN THE CAPACITY OFA 20 ML SUBMOD,I.E., 06071600
10,000 SEGMENTS. 06071700
MINSIZE: THE MINIMUM SIZE, IN SEGMENTS, ALLOWED FOR AN 06071800
AVAILABLE AREA TO BE CONSIDERED AS A CANDIDATE 06071900
FOR SQUASHING. MINSIZE MAY BE MADE AS SMALL AS 06072000
ONE, BUT AS SQUASH TIME VARIES INVERSLY WITH 06072100
MINSIZE, SMALLER VALUES WILL INCREASE SQUASH- 06072200
ING TIME PROPORTIONALLY. MINSIZE LIMITA- 06072300
TIONS MAY BE OVERRIDEN BY THE LOOKAHEAD 06072400
FACILITY. 06072500
MAXMVSIZE: LIMITS THE NUMBER OF INDIVIDUAL AREAS IN AN 06072600
IN-USE AREA TO BE AT MOST MAXMVSIZE/3 AREAS 06072700
FOR SQUASHING TO OCCUR. 06072800
NOTE: 06072900
1) MAXMVSIZE MUST BE LESS THAN 1024, 06073000
2) MAXMVSIZE MUST BE A MULTIPLE OF 3. ; 06073100
DEFINE CELL = M[PRTADDR]#, 06073200
STOP = M[PRTADDR]#, 06073300
STOPCK = IF M[PRTADDR] THEN GO STOPSQ#, 06073400
MOVEABLE = NOT DIR[X3+4].[42:1]#, 06073500
TEMPDSK = MV[I+2].[1;1]#; 06073600
SUBROUTINE SQUASHMESS; 06073700
BEGIN 06073800
IF (X1:=P(XCH))>1 THEN X3:=IF SQSIZE!0 THEN SQSIZE 06073900
ELSE EUS[EU-1].DSIZE; 06074000
STREAM(A:=EU-1,B:=X1,C:=X3,C1:=0,C2:=0,CX:=0, 06074100
NOSQ:=EUNOTSQUASHED, X2:=X2:=SPACE(10)); 06074200
BEGIN 06074300
C1:=CI; GO TO L0; 06074400
SI:=LOC A; DS:=4 LIT" EU"; DS:=2 DEC; 06074500
A:=DI; DI:=DI-2; DS:=FILL; DS:=A; CI:=CX; 06074600
L0: C2:=CI; GO TO L2; DS:=4 LIT"NULL"; CI:=CX; 06074700
L1: DS:=7 LIT" SQUASH"; CI:=CX; 06074800
L2: CI:=CI+B; 06074900
GO TO LL0; GO TO LL0; GO TO LL2; TO TO LL2; 06075000
LL0: CX:=CI; CI:=C1; 06075100
N(NOSQ(DS:=LIT" "; CX:=CI; CI:=C2)); 06075200
CX:=CI; GO TO L1; 06075300
B(NOSQ(JUMP OUT 2 TO LL1); DS:=2 LIT"ED"; 06075400
JUMP OUT TO LL1); 06075500
DS:=3 LIT"ING"; 06075600
LL1: GO TO EXT; 06075700
LL2: DS:=LIT" "; CX:=C1; CI:=C2; 06075800
CX:=CI; GO TO L1; 06075900
SI:=B; 2(SI:=SI-8); B:=SI; 06076000
B(CX:=CI; CI:=C1); 06076100
DS:=2 LIT" ("; SI:=LOC C; 06076200
DS:=6 DEC; C:=DI; DI:=DI-6; DS:=5 FILL; DI:=C; 06076300
DS:=19 LIT" SEGMENTS AVAILABLE"; 06076400
B(JUMP OUT TO LL3); DS:=4 LIT" ON "; 06076500
CX:=CI; CI:=C1; 06076600
LL3: DS:=LIT")"; 06076700
EXT: DS:=LIT"~"; 06076800
END; 06076900
SPOUT(X2); 06077000
END PRINTING MESSAGES; 06077100
SUBROUTINE SCANMESSAGE; 06077200
BEGIN 06077300
X1:=(X5:=NEUP.[FF])-1; X2:=BUFF.[30:18]; 06077400
FIXARRAY(EUS,A5,X5); 06077500
MOVE(X5,A5-1,A5); 06077600
X5:=-1; % WILL BE GEQ ZERO AFTER FIRST PASS THRU SCAN 06077700
SCAN: 06077800
STREAM(A:=0,SIZ:=0,EU1:=-1,EU2:=-1,ERRTOG:=0:NO:=0, 06077900
B:=X5<0,EU:=@2564000000000000,CX:=0,C1:=0, 06078000
C2:=0,KTR:=X2); 06078100
BEGIN 06078200
C1:=CI; GO TO L2; 06078300
IF SC<0 THEN 06078400
A0: BEGIN TALLY:=1; NO:=TALLY; CI:=CX END; 06078500
IF SC=12 THEN GO TO A0; 06078600
DI:=LOC SIZ; 06078700
L1: IF SC GEQ 0 THEN IF SC<12 THEN 06078800
BEGIN 06078900
TALLY:=TALLY+1; 06079000
SI:=SI+1; 06079100
GO TO L1; 06079200
END; 06079300
NO:=TALLY; 06079400
SI:=SI-NO; 06079500
DS:=NO OCT; 06079600
TALLY:=0; NO:=TALLY; 06079700
CI:=CX; 06079800
L2: C2:=CI; GO TO STR; 06079900
TALLY:=1; DI:=LOC EU; 06080000
IF 2 SC=DC THEN % AN EU SPECIFIED 06080100
BEGIN 06080200
CX:=CI; GO TO L3; 06080300
IF SC GEQ 0 THEN IF SC<12 THEN 06080400
BEGIN 06080500
SI:=SI+1; DI:=LOC EU1; 06080600
IF SC GEQ 0 THEN IF SC<12 THEN 06080700
TALLY:=2 ELSE GO TO A1; 06080800
SI:=SI-1; NO:=TALLY; 06080900
DS:=NO OCT; TALLY:=0; 06081000
END ELSE GO TO A1; 06081100
END; 06081200
NO:=TALLY; CI:=A; 06081300
CI:=A; 06081400
L3: IF SC=" " THEN BEGIN SI:=SI+1; GO TO L3 END; CI:=CX; 06081500
STR: SI:=KTR; CI:=CI+B; GO TO L5; GO TO L4; 06081600
L4: IF SC="~" THEN GO TO EXT; 06081700
CX:=CI; CI:=C1; % SIZE CHECK 06081800
NO(JUMP OUT TO L5); 06081900
CX:=CI; GO TO L3; 06082000
IF SC!"~" THEN 06082100
A1: GO TO ERR; 06082200
GO EXT; 06082300
L5: A:=CI; CI:=C2; % EU CHECK 06082400
NO(JUMP OUT TO ERR); 06082500
IF SC="-" THEN 06082600
BEGIN 06082700
SI:=SI+1; CX:=CI; GO TO L3; 06082800
CX:=CI; CI:=C1; % SIZE CHECK 06082900
NO(JUMP OUT TO L6); GO TO L7; 06083000
L6: TALLY:=EU1; EU2:=TALLY; 06083100
A:= CI; CI:=C2; % EU CHECK 06083200
NO(JUMP OUT TO ERR); 06083300
END; 06083400
L7: A:=TALLY; % ZERO OUT A 06083500
IF SC="~" THEN GO TO EXT; 06083600
IF SC="," THEN 06083700
BEGIN SI:=SI+1; A:=SI; GO EXT END; 06083800
ERR: TALLY:=1; ERRTOG:=TALLY; 06083900
EXT: 06084000
END; 06084100
IF P THEN % ERROR IN INPUT MESSAGE 06084200
BEGIN 06084300
SPOUTERR: 06084400
SPOUT(P(BUFF.[15:15]-1,DUP)&M[P-1][9:9:9]); 06084500
FORGETSPACE(A5); 06084600
P(XIT); 06084700
END; 06084800
IF (X3:=P) GEQ 0 THEN % AN EU RANGE SPECIFIED. 06084900
BEGIN 06085000
IF (X4:=P)>X1 OR X3<X1 THEN GO SPOUTERR; 06085100
FOR I:=X3 STEP 1 UNTIL X4 DO EUS[I]:=1; 06085200
P(DEL); GO CK; 06085300
END; 06085400
X5:=P(XCH); % SIZE OF SQUASH 06085500
IF (X4:=P) GEQ 0 THEN IF X4>X1 THEN GO SPOUTERR ELSE 06085600
EUS[X4]:=1&X5[TODSIZE] ELSE IF X5=0 THEN SQALL:=1 06085700
ELSE SQSIZE:=X5; 06085800
CK: IF (XS:=P)!0 THEN GO SCAN; % NOT FINISHED YET 06085900
END SCANNING INPUT MESSAGE; 06086000
SUBROUTINE FIXANDWRITEHEADER; 06086100
BEGIN 06086200
M[A4+9+X2.[28:5]]:=C; 06086300
DISKWAIT(A4,30,X2.[CF]); 06086400
END WRITING NEW HEADER; 06086500
SUBROUTINE BOUNDARYCK; 06086600
BEGIN 06086700
LSTCNT:=0; M[X2-1]:=-1; 06086800
MVEMORE: 06086900
X3:=HICNT:=0; STOPCK; 06087000
FOR I:=CNT SETP -3 UNTIL 0 DO 06087100
IF P(MV[I],DUP).DEND>X3 AND P(XCH)>0 THEN 06087200
BEGIN X3:=MV[I].DEND; HICNT:=I END; 06087300
IF X3=0 THEN % RE-ORDERING OF MV ARRAY COMPLETE 06087400
BEGIN 06087500
MV[LSTCNT+2].LINK:=@1777; 06087600
GO OKBOUNDS; 06087700
END; 06087800
IF M[A2-1]<0 THEN M[A2-1]:=HICNT ELSE MV[LSTCNT+2].LINK:=HICNT; 06087900
MV[LSTCNT:=HICNT]:=NABS(*P(DUP)); 06088000
MV[HICNT+1].[2:26]:=HI; 06088100
HI:=HI-(X3:=MV[HICNT].DSIZE); 06088200
IF X3 LEQ UT[AV+1].ASIZE THEN 06088300
OK: BEGIN 06088400
MV[HICNT+2]:=0; 06088500
GO MVEMORE; 06088600
END ELSE 06088700
BEGIN % LOOKING FOR TEMPORARY STORAGE 06088800
FOR I:=S-2 STEP -1 UNTIL D DO 06088900
IF X3 LEQ UT[I].ASIZE THEN 06089000
IF NOT UT[I].LOCKED THEN % OK FOR TEMP STORAGE 06089100
BEGIN 06089200
MV[HICNT+2]:=UT[I].DEND&I[2:38:10]; 06089300
GO MVEMORE; 06089400
END; 06089500
END; 06089600
IF PASSTWO THEN % NON-PROTECTED FILE TRANSFER 06089700
BEGIN 06089800
DISKWAIT(-A4,30,MV[HICNT+2].[CF]); 06089900
STREAM(A:=[M[A4+MV[HICNT+2].[FF]]],X2:=X2:=SPACE(6)); 06090000
BEGIN 06090100
DS:=27 LIT" #FILE INTEGRITY CONFLICT: "; SI:=A; 06090200
SI:=SI+1; DS:=7 CHR; DS:=LIT"/"; SI:=SI+1; 06090300
DS:=7 CHR; DS:=LIT"~"; 06090400
END; 06090500
SPOUT(X2); CELL.KEYINMASK:=7; 06090600
SLEEP((PRTADR INX M),@77777); STOPCK; 06090700
IF CELL=2 THEN BEGIN CELL:=0&1[CTF]; GO TO OK END; 06090800
END ELSE CONFLICT:=TRUE; 06090900
TOG:=0; 06091000
OKBOUNDS: 06091100
END BOUNDARY AND CONFLICT CHECKING; 06091200
BOOLEAN SUBROUTINE INUSEOK; 06091300
BEGIN 06091400
UT[AV+1].[1:1]:= NOT PASSTWO; TOG:=1; CNT:=0; 06091500
FOR X1:=DIRECTORYTOP+4 STEP 16 WHILE TRUE DO 06091600
BEGIN STOPCK; 06091700
DISKWAIT(-A1,480,X1); 06091800
FOR I:=14 STEP -1 UNTIL 0 DO 06091900
BEGIN STOPCK; 06092000
IF((E:=DIR[450+P(I,DUP,+)]) EQV @114)=NOT 0 THEN 06092100
GO TO NOTOK; 06092200
IF (E EQV @14)! NOT 0 THEN 06092300
BEGIN FILEOK:=FALSE; % INITIATE STATUS CHECKING 06092400
B:=DIR[(X3:=30|I)+9].[43:5]; 06092500
FOR X2:=1 STEP 1 UNTIL B DO 06092600
IF (C:=DIR[X3+9+X2])!0 THEN 06092700
IF P(C,DUP)<HI AND P(XCH)>LO THEN 06092800
IF FILEOK THEN GO FIXMV ELSE % CHECK STATUS 06092900
IF NOT SYSTEMFILE(E,DIR[450+P(I,DUP,+)+1]) AND 06093000
DIR[X3+4].[12:4]=0 THEN % NOT SYSTEM FILE 06093100
IF (P(DIR[X3+4],DUP).[1:3] OR P(XCH).[16:20] OR 06093200
DIR[X3+9].[1:28])=0 THEN % FILE NOT IN USE 06093300
IF MOVEABLE THEN % NOT PERMANENT 06093400
BEGIN 06093500
FILEOK:=TRUE; % ELIMINATE STATUS CHECKING 06093600
FIXMV: USE:=USE-(MV[CNT]:=C&DIR[X3+8][TODSIZE]) 06093700
.DSIZE; 06093800
MV[CNT+1]:=(X1+I)&X2[CTF]; % HEADER INFO 06093900
IF PASSTWO THEN % SAVE LOC OF FIDS 06094000
MV[CNT+2]:=(X1+15)&(I|2)[CTF]; 06094100
IF USE=0 THEN % FOUND ALL USERS OF IN-USE AREA 06094200
BEGIN 06094300
BOUNDARYCK; 06094400
GO OKINUSE; 06094500
END; 06094600
IF USE<0 THEN GO TO NOTOK; % DIERCTORY ERROR 06094700
IF (CNT:=CNT+3) MOD 150 = 0 THEN 06094800
BEGIN 06094900
IF CNT=MAXMVSIZE THEN GO TO NOTOK; 06095000
FIXARRAY(MV,X4,(CNT+150)); 06095100
MOVE(CNT,A2,X4); 06095200
FORGETSPACE(A2); 06095300
A2:=X4; 06095400
END; 06095500
END ELSE GO TO NEXT ELSE GO TO NEXT; 06095600
END; 06095700
NEXT: END; 06095800
END; 06095900
NOTOK: 06096000
TOG:=0; 06096100
OKINUSE: 06096200
INUSEOK:=TOG; 06096300
END SEARCHING IN USE AREAS; 06096400
SUBROUTINE MOVEANDFIX; 06096500
BEGIN 06096600
I:=M[X2-1]; STOPCK; 06096700
WHILE I<@1777 DO 06096800
BEGIN 06096900
DISKWAIT(-A4,30,(X2:=MV[I+1]).[CF]); % READ IN HEADER 06097000
MVE: X1:=-30; F:=P(MV[I],DUP).DEND+(B:=P(XCH).ASIZE); 06097100
IF P(MV[I+2].DEND=0,DUP) THEN C:=MV[I+1].[2:26] ELSE 06097200
MV[I].DEND:=(C:=MV[I+2].DEND)-B; 06097300
WHILE (X1:=X1+30)<B DO 06097400
BEGIN 06097500
E:=IF P((B-X1),DUP)<30 THEN P ELSE P(DEL,30); 06098300
DISKIO(T,1-A3,E|30,F:=F-E); 06098400
IOD:=IOD&(E|30)[8:38:10]&E[27:42:6]; 06098500
LOCIOD:=0; SLEEP([T],IOMASK); 06098600
STREAM(A:=C:=C-E,B:=A3-1); 06098700
BEGIN SI:=LOC A; DS:= 8 DEC END; 06098800
IOREQUEST(NABS(IOD)&@357[25:40:8],IOD, 06098900
[LOCIOD]&18[12:42:6]); 06099000
SLEEP([LOCIOD],IOMASK); 06099100
IF LOCIOD.[28:1] THEN % WRITE LOCKOUT OCCURED 06099200
BEGIN 06099300
UT[IF P THEN AV+1 ELSE MV[I+2].[2:10]].LOCKED:=1; 06099400
UT[AV+1].DEND:=MV[I+1].[2;26]; GO ENDMVE; 06099500
END; 06099600
END; 06099700
FIXANDWRITEHEADER; 06099800
IF NOT P THEN % TEMPORARY DISK STORAGE WAS USED. 06099900
BEGIN 06100000
MV[I-2].DEND:=0; 06100100
TEMPDISK:=1; 06100200
GO TO MVE; 06100300
END; 06100400
I:=MV[I+2].LINK; 06100500
END; 06100600
% WILL NOW RECONFIGURE THE AVAILABLE TABLE 06100700
UT[AV]:=HI&(UT[AV].ASIZE+UT[AV+I].ASIZE)[2:28:20]; 06100800
MOVE(S-AV,P([UT[AV+2]],DUP),NOT 0 INX P(XCH)); 06100900
C:=(S:=S-1)-1; FOR I:=C STEP -1 UNTIL D DO 06101000
IF P(UT[I].ASIZE,DUP)>USE THEN USE:=P ELSE P(DEL); 06101100
U[EU]:=P(DUP,LOD,DUP)&USE[1:28:20]&(P(XCH).NUMENT-1)[TONUMENT]; 06101200
EUNOTSQUASHED:=FALSE; 06101300
IF NOT SQALL THEN 06101400
BEGIN 06101500
IF P(SQSIZE,DUP)!0 AND P(XCH) LEQ USE THEN CELL:=1 06101600
ELSE IF P(EUS[EU-1],DSIZE,DUP)!0 AND P(XCH) LEQ USE 06101700
THEN ELSE GO TO ENDMVE; 06101800
P(DEL); GO STOPSQ; 06101900
END; 06102000
ENDMVE: 06102100
END FIXING AND MOVING; 06102200
$ SET OMIT = NOT SHAREDISK 06102220
P(0,0,0,0,0,0,0,0,0,0); 06102500
P(0,0,0,0,0,0,0,0,0,0); 06102600
P(0,0,0,0,0,0,0,0,0,0); 06102700
P(0,0,0,0,0,0,0,0,0); 06102800
P(.DISKSQUASH,DUP,M[(P)]); % PRTADDR,PRTVALUE 06102900
$ SET OMIT = NOT SHAREDISK 06103000
SCANMESSAGE; 06103300
$ SET OMIT = SHAREDISK 06103400
LOCKDIRECTORY; 06103500
$ POP OMIT 06103600
SLEEP([TOGLE],USERDISKMASK); LOCKTOG(USERDISKMASK); 06103700
HALT; % STOP NORMAL STATE PROCESSING WHILE SQUASHING 06103800
A4:=SPACE(30); 06103900
$ SET OMIT = NOT SHAREDISK 06104000
FIXARRAY(DIR,A1,480); FIXARRAY(MV,A2,150); 06107200
A3:=SPACE(900); 06107300
IOD:=@140000100000000&(A3-1)[CTC]; 06107400
IF NOT SQALL THEN FOR EU:=1 STEP 1 UNTIL NEUP.[FF] DO 06107900
IF (CELL:=(P(SQSIZE,DUP)!0 AND P(XCH) LEQ U[EU].[1:20])) 06108000
THEN BEGIN P(2); SQUASHMESS; GO STOPIT END; 06108100
FOR EU:=1 STEP 1 UNTIL NEUP.[FF] DO % 06108200
IF NOT (E:=U[EU]).EUNP THEN % NOT A DUMMY EU 06108300
IF EUS[EU-1] OR SQALL OR SQSIZE!0 THEN % SQUASH THIS EU 06108400
BEGIN 06108500
EUNOTSQUASHED:=TRUE; 06108600
IF NOT SQALL THEN % CHECK IF SQUASH IS NECESSARY 06108700
IF (P(EUS[EU-1].DSIZE,DUP) LEQ E.[1:20] AND P(XCH)!0) 06108800
THEN BEGIN P(3); SQUASHMESS; GO STOPIT END; 06108900
CELL:=0&1[CTF]; 06109000
P(0); SQUASHMESS; 06109100
D:=(I:=E.STARTWRD) MOD 30; 06109200
AVSIZE:=30-(S:=(E AND NUMENTM)+D) MOD 30+S; 06109300
FIXARRAY(UT,R,AVSIZE); 06109400
DISKAV:=I DIV 30+USERDISKBOTTOM; 06109500
$ SET OMIT = NOT SHAREDISK 06109600
DISKWAIT(-R,AVSIZE,DISKAV); 06110300
AGAIN: SUM:=USE:=0; 06110400
FOR I:=S-3 STEP -1 UNTIL D DO 06110500
BEGIN STOPCK; 06110600
IF (UT[I+1]<0)=PASSTWO THEN % NOT CHECKED THIS PASS 06110700
IF ((X1:=UT[I].ASIZE)+(X2:=UT[I+1].ASIZE)) GEQ SUM 06110800
THEN IF (X3:=(((X4:=UT[I+1].DEND)-1)-UT[I+1].ASIZE)- 06110900
X5:=(UT[I].DEND-1)) LEQ FACTOR THEN IF MINSIZE LEQ X2 06111000
THEN IF MINSIZE LEQ X1 THEN 06111100
BEGIN 06111200
SQIT: USE:=X3; AV:=I; 06111300
SUM:=X1-X2; % SUM OF CURRENT AVAILABLE AREAS 06111400
HI:=X4; LO:=X5; 06111500
END ELSE IF I!0 THEN % LOOK AHEAD TO NEXT AREA 06111600
IF ((MINSIZE LEQ UT[I-1].ASIZE) AND (((X5-X1)- 06111700
UT[I-1].DEND-1) LEQ FACTOR)) THEN GO SQIT; 06111800
END; 06111900
IF USE!0 THEN % FOUND A POSSIBLE SQUASH SITUATION 06112000
BEGIN 06112100
IF INUSEOK THEN MOVEANDFIX; 06112200
GO AGAIN; 06112300
END ELSE % TIME TO WRAP IT UP FOR THIS EU UNLESS.... 06112400
IF CONFLICT THEN IF NOT PASSTWO THEN % ..CONFLICTS EXIST 06112500
BEGIN 06112600
PASSTWO:=TRUE; 06112700
GO AGAIN; 06112800
END ELSE 06112900
BEGIN % CLEAN-UP PASS AFTER CONFLICTS RESOLVED. 06113000
PASSTWO:=CONFLICTS:=0; 06113100
GO AGAIN; 06113200
END; 06113300
STOPSQ: FOR I:=D STEP 1 UNTIL S DO UT[I]:=ABS(P(DUP.LOD)&0[2:2:1]); 06113400
IF NOT EUNOTSQUASHED THEN 06113500
$ SET OMIT = NOT SHAREDISK 06113600
DISKWAIT( R,AVSIZ,DISKAV); 06114300
FORGETSPACE(R); 06114400
P(1); SQUASHMESS; 06114500
STOPIT: IF STOP THEN GO OUT; % STOPCK GOT US HERE 06114600
END EU LOOP; 06114700
OUT: 06114800
FORGETSPACE(A1); FORGETSPACE(A2); FORGETSPACE(A3); 06114900
$ SET OMIT = NOT SHAREDISK 06115000
SDXIT: 06115500
FORGETSPACE(A4); FORGETSPACE(A5); 06115600
CELL:=PRTVALUE; 06115700
STREAM(A:=BUFF.[15:15]-1); DS:=13 LIT" END SQUASH.~"; 06115800
SPOUT(BUFF.[15:15]-1); 06115900
$ SET OMIT = SHAREDISK 06115990
UNLOCKDIRECTORY; 06116000
$ POP OMIT 06116010
UNLOCKTOG(USERDISKMASK); 06116100
NOPROCESSTOG:=NOPROCESSTOG-1; 06116200
KILL([MSCW]); 06116300
END SQUASHING; 06116400
PROCEDURE CHANGEABORT(X); VALUE X; REAL X; FORWARD;% 06179000
REAL LOOKQ; 06179200
PROCEDURE SIGNOFF(VECTOR,FILEBLOCK,PKT); 06180000
VALUE VECTOR,FILEBLOCK,PKT; 06181000
ARRAY VECTOR[*],FILEBLOCK[*];% 06182000
REAL PKT; 06182100
BEGIN ARRAY NAME LOG; 06183000
INTEGER N,L,I,J,TIMEX;% 06184000
INTEGER MIX; 06184100
$ SET OMIT = NOT STATISTICS 06184199
REAL TIMEAX,T,A,Q,ESED; 06185000
$ SET OMIT = NOT(PACKETS) 06185099
REAL UNITNO; 06185100
INTEGER ARRAY PM[*]; 06185105
$ POP OMIT 06185110
$ SET OMIT = NOT(WORKSET AND WORKSETMONITOR) 06185111
REAL DD; 06185112
$ POP OMIT % WORKSET AND WORKSETMONITOR 06185113
SUBROUTINE TIMEIT;% 06186000
BEGIN CHANGEABORT(0);% 06187000
WHILE (NT2:=XCLOCK+P(RTR)) GEQ WITCHINGHOUR DO 06188000
MIDNIGHT; 06188100
LOG[TIMEAX+2] ~ NT2;% 06189000
$ SET OMIT = NOT(STATISTICS) 06189099
STOPLOG(P1MIX,0); 06190000
MIX~P1MIX; P1MIX~0; 06190100
IDLETIME;% 06191000
OLDIDLETIME ~ (LOG[TIMEX] ~ VECTOR[3]+% 06192000
PROCTIME[MIX])+OLDIDLETIME; 06193000
PROCTIME[MIX] ~ -VECTOR[3];% %127-06193500
LOG[TIMEX+1]~VECTOR[4]+IOTIME[MIX]; 06194000
$ SET OMIT = NOT WORKSET 06194890
LOG[TIMEX+2] ~ OLAYTIME[MIX]; %710-06194900
$ SET OMIT = WORKSET%710-06194990
$ SET OMIT = NOT(WORKSET AND WORKSETMONITOR) 06195090
IF WKSETMONITOR AND (DD=0) THEN 06195095
BEGIN 06195100
STREAM(N1 := VECTOR[0], N2 := VECTOR[1], 06195105
T1 := ((LOG[TIMEX]+0.5)/60 DIV 1), 06195110
T2 := ((LOG[TIMEX+1]+0.5)/60 DIV 1), 06195115
T4 ~ (OLAYTIME[MIX]+59) DIV 60, % OLAY I/O TIME IN SECS %710-06195118
T3:=(((LOG[TIMEAX+2]-VECTOR[5].[24:24])+0.5)/60 DIV 1), 06195120
DV:=0, DD := DD := SPACE(10)); 06195125
BEGIN 06195130
SI:=LOC N; DS:=LIT" "; 06195135
2(SI:=SI+1; DS:=7CHR; DS:=LIT" "); 06195140
DS:=4LIT"CPU="; 06195145
DS:=6DEC; DV:=DI; DI:=DI-6; DS:=5FILL; DI:=DV; 06195150
DS:=5LIT" I/O="; 06195155
DS:=6DEC; DV:=DI; DI:=DI-6; DS:=5FILL; DI:=DV; 06195160
DS~ 6LIT" OLAY="; %710-06195161
DS~ 6DEC; DV~ DI; DI~ DI-6; DS~ 5FILL; DI~ DV; %710-06195162
DS:=6LIT" ELAP="; 06195165
DS:=6DEC; DV:=DI; DI:=DI-6; DS:=5FILL; DI:=DV; 06195170
DS:=LIT"~"; 06195175
END STREAM STATEMENT; 06195180
SPOUT(DD); 06195185
END; 06195190
$ POP OMIT % WORKSET AND WORKSETMONITOR 06195195
STREAM(A~VECTOR[5].[1:23]:B~0);% 06196000
BEGIN SI ~ LOC A; DI ~ LOC A; DS ~ 8 DEC END;% 06197000
LOG[TIMEAX] ~ P(XCH);% 06198000
LOG[TIMEAX+1] ~ VECTOR[5].[24:24];% 06199000
$ SET OMIT = NOT(STATISTICS) 06199099
NT4 ~ VECTOR[2].[8:10];% 06200000
LOG[TIMEAX+3] ~ IF VECTOR[1] < 0 THEN (NT4= 99) 06201000
+2 ELSE NT4 = 3;% 06202000
LOG[TIMEAX+3].[1:30]~ DATE.[18:30]; 06202100
LOG[TIMEAX+4]:=USERCODE[MIX]; 06203000
$ SET OMIT = NOT(DCLOG AND DATACOM) 06203099
IF TABCNT[MIX]!0 THEN 06203600
BEGIN T:=CLOCK+900; 06203650
COMPLEXSLEEP(TABACNT[MIX]=0 OR CLOCK>T); 06203700
END; 06203750
$ SET OMIT = NOT (DATACOM AND NOT DCLOG) 06203790
PRTROW[MIX].[PSF]:=0; 06204000
$ SET OMIT = NOT(PACKETS) 06205009
UNITNO:=PSEUDOMIX[MIX]; 06205010
PSEUDOMIX[MIX]:=0; 06205020
PM[0]:=LOG[TIMEX ]/60; 06205030
PM[1]:=LOG[TIMEX+1]/60; 06205040
$ SET OMIT = NOT(WORKSET) OR OMIT %759-06205049
PM[2]:=OLAYTIME[MIX]/60; %759-06205050
$ POP OMIT 06205051
$ POP OMIT %759-06205052
USERCODE[MIX] := 0; 06205100
STREAM(S~[NFO[(MIX-1)|NDX]]);% 06205200
BEGIN DS~8 LIT "0"; DI~S; DS~2 WDS; END;% 06205300
$ SET OMIT = NOT STATISTICS 06205540
JARROW[MIX]:=PRTROW[MIX]:=0; 06206000
END TIMET; 06206100
$ SET OMIT = NOT(PACKETS) 06206109
SUBROUTINE MESSAGE; 06206110
IF UNITNO!0 OR (VECTOR.[24:9]!0) THEN 06206120
BEGIN 06206130
STREAM(A:=[VECTOR[0]],MIX,B:=[PM[0]],T:=T:=SPACE(10)); 06206140
BEGIN DS:=5LIT" FOR";SI:=A;SI:=SI+1;DS:=7CHR; 06206150
DS:=LIT"/";SI:=SI+1;DS:=7CHR;SI:=LOC MIX; 06206160
DS:=LIT"=";DS:=2DEC; 06206170
A:=DI;DI:=DI-2;DS:=FILL;DI:=A; SI:=B; 06206175
DS:=10 LIT ": PROCESS="; DS:=5 DEC; %759-06206180
A:=DI;DI:=DI-5;DS:=4FILL;DI:=A; 06206190
DS:=10 LIT " SECS, IO="; DS:=5 DEC; %759-06206200
A:=DI;DI:=DI-5;DS:=4FILL;DI:=A; 06206205
$ SET OMIT = NOT(WORKSET) OR OMIT %759-06206209
DS:=12 LIT " SECS, OLAY="; DS:=5 DEC; %759-06206210
A:=DI;DI:=DI-5;DS:=4FILL;DI:=A; %759-06206215
$ POP OMIT %759-06206216
DS:=LIT"~"; 06206220
END; 06206230
SPOUTER(T,IF VECTOR.[24:9] NEQ 0 THEN 06206240
VECTOR.[24:9] ELSE UNITNO,64); 06206250
END; 06206260
$ POP OMIT 06206261
A ~ VECTOR[6].[33:15];% 06207000
ESED:=VECTOR[2].[2:1]; 06207100
T:=Q:=((L:=VECTOR[6].[18:15])+(IF ESED THEN N~0 ELSE 06208000
N:=FILEBLOCK.[8:10])+60) DIV 25|27; 06209000
LOG:=[M[TYPEDSPACE(T,LOGAREAV)]];% %167-06210000
M[LOG INX NOT 1].[9:6] ~ 0;% 06211000
$ SET OMIT = NOT(PACKETS) 06211099
PM:=[M[SPACE(5)]]&5[8:38:10]; 06211100
M[PM INX NOT 1].[9:6]:=0; 06211200
$ POP OMIT 06211201
J ~ A;% 06212000
DO BEGIN I ~ I+27;% 06213000
DISKIO( T ,-( LOG INX I),26,J);% 06214000
SLEEP([T],IOMASK);% 06215000
J ~ LOG[I+1];% 06216000
END UNTIL J=0 OR I+53>Q;% 06217000
IF VECTOR[2].[8:10]=0 THEN L ~ LOG[29]; 06217100
IF(I:=(L-5) MOD 25+I+7) LSS Q-3 THEN 06218000
IF I MOD 27 = 0 THEN% 06219000
BEGIN LOG[I] ~ LOG[I+1] ~ 0;% 06220000
I ~ I+2 END;% 06221000
$ SET OMIT = NOT(STATISTICS) 06221099
LOG[I]:= IF VECTOR[0] LSS 0 06222000
THEN IF VECTOR[0]=(-"COBOL ") THEN 2 06222100
ELSE IF VECTOR[0]=(-"FORTRAN") THEN 6 06222200
ELSE IF VECTOR[0]=(-"BASIC ") THEN 7 06222300
ELSE IF VECTOR[0]=(-"XALGOL ") THEN 9 06222400
ELSE IF VECTOR[0]=(="TSPOL ") THEN 10 06222500
ELSE IF VECTOR[0]=(-"COBOL68") THEN 11 06222550
ELSE 1 ELSE 0; 06222600
LOG[I+1] ~ N DIV 5;% 06223000
IF(I:=(TIMEX:=I+2)+3) LSS Q-1 THEN 06224000
IF I MOD 27 = 0 THEN% 06225000
BEGIN LOG[I] ~ LOG[I+1] ~ 0;% 06226000
I ~ I+2;% 06227000
END;% 06228000
I ~ (TIMEAX ~ 1)+5;% 06229000
IF NOT ESED THEN%IF JOB ES-ED THEN NO FPB ENTRIES 06229100
FOR J ~ 5 STEP 5 UNTIL N DO% 06230000
IF FILEBLOCK[J-1]=0 THEN LOG[TIMEX -1]~*P(DUP)-1 ELSE 06230100
BEGIN IF I MOD 27 = 0 THEN% 06231000
BEGIN LOG[I] ~ LOG[I+1] ~ 0;% 06232000
I ~ I+2 END;% 06233000
IF I+4 LEQ Q THEN 06233100
STREAM(A~[FILEBLOCK[J-5]],B~[LOG[I]]);% 06234000
BEGN SI ~ A; DS ~ 5 WDS END;% 06235000
IF I+4 LEQ Q THEN 06235100
IF LOG[I+4] < 0 THEN 06236000
BEGIN LOG[I+4] ~ *P(DUP)+CLOCK+P(RTR);% 06237000
LOG[I+3].[24:12]~P(DUP,DUP).[24:12]+TINU06238000
[NT1~P(XCH).[36:6]-1].[18:12];% 06239000
TINU[NT1].[18:12] ~ 0;% 06240000
END;% 06241000
IF LOG[I+2].[18:30]=0 THEN 06241100
LOG[I+2].[18:30]:=DATE.[18:30];%ENTER CURR DATE 06241200
I ~ I+5% 06242000
END;% 06243000
N ~ LOG[TIMEX -1]|5; 06243100
FORGETSPACE(FILEBLOCK);% 06244000
J ~ 0;% 06245000
IF VECTOR[2].[8:10] = 1 THEN% 06246000
BEGIN DO J ~ J+27 UNTIL LOG[J+1] = 0;% 06247000
WHILE J+27 LSS I AND I LSS Q DO% 06248000
BEGIN LOG[J+1] ~ GETESPDISK;% 06249000
J ~ J+27;% 06250000
END;% 06251000
I ~ 27;% 06252000
TIMEIT;% 06253000
LOG[29]~5|LOG[40]+20; 06253500
DO BEGIN DISKIO(T,LOG INX I,26,A);% 06254000
A ~ LOG[I+1];% 06255000
I ~ I+27;% 06256000
SLEEP([T],IOMASK);% 06257000
END UNTIL A = 0;% 06258000
END% 06259000
ELSE BEGIN 06260000
DO BEGIN J~J+27; 06260100
FORGETESPDISK(A);% 06261000
A ~ LOG[J+1];% 06262000
END UNTIL A = 0;% 06263000
IF LOGFREE=0 THEN TIMEIT ELSE 06263100
BEGIN A~J+29; 06263200
LOG[29]~3; 06265000
I ~ I+6;% 06266000
WHILE (J ~ J+27) < I DO% 06267000
BEGIN A ~ A+25;% 06268000
STREAM(X~[LOG[J]],Y~[LOG[A]]);% 06269000
BEGIN SI ~ X; DS ~ 25 WDS END;% 06270000
IF TIMEX } A THEN TIMEX ~ TIMEX-2; 06271000
IF TIMEAX } A THEN TIMEAX ~ TIMEAX-2; 06272000
END;% 06273000
N ~ (N+L) DIV 5+3;% 06278000
L ~ 28;% 06279000
IF TIMEX+2 LSS Q AND TIMEAX+4 LSS Q THEN 06279100
TIMEIT; LOGSPACE(L+1 INX LOG,(N-1)|5); 06280000
END;% 06327000
END;% 06328000
$ SET OMIT = NOT(PACKETS) 06328099
MESSAGE; FORGETSPACE(PM); 06328100
IF UNITNO!0 THEN 06328200
DRAINO(UNITNO,(VECTOR[2].[8:10]!1) OR (PKT!0), 06328300
((VECTOR[1]<0) OR (VECTOR[2].[8:10]=3)) 06328400
%VECTOR[6][1:1:1]); 06328500
$ POP OMIT 06328501
FORGETSPACE(LOG);% 06329000
END SIGNOFF;% 06330000
PROCEDURE USERDISKSPECIALCASE(Q,R,UT,J) ; 06350000
VALUE Q,J; REAL R,J; INTEGER Q; ARRAY UT[*] ; 06350300
BEGIN 06350600
REAL BUFF=Q,N=J,Z=UT,E=R ; 06351000
$ SET OMIT = NOT(SHAREDISK ) 06351050
$ SET OMIT = SHAREDISK 06351100
REAL NEU,NT; ARRAY UA[*]; 06351104
DEFINE U=AVTABLE #, AVS=B #, NEU1=J-1 #, NEU2=NT-1 #; 06351105
$ POP OMIT 06351106
INTEGER NT1,NT3,NT4,B ; 06351250
LABEL L1,L2,L3,UP,PU,BD,WHY,M1,T10 ; 06351500
SWITCH SW,~L1,L2,L3 ; 06351800
IF Q!0 THEN GO SW[Q-1] ; 06352000
$ SET OMIT = NOT(SHAREDISK ) 06352490
L1: BUFF:=R; Z:=0; UNLOCKTOG(USERDISKMASK); 06353500
IF N LEQ RESERVEDISKSIZE THEN% CALL OUT RESERVES 06353510
IF (Z:=DIRECTORYSEARCH("RESERVE","DISK ",6)) NEQ 0 THEN 06353530
BEGIN FORGETSPACE(Z); 06353540
IF N>0 THEN 06353541
$ SET OMIT = PACKETS 06353542
BEGIN STREAM(Z:=Z:=SPACE(3)); 06353545
DS!23 LIT "**RESERVE/DISK REMOVED~"; 06353550
SPOUTER(Z,25,(NOT LIBMSG) AND 1); %523-06353551
END; 06353552
FORGETSPACE(BUFF); P(XIT); %528-06353555
END OF RESERVE CALL UP; 06353570
IF AUTOUNLD THEN 06353580
BEGIN P(P1MIX); AUTOUNLD:=P1MIX:=0; 06353590
STREAM(A:=DATE,Z:=Z:=SPACE(10)+2); 06353600
BEGIN DS:=23 LIT"CC UNLOAD EXPIRED TO XP"; 06353610
SI:=LOC A; SI:=SI+3; DS:=5 CHR; 06353620
DS:=9 LIT " =/=;END."; 06353630
END; 06353640
INDEPENDENTRUNNER(P(.CONTROLCARD),Z&31[3:43:5],192); 06353650
P1MIX:=P; 06353660
IF N GEQ 0 THEN 06353670
BEGIN STREAM(Z:=Z:=SPACE(10)); 06353680
DS:=18 LIT"18 AUTOUNLD RESET~"; 06353690
SPOUT(Z); 06353700
END END AUTOMATIC UNLOADING; 06353710
IF NOT N.[2:1] THEN 06353720
BEGIN IF P1MIX!0 THEN 06354000
BEGIN 06354100
NT1 ~ NOTERMSET(P1MIX); % NOTE: NT1 IS LOCAL %537-06354200
WHY: STREAM(J:=JARROW[P1MIX],P1MIX,N,BUFF); 06355000
BEGIN DS~14 LIT "#NO USER DISK:"; 06356000
SI~J; SI~SI+1; DS~7 CHR; 06357000
DS~LIT "/"; SI~SI+1; DS~7 CHR; 06358000
SI~LOC P1MIX; DS~LIT "="; DS~2 DEC; 06359000
J:=DI; DI:=DI-2; DS:=FILL; DI:=J; DS:=LIT"-"; 06359500
SI:=LOC N; DS:=8 DEC; DS:=7 LIT" SEGS.~"; 06360000
DI:=DI-15; DS:=7 FILL; 06360500
END; 06360505
SPOUT(BUFF); 06360510
IF AUTODS AND NOTERMSET(P1MIX) THEN %747-06360515
TERMINATE(P1MIX&61[CTF]) ELSE %747-06360516
BEGIN %747-06360517
REPLY[P1MIX]:=-VWY&VOK[36:42:6]; 06360520
COMPLEXSLEEP((REPLY[P1MIX] GTR 0) OR 06360530
(TERMSET(P1MIX) AND NT1)); %537-06360540
END; %747-06360542
IF NT1 THEN %537-06360545
IF TERMSET(P1MIX) THEN 06360550
BEGIN PRTROW[P1MIX].[7:1]~1; 06360560
GO TO INITIATE; 06360570
END; 06360580
IF NOT WHYSLEEP(VWY&VOK[36:42:6]) THEN 06360590
BEGIN BUFF~SPACE(10); 06360600
GO TO WHY; 06360610
END; 06360620
END ELSE 06361000
BEGIN 06361010
STREAM(N,BUFF); 06361100
BEGIN DS:=20 LIT"#NO USER DISK:MCP - "); 06361200
SI:=LOC N; DS:=8 DEC; 06361300
DS:=6 LIT" SEGS~"; 06361400
DI:=DI-14; DS:=7 FILL; 06361500
END; 06361600
SPOUT(BUFF); 06361610
NT1:=0; DO SLEEP([CLOCK], NOT CLOCK) 06361700
UNTIL (NT1~NT1+1)=30); 06361705
END; 06361710
END ELSE FORGETSPACE(BUFF); 06365110
P(XIT) ; 06380070
L2: U[J]:=E; E:=NEU:=(NT:=NEUP.NEUF)+2+(NT+1)DIV 2; P(NT); J:=1; 06380100
$ SET OMIT = SHAREDISK 06380120
NT1:=NT+NT+NT; FORGETSPACE(UT); FIXARRAY(UA,NT2,NT1); E:=0; 06380140
$ POP OMIT 06380141
UP: IF (NT4:=E MOD 30) LSS (NT3:=(NT1:=U[J].STARTWRD) MOD 30) 06380150
THEN NT4:=NT3 ; 06380200
IF (NT2:=(Q:=U[J] AND NUMENTM)+NT4) GTR 1023 06380250
OR ((Q+E+1) DIV 30+1-E DIV 30) GTR 34 THEN 06380300
BD: BYBY("ODISK IS TOO CHECKERED...PLEASE COMPACT IT~",43) ; 06380350
DISKWAIT(-((UA[NEU1]:=(UA[NEU2+J]:=SPACE(NT2))+NT4)-NT3),Q+NT3, 06380400
USERDISKBOTTOM~NT1 DIV 30) ; 06380450
$ SET OMIT = NOT(SHAREDISK ) 06380490
$ SET OMIT = SHAREDISK 06380520
IF J=1 THEN B:=UA.[CF]+NT+NT-1 ; 06380525
$ POP OMIT 06380526
M[B+J]:=U[J]&E[TOSTARTWRD] ; 06380550
IF (NT1:=Q DIV 4) LSS AVDIFFMIN THEN NT1:=AVDIFFMIN ; 06380600
IF (E:=E+Q+NT1) GTR AVTMAX THEN GO TO BD; 06380650
IF P(DUP) GEQ J:=J+1 THEN GO UP; E:=E-NT1; J:=1 ; 06380700
PU: NT2:=(NT3:=P(M[B+J],DUP).STARTWRD)+NT5:=P(XCH) AND NUMENTM ; 06380750
IF P(DUP)!J THEN IF (NT2-1)DIV 30=(NT4~M[B+J+1].STARTWRD)DIV 30 THEN06380800
MOVE(NT1~NT2 MOD 30,UA[NEU1]+NT5-NT1,NT1~UA[NEU1+1]-NT4 MOD 30); 06380850
DISKWAIT(UA[NEU1]-NT1~NT3 MOD 30,NT1~NT5,USERDISKBOTTOM+NT3 DIV 30);06380900
$ SET OMIT = NOT(SHAREDISK) 06380924
FORGETSPACE(UA[NEU2+J]); 06380950
IF P(DUP) GEQ J:=J+1 THEN GO PU ; 06381000
$ SET OMIT = SHAREDISK 06381020
MOVE(NT,[UA[NT+NT]].[AVTABLE[1]]) ; 06381070
$ POP OMIT 06381071
$ SET OMIT = NOT(SHAREDISK ) 06381075
FORGETSPACE(UA) ; 06381085
$ SET OMIT = NOT(SHAREDISK ) 06381095
P(DEL,Q&AVS[TOSIZE] OR M,RTN) ; 06381250
L3: P(U[NEUP.NEUF+2+(Q:=J DIV P(M1)) DIV 2],IF Q THEN P.[8:20] ELSE 06381300
P.[28:20]) ; 06381310
IF U[Q+1].SPEED = 2 THEN 06381320
BEGIN % 40-MILL MASK CONSTRUCTION. 06381330
Q:=P ; 06381335
STREAM(S:=0:Q); 06381340
BEGIN 06381345
SI:=LOC Q; SKIP 28SB; DI:=LOC S; SKIP 8DB; 06381350
5(4(IF SB THEN DS:=SET ELSE SKIP DB;SKIP SB); SKIP 4 DB); 06381355
SI:=LOC Q; SKIP 28 SB; DI:=LOC S; DI:=DI+2; 06381360
5(4(IF SB THEN DS:=SET ELSE SKIP DB;SKIP SB); SKIP 4 DB); 06381365
END STREAM; 06381380
END ; 06381390
STREAM(MSG:=0:V:=47-(J:=((Q:=J MOD P(M1))+ABS(R)-1) DIV P(T10)), 06381395
W:=1+J-Q DIV P(T10)); 06381400
BEGIN DI:=LOC MSK; SKIP V DB; DS:=W SET; END; 06381405
P(LND,LNG,0,LNG,=,RTN); 06381410
M1::: @3641100; % DECIMAL 1000000. 06381450
T10::: @23420; % DECIMAL 10000. 06381500
END OF USERDISKSPECIALCASE ; 06381550
PROCEDURE GETMOREOLAYDISK(MIX);% 06400000
VALUE MIX;% 06401000
INTEGER MIX;% 06402000
BEGIN INTEGER I=+1,% 06403000
J=+2,% 06404000
T=+3;% 06405000
ARRAY A=+4[*];% 06406000
REAL MSCW=-2; 06406500
REAL RCW=+0;% 06407000
LABEL EXIT;% 06408000
DEFINE DALOCMAXSZ = 06408100
$ SET OMIT = NOT(AUXMEM) 06408199
$ SET OMIT = AUXMEM 06408299
127#; %DALOC SIZE MUST = 9 INIITALLY. 06408300
$ POP OMIT 06408301
P(0, 0, 0, 0); TOGLE ~ TOGLE OR STACKMASK;% 06410000
IF (T~DALOC[MIX,0].[CF]+1)=DALOCMAXSZ THEN BEGIN 06411000
TERMINATE (MIX&111[CTF]); %517-06411010
GO TO EXIT; END; 06411030
IF T=DALOCROW[MIX].[8:10] THEN% 06412000
BEGIN IF (J~T+P(DUP) - 1)=129 THEN J~DALOCMAXSZ; 06413000
WHILE (I := GETSPACE(J, 0, 3)+2)=2 DO 06414000
SLEEP([CLOCK], NOT CLOCK); 06415000
MOVE(T, DALOCROW[MIX], I); 06416000
FORGETSPACE(DALOCROW[MIX]); 06417000
DALOCROW[MIX] := (*P(DUP)) & I[CTC] & J[8:38:10]; 06417500
M[I-2].[9:6] := MIX; 06418000
END AIT TYPE ACTION;% 06419000
IF (I ~ GETUSERDISK(500 OR MEMORY))=0 THEN GO TO EXIT;% 06420000
DALOC[MIX,0] ~ (*P(DUP))&(T+1)[CTC];% 06421000
DALOC[MIX,T] ~ I;% 06422000
DALOC[MIX,T+1] ~ 0;% 06423000
EXIT: OLAYMASK ~ TWO(MIX) OR OLAYMASK;% 06424000
KILL([MSCW]); 06425000
END GET MORE OVERLAY DISK FOR A MIX INDEX;% 06426000
REAL PROCEDURE SECURITYCHECK(MID,FID,USERID,HEADER); 06460000
VALUE MID,FID,USERID; 06460100
REAL MID,FID,USERID,HEADER; 06460200
% MID MULTI FILE ID OF FILE TO BE CHECKED 06460300
% FID FILE ID OF FILE TO BE CHECKED 06460400
% USERID USER IDENTIFICATION 06460500
% HEADER 06460600
% >512 CORE ADDRESS OF HEADER IN 33:15. JUST CHECK IT. 06460700
% >0, <512 VALUE FOR DIRECTORYSEARCH, FIND THE FILE AND PASS 06460800
% BACK THE HEADER IN ADDITION TO SECURITY INFO. 06460900
% <0 DISK ADDRESS OF HEADER. READ IT IN AND CHECK IT, BUT 06460950
% DONT PASS IT BACK. 06460960
% 06461100
% RESULT FROM SECURITYCHECK 06461200
% =0 NO LEGITIMATE USER FOUND 06461300
% =2 TERTIARY USER ( INPUT ONLY) 06461400
% =3 SECONDARY USER (INPUT/OUTPUT) 06461500
% =7 PRIMARY USER (INPUT/OUTPUT/LIB MAINT.) 06461600
BEGIN 06462000
REAL T2,DKSGROW,CODES,ROWS,ROW,DKADR,ROWSZ,C,USER,TYPE,SH; 06462100
REAL I=DKSGROW, FPBSIZE=CODES; 06462105
ARRAY FH[*],FPB=ROW[*]; 06462110
LABEL FOUND; 06462120
LABEL EXYT,NOTFOUND,LOOK,WHY,FORGET; 06462200
REAL SUBROUTINE DIRSRH; 06463000
BEGIN 06463100
LOOK: IF (T2:=DIRECTORYSEARCH(MID,FID,HEADER)) LSS 64 THEN 06463200
WHY: BEGIN 06463210
IF T2=0 THEN FILEMESS("#NO FIL","ON DISK",MID,FID,0,0,0) 06463220
ELSE IF T2=1 THEN BEGIN P(DEL); TYPE:=-1; GO EXYT; END 06463225
ELSE IF T2=2 THEN FILEMESS("#SYSFIL","ERROR ", 06463230
MID,FID,0,0,0); 06463240
IF AUTODS THEN TERMINATE(P1MIX&61[CTF]) ELSE %747-06463260
BEGIN %747-06463270
REPLY[P1MIX]:=-(SH:=VWY&VOK[36:42:6]&VIL[30:42:6]); 06463280
COMPLEXSLEEP((REPLY[P1MIX] GTR 0) OR TERMSET(P1MIX)); 06463300
END; 06463310
IF TERMSET(P1MIX) THEN GO INITIATE; 06463340
IF NOT WHYSLEEP(SH) THEN GO TO WHY; 06463360
IF (SH~T2~REPLY[P1MIX].[FF]) > PSEUDOMAXT THEN % IL%540-06463380
BEGIN STREAM(T2:); 06463400
BEGIN SI:=T2; 06463420
LL: SI:=SI+1; IF SC!"L" THEN GO TO LL; 06463440
SI:=SI+1; T2:=SI; 06463460
END; 06463480
T2:=P; 06463500
FPBSIZE:=(FPB:=PRT[P1MIX,3]).[8:10]; 06463520
FOR I:=0 STEP ETRLNG UNTIL FPBSIZE DO 06463540
IF (FPB[I] EQV MID)=NOT 0 THEN 06463560
IF (FPB[I+1] EQV ABS(FID))=NOT 0 THEN GO FOUND; 06463580
FOUND: NAMEID(C,T2); MID:=C; NAMEID(C,T2); 06463600
NAMEID(C,T2); FID:=C&FID[1:1:1]; 06463620
IF I LSS 1020 THEN 06463640
BEGIN FPB[I]:=MID; 06463660
FPB[I+1]:=C; 06463680
END; 06463700
FORGETSPACE(SH-1); 06463720
END ELSE LABELTABLE[T2]:=-(*P(DUP)); %764-06463740
REPLY[P1MIX]:=0; 06463760
GO TO LOOK; 06463780
END; 06463800
DIRSRH := T2; 06463810
END DIRSRH; 06463820
IF HEADER GEQ 0 THEN 06463840
SH:=IF HEADER GTR 511 THEN HEADER ELSE DIRSRH 06463860
ELSE DISKWAIT(-(SH:=SPACE(30)),30,HEADER.[CF]); 06463880
FH:=IOQUE&SH[CTC]; 06463900
IF(FH[2] EQV 0)=NOT 0 OR (ABS(USERID) EQV ABS(FH[2]))=NOT 0 06463910
OR (USERID EQV MCP)=NOT 0 THEN TYPE+7 ELSE% 06463920
IF HEADER<0 THEN GO EXYT ELSE 06463925
IF (FH[5] EQV @14)=NOT 0 THEN% 06463930
IF (FH[6] EQV @14)=NOT 0 THEN TYPE~2 ELSE TYPE~3;% 06463940
IF TYPE ~ 0 THEN GO TO EXYT; 06463950
IF FH[5].[1:1] THEN 06463960
BEGIN IF (SH:=DIRECTORYSEARCH(ABS(FH[5]),FH[6],19))=0 06463970
THEN BEGIN TYPE:=0; GO TO EXYT END; 06463980
M[SH+4].[11:1]:=1; 06463982
STREAM(DATE,J:=5); BEGIN SI:=LOC DATE; DS:=8OCT; END; 06463984
M[SH+3].[12:18]:=JUNK; 06463986
DISKWAIT(SH.[CF],-30,SH.[FF]); 06463988
$ SET OMIT = SHAREDISK 06463990
UNLOCKDIRECTORY; 06463992
$ POP OMIT 06463994
DKSGROW:=M[SH INX 8]; 06463996
CODES:=SPACE(30); 06464000
ROWS:=(M[SH INX 9] AND 31)-1; 06464050
FOR ROW:=0 STEP 1 UNTIL ROWS DO 06464100
BEGIN IF (DKADR:=M[SH INX 10+ROW])=0 THEN 06464200
NOTFOUND: BEGIN TYPE := 0; 06464300
FORGETSPACE(CODES); FORGETSPACE(SH);GO TO EXYT; 06464400
END; 06464500
ROWSZ := DKADR + DKSGROW; 06464600
WHILE DKADR < ROWSZ DO 06464700
BEGIN DISKIO(C,1-CODES,30,DKADR); 06464800
SLEEP([C],IOMASK); 06464900
FOR C:=0 STEP 1 UNTIL 29 DO 06465000
BEGIN IF((USER:=NFLAG(M[CODES INX C]))EQV @114= 06465100
NOT 0 THEN GO TO NOTFOUND; 06465200
IF (USER EQV @14)! NOT 0 THEN 06465210
IF USER.[3:3]=0 THEN 06465220
BEGIN 06465230
IF (USERID EQV ABS(USER))=NOT 0 THEN 06465300
BEGIN TYPE := 06465400
IF USER < 0 THEN 2 ELSE 3; 06465500
GO TO FORGET; 06465600
END; 06465700
END ELSE 06465800
BEGIN 06465805
IF P1MIX ! 0 THEN 06465810
IF (ABS)JAR[P1MIX,0])EQV 06465820
USER.[6:42])= NOT 0 THEN 06465830
IF((IF JAR[P1MIX,0]<0 THEN "DISK "ELSE JAR[P1MIX,1])EQV 06465840
M[CODES INX C+1].[6:42])= NOT 0 06465850
THEN 06465860
BEGIN 06465870
TYPE := USER.[3:3]; 06465880
GO TO FORGET; 06465900
END; C:=C+1; 06465910
END; 06465920
END; % 30 USERS 06466000
DKADR := DKADR + 1; 06466100
END; % ROW 06466200
END; % ROWS 06466300
GO TO NOTFOUND; 06466310
END; % NO SECURITY BLOCK FILE 06466400
TYPE :=0; 06466500
EXYT: 06466600
IF HEADER LSS 512 THEN 06466610
IF HEADER GEQ 0 THEN HEADER:=FH ELSE FORGETSPACE(FH); 06466620
SECURITYCHECK :=TYPE; 06466700
END SECURITYCHECK; 06467500
$ SET OMIT = NOT(DATACOM ) 06499999
% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *%JS06845900
$ SET OMIT = NOT(DCLOG AND DATACOM ) 06845999
DEFINE KLULMP=@174#; @173 IS RESERVED FOR THE DISK ADDRESS 07000000
COMMENT LASTCDNUM, FIRSTDECK, AND LASTDECK ARE STORED IN THE 07000010
FIRST THREE WORDS OF THE DISK SEGMENT LOCATED AT DIRECTORYTOP 07000015
+3. IN A NON SHARED DISK SYSTEM, THEY ARE WRITTEN OUT EACH 07000020
TIME ONE OF THEM IS CHANGED SO THAT THEY WILL BE PRESERVED 07000025
IF A HALT/LOAD OCCURS. N A SHARED DISK SYSTEM, THEY ARE 07000030
READ INTO THE PRT WITH A READ-LOCK COMMAND EACH TIME THEY ARE 07000035
USED. THIS PROVIDES CONTROL DECK INTERLOCKING BETWEEN SYSTEMS 07000040
IN ADDITION TO PASSING THE INFORMATION BETWEEN SYSTEMS. 07000045
END COMMENT; 07000050
INTEGER LASTCDNUM=@174; 07000100
REAL FIRSTDECK=@175; 07000200
REAL LASTDECK=@176; 07000300
DEFINE LOCKCONTROLDECKS=BEGIN SLEEP([TOGLE],CDMASK); LOCKTOG(CDMASK); 07001000
$ SET OMIT = NOT(SHAREDISK) 07001099
END#, 07001200
UNLOCK(CONTROLDECKS=BEGIN 07001300
$ SET OMIT = NOT(SHAREDISK) 07001399
UNLOCKTOG(CDMASK) END#; 07001500
REAL PROCEDURE NEXTCDNUM(UPDATE); VALUE UPDATE; BOOLEAN UPDATE; 07001600
BEGIN 07001620
LOCKCONTROLDECKS; 07001640
LASTCDNUM := (LASTCDNUM MOD 9999) + 1; 07001660
STREAM(CDNUM:=0; LNUM:=LASTCDNUM); 07001680
BEGIN 07001700
SI:=LOC LNUM; DI:=LOC CDNUM; DS:=8 DEC; 07001720
END; 07001740
NEXTCDNUM := P; 07001760
IF UPDATE THEN 07001780
BEGIN 07001800
DISKWAIT(KLUMP,-3,DIRECTORYTOP+3); 07001820
UNLOCKTOG(CDMASK); 07001840
END; 07001860
END; 07001880
PROCEDURE STARTADECK(N); VALUE N; REAL N; FORWARD; 07002000
PROCEDURE ENTERCONTROLDECK(H); VALUE H; ARRAY H[*]; FORWARD; 07002100
REAL RUNNUMBER;% 07003000
%891-07003250
%#######################################################################07003251
%891-07003252
PROCEDURE EBTABLE; %890-07003270
BEGIN LABEL L; %890-07003280
P(0,XIT,.L,DEL); %890-07003290
L::: %890-07003300
0," 32?","1???","0TS?","/???","-LK?","J???","????","????","&CB?","A???",07003310
"!???","????","????","????","????",""????", %890-07003312
"9???","????","Z???","????","R???","????","????","????","I???","????", 07003320
"????","????","????","????","????","????", %890-07003322
"8#:?","????","Y,|?","????","Q$]?","????","????","????","H.[?","????", 07003330
"????","????","????","????","????","????", %890-07003332
@07770675,@05770413,@067146616,@65176473, %892-07003340
@47574656,@45554453,"????","????", @27742620,@25352436, %890-07003342
"????","????","????","????","????","????", %891-07003344
%QMARKADDRESSES %890-07003350
"????","????","????","????","????","????","????","????","????","????", 07003352
"????","????","????","????","????","????", %890-07003354
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, % SPACE FOR ADDRESSES %890-07003360
0,0,0,0,0,0,0; %890-07003370
END; %890-07003380
%891-07003390
%#######################################################################07003391
%891-07003392
PROCEDURE SETUPEBTABLE; %890-07003400
BEGIN REAL ADR; LABEL EXIT; %890-07003410
DEFINE STOREADDRESS= %890-07003412
X:=SI; SI:=LOC X; SI:=SI+5; %890-07003414
DS:=3 CHR; DI:=DI+5 #; %890-07003416
EBTABLE; %890-07003420
P([M[(ADR:=*P(.EBTABLE) INX NOT 1)]],IOR); %890-07003430
SETUPEBTABLE:=ADR:=ADR.[CF]+3; %890-07003440
IF M[ADR+81] = 0 THEN %890-07003450
STREAM (X:=0,TABLE:=ADR,QMARKTABLEADDRESS:=ADR+32,LOCATIONS:=ADR+40); 07003462
BEGIN %890-07003464
DI:=TABLE; SI:=TABLE; SI:=SI+8; %890-07003466
2(40(SI:=SI+4; DS:=4 CHR;)); %890-07003468
%FIRST FILL ALL OF ADDRESSES WITH ADDRESS OF ?S %890-07003482
SI:=QMARKTABLEADDRESS; %890-07003484
X:=SI; %890-07003486
SI:=LOC X; SI:=SI+5; %POINT SI AT ADDRESS OF QMARKS %890-07003488
DI:=LOCATIONS; %890-07003490
DS:=3 CHR; %890-07003492
SI:=LOCATIONS; %890-07003494
DS:=63 WDS; %890-07003496
%NOW SET ADDRESSES FOR VALID CHARS INTO EBCDIC TABLE %890-07003498
SI:=TABLE; %890-07003500
DI:=LOCATIONS; %890-07003502
3(STOREADDRESS; %STORE ADDRESSES FOR LP=0,1,2 %890-07003504
%CORRESPONDING TO BLANK,9 HOLE,8 HOLE %890-07003506
SI:=X; %890-07003508
SI:=SI+63; SI:=SI+1); %SKIP 8 WORDS DOWN TABLE %890-07003510
DI:=DI+8; %LP=3 IN INVALID %890-07003512
STOREADDRESS; %LP=4..... 7 HOLE %890-07003514
DI:=DI+8; %LP=5 IS INVALID %890-07003516
SI:=X; %890-07003518
SI:=SI+1; %SKIP 1 CHAR DOWN TABLE %890-07003520
STOREADDRESS; %LP=6....7&8 HOLES TOGETHER %890-07003522
DI:=DI+8; %890-07003524
SI:=X; %890-07003526
SI:=SI+1; %890-07003528
STOREADDRESS; %LP=8....6 HOLE %890-07003530
DI:=DI+8; %890-07003532
SI:=X; %890-07003534
SI:=SI+1; %890-07003536
STOREADDRESS; %LP=10....6&8 HOLES TOGETHER %890-07003538
SI:=DI+40; %MISS 5 WORDS...LP=11,12,13,14,15 %890-07003540
SI:=X; %890-07003542
SI:=SI+1; %890-07003544
STOREADDRESS; %LP:=16.... 5 HOLE %890-07003546
DI:=DI+8; %890-07003548
SI:=X; %890-07003550
SI:=SI+1; %890-07003552
STOREADDRESS; %LP=18.... 5&8 HOLES TOGETHER %890-07003554
2(DI:=DI+52); %MISS 13 WORDS....LP=19-31 %890-07003556
SI:=X; %890-07003558
SI:=SI+1; %890-07003560
STOREADDRESS; %LP=32..... 4 HOLE %890-07003562
DI:=DI+8; %890-07003564
SI:=X; %890-07003566
SI:=SI+1; %890-07003568
STOREADDRESS; %LP=34...... 4&8 HOLES TOGETHER %890-07003570
END; %890-07003580
END; %890-07003590
%***********************************************************************07003600
STREAM PROCEDURE EBCDICCONVERT(INTO,TABLE,POINTERS); %890-07003610
VALUE INTO,TABLE,POINTERS; %890-07003615
%***********************************************************************07003620
BEGIN %890-07003630
LOCAL HP,LP,SRCE,DEST,HPPTR,LPPTR; %890-07003640
%POINT HPPTR & LPPTR TO LAST CHAR OF HP,LP %890-07003650
SI:=LOC HP; %890-07003660
SI:=SI+7; %890-07003670
HPPTR:=SI; %HIGH PART %890-07003680
SI:=LOC LP; %890-07003690
SI:=SI+7; %890-07003700
LPPTR:=SI; %LOW PART %890-07003710
SI:=INTO; SI:=SI+8; %890-07003720
DI:=INTO; %890-07003730
%START CHARACTER TRANSLATE LOOP %890-07003740
2(40( %890-07003750
DEST:=DI; %890-07003760
%TRANSFER LOW & HIGH PARTS %890-07003770
DI:=HPPTR; %890-07003780
DS:=1 CHR; %890-07003790
DI:=LPPTR; %890-07003800
DS:=1 CHR; %890-07003810
SRCE:=SI; %STORE SI FOR NEXT PASS THRU LOOP %890-07003820
%NOW FIND THE POINTER INTO TABLE APPROPRIATE TO LP %890-07003830
SI:=POINTERS; %890-07003840
LP(SI:=SI+8); %890-07003860
SI:=SC; %SI NOW POINTS INTO TABLE @ POINT DEPENDANT ON LP %890-07003870
DI:=DEST; %890-07003880
SI:=SI+HP; %SKIP SI THROUGH TABLE HP CHARS %890-07003890
DS:=CHR; %890-07003900
SI:=SRCE)); %890-07003910
DI:=TABLE; DI:=DI+3; %POINT TO QMRK %890-07003920
END CONVERT; %890-07003950
PROCEDURE COM23;% 07004000
BEGIN% 07005000
REAL INBUFF,% ADDRESS OF THE INPUT BUFFER. 07006000
OUTBUFF,% " " " OUTPUT BUFFER. 07006010
FIRSTCARD,% " " " CARD IMAGE OF THE FIRST CARD 07006020
OUTBUFFOLD,% " " " LAST OUTPUT BUFFER. 07006030
RESERVE,% " " 30 WDS OF CORE USED TO BUILD THE 07006040
T,T1,T2,% TEMPORARY VARIABLES. 07006050
R,L,N,% " " USED TO COUNT CARD IMAG 07006060
Q,% USUALLY INDICATES COL 1 HAS A QUESTION MARK 07006070
IU,% UNIT NUMBER OF THE INPUT UNIT. 07006080
OU,% " " " " OUTPUT UNIT. 07006090
FIRST,% TRUE IF THE FIRST CARD OF A DECK. 07006100
S,% USED AS A TEMPROARY VARIABLE IN SUBROUTINE 07006140
% AND TO HAND THE UNIT NUMBER TO SUBROUTINE S 07006150
D;% USED AS A MASK TO SLEEP UNTIL DISK OPERATIO 07006160
% ARE COMPLETED. 07006161
$ SET OMIT = NOT(PACKETS) 07006169
REAL VERYFIRST, %TRUE IF THE FIRST CARD OF THE FIRST DECK 07006172
%IN SINCE LOAD CONTROL WAS EXECUTED. 07006174
FIRSTORSEC, %TRUE IF THE FIRST OR SEC. CARD OF NEW DECK 07006176
PTYPE,% CONTAINS THE RESULT OF REAL SUBROUTINE 07006180
% PACKETCARD.SAVING SOME NEEDLESS EXTRA 07006190
% CALLS ON IT TO CHECK THE TYPE OF A CARD. 07006200
% THE VALUE OF PTYPE IS AS FOLLOWS: 07006210
% 0 = NOT A PACKET CONTROL CARD 07006220
% 1 = "PACKEND"CARD, (USED BY THE 07006230
% OPERATORS TO END A GROUP 07006240
% OF PACKETS BEING LOADED TO 07006250
% DISK) 07006260
% 3 = "PACKET" CARD,(FIRST CARD 07006270
% OF A PACKET) 07006280
% 5 = "END PACKETS" CARD, (USED BY 07006290
% THE OPERATORS TO BOTH END 07006300
% A GROUP OF PACKETS AND 07006310
% SIMULTANEOUSLY DISCONTINUE 07006320
% LOAD CONTROL). 07006330
PLUGGED;% TRUE IF THE LAST "PACKET" CARD(I.E., 07006340
% PTYPE=3), WAS BOTH THE START OF A NEW 07006350
% PACKET AND WAS USED TO "PLUG" THE END 07006360
% OF THE LAST PACKET WITH AN ARTIFICIAL 07006370
% "-QUESTION MARK- PACKET." CARD; 07007000
$ POP OMIT 07007001
BOOLEAN CDONLY; 07007100
INTEGER A,I;% 07008000
$ SET OMIT = NOT(PACKETS) 07008199
REAL CONTINUE,DISKCHAIN,ADECK; LABEL OK; 07008200
$ POP OMIT 07008251
LABEL AGAIN,INL,ERROR,SUPER,BOMB,SKIPIT,EXIT; 07009000
LABEL INPUTL; 07009100
BOOLEAN EBCDIC; REAL EBTABLEADR; %890-07009200
ARRAY FPB[*],H[*];% 07010000
SUBROUTINE STOP;% 07011000
BEGIN IF S ! 18 THEN% 07012000
BEGIN READY ~ NOT(Q ~ TWO(S)) AND READY;% 07013000
RRRMECH ~ NOT Q AND RRRMECH OR Q AND SAVEWORD;% 07014000
LABELTABLE[S] ~ @114;% 07015000
RDCTABLE[S] ~ MULTITABLE[S] ~ 0% 07016000
END;% 07017000
FPB[T+1]~ *P(DUP)+CLOCK+P(RTR);% 07018000
FPB[T].[24:12] ~ TINU[S].[18:12];% 07019000
TINU[S].[18:12]:=0; 07020000
END;% 07021000
$ SET OMIT = PACKETS 07021999
$ SET OMIT = NOT(PACKETS) 07022099
SUBROUTINE FORGETONE; 07022100
$ POP OMIT 07022101
BEGIN T1 ~ H[9]+9;% 07023000
FOR T2 ~ 10 STEP 1 UNTIL T1 DO% 07024000
FORGETUSERDISK(H[T2],-H[8]); 07025000
END;% 07026000
$ SET OMIT = NOT(PACKETS) 07026099
SUBROUTINE FORGETIT; 07026100
BEGIN FORGETONE; 07026200
WHILE DISKCHAIN NEQ 0 DO 07026300
BEGIN DISKWAIT(-(H INX 0),30,DISKCHAIN); 07026400
DISKCHAIN:=H[6].[FF]; 07026500
FORGETONE; 07026600
END; 07026700
END FORGETIT; 07026800
$ POP OMIT 07026801
SUBROUTINE BOMBTIME;% 07027000
BEGIN WHILE STOPSET(P1MIX) DO STOPM(FALSE); 07028000
IF TERMSET(P1MIX) THEN GO BOMB; END; 07028100
$ SET OMIT = NOT(PACKETS) 07028999
REAL SUBROUTINE PACKETCARD;% THIS USED TO BE "ENDCARD" 07029000
BEGIN IF Q THEN% 07030000
BEGIN;% 07031000
IF EBCDIC THEN %890-07031200
BEGIN %890-07031300
EBCDIC:=FALSE; %890-07031400
M[(*P(.EBTABLE) INX NOT 1)].[2:1]:=0; %890-07031500
END; %890-07031600
STREAM(X:="PACKETS":Y:="CONTINU",Z:="END. ", %890-07032000
EB:="DATA029",INBUFF); %890-07032100
BEGIN SI ~ INBUFF;% 07033000
L: SI ~ SI+1; IF SC = " " THEN GO TO L;% 07034000
INBUFF:=SI; %890-07034500
DI~LOC X; DI~DI+1;% POINT TO "PACKETS" 07035000
IF 4SC=DC THEN% A "PACKET" OR "PACKEND" CARD 07036000
IF 2SC=DC THEN TALLY~3% A "PACKET" CARD 07036100
ELSE TALLY~1% A "PACKEND" CARD 07036150
ELSE BEGIN DI~DI-4;% POINT TO "PACKETS" 07036200
IF 7 SC=DC THEN TALLY:=5 %"END PACKET" 07036210
ELSE BEGIN SI:=INBUFF;DI:=LOC Y; %890-07036220
DI:=DI+1;IF 7SC=DC THEN TALLY:=6 07036230
ELSE BEGIN DI:=LOC Z;DI:=DI+1; 07036240
SI:=INBUFF; %890-07036250
IF 3 SC=DC THEN TALLY:=7 %890-07036260
ELSE BEGIN %890-07036270
DI:=LOC EB;DI:=DI+1 %890-07036280
SI:=INBUFF; 07036290
IF 6 SC=DC THEN %890-07036300
$VOID %890-07036310
TALLY:=4; 07036320
$ VOID 07036351 %890-07036330
END END END; %890-07036390
END;% 07036400
X ~ TALLY;% 07037000
END;% 07038000
END ELSE P(0);% 07039000
PTYPE:=P; 07039100
IF PTYPE=6 THEN BEGIN PTYPE:=3; CONTINUE:=TRUE END 07039200
ELSE CONTINUE:=FALSE; 07039300
IF PTYPE=7 THEN PTYPE:=ADECK; 07039410
IF PTYPE = 4 THEN %890-07039500
BEGIN PTYPE:=0; EBCDIC:=TRUE; %890-07039600
EBTABLEADR:=SETUPEBTABLE; %890-07039700
END; %890-07039800
PACKETCARD:=PTYPE; 07040000
END;% 07041000
$ POP OMIT 07041001
$ SET OMIT = PACKETS 07041099
REAL SUBROUTINE ADR;% 07042000
BEGIN IF (T2 ~ H[(T1 ~ R DIV 200)+10]) = 0 THEN% 07043000
BEGIN H[9] ~ T1+1;% 07044000
H[T1+10] ~ T2 ~ GETUSERDISK(200);% 07045000
END;% 07046000
ADR ~ R MOD 200+T2% 07047000
END;% 07048000
SUBROUTINE INPUT;% 07049000
BEGIN% 07050000
IF IU < 16 THEN% 07051000
$ SET OMIT = NOT(PACKETS) 07051099
BEGIN 07051100
INPUTL: T ! WAITIO (@120540000000 + INBUFF, 07051110
@6000040, IU); 07051120
IF T=@40 THEN GO TO INPUTL; 07051130
IF T!0 THEN 07051140
BEGIN 07051150
P(DEL); 07051160
GO TO ERROR 07051170
END; 07051180
$ POP OMIT 07051181
$ SET OMIT = PACKETS 07051999
Q ~ M[INBUFF-1]=9;% 07057000
END% 07058000
ELSE BEGIN WHILE(Q:=WAITIO(@40000000+INBUFF+ %890-07059000
EBCDIC|@400000001,FIRST|4+ %890-07059010
@4000000,IU).[45:1] DO 07059100
IF FIRST AND CDONLY AND NOT CONTINUE THEN %654-07059110
GO EXIT ELSE %654-07059112
BEGIN SLEEP([TOGLE],STATUSMASK); 07059200
RRRMECH~RRRMECH AND NOT Q~TWO(IU); 07059300
READY~READY AND NOT Q; 07059400
SLEEP([READY],Q); 07059500
END; 07060000
IF EBCDIC THEN EBCDICCONVERT(INBUFF, %890-07060100
EBTABLEADR,EBTABLEADR+40) ELSE %890-07060200
IF Q ~ Q ! 0 THEN 07061000
BEGIN S:=(T:=UNIT[IU]).[FF]; 07062000
RETURNIOSPACE(S); 07063000
UNIT[IU] ~ T&@77777[5:20:28]; 07065000
END;% 07066000
STREAM(QMK:=12:BCL:=1-EBCDIC,INBUFF); %890-07066100
BEGIN %890-07066200
SI:=INBUFF; %890-07066300
BCL (IF SC=""" THEN JUMP OUT TO L1); 07066350
IF SC=@14 THEN %890-07066400
L1: BEGIN SI:=LOC QMK;SI:=SI+7; %890-07066500
DS:=1 CHR; %890-07066550
TALLY:=1; %890-07066600
SI:=INBUFF; %890-07066610
2(36(IF SC=">" THEN %890-07066620
BEGIN INBUFF:=SI; DI:=INBUFF; %890-07066630
DS:=LIT "="; %890-07066635
END; %890-07066640
IF SC="}" THEN %890-07066650
BEGIN INBUFF:=SI; DI:=INBUFF; %890-07066660
DS:= LIT """ %890-07066665
END; SI:=SI+1;)) %890-07066670
END; %890-07066700
QMK :=TALLY; %890-07066800
END; %890-07066850
Q:=P OR Q; %890-07066900
T = 0;% 07067000
END;% 07068000
END INPUT; % -07069000
%---------------- COM23 ------------------- -07069200
$ SET UP INPUT VARIABLES% 07071000
IF CDONLY:=(PRT[P1MIX,@25]>22) THEN 07072000
BEGIN IU:=PRT[P1MIX,@25]; 07072100
PRT[P1MIX,@25]:=0; % DISK 07072200
END ELSE 07072300
BEGIN IF (IU:=FINDINPUT("CONTROL","DECK ",0,0,0,0,0,0, 07072400
0,0)) LSS 0 THEN GO INITIATE; % BEEN DS-ED 07072500
IF IU GEQ 32 THEN P(XIT); % EOJ IF PSEUDODCK07072600
END; 07072700
STARTIMING(0,IU); 07073000
FPB:=PRT[P1MIX,3]; 07073500
$ SET OMIT = PACKETS 07073999
IF NOT(JAR[P1MIX,9].[2:1]) THEN % DONT SUPPRESS MESSAGE 07074090
FILEMESSAGE(" IN "&TINU[IU][6:30:18],0, 07074100
"CONTROL","DECK ",0,0,0,OPNMESS); 07074200
RDCTABLE[IU].[8:6] ~ P1MIX;% 07075000
IF IU LSS 16 THEN BEGIN% 07076000
FPB[3].[23:1]:=1; %SET INPUT FLAG FOR LOG 07076010
T ~ WAITIO(@540000005,0,IU)% 07077000
END% 07077010
ELSE IF IU=23 AND READERA NEQ 0 THEN 07078000
BEGIN FORGETSPACE(READERA-2);% 07079000
READERA ~ 0;% 07080000
END% 07081000
ELSE IF IU=24 AND READERB NEQ 0 THEN 07082000
BEGIN FORGETSPACE(READERB-2);% 07083000
READERB ~ 0;% 07084000
END;% 07085000
$ VOIDT %890-07086000
FIRSTCARD ~ GETSPACE(10,CONTROLCARDAREAV,1)_2);% %167-07087000
% SET UP OUTPUT VARIABLES% 07088000
IF PRT[P1MIX,@25] THEN% 07089000
BEGIN OU ~ LABELASCRATCH(T ~% 07090000
TAPELABEL("CONTROL","DECK ",1,1,100));% 07091000
IF OU<0 THEN GO INITIATE; %BEEN DS-ED 07091100
FORGETSPACE(I);% 07093000
FPB[3].[23:1]:=0; %SET OUTPUT FLAG FOR LOG 07093010
END% 07094000
ELSE BEGIN OUTBUFFOLD ~ OUTBUFF ~% %167-07095000
GETSPACE(60,IOBUFERAREAV,1)+2;% %167-07095100
RESERVE ~ GETSPACE(30,0,1)+2;% 07096000
H := SAVEARRAYDESC(30,DISKHEADERAREAV); %167-07097000
OU ~ 18;% 07098000
INBUFF ~ GETSPACE(21,IOBUFFERAREAV,1) + 2; %892-07101000
END;% 07103000
STARTIMING(5,OU); 07104000
FPB:=PRT[P1MIX,3]; % STARTIMING MAY HAVE MOVED IT. 07104500
$ SET OMIT = NOT(PACKETS) 07105499
VERYFIRST~1;% 07105500
$ POP OMIT 07105501
% BEGIN ONE DECK% 07106000
AGAIN: OUTBUF ~ OUTBUFFOLD;% 07107000
L ~ N ~ 0;% 07108000
$ SET OMIT = NOT(PACKETS) 07108099
ADECK ~ 0; FIRSTORSEC ~ %178-07108100
$ POP OMIT 07108101
FIRST ~ D ~ 1; 07109000
IF OU = 18 THEN% 07110000
BEGIN H[ 9] ~ 0;% 07111000
MOVE(20,[H[9]],[H[10]]); 07112000
H[8]~200; 07112100
END;% 07113000
% BEGIN ONE CARD% 07114000
INL: 07115000
$ SET OMIT = NOT(PACKETS) 07115099
IF PTYPE NEQ 3 OR VERYFIRST THEN 07115100
$ POP OMIT 07115101
INPUT; 07115200
$ SET OMIT = NOT(PACKETS) 07115499
IF FIRSTORSEC THEN% 07115500
$ POP OMIT 07115501
IF FIRST THEN% 07116000
BEGIN 07117000
$ SET OMIT = NOT(PACKETS) 07117099
PLUGGED:=VERYFIRST; 07117100
$ POP OMIT 07117101
$ SET OMIT = PACKETS 07117199
MOVE(10,INBUFF,FIRSTCARD);% 07118000
$ SET OMIT = NOT(PACKETS) 07118099
IF PACKETCARD=5 THEN %124-07118500
IF OU<16 THEN FIRST:=VERYFIRST:=0 ELSE 07118510
GO TO EXIT ELSE 07118520
IF PTYPE!3 OR CONTINUE THEN 07118550
BEGIN 07118600
ADECK:=1; GO DK; 07118690
END; 07118700
END ELSE% THIS MUST BE THE SECOND CARD IN 07119000
$ POP OMIT 07119001
$ SET OMIT = PACKETS 07119009
$ SET OMIT = NOT(PACKETS) 07119099
DK: IF Q THEN FIRSTORSEC:=0 ELSE%BAD SEC./FIRST 07119100
BEGIN VERYFIRST+4; % CARD 07119200
GO TO ERROR;% 07119300
END;% INV DECK SET-UP 07119400
$ POP OMIT 07119401
IF T NEQ 0 THEN 07120000
$ SET OMIT = NOT(PACKETS) 07120009
IF PTYPE NEQ 3 OR VERYFIRST THEN 07120010
$ POP OMIT 07120011
GO TO ERROR; 07120020
BOMBTIME;% 07121000
IF OU < 16 THEN % OUTPUT TO TAPE ( OU = 18 NORMALLY) -07122000
BEGIN 07122010
$ SET OMIT = NOT(PACKETS) 07122999
PLUGGED ~ VERYFIRST OR (PACKETCARD!3) 07123500
OR FIRST; 07124000
IF PLUGGED THEN 07124500
$ POP OMIT 07124501
T~WAITIO(INBUFF&@5000[18:33:15] 07125000
&(10-Q)[8:38:10],0,OU); 07125500
$ SET OMIT = PACKETS 07125599
$ SET OMIT = NOT(PACKETS) 07125999
IF VERYFIRST THEN VERYFIRST~PTYPE~0; 07126000
IF FIRST THEN FIRST~PTYPE~0; 07126500
IF PTYPE=0 THEN GO TO INL; 07127000
$ POP OMIT 07127001
M[INBUFF-1] ~ @1737000000000000; 07127500
T ~ WAITIO(INBUFF-1,0,OU); 07128000
SUPER:: 07129000
$ SET OMIT = NOT(PACKETS) 07129099
IF PTYPE=5 THEN GO TO EXIT; 07129100
IF PTYPE=1 THEN VERYFIRST:=TRUE; 07129200
GO TO AGAIN; 07129300
$ POP OMIT 07129301
$ SET OMIT = PACKETS 07129999
END;% 07139000
IF D = 0 THEN SLEEP([D],NOT 0); 07139500
$ SET OMIT = NOT(PACKETS) 07139509
IF PACKETCARD NEQ 0 AND NOT(ADECK AND PTYPE=1) THEN 07139510
BEGIN IF NOT(PLUGGED OR FIRST) THEN% 07139511
BEGIN STREAM(D~OUTBUFF); BEGIN DS~27 LIT 07139512
"CC END...IN CASE YOUR FORGOT";DS~45LIT" " END; 07139513
IF PTYPE = 3 AND NOT CONTINUE AND NOT ADECK THEN %124-07139520
BEGIN STREAM(FIRSTCARD,T!T!SPACE(13)); 07139530
BEGIN DS~24LIT"#NO PACKEND CARD, PKT - "; SI~FIRSTCARD; 07139540
DS!9 WDS; DS~LIT"~"; 07139550
END; 07139560
SPOUT(T); 07139565
END; 07139570
END ELSE MOVE(10,INBUFF,OUTBUFF);% 07139575
END ELSE% 07139590
$ POP OMIT 07139591
MOVE(10,INBUFF,OUTBUFF);% 07140000
$ SET OMIT = NOT(PACKETS) 07140099
IF VERYFIRST THEN PLUGGED~0;% 07140100
$ POP OMIT 07140101
IF Q THEN% 07141000
BEGIN IF L DIV 6 ! N DIV 6 THEN% 07142000
BEGIN R ~ L DIV 3;% 07143000
A ~ ADR;% 07144000
DISKIO(T,1-RESERVE,30,A);% 07145000
SLEEP([T],IOMASK);% 07146000
M[I~L MOD 3|10+9+RESERVE] ~ N;% 07147000
DISKIO(T,RESERVE-1,30,A);% 07148000
SLEEP([T],IOMASK);% 07149000
END% 07150000
ELSE M[I ~(L-N)|10+9+OUTBUFF] ~ N;% 07151000
L ~ M[OUTBUFF+9] ~ N;% 07152000
END;% 07153000
IF N = 12000 THEN% 07154000
BEGIN I ~ SPACE(14);% 07155000
STREAM(FIRSTCARD,T); 07156000
BEGIN DS ~ 32 LIT% 07157000
$ SET OMIT = NOT(PACKETS) 07157099
"#MORE THAN 12000 CARDS IN PKT - "; 07157100
$ POP OMIT 07157101
$ SET OMIT = PACKETS 07157999
SI~FIRSTCARD;DS~9WDS;DS~LIT "~"; 07159000
END;% 07160000
GO TO SKIPIT; 07161000
END;% 07162000
IF (N ~ N+1) MOD 6 = 0 THEN% 07163000
BEGIN R ~ N DIV 3-2;% 07164000
A ~ ADR;% 07165000
OUTBUFF ~ OUTBUFFOLD;% 07166000
DISKIO(D,OUTBUFF-1,60,A); 07167000
END ELSE OUTBUFF ~ OUTBUFF+10;% 07169000
$ SET OMIT = NOT(PACKETS) 07169099
IF FIRST THEN FIRST~PTYPE~0;% 07169100
IF VERYFIRST THEN VERYFIRST:=PTYPE:=0; 07169110
$ POP OMIT 07169201
$ SET OMIT = NOT(PACKETS) 07169499
IF PTYPE=0 THEN GO INL; 07169500
$ POP OMIT 07169501
$ SET OMIT = PACKETS 07169999
IF D = 0 THEN SLEEP([D],NOT 0); 07171000
OUTBUFF ~ OUTBUFFOLD;% 07173000
R ~ N DIV 6|2;% 07174000
A ~ ADR;% 07175000
IF N MOD 6 ! 0 THEN 07175100
BEGIN 07175200
DISKIO(T,OUTBUFF-1,60,A);% 07176000
SLEEP([T],IOMASK);% 07177000
END;% 07178000
IF R+2 < 200 THEN 07178100
BEGIN H[8] ~ R+2; 07178200
FORGETUSERDISK(A+2,R-198); 07178300
END; 07178400
H[7]~N-1; 07179000
H[4]~H[6]~0; 07179050
H[5]:= -0; 07179100
$ SET OMIT = NOT(PACKETS) 07179199
H[6]~0&DISKCHAIN[CTF]&(IF IU<23 THEN 2 ELSE IU-23) 07179200
[2:42:6]; 07179202
IF CONTINUE THEN 07179205
BEGIN 07179210
H[2]:=NEXTCDNUM(1); 07179220
DISKCHAIN:=GETESPDISK; 07179230
DISKWAIT(H INX 0,30,DISKCHAIN); 07179250
STREAM(A:=H[2],B:=FIRSTCARD,INBUFF); 07179260
BEGIN SI:=B; DS:=8 CHR;DS:=15 LIT" CONTINUES PKT#"; 07179270
DS:=15 LIT" CONTINUES PKT#"; 07179280
SI:=LOC A; SI:=SI+4; DS:=4 CHR; DS:=LIT":"; 07179290
END; 07179300
END ELSE 07179310
BEGIN DISKCHAIN:=0; 07179320
$ POP OMIT 07179321
ENTERCONTROLDECK(H); 07180000
$ SET OMIT = NOT(PACKETS) 07180009
END; 07180010
$ POP OMIT 07180011
GO TO SUPER; 07181000
ERROR: T ~ SPACE(12);% 07214000
$ SET OMIT = NOT(PACKETS) 07214099
STREAM(FIRSTCARD,X~VERYFIRST,T);% 07214100
BEGIN SI~LOC X; SI~SI+7; IF SC="2" THEN 07214110
DS~16 LIT "#INV PKT CARD - "% 07214120
ELSE IF SC="4" THEN% 07214130
DS~16 LIT "#INV DECK,PKT - "% 07214140
ELSE DS~16 LIT "#READ ERR,PKT - ";% 07214150
$ POP OMIT 07214151
$ SET OMIT = PACKETS 07214999
SI ~ FIRSTCARD; DS ~ 9 WDS; DS ~ LIT "~";% 07217000
END;% 07218000
SKIPIT: SPOUT(T); 07219000
DO BEGIN INPUT;% 07220000
VOMVRIMW;% 07221000
$ SET OMIT = PACKETS 07221999
$ SET OMIT = NOT(PACKETS) 07222099
END UNTIL PACKETCARD NEQ 0; 07222100
$ POP OMIT 07222101
IF OU < 16 THEN% 07223000
BEGIN DO BEGIN T ~ WAITIO(@340000005,@60,OU);% 07224000
BOMBTIME;% 07225000
END UNTIL T.[42:1];% 07226000
T ~ WAITIO(@140000005,@60,OU);% 07227000
END;% 07228000
ELSE FORGETIT;% 07229000
GO TO SUPER;% 07230000
BOMB:: IF OU=18 THEN FORGETIT;% %164-07231000
EXIT: SLEEP([TOGLE]),STATUSMASK); 07232000
IF IU GEQ 23 THEN UNITCODE[IU-23]:=-0; 07232500
S ~ IU; T ~ 3; STOP;% 07233000
S ~ OU; T ~ 8; STOP;% 07234000
FORGETSPACE(INBUFF);% 07235000
FORGETSPACE(FIRSTCARD);% 07236000
IF OU > 16 THEN% 07237000
BEGIN FORGETSPACE(H);% 07238000
FORGETSPACE(OUTBUFFOLD);% 07239000
FORGETSPACE(RESERVE);% 07240000
END;% 07241000
END COM23;% 07242000
PROCEDURE STARTLOADN(KTR); VALUE KTR; REAL KTR;% 07243000
BEGIN REAL HDR,SEG0,I,F,T,C; ARRAY SHEAT[*]; 07244000
LABEL TRYAGAIN,LDCNTRL,DISK; 07244100
STREAM(K~0:KTR);% 07245000
BEGIN SI ~ KTR;% 07246000
L: IF SC = " " THEN% 07247000
BEGIN SI ~ SI+1; GO TO L END;% 07248000
DI ~ LOC K; DI ~ DI+6; DS ~ 2 CHR;% 07249000
END;% 07250000
C ~ P;% 07251000
T ~ KTR.[15:15]-1;% 07252000
IF (C NEQ "MT" AND C NEQ "DK") OR 07253000
(C = "DK" AND CDONLY ) THEN 07253100
SPOUT(T INX M[T-1]) 07254000
ELSE BEGIN C ~ C = "MT";% 07255000
TRYAGAIN: 07255100
IF (HDR:=DIRECTORYSEARCH(P(LDCNTRL),P(DISK),3)) ! 0 THEN 07256000
BEGIN 07256200
SHEAT := [M[F:=TYPEDSPACE(31,SHEETAREAV)]] & 30[8:38:10];%07256400
STREAM(S:=F-1, D:=F); % ZERO OUT THE SHEAT ENTRY 07256600
BEGIN 07256800
SI:=S; DS:=30 WDS; 07257000
END; 07257200
SEG0 := TYPEDSPACE(30,SEGZEROAREAV);% %167-07257400
DISKWAIT(-SEG0, 30, M[HDR INX 10]); 07257600
F.[FF] := HDR; % CORE ADDRESS OF HEADER IN [FF] OF PARAM. 07257800
SHEAT[7] := SEG0; % CORE ADRS.OF SEGMENT ZERO IN SHEAT[7]07258000
SHEAT[0] := P(LDCNTRL); 07258200
SHEAT[1] := P(DISK); 07258400
SHEAT[2] := 0 & LDCNTRLCODE[5:45:3] & 2[8:38:10]; 07258600
% [4:1] IN SHEET[2] MEANS SUPRESS BOJ/EOJ MESSAGES 07258800
SHEAT[16] := SHEAT[17] := @377777777777; % TIME LIMITS 07259000
SHEAT[19] := C; % COMMON VALUE 07259200
SHEAT[20] := 4; % CORE ESTIMATE 07259400
SHEAT[21] := 150; % STACK SIZE 07259600
07259800
STREAM(A:=0 : S := P(.SCHEDULEIDS)); 07260000
BEGIN 07260200
SI:=S; 07260400
47(SKIP SB; SKIP DB; TALLY:=TALLY+1; 07260600
IF SB THEN ELSE JUMP OUT); 07260800
DS:=SET; A:=TALLY; 07261000
END STREAM STATEMENT; 07261200
07261400
I := P; 07261600
SHEAT[3].[8:10] := 1; % SCHEDULE NUMBER 07261800
SHEAT[23] := (CLOCK + P(RTR)) DIV 60; 07262000
SHEAT[24] := MCP; %131-07262100
SHEAT[25] := HDR.[FF]; % DISK ADDRESS OF FILE HEADER 07262200
STREAM(C, T); 07262400
BEGIN 07262600
DI:=DI+16; 07262800
DS:=31LIT"CC EXECUTE LDCNTRL/DISK;COMMON="; 07263000
SI:=LOC C; DS:=8DEC; 07263200
DS:=6LIT";END.~"; 07263400
END STREAM STATEMENT; 07263600
M[T] := 0; M[T+1] := 10; 07263700
SHEAT[6] := GETESPDISK & 10[18:33:15]; 07263800
DISKWAIT(T, 11, SHEAT[6].[CF]); 07264000
FORGETSPACE(T); 07264200
INDEPENDENTRUNNER(P(.SELECTRUN),F,160); 07264400
END ELSE % IF IN DIRECTORY 07265000
BEGIN 07265100
ENTERSYSFILE(2); 07265200
GO TRYAGAIN; 07265300
LDCNTRL::: "LDCNTRL"; 07265400
DISK::: "DISK "; 07265500
END; 07265600
END;% 07266000
END;% 07267000
PROCEDURE TABLEOFCONTENTS(B,COUNT);% 07268000
VALUE B,COUNT; REAL B,COUNT;% 07268100
BEGIN REAL I,T,NA,TUSTA,TU,BU; 07269000
$ SET OMIT = NOT(PACKETS) 07269099
REAL FIRST,START,FINAL,PKTCT;% 07269100
$ POP OMIT 07269101
LABEL L,EXIT,G;% 07270000
$ SET OMIT = NOT(SHAREDISK) 07270099
A:=B.[15:15]-1; 07271900
TUSTA:=M[A-1]; 07272000
LOCKCONTROLDECKS; 07272500
A:=FIRSTDECK; 07273000
$ SET OMIT = NOT(PACKETS) 07273099
FIRST~1;% 07273100
$ POP OMIT 07273101
L: I:=SPACE(14) INX TUSTA; 07274000
G: IF A = 0 THEN GO TO EXIT;% 07275000
DISKWAIT(-1,12,A); 07276000
A:=M[I+6].[CF]; 07278000
$ SET OMIT = NOT(DATACOM AND RJE ) 07278499
$ SET OMIT = NOT(SHAREDISK) 07279000
N ~ M[I+2];% 07281000
$ SET OMIT = NOT(PACKETS) 07281099
IF NOT COUNT THEN% 07281100
BEGIN% 07281200
$ POP OMIT 07281201
DISKWAIT(-I-4,9,M[I+10]); 07282000
STREAM(N,T,TU,BU,I); 07284000
BEGIN SI ~ LOC N; SI ~ SI+1;% 07285000
$ SET OMIT = NOT(PACKETS) 07285099
DS:=8 LIT " PACKET ";DS:=5 CHR; 07285100
$ POP OMIT 07285111
$ SET OMIT = PACKETS 07285999
$ SET OMIT = NOT(SHAREDISK) 07286100
$ SET OMIT = SHAREDISK 07286400
DS:=8 LIT" "; 07286500
$ POP OMIT 07286501
$ SET OMIT = NOT(PACKETS) 07286509
DS:=3 LIT " ="; 07286510
$ POP OMIT 07286511
$ SET OMIT = NOT(RJE AND DATACOM ) 07286599
DS:=8 LIT " "; 07286800
NEX: 07286900
$ SET OMIT = PACKETS 07286999
$ SET OMIT = NOT(PACKETS) 07288099
DI:=DI+40;DI:=DI+19;DS:=LIT"~"; 07288100
$ POP OMIT 07288101
END;% 07289000
SPOUT(I);% 07290000
$ SET OMIT = NOT(PACKETS) 07290099
END ELSE% 07290100
BEGIN% OPERATOR WANTS A COUNT 07290200
IF FIRST THEN BEGIN% STORE FIRST DECK #. 07290300
FIRST~0; START~N;% 07290400
END;% 07290500
PKTCT~PKTCT+1; FINAL~N;% 07290600
FORGETSPACE(I);% 07290650
END;% 07290700
$ POP OMIT 07290701
GO TO L;% 07291000
EXIT:IF N=0 THEN 07292000
BEGIN STREAM(I); 07293000
$ SET OMIT = NOT(PACKETS) 07293099
DS:=20 LIT " NO PACKETS ON DISK~"; 07293100
$ POP OMIT 07293101
$ SET OMIT = PACKETS 07293199
SPOUT(I);% 07294000
$ SET OMIT = PACKETS 07294899
$ SET OMIT = NOT(PACKETS) 07294999
END ELSE% CHECK FOR COUNT REQUEST. 07295000
IF COUNT THEN% 07295010
BEGIN;STREAM(C~PKTCT,S~START,% 07295020
F~FINAL,T1~0,T2~0,I);% 07295030
BEGIN DS~LIT " "; T2~DI;% 07295040
SI~LOC C; DI~LOC T1;% 07295050
DS~2 DEC; SI~LOC T1; DI~T2; 07295060
DS~2 CHR; T2~DI; DI~DI-2;% 07295070
DS~FILL; DI~T2;% 07295080
DS~7 LIT " PACKET";% 07295090
SI~LOC T1; %511-07295100
IF SC!"0" THEN GO TO AQ %511-07295102
ELSE SI~SI+I; %511-07295104
IF SC="1" THEN% ONLY 1 DECK %511-07295110
BEGIN DS~2LIT ", ";% 07295120
SI~LOC F; SI~SI+1;% 07295130
DS~5 CHR;% 07295140
END ELSE% MORE THAN 1 07295150
AQ: BEGIN DS~3 LIT "S, "; %511-07295160
SI~LOC S; SI~SI+1;% 07295170
DS~5 CHR;% 07295180
DS~6 LIT " THRU ";% 07295190
SI~SI+4; DS~4 CHR;% 07295200
END;% 07295210
DS~LIT "~"; 07295220
END;% 07295230
SPOUT(I);% 07295235
END ELSE FORGETSPACE(I);% 07295240
$ POP OMIT 07295241
UNLOCKCONTROLKECKS; 07296000
END;% 07297000
PROCEDURE REMOVEDECK(N,TUSTA);VALUE N,TUSTA;REAL N,TUSTA; 07298000
BEGIN REAL I,T,A,L1,J=I,L2,V;% 07299000
$ SET OMIT = NOT(PACKETS) 07299499
REAL L3; 07299500
LABEL FAIL,CONTINUE; 07299600
$ POP OMIT 07299601
LABEL L,EXIT,REMOVE;% 07300000
LOCKCONTROLDECKS; 07301000
IF (I ~ DIRECTORYSEARCH("DECK ",N,5)) = 0 THEN% 07303000
$ SET OMIT = NOT(PACKETS) 07303499
FAIL: 07303500
$ POP OMIT 07303501
BEGIN I ~ SPACE(5);% 07304000
STREAM(N,I);% 07305000
$ SET OMIT = NOT(PACKETS) 07305099
BEGIN DS:=5 LIT " PKT "; 07305100
$ POP OMIT 07305101
$ SET OMIT = PACKETS 07305999
SI ~ LOC N; SI ~ SI+1; DS ~ 5 CHR;% 07307000
DS ~ 13 LIT " NOT ON DISK~";% 07308000
END;% 07309000
GO TO EXIT;% 07310000
END;% 07311000
$ SET OMIT = NOT(SHAREDISK) 07311199
$ SET OMIT = NOT(PACKETS) 07311499
L3:=M[I+6].[FF]; 07311500
$ POP OMIT 07311501
L2:=M[I+6].[CF]; 07312000
IF (A:=FIRSTDECK)=(L1:=I.[FF]) THEN 07313000
BEGIN 07314000
$ SET OMIT = PACKETS 07314099
$ SET OMIT = NOT(PACKETS) 07314109
FIRSTDECK:=IF L3 NEQ 0 THEN L3 ELSE L2; 07314110
IF L2=0 THEN LASTDECK~IF L3 NEQ 0 THEN L3 ELSE 0; 07314120
$ POP OMIT 07314121
DISKWAIT(KLUMP,3,DIRECTORYTOP+3); 07314200
$ SET OMIT = NOT(PACKETS) 07314289
IF L3 NEQ 0 THEN GO TO CONTINUE ELSE 07314290
$ POP OMIT 07314291
GO TO REMOVE; 07314300
END; 07314400
J ~ I.[33:15];% 07315000
L: 07316000
DISKWAIT(-J,30,A); 07317000
IF (V:=M[J+6].[CF])=0 THEN 07318000
$ SET OMIT = NOT(PACKETS) 07318009
IF A=L1 THEN GO REMOVE ELSE BEGIN FORGETSPACE(I); GO FAIL 07318010
END; 07318012
$ POP OMIT 07318013
$ SET OMIT = PACKETS 07318019
IF V ! L1 THEN% 07319000
BEGIN A ~ V; GO TO L END;% 07320000
$ SET OMIT = PACKETS 07320999
$ SET OMIT = NOT(PACKETS) 07321099
M[J+6].[CF]~IF L3!0 THEN L3 ELSE L2; 07321100
$ POP OMIT 07321101
DISKWAIT(J,30,A); 07322000
IF L2 = 0 THEN% 07324000
BEGIN 07325000
$ SET OMIT = PACKETS 07325999
$ SET OMIT = NOT(PACKETS) 07326099
LASTDECK:=IF L3 NEQ 0 THEN L3 ELSE A; 07326100
$ POP OMIT 07326101
DISKWAIT(KLUMP,3,DIRECTORYTOP+3); 07327000
$ SET OMIT = PACKETS 07327999
$ SET OMIT = NOT(PACKETS) 07329999
END ELSE IF L3=0 THEN ELSE 07330000
CONTINUE: 07330050
BEGIN J~I INX 0; 07330100
DISKWAIT(-J,30,L3); 07330200
M[J+6].[CF]~L2; 07330300
DISKWAIT(J,30,L3); 07330400
END; 07330500
$ POP OMIT 07330501
REMOVE: 07331000
FORGETSPACE(I); 07332000
I:=DIRECTORYSEARCH("DECK ",N,8).[CF]; 07333000
T ~ M[I+9];% 07343000
FOR V ~ 1 STEP 1 UNTIL T DO% 07344000
IF M[I+V+9]!0 THEN FORGETUSREDISK(M[I+V+9],M[I+8]); 07345000
STREAM(N,I);% 07346000
$ SET OMIT = NOT(PACKETS) 07346099
BEGIN DS:=5 LIT " PKT "; 07346100
$ POP OMIT 07346101
$ SET OMIT = PACKETS 07346999
SI ~ LOC N; SI ~ SI+1; DS ~ 5 CHR;% 07348000
DS ~ 9 LIT " REMOVED~";% 07349000
END;% 07350000
$ SET OMIT = PACKETS 07350099
EXIT: SPOUTER(I&TUSTA[9:9:9],TUSTA,LIBMSG) 07351000
$ SET OMIT = PACKETS 07351099
;UNLOCKCONTROLDECKS; 07352000
END;% 07353000
PROCEDURE DECKREMOVER(B); BALUE B; REAL B;% 07354000
BEGIN REAL K,N,F;% 07355000
INTEGER U; LABEL ON,ERR; 07355100
REAL D; 07355200
LABEL L,TRYIT,GIVEUP; 07356000
K ~ B.[15:15]-1;% 07357000
L: STREAM(X~12,B:A~0);% 07358000
BEGIN SI ~ B;% 07359000
U: IF SC = " " THEN BEGIN SI~SI+1; GO TO U END;% 07360000
IF SC="=" THEN BEGIN DI~LOC X; DI~DI+6; DS~CHR; 07360100
SI~SI-1; B~SI; GO TO E END;07360200
IF SC = "#" THEN SI:=SI+1; 07361000
BL: IF SC=" " THEN BEGIN SI:=SI+1;GO TO BL; END; 07361500
DI:=LOC X; DI:=DI+1; DS:=5 LIT "#0000"; 07362000
4(IF SC < "0" THEN JUMP OUT TO EN; 07363000
IF SC > "9" THEN JUMP OUT TO EN; 07364000
SI:=SI+1; TALLY:=TALLY+1); 07365000
EN: A:=TALLY; SI:=SI-A; DI:=DI-A; DS:=A CHR; 07365500
N: IF SC = " " THEN BEGIN SI~SI+1; GO TO N END;% 07366000
DS ~ CHR; B ~ SI;% 07367000
E: END;% 07368000
P(.B,~,.N,~);% 07369000
F~N.[36:6]; N.[36:6]~"~"; 07370000
IF F="~" OR F="," OR F="=" THEN 07371000
BEGIN IF F="=" THEN 07371100
BEGIN IF D=0 THEN D~SPACE(30); 07371200
LOCKCONTROLDECKS; 07371300
IF (N:=FIRSTDECK)=0 THEN 07371400
GIVEUP: 07371450
BEGIN F:="~"; 07371500
UNLOCKCONTROLDECKS; 07371600
GO ON; 07371700
END; 07371750
TRYIT: DISKWAIT(-D,30,N); 07371800
$ SET OMIT = NOT(SHAREDISK) 07371809
N:=M[D+2]; 07371900
UNLOCKCONTROLDECKS; 07371950
END; 07372000
FOR U ~ 0 STEP 1 UNTIL PSEUDOMAX DO 07372090
IF CIDROW[U]!0 THEN 07372100
IF(CIDTABLE[U,2] EQV N)=NOT 0 THEN 07372200
IF LABELTABLE[U+32]}0 07372300
$ SET OMIT = NOT(PACKETS) 07372309
AND LABELTABLE[U+32]!@214 AND 07372310
PACKETACT[U]=0 07372320
$ POP OMIT 07372321
THEN 07372330
BEGIN 07372400
ENDOFDECK(U,M[K-1]); 07372500
GO ON; 07372600
END ELSE GO TO ERR; 07372700
REMOVEDECK(N,M[K-1]); 07372800
ON: IF F!"~" THEN GO TO L; 07372900
FORGETSPACE(K);% 07373000
END ELSE 07374000
ERR: SPOUT(K INX M[K-1]); 07374100
IF D!0 THEN FORGETSPACE(D); 07374200
END;% 07375000
BOOLEAN PROCEDURE READEMFROMDISK(H,IB);% 07376000
VALUE H,IB; ARRAY H[*],IB[*];% 07377000
BEGIN% 07378000
% H[0] = ADDRESS OF BU+1 (B)% 07379000
% H[1] = ADDRESS OF B2+1% 07380000
% H[2] = DECK NAME% 07381000
% H[3] = RECORDCOUNT (N)% 07382000
% H[4] = NEXT CONTROL CARD (L)% 07383000
% H[5] = RECORDS USED IN THIS BLOCK | 10 (R)% 07384000
% H[7] - H[30] ARE FILE HEADER% 07385000
REAL A,B;% 07386000
DEFINE N=H[3]#,L=H[4]#,R=H[5]#;% 07387000
INTEGER I=A; DEFINE MOM=CIDROW[M[B]]#; 07388000
$ SET OMIT = NOT(BREAKOUT) 07388010
B ~ H[0];% 07389000
IF R = 0 THEN% 07390000
IF (M[B-2] AND IOMASK) = 0 THEN% 07391000
SLEEP([M[B-2]],IOMASK);% 07392000
STREAM(B!B+R,IB);% 07393000
BEGIN SI ~ B; DS ~ 10 WDS END;% 07394000
M[IB INX NOT 0] ~ 10; 07394500
IF (READEMFROMDISK ~ N=L) THEN% 07395000
L ~ IB[9];% 07396000
IF (A:=N:=*P(DUP)+1) > (H[7]+1) THEN %639-07397000
BEGIN READEMFROMDISK:=1; 07398000
STREAM(IB); 07398100
BEGIN 07398200
$ SET OMIT = NOT(PACKETS) 07398299
DS:=8LIT" "; SI:=IB; DS:=8 WDS; DI:=IB; 07398300
$ POP OMIT 07398301
DS:=5LIT"-END."; DI:=DI-5; DS:=RESET; 07398400
END; 07398500
END 07398600
ELSE BEGN IF (R ~ *P(DUP)+10) = 30 THEN% 07399000
BEGIN IB ~ [M[B-2]];% 07400000
R ~ 0; 07400400
A ~ A DIV 3+1; 07400500
I~H[A DIV H[8]+10]+A MOD H[8]; 07401000
IF I>0 THEN % NEXT BUFF EXISTS %639-07401900
DISKIO(IB,1-B,30,I);% 07402000
H[0] ~ H[1];% 07403000
H[1] ~ B;% 07404000
END; END; END;% 07405000
BOOLEAN PROCEDURE PRINTORPUNCHWAIT(Q,PNCH);VALUE Q,PNCH;REAL Q,PNCH; 07405100
FORWARD; 07405110
PROCEDURE ENDOFDECK(R,TUSTA);VALUE R,TUSTA; REAL R,TUSTA; 07406000
BEGIN ARRAY H[*];% 07407000
REAL B,I;% 07408000
$ SET OMIT = NOT(PACKETS) 07408099
REAL DISKAD,PBREC,T,USERIO; % %750-07408100
$ POP OMIT 07408101
LABEL EXIT; 07408500
IF (H:=CIDROW[R])=0 THEN GO TO EXIT; 07409000
LABELTABLE[R+32] ~ @114; 07409100
MULTITABLE[R+32] ~ RDCTABLE[R+32] ~ 0; 07409200
USERID~UNITCODE[R+29]; % %750-07409250
UNITCODE[R+9]:=-0; 07409300
IF NOT TUSTA.[1:1] THEN REMOVEDECK(H[2],ABS(TUSTA)) ELSE 07410000
P(DIRECTORYSEARCH(-"DECK ",H[2],14),DEL);07410100
FOR I ~ 0 STEP 1 UNTIL 1 DO% 07411000
BEGIN B ~ H[I];% 07412000
IF (M[B-2] AND IOMASK) = 0 THEN 07413000
SLEEP([M[B-2]],IOMASK);% 07414000
END;% 07415000
IF CIDROW[R]=0 THEN GO TO EXIT; % FIXES TIMING PROB. 07415100
IF H.[18:15] ! 0 THEN 07416000
FORGETSPACE(H.[18:15]-2); 07417000
$ SET OMIT = NOT(PACKETS) 07417099
IF PACKETPBD[R] GEQ 11 THEN 07417100
BEGIN 07417200
PBCOUNT := PBCOUNT+1; 07417300
I := 001 & CIDTABLE[R,6][6:6:24]; 07417400
IF (PBREC := DIRECTORYSEARCH("PBD ",I,5))!0 THEN 07417500
BEGIN 07417600
IF PACKETPAGE[R]>1 THEN 07417700
BEGIN 07417800
PBREC := PBREC.[CF]; 07417900
T := M[PBREC+6]; 07418000
DISKAD := M[PBREC+10]+2; 07418100
DISKWAIT(-PBREC,30,DISKAD); 07418200
IF (M[PBREC+12] EQV (-"ABORTED"))=NOT 0 THEN 07418300
STREAM(B:=PBREC+11); 07418500
BEGIN 07418600
DS:=8LIT":|0|4000"; DS:=8LIT"0PACKET "; 07418700
END; 07418800
M[PBREC+15]~M[PBREC+27]~USERID; % %750-07418850
DISKWAIT(PBREC,30,DISKAD); 07418900
END; 07419000
P(DIRECTORYSEARCH(-"PBD ",1,14),DEL); 07419100
IF AUTOPRINT OR T0 THEN 07419200
P(PRINTORPUNCHWAIT(I,0&T[9:39:9[),DEL); 07419300
FORGETSPACE(PBREC); 07419400
END; 07419500
END; 07419600
PSEUDO[R] := 07419700
$ POP OMIT 07419701
CIDROW[R] := 0; 07419800
IF(RUNUMBER~RUNUMBER+1)>0 THEN 07420000
STARTADECK(IF TUSTA.[1:1] THEN -H[2] ELSE 0); 07420010
FORGETSPACE(H); 07420050
EXIT: 07420100
END;% 07421000
% PSEUDOCOPY DECLARATION MOVED TO 02347110 TO %541-07421500
% ALLOW ACCESS IN DRANO %541-07421505
PROCEDURE STARTADECK(N); VALUE N; REAL N; 07422000
BEGIN LABEL EXIT,L,POSSIBLE,NEXT;% 07423000
REAL I,R,T,A,S; 07424000
READ SDED; 07424100
ARRAY H[*];% 07425000
LABEL AGAIN,START; 07425500
START: 07425600
IF N.[1:1] THEN BEGN SDED~ABS(N); N~0 END; 07425700
LOCKCONTROLDECKS; 07426000
IF RUNUMBER LEQ 0 AND N=0 THEN GO TO EXIT; 07426100
AGAIN: 07427500
IF PSEUDOCOPY > 2 THEN% TOO MANY COPIES CONTROLCARD 07427600
IF STARTOG AND N=0 THEN GO TO EXIT % 07427610
ELSE BEGIN STARTOG ~ TRUE; 07427620
UNLOCKCONTROLDECKS; 07427625
COMPLEXSLEEP(PSEUDOCOPY { 2);% 07427630
STARTOG ~ FALSE;% 07427640
GO TO START;% 07427645
END;% 07427650
FOR R ~ 0 STEP 1 UNTIL PSEUDOMAX DO 07428000
IF CIDROW[R] = 0 THEN GO TO POSSIBLE;% 07429000
STREAM(S~S~SPACE(4)); 07429100
DS:=27 LIT" ALL PSEUDO-READERS IN USE~"; 07429200
SPOUT(S); 07429300
GO TO EXIT;% 07430000
POSSIBLE:% 07431000
IF (A:=FIRSTDECK)=0 THEN GO TO EXIT; 07432000
LABELTABLE[R+32]:=@114; 07432100
W~CIDROW[R]~[M[S~GETSPACE(94,20,1)+2]]&94[8:38:10]; 07433000
M[S-2].[9:6] ~ 0; H[2] ~ 0;% 07434000
L: DISKWAIT(-S,30,A); 07435000
IF N!0 THEN 07436000
BEGIN 07436100
IF H[2].[12:24]~N THEN GO TO NEXT; 07436200
IF H[4].[2:1] THEN 07436300
BEGIN 07436400
STREAM(A:=[H[2]], 07436500
$ SET OMIT = NOT(SHAREDISK) 07436509
S); 07436520
$ SET OMIT = PACKETS 07436599
$ SET OMIT = NOT(PACKETS) 07436609
BEGIN SI:=A;SI:=SI+1;DS:=5 LIT" PKT "; 07436610
$ POP OMIT 07436611
SI:=5 CHR;DS:=7LIT" IN USE"; 07436700
$ SET OMIT = NOT(SHAREDISK) 07436799
DS:=LIT"~"; 07437000
END; 07437100
SPOUT(S); 07437200
CIDROW[R]:=0; 07437300
GO TO EXIT; 07437400
END; 07437500
END ELSE 07437600
IF H[4].[2:1] OR (SDED!0 AND H[2]=SDED) 07437800
$ SET OMIT = NOT(SHAREDISK) 07437899
THEN GO TO NEXT; 07438000
H[4]:=(*P(DUP))&2[2:46:2]&SYSNO[4:46:2]; 07438100
DISKWAIT(S,30,A); 07438200
$ SET OMIT = NOT (DATACOM AND RJE) 07438250
H[0] ~ S+32;% 07441000
H[1] ~ S+64;% 07442000
T ~ [H[30]]; DISKIO(T,1-H[0],30,H[10]);% 07444000
IF H[7] LSS 3 THEN H[62]:=IOMASK ELSE 07445000
BEGIN T:=[H[62]]; IF H[8]=1 THEN 07445100
DISKIO(T,1-H[1],30,H[11]) ELSE 07445200
DISKIO(T,1-H[1],30,H[10]+1); 07445300
END; 07445400
T:=GTSPACE(13,20,0)+4; 07446000
$ SET OMIT = NOT(BREAKOUT) 07446010
M[T INX 10] := H[5]; 07446100
$ SET OMIT = NOT(PACKETS) 07446149
T.[24:6]+H[6].[2:6]; 07446150
$ POP OMIT 07446151
H[3] := H[4] := H[5] := H[6] := 0; 07446200
M[T-4].[9:6] ~ 0;% 07447000
LABELTABLE[R+32]~-@14; %LET IT BE MOVED 07448000
I~READEMFROMDISK(H,[M[T]]&10[8:38:10]); 07448500
INDEPENDENTRUNNER(P(.CONTROLCARD),T& 07449000
$ SET OMIT = NOT(DATACOM AND RJE ) 07449099
(R+32)[2:42:6],192); 07449200
PSEUDOCOPY ~ PSEUDOCOPY + 1;% 07449500
IF (RUNUMBER~RUNUMBER-1) LEQ 0 OR N!0 THEN GO TO EXIT; 07450000
GO TO AGAIN; 07450200
NEXT:IF (A:=H[6].[CF])!0 THEN GO TO L; 07451000
IF N!0 THEN 07452000
BEGIN 07452100
STREAM(N,S); 07452200
$ SET OMIT = PACKETS 07452299
$ SET OMIT = NOT(PACKETS) 07452309
BEGIN SI~LOC N; SI~SI+4; DS:=6 LIT" PKT #"; 07452310
$ POP OMIT 07452311
DS:=4 CHR;DS:=13 LIT" NOT ON DISK~"); 07452400
END; 07452500
SPOUT(S); 07452600
END ELSE FORGETSPACE(S); 07452700
CIDROW[R] ~ 0;% 07453000
EXIT: UNLOCKCONTROLDECKS; 07455000
END;% 07456000
PROCEDURE RUNTHEDECK(B);VALUE B; REAL B;% 07457000
BEGIN REAL I,J;% 07458000
STREAM(S:=0:B,A:=[I]); 07461000
BEGIN SI ~ B;% TO REAL IN I 07461100
L: IF SC=" " THEN BEGIN SI:=SI+1; GO TO L END; 07461120
IF SC="#" THEN 07461140
BEGIN 07461160
L1: SI:=SI+1; IF SC=" " THEN GO TO L1; 07461180
DS:=8 LIT"00000000"; 07461200
4(IF SC<"0" THEN JUMP OUT; 07461220
IF SC>"9" THEN JUMP OUT; 07461240
SI:=SI+1; TALLY:=TALLY+1); 07461260
S:=TALLY; SI:=SI-S; DI:=DI-S; DS:=S CHR; 07461280
TALLY:=1; 07461300
GO TO FX; 07461320
DS:=4 LIT"0000";DS:=4 CHR;TALLY:=1;GO TO EX; 07461330
END; 07461340
SI ~ SI + 1;% 07461400
IF SC { "9" THEN IF SC } "0" THEN GO TO TWO; 07461500
SI ~ SI - 1; DS ~ OCT;% 07461510
GO TO EX; 07461520
TWO: SI ~ SI - 1; DS ~ 2 OCT; 07461530
EX:S:=TALLY; 07461540
END; 07461550
J:=P; 07461560
B:=B.[15:15]-1; 07461570
IF J THEN 07461600
BEGIN 07461700
FORGETSPACE(B); 07461800
STARTADECK(I); 07461900
END ELSE 07462000
BEGIN 07462100
IF I GTR PSEUDOMAX1 THEN I:=NABS(RUNUMBER) ELSE 07462200
BEGIN 07462250
RUNUMBER:=I; 07462300
FOR J:=0 STEP 1 UNTIL PSEUDOMAX DO 07462400
RUNUMBER:=RUNUMBER-(CIDROW[J]!0); 07462500
END; 07462600
STREAM(X1:=1-I.[1:1],K2:=RUNUMBER.[1:1],I:=ABS(I),B);07463000
BEGIN CI:=CI+X1; GO L1; DS:=10LIT" WILL USE ";GO L2; 07464000
L1: CI:=CI+X2; GO L2; DS:=LIT"-"; L2: 07464100
SI:=LOC I;DS:=2 DEC; 07465000
DS ~ 13 LIT " PSEUDO-RDRS~"; 07466000
END;% 07467000
SPOUT(B INX M[B-1]); 07468100
IF RUNUMBER GTR 0 THEN STARTADECK(0); 07469000
END; 07472500
END;% 07473000
PROCEDURE EXTERNALEND(B); VALUE B; REAL B; 07473100
BEGIN REAL U; LABEL EXIT; 07474000
U ~ UNITIN(TINU,B); 07475000
B ~ B.[15:15]-1; 07476000
IF 32 { U AND U { PSEUDOMAXT THEN 07477000
IF LABELTABLE[U] } 0 THEN 07478000
$ SET OMIT = NOT(PACKETS) 07478099
IF LABELTABLE[U] NEQ @214 AND PACKETACT[U=32]=0 THEN 07478100
$ POP OMIT 07478101
IF CIDROW[U-32] ! 0 THEN 07478500
BEGIN 07479000
ENDOFDECK[U-32],M[B-1]); 07479100
FORGETSPACE(B); 07480000
GO TO EXIT; 07481000
END; 07482000
SPOUT(B INX M[B-1]); 07483000
EXIT:END; 07484000
PROCEDURE CHANGEPRIORITY(BUFF,MIX); VALUE BUFF,MIX; REAL BUFF,MIX; 07485000
BEGIN INTEGER PRIORITY; REAL B; 07486000
$ SET OMIT = NOT(PACKETS) 07486499
DEFINE UNITNO = PSEUDOMIX[MIX]#; 07486500
$ POP OMIT 07486501
BUFF ~ ((B~BUFF).[15:15]-1)&M[P(DUP)-1][9:9:9]; 07487000
STREAM(PRIORITY:B); 07488000
BEGIN SI~B; 07489000
N: IF SC="~" THEN GO TO X; 07490000
IF SC<"0" THEN BEGIN SI~SI+1; GO TO N; END; B~SI; 07491000
K: IF SC}"0" THEN IF SC{"9" THEN 07492000
BEGIN TALLY~TALLY+1; SI~SI+1; GO TO K END; 07493000
SI~B; DI~LOC PRIORITY; B~TALLY; DS~B OCT; GO TO Z; 07494000
X: DI~LOC PRIORITY; SKIP DB; DS~11 SET; 07495000
Z: 07496000
END STREAM; 07497000
IF (PRIORITY~P) } 0 THEN 07498000
IF PRYOR[MIX]}0 THEN% 07501000
IF JAR[MIX,*]~0 THEN 07502000
BEGIN JAR[MIX,2].[CF]~ PRYOR[MIX]~ P(PRIORITY~ 07503000
IF PRIORITY}32766 THEN 32766 ELSE PRIORITY, DUP) & P[CTF]; 07503500
STREAM(J~JAR[MIX,*],MIX,PRIORITY,BUFF); 07504000
BEGIN DS~10 LIT " PRIORITY="; 07505000
SI~LOC PRIORITY; BUFF~DI; DS~6 DEC; DI~DI-6; 07506000
DS~5 FILL; DI~BUFF; DI~DI+6; DS~LIT":"; 07507000
SI~J; SI~SI+1; DS~7 CHR; SI~SI+1; DS~LIT"/"; DS~7 CHR;07508000
DS~LIT"="; SI~LOC MIX; DS~2DEC; DS~LIT"~"; 07509000
DI~DI-3; DS~FILL; 07509500
END END; 07510000
SPOUTER(BUFF,UNITNO,1); 07511000
END CHANGEPRIORITY; 07512000
PROCEDURE ENTERCONTROLDECK(H); VALUE H; ARRAY H[*]; 07541000
BEGIN REAL R,S,T,T1,T2; 07542000
INTEGER I; 07543000
$ SET OMIT = NOT(PACKETS) 07543099
LABEL MORE; 07543100
$ POP OMIT 07543101
T~"DECK "&H[4][1:47:1]; % FOR SCRATCHDIR DELETE 07545000
S:=NEXTCDNUM(0); 07547000
DISKWAIT(KLUMP,3,DIRECTORYTOP+3); % CHANGE LASTCDNUM ON DISK07547100
$ SET OMIT = NOT(PACKETS) 07547499
MORE: 07547500
$ POP OMIT 07547501
H[0]:=@001200036000301; 07548000
$ SET OMIT = NOT(PACKETS) 07548099
T2~H[6].[FF]; H[6].[FF]~T; 07548100
$ POP OMIT 07548101
STREAM(DATE,B~[H[3]]); 07549000
BEGIN SI~LOC DATE;DS~8 OCT;DI~DI-8;DS~2 LIT"+7";END; 07549100
H[4] := 0& 07550000
$ SET OMIT = NOT SHAREDISK 07550003
15[12:44:4]; 07550010
H[1]~(XCLOCK+P(RTR))&H[3][6:30:18]; 07550100
H[2]:=S:=@14&@12[6:42:6]&S[12:24:24]&@37[36:42:6]; 07557000
T1:=EUF(T,S,H.[CF]-1); 07559000
$ SET OMIT = NOT(PACKETS) 07559099
IF T2 NEQ 0 THEN 07559100
BEGIN DISKWAIT(-(H INX 0), 30, T2); 07559110
FORGETSPACE(T2); 07559120
S~H[2]; GO TO MORE; 07559180
END; 07559190
$ POP OMIT 07559191
H[2]~LASTCDNUM; 07559500
IF FIRSTDECK=0 THEN FIRSTDECK:=T1 ELSE 07560000
BEGIN 07561000
$ SET OMIT = SHAREDISK 07561990
LOCKDIRECTORY; 07562000
$ POP OMIT 07562010
DISKWAIT(-(I:=SPACE(30)),-30,LASTDECK); 07564000
M[I+6].[CF]:=T1; 07565000
DISKWAIT(I,-30,LASTDECK); 07566000
FORGETSPACE(I); 07567000
$ SET OMIT = SHAREDISK 07567990
UNLOCKDIRECTORY; 07568000
$ POP OMIT 07568010
END; 07569000
LASTDECK:=T1; 07570000
DISKWAIT(KLUMP,-3,DIRECTORYTOP+3); 07571000
UNLOCKTOG(CDMASK); 07572000
IF RUNUMBER GTR 0 THEN STARTADECK(0); 07573000
END ENTERCONTROLDECK; 07575000
BOOLEAN PROCEDURE MTXIN(I,U,BUFF);% 08000000
REAL U,BUFF; INTEGER I;% 08001000
BEGIN LABEL EXIT,X;% 08002000
U ~ UNITIN(TINU,BUFF); 08003000
BUFF ~ BUFF.[15:15]-1; 08004000
IF U > 15 THEN% 08005000
BEGIN;STREAM(BUFF); DS ~ 8 LIT "INV KBD ";% 08006000
GO TO EXIT;% 08007000
END ELSE I ~ TWO(U); 08008000
STREAM(A~TINU[U];BUFF);% 08009000
BEGIN SI~LOC A; SI~SI+5; DS~LIB" "; DS~3 CHR;% 08010000
DS ~ LIT " "; A ~ DI;% 08011000
END;% 08012000
P([BUFF].~);% 08013000
IF LABELTABLE[U] = @114 OR LABELTABLE[U] = @214 THEN% 08014000
BEGIN 08015000
STREAM(SAV:=((I AND SAVEWORD) NEQ 0), BUFF); 08015100
BEGIN 08015200
DS:=10LIT"NOT READY~"; 08015300
SAV(DI:=DI-1; DS:=8LIT"*SAVED)~"); 08015400
END; 08015500
GO TO EXIT; 08016000
END;% 08017000
IF LABELTABLE[U] < 0 THEN% 08018000
BEGIN;STREAM(BUFF); DS ~ 7 LIT "IN USE~";% 08019000
END% 08020000
ELSE GO TO X;% 08021000
EXIT:MTXIN ~ TRUE;% 08022000
X:END;% 08023000
PROCEDURE TAPEPURGE(BUFF); VALUE BUFF; REAL BUFF;% 08024000
BEGIN LABEL EXIT;% 08025000
REAL I,U;% 08026000
REAL R,T; 08027000
BOOLEAN TEST; 08027100
REAL WHAT = BUFF;% 08028000
IF MTXIN(I,U,WHAT) THEN GO TO EXIT;% 08029000
STREAM(B:=BUFF,T~[T]); 08029015
BEGIN SI:=B; SI:=SI+6; 08029020
IF SC="-" THEN 08029025
BEGIN SI:=SI+1; 08029030
5(IF SC="~" THEN JUMP OUT; 08029035
TALLY:=TALLY+1;SI:=SI+1); 08029040
B:=TALLY; SI:=SI-B; DS:=B OCT; 08029045
DI~DI-8; DS:=LIT "+"; %725-08029046
END; 08029050
END; 08029055
LABELTABLE[U] ~ -@14; 08029100
IF (R~WAITIO(@500000000,@177,U))!0 THEN 08030000
IF R!@120 THEN %ERROR OTHER THAN WRITE LOCK 08030100
BEGIN;STREAM(U~TINU[U],BUFF); 08030200
BEGIN DS~14 LIT "#CANNOT PURGE "; 08030300
SI~LOC U; SI~SI+5; DS~3CHR; 08030310
DS~LIT"~"; 08030320
END; 08030330
LABELTABLE[U]~@214; 08030400
GO TO EXIT; 08030500
END ELSE %NO WRITE RING 08030600
BEGIN; STREAM(BUFF); DS ~ 11 LIT "WRITE LOCK.";% 08031000
LABELTABLE[U] ~ @114; 08031100
GO TO EXIT;% 08032000
END;% 08033000
IF NOT T.[1:1] THEN IF T=0 THEN %725-08033980
BEGIN T:=PRNTABLE[U].[30:18]; TEST:= TRUE END; 08033990
IF I.[1:1]=0 AND T=0 THEN BEGIN %725-08033992
STREAM(BUFF); DS~17 LIT "NOT PG-ED(PRN=0)~"; %725-08033993
LABELTABLE[U]~ @14; GO EXIT END; T~ABS(T); %725-08033994
STREAM(A:=T,BUFF); 08034000
BEGIN DI ~ DI + 3; DS ~ 8 LIT " LABEL "; 08035000
8(DS~2 LIT "0X"); 08035100
24(DS~2 LIT "0"); DS~2 LIT "}!"; 08036000
DI ~ DI-21; SI ~ LOC A; DS ~ 5 DEC;% 08037000
END;% 08038000
RRRMECH ~ I OR RRRMECH;% 08039000
MULTITABLE[U] ~ 0;% 08041000
P(WAITIO(@4200000000,0,U),DEL);% 08042000
R ~ WAITIO(BUFF INX @120500000001,@2000000,U) OR% 08043000
WAITIO(BUFF INX 10,@2000000,U);% 08044000
IF MOD3IOS THEN %AI08044500
DO UNTIL P(WAITIO(BUFF INX @340000012,@50,U))=@10 %AI08044600
ELSE %AI08044700
P(WAITIO(@4200000000,0,U),DEL);% 08045000
SLEEP([TOGLE],STATUSMASK); 08046000
RRRMECH ~ RRRMECH AND NOT I;% 08047000
READY ~ READY AND NOT I;% 08048000
IF R = 0 THEN BEGIN% 08049000
LABELTABLE[U] ~ @114;% 08050000
IF TEST THEN BEGIN STREAM(B~T,BUFF); %708-08051000
BEGIN DS~10 LIT"PG-ED(PRN="; SI~LOC B; DS~5 DEC; DS~2 LIT")~";%708-08051004
END; END % PRINT PRN WITH PLAIN PGMT %708-08051005
ELSE BEGIN STREAM(A:=T,B:=PRNTABLE[U],[30:18],BUFF); 08051010
BEGIN DS:=10LIT"PG-ED(PRN="; 08051020
SI:=LOC A; DS:=5 DEC; 08051030
DS:=5LIT",WAS "; 08051040
SI:=LOC B; DS:=5 DEC;DS:=2LIT")~"; 08051050
END; 08051060
PRNTABLE[U].[30:18] ~ T; 08051065
END; 08051070
EXIT: SPOUT(NABS(BUFF INX M[BUFF-1]));% 08052000
END ELSE BEGIN% 08053000
LABELTABLE[U] ~ @214;% 08054000
FORGETSPACE(BUFF);% 08055000
END;% 08056000
END;% 08057000
PROCEDURE GIMEDATE(B,DT); VALUE B,DT; REAL B,DT; FORWARD; 08070000
PROCEDURE REWINDANDLOCK(WHAT); VALUE WHAT; REAL WHAT;% 08079000
BEGIN REAL BUFF=WHAT,U;% 08080000
INTEGER I;% 08081000
LABEL EXIT;% 08082000
IF MIXIN(I,U,BUFF) THEN GO TO EXIT;% 08083000
RRRMECH ! RRRMECH OR I;% 08084000
LABELTABLE[U] ~ -@14;% 08085000
MULTITABLE[U] ~ 0;% 08086000
P(WAITIO(@4200000000,0,U),DEL);% 08087000
SLEEP([TOGLE],STATUSMASK); 08088000
RRRMECH ~ RRRMECH AND NOT I;% 08089000
READY ~ READY AND NOT I;% 08090000
LABELTABLE[U] ~ @214;% 08091000
STREAM(BUFF); DS ~ 5 LIT "RW/L~";% 08092000
EXIT: SPOUT(BUFF INX M[BUFF-1]); 08093000
END;% 08094000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%08095050
%**********************************************************************%08095100
%* *%08095150
%* P R I N T D I R E C T O R Y *%08095200
%* - - - - - - - - - - - - - - *%08095250
%* *%08095300
%* PURPOSE: THIS PROCEDURE HANDLES THE PD, EX, LF, LC AND LS *%08095350
%* MESSAGES. ALL MESSAGES ARE FORMS OF THE PD MESSAGE *%08095400
%* EXCEPT FOR CERTAIN DIFFERENCES. THE PD MESSAGE WILL *%08095450
%* LIST THE NAMES OF THE DESIRED FILES AS WELL AS *%08095500
%* CERTAIN PIECES OF INFORMATION IF REQUESTED. *%08095550
%* *%08095600
%* SYNTAX: THE FORMAT OF ALL THE KEYIN MESSAGES WITH THE *%08095650
%* EXCEPTION OF THE LF MESSAGE IS AS FOLLOWS: *%08095700
%* *%08095750
%* <MESSAGE> <FILE SPECIFIER> <OPTION-LIST> *%08095800
%* *%08095850
%* <MESSAGE> ::= PD / EX / LC / LS *%08095900
%* *%08095950
%* <FILE SPECIFIER> ::= <FILENAME> / <FILENAME> "/" *%08096000
%* <FILENAME> *%08096050
%* *%08096100
%* <OPTION-LIST> ::= <EMPTY> / <OPTION> / <OPTION> , *%08096150
%* <OPTION-LIST> *%08096200
%* *%08096250
%* <OPTION> ::= RECS / LAST / DATE / SAVE / SIZE / *%08096300
%* CREATOR / SECURITY / ALL *%08096350
%* *%08096400
%* <FILENAME> ::= [FROM 1 TO 7 CHARACTERS OPTIONALLY *%08096450
%* ENCLOSED IN QUOTES] / = *%08096500
%* *%08096550
%* THE SYNTAX FOR THE LF MESSAGE IS: *%08096600
%* *%08096650
%* LF <USERID> <OPTION-LIST> *%08096700
%* *%08096750
%* SEMANTICS: THE EX, LF, LC, AND LS MESSAGES ARE JUST *%08096800
%* MODIFIED FORMS OF THE PD MESSAGE. THE EX MESSAGE IS *%08096850
%* THE SAME AS A PD EXCEPT THAT ONLY THE EXPIRED FILES *%08096900
%* ARE LISTED. THE LF IS THE SAME AS A PD=/= EXCEPT *%08096950
%* THAT ONLY THE FILES BELONGING TO THE SPECIFIED USER *%08097000
%* ARE LISTED. THE LC MESSAGE IS THE SAME AS A "PD *%08097050
%* <FILE SPECIFIER> CREATOR". THE LS MESSAGE IS THE *%08097100
%* SAME AS "PD <FILE SPECIFIER> SECURITY,CREATOR". *%08097150
%* *%08097200
%* THE OPTIONS SPECIFY WHAT ADDITIONAL INFORMATION *%08097250
%* IS TO BE LISTED BESIDES THE DEFAULT INFORMATION, IF *%08097300
%* AN UNRECOGNIZABLE WORD IS ENCOUNTERED IN THE OPTION *%08097350
%* LIST, IT IS IGNORED. THE AVAILABLE OPTIONS ARE: *%08097400
%* *%08097450
%* RECS - NUMBER OF RECORDS IN THE FILE, (SPECIAL LOGIC *%08097500
%* IS INCORPORATED TO THE LIST THE CORRECT NUMBER *%08097550
%* FOR BACKUP FILES). *%08097600
%* *%08097650
%* LAST - LAST ACCESS DATE. *%08097700
%* *%08097750
%* DATE - CREATION DATE. *%08097800
%* *%08097850
%* SAVE - SAVE FACTOR. *%08097900
%* *%08097950
%* SIZE - SIZE OF THE FILE IN SEGMENTS. *%08098000
%* *%08098050
%* CREATOR - PRIVILEGED USERCODE ASSOCIATED WITH FILE. *%08098100
%* (FOR BACKUP FILES THE LABEL OF THE PRINT FILE *%08098150
%* AND THE NAME OF THE PROGRAM CREATING THE BACKUP *%08098200
%* IS ALSO LISTED). *%08098250
%* *%08098300
%* SECURITY - ACCESS PRIVILEGES OF THE FILE, I.E., *%08098350
%* LOCKED, UNLOCKED, PUBLIC, PRIVATE, FREE. *%08098400
%* *%08098450
%**********************************************************************%08098500
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%08098550
PROCEDURE PRINTDIRECTORY(BUFF,CODE); %152-08098600
VALUE BUFF,CODE; %152-08098650
REAL BUFF, %152-08098700
BEGIN %152-08098750
%152-08098800
INTEGER %152-08098850
I, % NORMALLY CONTAINS OPTION NUMBER. %152-08098900
J; % JUNK. %152-08098950
%152-08099250
REAL %152-08099300
MFID, % MFID OF DESIRED FILE OR -1 IF "=". %152-08099350
FID, % FID OF DESIRED FILE OR -1 IF "=". %152-08099400
C, % ADDRESS OF DISK HEADER. %152-08099450
D, % MFID OF LAST FILE FOUND BY SEEKNAM. %152-08099500
E, % FID OF LAST FILE FOUND BY SEEKNAM. %152-08099550
N, % WORK VARIABLE USED BY SEEKNAM TO SAVE INFO. %152-08099600
T, % NORMALLY USED TO SAVE DEST. INDEX. %152-08099650
INFO, % BIT MASK FOR OPTIONS SELECTED. %152-08099700
LABELREC, % ADDRESS OF LABEL RECORD FOR PDB ( IF LC ). %152-08099750
STA, % ORIGINATING STATION. TU/BUFF IN [9:9] FIELD. %152-08099775
USERID, % USERID IF LF. %152-08099800
X; % JUNK. %152-08099850
%152-08099900
ARRAY %152-08099950
HDR[*], % DESCRIPTOR TO DISK HEADER. %152-08100000
XLST[*];% SOME DAY WE MAY ALLOW EXCEPTION LIST. %152-08100050
%152-08100100
BOOLEAN %152-08100150
PBDTOG, % TRUE IF SELECTED FILE IS A PBD. %152-08100200
FOUNDAFILE; % TRUE IF WE LISTED OUT AT LEAST ONE FILE. %152-08100250
%152-08100300
LABEL EXIT,DROPOUT,DUMMY,OPTIONS; %152-08100350
DEFINE NUMOPTS = 7#; %152-08100500
DEFINE %152-08100510
TUANDBUF = [9:9]%, % TU/BUFF STORED IN [9:9] FIELD. %152-08100520
STATUANDBUF = STA.TUANDBUF#; % TU/BUFF OF ORIGINATING STATION. %152-08100530
DEFINE PD = (CODE = 0)#, %152-08100550
EX = (CODE = 1)#, %152-08100600
LC = (CODE = 2)#, %152-08100650
LF = (CODE = 3)#, %152-08100700
LS = (CODE = 4)#; %152-08100750
DEFINE %152-08100800
PRIMARYUSER = HDR[2]#, % PRIV. USER CODE. %152-08100850
SAVEFACTOR = HDR[3].[2:10]#, % SAVE FACTOR. %152-08100900
LASTACCESSDATE = HDR[3].[12:18]#, % LAST ACCESS DATE. %152-08100950
CREATIONDATE = HDR[3].[30:18]#, % CREATION DATE. %152-08101000
GUARDFILEMFID = HDR[5]#, % MFID OF GUARD FILE. %152-08101050
GUARDFILEFID = HDR[6]#, % FID OF GUARD FILE. %152-08101100
PBDTUANDBUF = HDR[6].[39:9]#, % RJE TU/BUFF FOR PBD. %152-08101110
PBDTU = HDR[6].[39:4]#, % RJE TU NUMBER FOR PBD. %152-08101120
PBDBUF = HDR[6].[44:4]#, % RJE BUF NUMBER FOR PBD. %152-08101130
EOFPOINTER = HDR[7]#, % EOF POINTER. %152-08101150
SEGSPERROW = HDR[8]#, % SEG. POER ROW. %152-08101200
NOOFROWS = HDR[9].[43:5]#, % NO. OF ROWS DECLARED. %152-08101250
HEADERADDRESS = HDR.[CF]#; % CORE ADDRESS OF HEADER. %152-08101300
%******************** S U B R O U T I N E S **************************08101350
SUBROUTINE GETREADY; %152-08101400
% ---------- -------- %152-08101450
BEGIN %152-08101500
STA := M[(BUFF := (T:=BUFF).[15:15] -1) -1]; %152-08101520
$ SET OMIT = NOT(DATACOM) %152-08101540
INFO := 0 & (LC OR LF OR LS)[42:47:1] & LS[43:47:1]; %152-08101650
END OF GETREADY; %152-08101700
% %152-08101750
SUBROUTINE GETFILESPECIFIER; %152-08101800
% ---------- ---------------- %152-08101850
BEGIN %152-08101900
NAMEID(MFID,T); % GET MFID (OR USERCODE IF "LF") %152-08101950
IF LF THEN USERID := MFID; % FIRST THING IS USERID FOR LF. %152-08102000
IF MFID = "~~ " OR LF THEN %152-08102050
MFID := - 1; %152-08102100
NAMEID(FID,T); %152-08102150
IF FID = "/ " THEN % GET FID %152-08102200
BEGIN %152-08102250
NAMEID(FID,T); %152-08102300
NAMEID(N,T); % GET NEXT ITEM. %152-08102350
END %152-08102400
ELSE % NO FID SPECIFIED IMPLIES FID OF "=" %152-08102450
BEGIN %152-08102500
N := FID; %152-08102550
FID := -1; %152-08102600
END; %152-08102650
IF FID.[6:6] = LEFTARROW OR LF THEN % NO FID SPECIFIED %152-08102700
FID := - 1; %152-08102750
END OF GETFILESPECIFIER; %152-08102800
% %152-08102850
SUBROUTINE PROCESSOPTIONLIST; %152-08102900
% ---------- ----------------- %152-08102950
BEGIN %152-08103000
WHILE N ! "~ " DO % ACCUMULATE OPTIONS %152-08103050
BEGIN %152-08103100
FOR I := -1 STEP 1 UNTIL (NUMOPTS - 2) DO %152-08103150
DUMMY:: IF P(.OPTIONS,I,+,LOD) = N THEN % MATCHES AN OPTION WORD 08103200
BEGIN %152-08103250
INFO := INFO OR TWO(I+1); % SET BIT CORRESPONDING TO OPT08103300
GO TO DROPOUT; %152-08103350
END %152-08103400
ELSE % CHECK FOR "ALL" %152-08103450
IF N = "ALL " THEN % SET ALL OPTION WORD BITS. %152-08103500
INFO := NOT 0; %152-08103550
DROPOUT: %152-08103600
NAMEID(N,T); % GET NEXT OPTION WORD. %152-08103650
IF N = ", " THEN NAMEID(N,T); % SKIP OVER COMMA. %152-08103700
END; %152-08103750
GO TO EXIT; %152-08103800
% %152-08103850
OPTIONS ::: "RECS ", % OPTION 0 (INFO.[47:1]) %152-08103900
"LAST ", % OPTION 1 (INFO.[46:1]) %152-08103950
"DATE ", % OPTION 2 (INFO.[45:1]) %152-08104000
"SIZE ", % OPTION 3 (INFO.[44:1]) %152-08104050
"SECURIT", % OPTION 4 (INFO.[43:1]) %152-08104100
"CREATOR", % OPTION 5 (INFO.[42:1]) %152-08104150
"SAVE "; % OPTION 6 (INFO.[41:1]) %152-08104200
EXIT: %152-08104250
END OF PROCESSOPTIONLIST; %152-08104300
% %152-08104350
SUBROUTINE GETSET; %152-08104400
% ---------- ------ %152-08104450
BEGIN %152-08104500
IF EX OR INFO ! 0 OR (PD AND USERID ! 0) THEN % WE WILL NEED HDR. 08104550
HDR := IOQUE & SPACE(30) [CTC]; %152-08104600
END OF GETSET; %152-08104650
% %152-08104700
BOOLEAN SUBROUTINE WEGOTAFILE; %152-08104750
% ------- ---------- ---------- %152-08104800
BEGIN %152-08104850
SEEKNAM(MFID,FID,C,D,E,N,XLST); % FIND A FILE. %152-08104900
WEGOTAFILE := C ! 0; % C IS ADDRESS OF DISK HEADER. %152-08104950
END OF WEGOTAFILE; %152-08105000
% %152-08105050
BOOLEAN SUBROUTINE WEWANTTHISFILE; %152-08105100
% ------- ---------- -------------- %152-08105150
BEGIN %152-08105200
PBDTOG := ((D EQV "PBD ") = NOT 0 OR (D EQV "PUD ") %152-08105250
= NOT 0); %152-08105300
IF HEADERADDRESS ! 0 THEN % WE NEED THE HEADER. %152-08105350
DISKWAIT(-HEADERADDRESS,30,C); % READ HEADER. %152-08105400
IF LF THEN % CHECK TO SEE IF WE WANT THIS FILE. %152-08105450
WEWANTTHISFILE := PRIMARYUSER = USERID %152-08105500
ELSE %152-08105550
IF EX THEN %152-08105600
BEGIN %152-08105650
STREAM(A:=CALCULATEPURGE(-SAVEFACTOR),X:=[X]); %152-08105700
BEGIN %152-08105750
SI := LOC A; DS := 8 OCT; %152-08105800
END; %152-08105850
WEWANTTHISFILE := X > LASTACCESSDATE; % TRUE IF FILE EXPIRED08105900
END %152-08105950
ELSE %152-08106000
IF PD AND USERID ! 0 THEN % NEED TO CHECK SECURITY. %152-08106020
WEWANTTHISFILE := SECURITYCHECK(D,E,USERID,HEADERADDRESS)!0 08106040
ELSE %152-08106060
WEWANTTHISFILE := TRUE; %152-08106080
END OF WEWANTTHISFIE; %152-08106100
% %152-08106150
SUBROUTINE PUTINFILENAME; %152-08106200
% ---------- ------------- %152-08106250
BEGIN %152-08106300
STREAM(A:=0 : D, E, BUFF); % SET UP FILE NAME. %152-08106350
BEGIN %152-08106400
SI := LOC D; %152-08106450
DS := LIT " "; %152-08106500
2 ( SI := SI + 1; DS := 7 CHR; DS := LIT "/"); %152-08106550
DI := DI - 1; %152-08106600
DS := 2 LIT " "; % NEED 2 SPACES TO ALLOW FOR ARROW. %152-08106650
A := DI; %152-08106700
END; %152-08106750
T := P; % SAVE OFF DEST. INDEX. %152-08106800
END OF PUTINFILENAME; %152-08106850
% %152-08106900
SUBROUTINE DORECS; %152-08106950
% ---------- ------ %152-08107000
BEGIN %152-08107050
STREAM(A:=IF PBDTOG THEN EOFPOINTER|5 ELSE EOFPOINTER+1 :T); %152-08107100
%152-08107150
BEGIN %152-08107200
DS := 9 LIT "RECORDS: "; %152-08107250
SI := LOC A; %152-08107300
DS := 8 DEC; % CONVERT NUMBER OF RECORDS TO DEC. %152-08107350
A := DI; % SAVE OFF DI BEFORE ZERO SUPPRESSING. %152-08107400
DI := DI - 8; %152-08107450
DS := 7 FILL; %152-08107500
END; %152-08107550
T := P; % SAVE DESTINATION ADDRESS. %152-08107600
END OF DORECS; %152-08107650
% %152-08107700
SUBROUTINE DODATEORLAST; %152-08107750
% ---------- ------------ %152-08107800
BEGIN %152-08107850
% %152-08107900
STREAM(X:=[X]); %152-08107950
BEGIN %152-08108000
SI := X; %152-08108050
DS := 8 DEC; % CONVERT DATE TO DECIMAL. %152-08108100
END; %152-08108150
GIMEDATE([X].[CF],-X); % CONVERT JUILIAN DATE TO 6 DIGITS. %152-08108200
STREAM(A:=(I=1) : X, T); %152-08108250
BEGIN %152-08108300
A ( DS := 10 LIT "ACCESSED: "; JUMP OUT TO L1); %152-08108350
DS := 9 LIT "CREATED: "; %152-08108400
L1: %152-08108450
SI := LOC X; %152-08108500
SI := SI + 2; %152-08108550
3 ( DS := 2 CHR; DS := LIT "/"); %152-08108600
DI := DI - 1; % ERASE THE EXTRA SLASH. %152-08108650
A := DI; % SAVE DEST. INDEX. %152-08108700
END; %152-08108750
T := P; % SAVE DESTINATION ADDRESS. %152-08108800
END OF DODATEORLAST; %152-08108850
% %152-08108900
SUBROUTINE DOSIZE; %152-08108950
% ---------- ------ %152-08109000
BEGIN %152-08109050
NT2 := NOOFROWS; % NO. OF ROWS DECLARED. %152-08109100
NT1 := 0; % NUMBER OF ROWS PROCESSED. %152-08109150
FOR J := 1 STEP 1 UNTIL NT2 DO % CHECK TO SEE IF ROW EXISTS. %152-08109200
IF HDR[J+9] ! 0 THEN NT1 := NT1 + 1; % BUMP UP COUNT. %152-08109250
STREAM(A:=NT1|SEGSPERROW : T); %152-08109300
BEGIN %152-08109350
DS := 10 LIT "SEGMENTS: "; %152-08109400
SI := LOC A; %152-08109450
DS := 8 DEC; %152-08109500
A := DI; %152-08109550
DI := DI - 8; %152-08109600
DS := 7 FILL; %152-08109650
END; %152-08109700
T := P; % SAVE DESTINATION ADDRESS. %152-08109750
END OF DOSIZE; %152-08109800
% %152-08109850
SUBROUTINE DOSECURITY; %152-08109900
% ---------- ---------- %152-08109950
BEGIN %152-08110000
J:= IF PRIMARYUSER = 0 THEN % FREE FILE %152-08110050
ELSE IF GUARDFILEMFID = "?" THEN % UNLOCK OR PUBLIC %152-08110100
IF GUARDFILEFID = "?" THEN 1 % UNLOCKED %152-08110150
ELSE 2 % PUBLIC %152-08110200
ELSE IF GUARDFILEMFID < 0 THEN 3 % PRIVATE %152-08110250
ELSE 4; % LOCKED %152-08110300
STREAM(J := A:=GUARDFILEMFID, B:=GUARDFILEFID, T); %152-08110350
BEGIN %152-08110400
DS := 10 LIT "SECURITY: "; %152-08110450
CI := CI + J; %152-08110500
GO TO FREE; %152-08110550
GO TO UNLOK; %152-08110600
GO TO PUBLIC; %152-08110650
GO TO PRIVATE; %152-08110700
LOCK: DS := 6 LIT "LOCKED"; GO TO EXIT; %152-08110750
PRIVATE:DS := 22 LIT "PRIVATE (SECURED WITH "; %152-08110800
SI := LOC A; %152-08110850
2 ( SI := SI + 1; DS := 7 CHR; DS := LIT "/"); %152-08110900
DI := DI - 1; %152-08110950
DS := LIT ")"; %152-08111000
GO TO EXIT; %152-08111050
PUBLIC: DS := 6 LIT "PUBLIC"; GO TO EXIT; %152-08111100
UNLOK: DS := 8 LIT "UNLOCKED"; GO TO EXIT; %152-08111150
FREE: DS := 4 LIT "FREE"; %152-08111200
EXIT: J := DI; %152-08111250
END; %152-08111300
T := P; % SAVE DESTINATION ADDRESS. %152-08111350
END OF DOSECURITY; %152-08111400
% %152-08111450
SUBROUTINE DOCREATOR; %152-08111500
% ---------- --------- %152-08111550
BEGIN %152-08111600
$SET OMIT = PACKETS %152-08111650
$SET OMIT = NOT(PACKETS) %152-08111800
IF J:=(PBDTOG AND (E.[42:6] = 1)) THEN % REEL 1 OF PBD %152-08111850
$POP OMIT %152-08111900
BEGIN %152-08111950
IF LABELREC = 0 THEN LABELREC := SPACE(30); %152-08112000
DISKWAIT(-LABELREC,30,HDR[10]+2); %152-08112050
END; %152-08112100
STREAM(J : B:= PRIMARYUSER=0, C:=PRIMARYUSER, %152-08112150
RJE := PBDTUANDBUF!0, TU:=PBDTU, BUF:=PBDBUF, %152-08112175
D:=LABELREC INX 12, T); %152-08112200
BEGIN %152-08112250
DS := 9 LIT "CREATOR: "; %152-08112300
B ( DS := 4 LIT "NONE"; JUMP OUT TO L2 ); %152-08112350
SI := LOC C; %152-08112400
SI := SI + 1; %152-08112450
DS := 7 CHR; %152-08112500
L2: %152-08112550
J ( DS := 2 LIT " ("; %152-08112600
SI := D; %152-08112650
2 ( SI := SI + 1; DS := 7 CHR; DS := LIT "/"); %152-08112700
DI := DI - 1; DS := 4 LIT " OF "; %152-08112750
2 ( SI := SI + 1; DS := 7 CHR; DS := LIT "/"); %152-08112800
DI := DI - 1; %152-08112820
RJE (DS := 2 LIT " ["; SI := TU; %152-08112840
DS := 2 DEC; DS := LIT "/"; DS := 2 DEC; %152-08112860
DS := LIT "]"); %152-08112880
DS := LIT ")"); %152-08112890
J := DI; %152-08112900
END; %152-08112950
T := P; % SAVE DESTINATION ADDRESS. %152-08113000
END OF DOCREATOR; %152-08113050
% %152-08113100
SUBROUTINE DOSAVEFACTOR; %152-08113150
% ---------- ------------ %152-08113200
BEGIN %152-08113250
STREAM(A := SAVEFACTOR : T); %152-08113300
BEGIN %152-08113350
DS := 6 LIT "SAVE: "; %152-08113400
SI := LOC A; %152-08113450
DS := 3 DEC; %152-08113500
A := DI; %152-08113550
DI := DI - 3; %152-08113600
DS := 2 FILL; %152-08113650
END; %152-08113700
T := P; % SAVE DESTINATION ADDRESS; %152-08113750
END OF DOSAVEFACTOR; %152-08113800
% %152-08113850
SUBROUTINE DOOPTIONS; %152-08113900
% ---------- --------- %152-08113950
BEGIN %152-08114000
FOR I := 0 STEP 1 UNTIL (NUMOPTS - 1) DO % SEE IF OPTION BIT SET. 08114050
IF (TWO(I) AND INFO) ! 0 THEN %OPTION SELECTED. %152-08114100
BEGIN %152-08114150
CASE I OF %152-08114200
BEGIN %152-08114210
DORECS; % CASE 0 - "RECS" %152-08114250
BEGIN % CASE 1 - "LAST" %152-08114290
X := LASTACCESSDATE; %152-08114300
DODATEORLAST; %152-08114310
END OF CASE 1; %152-08114320
BEGIN % CASE 2 - "DATE" %152-08114340
X := CREATIONDATE; %152-08114350
DODATEORLAST; %152-08114360
END OF CASE 2; %152-08114370
DOSIZE; % CASE 3 - "SIZE" %152-08114400
DOSECURITY; % CASE 4 - "SECURITY" %152-08114450
DOCREATOR; % CASE 5 - "CREATOR" %152-08114500
DOSAVEFACTOR; % CASE 6 - "SAVE" %152-08114550
END OF CASES; %152-08114600
STREAM(I : T); % PUT COMMA AFTER LAST OPTION. %152-08114650
BEGIN %152-08114700
DS := 2 LIT ", "; %152-08114750
I := DI; %152-08114800
END; %152-08114850
T := P; %152-08114900
END OF LOOP TO PROCESS OPTIONS; %152-08114950
END OF DOOPTIONS; %152-08115000
% %152-08115050
SUBROUTINE MAKETHEMESSAGE; %152-08115100
% ---------- -------------- %152-08115150
BEGIN %152-08115200
IF FOUNDAFILE THEN % WE NEED A BUFFER. %152-08115250
BUFF := SPACE(30); %152-08115300
PUTINFILENAME; %152-08115350
DOOPTIONS; %152-08115400
STREAM(T); % PUT IN THE LEFT ARROW. %152-08115450
BEGIN %152-08115500
DI := DI -2; %152-08115550
DS := LIT LEFTARROW; %152-08115600
END; %152-08115650
END OF MAKETHEMESSAGE; %152-08115700
% %152-08115750
SUBROUTINE COMPLAIN; %152-08115800
% ---------- -------- %152-08115850
BEGIN %152-08115900
STREAM(BUFF); %152-08115950
DS := 8 LIT " NULL "; % ORIGINAL INPUT IS AT BUFF + 1, %152-08116000
SPOUT(BUFF INX STA); %152-08116050
END OF COMPLAIN; %152-08116100
% %152-08116150
SUBROUTINE FORGETEVERYTHING; %152-08116200
% ---------- ---------------- %152-08116250
BEGIN %152-08116300
IF HEADERADDRESS ! 0 THEN FORGETSPACE(HEADERADDRESS); %152-08116350
IF LABELREC ! 0 THEN FORGETSPACE(LABELREC); %152-08116400
END OF FORGETEVERYTHING; %152-08116450
%******************** S T A R T O F C O D E ***********************08116500
GETREADY; %152-08116550
GETFILESPECIFIER; %152-08116600
PROCESSOPTIONLIST; %152-08116650
GETSET; %152-08116700
WHILE WEGOTAFILE DO %152-08116750
IF WEWANTTHISFILE THEN %152-08116800
BEGIN %152-08116850
MAKETHEMESSAGE; %152-08116900
SPOUT(BUFF INX STA); %152-08116950
FOUNDAFILE := TRUE; %152-08117000
END; %152-08117050
IF NOT FOUNDAFILE THEN COMPLAIN; %152-08117100
FORGETEVERYTHING; %152-08117150
END OF PRINTDIRECTORY; %152-08117200
$ SET OMIT = NOT(DCSPO AND DATACOM ) 08135999
PROCEDURE CONTINUITYBIT;% 08171000
BEGIN REAL T,IOD,LINK,U;% 08172000
ARRAY A[*]; 08172500
REAL RCW=+0;% 08173000
ARRAY R=-4[*]; DEFINE FIB=A#; %P 08173100
CHECKSTACKSPACE;% %WF 08173200
U ~(LINK ~ NFLAG(M[(IOD ~ NFLAG(M[T~PRT[P1MIX,9]]) INX% 08174000
P(0,LNG,XCH)) INX NOT 0])).[12:6];% 08175000
IF U } 32 THEN 08175100
BEGIN A ~ M[T]; 08175200
IF READEMFROMDISK(CIDROW[U-32],A) THEN 08175300
M[T] ~ A&1[27:47:1]&0[2:47:1] ELSE 08175400
M[1] ~ R; GO TO RETURN; 08175500
END; 08175600
M[IOD INX NOT 1]~FLAG(LINK); FIB~M[T-3]; %P 08176000
M[FIX[14]INX 17]~[M[FIB[5].[FF]]]&IOD[3:3:30]&0[20:20:1]; 08177000
;FIB[5]~P(DUP,LOD,0,1,CFX,ADD); %P 08177100
IF FIB[14].[FF]{FIB[14].[CF] THEN %% BUFFER FULL %P 08177200
PBIO(T,FIB[14]) %P 08178000
ELSE %P 08179000
BEGIN; STREAM(A~FIB[14].[CF], B~FIB[14].[FF]); %P 08179600
BEGIN SI~A; DS~18 WDS END; %P 08179700
FIB[14].[FF]~FIB[14].[FF]-18; %P 08179800
END; %P 08179900
GO RETURN %P 08180000
END CONTINUITYBIT; %P 08181000
BOOLEAN PROCEDURE PRINTORPUNCHWAIT(Q,PNCH);VALUE Q,PNCH;REAL Q,PNCH; 08255000
% 08255050
% THIS PROCEDURE IS RESPONSIBLE FOR STARTING PRNPBT/DISK. IT CHECKS 08255055
% FOR I/O UNITS AS REQUIRED AND, IF AVAILABLE, GRABS THEM. THE 08255060
% PARAMETERS ARE: 08255065
% Q {-16 LOGICAL UNIT NUMBER FOR OUTPUT. TAPES AND DISK ARE 08255070
% SEARCHED TO FIND A FILE TO PRINT. THIS IS USED ONLY 08255075
% WHEN AUTOPRINT IS SET OR FOR RJE. 08255080
% >-16, {0 LOGICAL UNIT NUMBER OF A BACK-UP TAPE. CHECK FOR AN 08255085
% AVAILABLE OUTPUT UNIT. 08255090
% >0 FID OF A DISK FILE. CHECK FOR OUTPUT UNIT. 08255095
% PNCH.[47:1] ON FOR PUNCH BACK-UP. 08255100
% [39:8] NUMBER OF COPIES FROM PB MESSAGE. 08255105
% [31:8] IF TAPE, NUMBER OF FILE TO PRINT (FROM PB). 08255110
% IF DISK, =0 IF ENTRIE PACKET SHOULD BE PRINTED, =1 IF08255115
% NOT. 08255120
% [30:1] ON IF =0 WAS USED IN PB MSG. 08255122
% [9:9] RJE TU/BUFF. 08255125
% [2:1] ON IF CALLED FROM PRINTBACKUP, I.E, A PB MESSAGE. 08255130
% [1:1] ON IF CALLED FROM PRNPBT/DISK. 08255135
% 08255140
BEGIN INTEGER U,V,I,J,J1,J2,S; 08255200
REAL A,HDR,SEG0=S,F=J; 08255400
REAL PBT,PBD,PUD; 08255500
ARRAY D[*],SHEAT=D[*]; 08255600
LABEL TRYAGAIN,PRNPBT,DISK; 08255700
LABEL FOUND,FIREITUP,QUIT; %717-08255800
DEFINE MFID = (IF V=22 THEN PUD ELSE PBD)#; 08255900
DEFINE STACURR = STATION[STA.[44:4],STA.[39:4]]#; 08256000
$ SET OMIT = SHAREDISK 08256190
DEFINE SIXTY = 60%; 08256200
$ SET OMIT = NOT SHAREDISK 08256210
$ SET OMIT = NOT RJE 08256390
% 08256420
SUBROUTINE LABELTHEPRINTER; 08256430
BEGIN LABELTABLE[V]:=Q&@21[1:43:5]; 08256440
MULTITABLE[V]:=IF V=22 THEN PUD ELSE PBD; 08256450
END; 08256460
% 08256470
PBT := "PBT "; PUD := "PUD "; PBD := "PBD "; 08256500
$ SET OMIT = NOT(DATACOM AND RJE ) 08256699
IF Q}(-15) THEN %%% PR GIVEN: LOOK FOR LP. 08257000
BEGIN 08257100
$ SET OMIT = NOT(DATACOM AND RJE ) 08257199
IF PNCH THEN IF LABELTABLE[V:=22]!0 THEN V:=0 ELSE ELSE 08257500
IF LABELTABLE[V~20]!0 THEN 08257600
IF LABELTABLE[V~21]!0 THEN V~0; 08258000
IF V!0 THEN % WE HAVE AN OUTPUT UNIT 08258200
IF Q>0 THEN % BACK-UP DISK 08258400
BEGIN U:=18; 08258600
LABELTHEPRINTER; % TO HOLD IT DURING DISK I/O-S. 08258700
IF AUTOPRINT % CHECK IF A PRNPBT WAS STARTED; 08258800
$ SET OMIT = NOT RJE % IF SO, START THIS ONLY FOR PB. 08258990
THEN 08259200
IF (A:=DIRECTORYSEARCH(MIFD,Q,19))!0 THEN 08259225
BEGIN IF M[A+4].[6:1] THEN% NOT FIRST TIME. 08259250
BEGIN 08259275
$ SET OMIT = NOT SHAREDISK 08259300
P(PNCH.[2:1]); % SEE 08259625 08259375
END ELSE % FIRST TIME, MARK IT. 08259400
BEGIN M[A+4].[6:1]:=1; 08259425
DISKWAIT(A.[CF],-30,A.[FF]); 08259450
P(1); 08259475
END; 08259500
FORGETSPACE(A); 08259525
$ SET OMIT = SHAREDISK 08259550
UNLOCKDIRECTORY; 08259575
$ POP OMIT 08259600
IF P THEN ELSE GO QUIT; 08259625
END ELSE GO QUIT; 08259650
GO FIREITUP; 08259700
END ELSE % Q{0, PB MT %717-08259800
BEGIN RRRMECH~TWO(U~ABS(Q)) OR RRRMECH; %717-08259810
LABELTABLE[U] ~ %717-08259820
PBT&TINU[V][6:30:18]&@21[1:43:5]; %717-08259830
MULTITABLE[V] ~ PBT; %717-08259840
LABELTABLE[V] ~ PBT&TINU[U][6:30:18]& %717-08259850
@21[1:43:5]; %717-08259860
GO FIREITUP; %717-08259870
END %717-08259880
ELSE GO QUIT; % V =0, NO OUTPUT UNIT 08260000
END; 08260250
BEGIN V:=ABS(Q); % LP (OR PUNCH) GIVEN, LOOK FOR FILE. 08260500
IF PBCOUNT!0 THEN % TRY FOR DISK 08267000
BEGIN D:=[M[SPACE(90)]]&90[8:38:10]; 08267500
$ SET OMIT = SHAREDISK 08267990
LOCKDIRECTORY; 08268000
$ POP OMIT 08268010
A:=MFID; 08268500
J1:=(A.[6:18] + A.[24:24]) MOD MODULUS; 08268600
FOR J2:=0 STEP 1 UNTIL (MODULUS-1) DO 08268700
BEGIN 08268750
$ SET OMIT = NOT SHAREDISK 08268790
J:=SCRAMBLE(J1,J2); 08268900
DO BEGIN DISKWAIT(-(D INX 30),SIXTY,J); 08268950
FOR I:=30 STEP 3 UNTIL 87 DO 08269000
IF (D[I] EQV A) = NOT 0 THEN 08269100
IF D[I+1].[CF]=1 THEN 08269200
BEGIN DISKWAIT(-D.[CF],-30,D[I+2].[CF]); 08269300
IF D[4].[1:3] ! 0 OR D[4].[6:1] 08269400
$ SET OMIT = NOT(RJE AND DATACOM ) 08269499
$ SET OMIT = NOT(PACKETS) 08269509
OR LABELTABLE[IF V=20 THEN 21 ELSE 08269510
IF V=21 THEN 20 ELSE 22].[6:24] 08269520
=D[I+1].[6:24] 08269530
$ POP OMIT 08269531
OR (D[4].[16:20] OR D[9].[1:28])!0 08269600
THEN 08269650
$ SET OMIT = NOT SHAREDISK 08269690
ELSE 08269750
BEGIN D[4].[6:1]:=1; 08269800
PBCOUNT:=PBCOUNT-1; 08269900
DISKWAIT(D.[CF],-30,D[I+2].[CF]);08270000
$ SET OMIT = NOT SHAREDISK 08270040
U:=18; 08270100
Q:=D[I+1]; 08270200
GO FOUND; 08270300
END END; 08270350
$ SET OMIT = NOT SHAREDISK 08270390
END UNTIL (J:=D[32].[FF])=0; 08270450
$ SET OMIT = NOT SHAREDISK 08270490
END; 08270550
FOUND: FORGETSPACE(D); 08270600
$ SET OMIT = SHAREDISK 08270640
UNLOCKDIRECTORY; 08270650
$ POP OMIT 08270660
END SEARCHING FOR DISK; 08270700
END; 08270725
% IF WE HAVE BOTH AN INPUT FILE AND AN OUTPUT UNIT, 08270740
% FIRE UP PRNPBT/DISK. 08270745
IF U!0 AND V!0 THEN 08270750
BEGIN 08270800
$ SET OMIT = NOT(DATACOM AND RJE ) 08270819
LABELTHEPRINTER; 08271000
FIREITUP: 08271750
A:=V&U[38:43:5]&PNCH[21:30:17]; 08272000
$ SET OMIT = NOT RJE 08272240
IF PNCH.[1:1] THEN P(A) ELSE 08272250
BEGIN 08272500
TRYAGAIN: 08272600
IF (HDR:=DIRECTORYSEARCH(P(PRNPBT),P(DISK),3)) ! 0 THEN 08272750
BEGIN 08273000
SHEAT := [M[F:=TYPEDSPACE(31,SHEETAREAV)]]&30[SIZE]; 08273250
M[F-1].[9:6] := 0; M[HDR INX NOT 1],[9:6]:=0; 08273260
MOVE(30,F-1,F); 08274500
SEG0 := TYPEDSPACE(30,SEGZEROAREAV);% %167-08275500
M[SEG0-2].[AREAMIXF] := 0;% %167-08275600
DISKWAIT(-SEG0, 30, M[HDR INX 10]); 08275750
F.[FF] := HDR; % CORE ADDRESS OF HEADER 08276000
SHEAT[7] := SEG0; % CORE ADDRESS OF SEGMENT ZERO 08276050
SHEAT[0] := P(PRNPBT); 08276100
SHEAT[1] := P(DISK); 08276150
SHEAT[2] := 0 & PRBPBTCODE[5:45:3] & 2[8:38:10] & 08276200
%PRIORITY=0.EXECUTE CODE 08276203
(PNCH.[2:1]=0)[4:47:1]; % SET IF NOT "PB" 08276205
SHEAT[16] := SHEAT[17] := @377777777777; % TIME LIMITS08276210
SHEAT[19] := A; % COMMON VALUE 08276220
SHEAT[20] := 4; % CORE ESTIMATE 08276230
SHEAT[21] := 150; % STACK SIZE 08276240
08276250
STREAM(A:=0: S:=P(.SCHEDULEIDS)); 08276260
BEGIN 08276270
SI:=S; 08276280
47(SKIP SB; SKIP DB; TALLY:=TALLY+1; 08276290
IF SB THEN ELSE JUMP OUT); 08276300
DS:=SET; A:=TALLY; 08276310
END STREAM STATEMENT; 08276320
08276330
I := P; 08276340
SHEAT[3].[8:10] := I; % SCHEDULE NUMBER 08276350
SHEAT[23] := (CLOCK + P(RTR)) DIV 60); 08276360
SHEAT[24] := MCP; %131-08276365
$ SET OMIT = NOT(DATACOM AND RJE) 08276370
SHEAT[25] := HDR.[FF]; % DISK ADDRESS OF FILE HEADER 08276400
STREAM(A, I:=I:=SPACE(11)); 08276410
BEGIN 08276420
DI:=DI+16; 08276430
DS:=30LIT"CC EXECUTE PRNPBT/DISK;COMMON="; 08276440
SI:=LOC A; DS:=8DEC; 08276450
DS:=6LIT";END.~"; 08276460
END STREAM STATEMENT; 08276470
M[I] := 0; M[I+1]:=10; 08276480
SHEAT[6] := GETESPDISK & 10[18:33:15]; 08276490
DISKWAIT(I, 11, SHEAT[6].[CF]); 08276500
FORGETSPACE(I); 08276510
INDEPENDENTRUNNER(P(.SELECTRUN),F,160); 08276520
P(1); 08276530
END ELSE % IF IN DIRECTORY 08276540
BEGIN 08276550
ENTERSYSFILE(3); 08276560
GO TRYAGAIN; 08276570
PRNPBT::: "PRNPBT "; 08276580
DISK::: "DISK "; 08276590
END; 08276600
END; 08277000
PRINTORPUNCHWAIT:=P; 08277500
END ELSE 08278000
08279000
QUIT: IF V NEQ 0 THEN 08280000
$ SET OMIT = NOT(RJE AND DATACOM ) 08280009
LABELTABLE[V]:=MULTITABLE[V]:=0; 08280030
END PRINTWAIT;% 08281000
PROCEDURE PRINTBACKUP(BUFF); VALUE BUFF; REAL BUFF; %P 08282000
% 08282100
% THIS PROCEDURE HANDLES THE PB MESSAGE, MAKING THE NECESSARY CHECKS 08282110
% AND THEN CALLING PRINTORPUNCHWAIT. THE SYNTAX OF THE MESSAGE IS: 08282120
% <PB MSG> ::= PB<INPUT FILE><PB SPECS> 08282140
% <INPUT FILE> ::= <TAPE UNIT> / <DISK FILE NUMBER> 08282150
% <PB SPECS> ::= <PB ELEMENT> / <PB ELEMENT><PB SPECS> / <EMPTY> 08282160
% <PB ELEMENT> ::= P / =<NUMBER OF COPIES> / #<STARTING FILE NUMBER>08282170
% 08282180
BEGIN REAL U,I,COPY,MS,STA,B=BUFF; 08283000
$ SET OMIT = NOT (DATACOM AND DCSPO) 08283400
LABEL OK,BAD,SPIT; 08284000
$ SET OMIT = NOT (DATACOM AND DCSPO) 08284450
STREAM(PCPY:=1, NUMB:=1, N:=1, CPY:=-0: B:=BUFF); 08285000
BEGIN SI~B; DI~LOC N; %P 08286000
L: IF SC=" " THEN BEGIN SI~SI+1; GO TO L END; %P 08287000
IF SC<"0" THEN BEGIN DS~5 LIT"+0000"; DS~3 CHR END ELSE%P 08288000
BEGIN B:=SI; 08289000
4(IF SC<"0" THEN JUMP OUT; TALLY~TALLY+1; SI~SI+1); 08289500
SI:=B; B:=TALLY; DI:=DI+5; DI:=DI-B; 08290000
DS~B CHR; %P 08290500
END; 08291000
LL: IF SC=" " THEN BEGIN SI:=SI+1; GO TO LL END; 08291025
IF SC="=" THEN BEGIN DI:=LOC CPY; GO TO CNT END; 08291050
IF SC="#" THEN 08291075
BEGIN DI:=LOC NUMB; 08291100
CNT: SI:=SI+1; B:=SI; IF SC=" " THEN GO TO CNT;TALLY:=0; 08291125
3(IF SC < "0" THEN JUMP OUT; 08291150
IF SC > "9" THEN JUMP OUT; 08291175
TALLY:=TALLY+1; SI:=SI+1); 08291200
SI:=B; B:=TALLY; DS:=8 OCT; 08291225
GO TO LL; 08291250
END; 08291275
IF SC="P" THEN 08291300
BEGIN TALLY:=0; PCPY:=TALLY; SI:=SI+1; 08291325
5(IF SC=ALPHA THEN IF SC<"0" THEN SI:=SI+1 ELSE 08291350
JUMP OUT ELSE JUMP OUT); 08291375
GO TO LL; 08291400
END; 08291425
END; 08291450
COPY:=(COPY:=P)&(NOT COPY = NOT 0)[31:47:1]; 08291460
% 08291470
% BACK UP TAPE. CHECK THE LABEL THEN CALL PRINTORPUNCHWAIT. 08291475
% 08291480
IF (U:=P) < 0 THEN 08291500
BEGIN COPY:=COPY&(P(XCH)-1)[32:40:8]; 08291750
IF NOT MTXIN(I,U,B) THEN 08292000
IF (STA:=MULTITABLE[U]!"PBTMCP " OR STA) AND 08292500
MULTITABLE[U]!"PUTMCP " THEN 08293000
BEGIN STREAM(BUFF); DS:=19 LIT" NOT A BACKUP TAPE~"; 08293500
GO TO SPIT; 08294000
END 08294500
ELSE 08295000
IF PRINTORPUNCHWAIT(-U, STA&COPY[30:31:17] OR M) THEN 08295200
GO TO OK ELSE BEGIN MS:=-1; GO TO BAD END 08295600
ELSE GO TO SPIT; 08295800
END; 08296000
% BACK UP DISK. SET FIRST REEL NUMBER. IF COPIES OR REEL NUMBER 08296160
% GIVEN, DISK IN "P" BIT, ELSE LEAVE IT OFF TO PRINT ENTIRE 08296170
% THING. CHECK FOR THE FILE, THEN CALL PRINTORPUNCHWAIT. 08296180
% 08296190
% 08296200
STREAM(I:=P: U:=[U]); 08296225
BEGIN SI:=LOC I; DI:=DI+5; 08296250
DS:=3 DEC; 08296275
END; 08296300
I:=P-1; 08296325
IF (COPY OR I).[CF]=0 THEN P(DEL) ELSE 08296350
COPY:=COPY&P(XCH)[39:47:1]; 08296375
BUFF:=BUFF.[15:15]-1; 08296400
IF (I:=DIRECTORYSEARCH("PBD ",U,5))=0 THEN 08296600
IF (I:=DIRECTORYSEARCH("PUD ",U,5))=0 THEN GO TO BAD 08296800
ELSE STA:=STA OR 1; 08297000
P(M[I+4]); 08297200
FORGETSPACE(I); 08297300
IF P.[2:1] THEN BEGIN MS:=2; GO TO BAD END; 08297400
IF PBCOUNT LSS 1 THEN PBCOUNT:=1; 08297600
IF PRINTORPUNCHWAIT(U, STA&COPY[30:31:17] OR M) THEN 08298000
OK: FORGETSPACE(BUFF) 08298200
ELSE 08298400
BEGIN MS:=1; 08298600
BAD: STREAM(MS, X:=MS<0, U:=IF P(DUP) THEN TINU[U] ELSE U, 08298800
BUFF:=BUFF.[CF]); 08299000
BEGIN DS:=8 LIT" NULL PB"; 08299200
SI:=LOC U; CI:=CI+X; GO TO DK; 08299400
SI:=SI+5; DS:=3 CHR; GO TO LL; 08299600
DK: SI:=SI+1; DS:=4 CHR; 08299800
BUFF:=DI; DI:=DI-4; DS:=3 FILL; DI:=BUFF; 08300000
LL: DS:=2 LIT"-("; 08300200
CI:=CI+MS; GO TO L0; GO TO L1; 08300400
DS:= 6 LIT"IN USE"; GO TO L; 08300600
L1: DS:=14 LIT"NO OUTPUT UNIT"; GO TO L; 08300800
L0: DS:=11 LIT"NOT ON DISK"; 08301000
L : DS:= 2 LIT")~"; 08301200
END; 08301400
SPIT: SPOUT(BUFF 08301600
$ SET OMIT = NOT (DATACOM AND DCSPO) 08301650
); 08301800
END; 08302000
END OF PB KEYBOARD MESSAGE HANDLER; 08302500
SAVE PROCEDURE INITIALIZE; FORWARD; 08303000
REAL ACTDATE=INITIALIZE; 08303100
SAVE REAL PROCEDURE COREND; FORWARD; 08303200
REAL WEEKDAY=COREND; 08303300
PROCEDURE TIMEOUT (B); VALUE B; REAL B;% 08305000
BEGIN INTEGER M,H,C;% 08306000
C ~XCLOCK/3600;% 08307000
M ~ C MOD 60;% 08308000
H ~ C DIV 60;% 08309000
STREAM(H,M,B);% 08310000
BEGIN DS ~ 9 LIT " TIME IS ";% 08311000
SI ~ LOC H; DS ~ 2 DEC; DS ~ 2 DEC;% 08312000
DS ~ LIT "~"% 08313000
END;% 08314000
SPOUT(B INX MEMORY[B-1]); 08315000
END;% 08316000
PROCEDURE GIMEDATE(B,DT); VALUE B,DT; REAL B,DT; 08317000
%% PARAMETER USE IS: 08317100
%% B=OUTPUT AREA FOR MESSAGE OR DATE 08317200
%%DT=0 RECONVERT ACTDATE,WEEKDAY THEN SPOUT TIME MSG 08317300
%% DT>0 SPOUT TIME MSG ONLY 08317400
%% DT<0 CONVERT MMDDYY USING DT (ACTDATE,WEEKDAY NOT CHANGED) 08317500
BEGIN REAL M,D,Y,NCV,NMG; 08318000
REAL SUBROUTINE DAY; 08318100
BEGIN;STREAM(M:X~0,Y~0,Z~0); 08318200
BEGIN DI~LOC X; DS~24 LIT"000~0%1.1Y2G2V3D3T4A4 5>";08318300
DI~LOC X; SI~SI+M; SI~SI+M; 08318400
DI~LOC M; DI~DI+6; DS~2 CHR; 08318500
END; 08318600
DAY~P; 08318700
END DAY; 08318800
LABEL DAYS; 08318900
LABEL ON;;% 08319000
IF NOT (NCV~(DT>0)) THEN % NOT PRINT ONLY 08319700
BEGIN 08319900
STREAM(DATE~IF (NMG~DT.[1:1]) THEN DT ELSE DATE,R~[Y]); 08320000
BEGIN SI ~ LOC DATE; SI ~ SI+3;% 08321000
DS~2 OCT; DI~DI-16; DS~3 OCT; 08322000
END;% 08323000
IF Y MOD 4 = 0 AND Y ! 0 THEN% 08324000
BEGIN IF D = 60 THEN% 08325000
BEGIN M~2; GO ON END; 08326000
IF D > 60 THEN D ~D-1;% 08327000
END;% 08328000
FOR M~1 STEP 1 UNTIL 11 DO 08329000
IF DAY}D THEN GO ON; 08330000
ON: M~M-1; 08331000
D~D-DAY; 08332000
IF M<2 THEN P(Y-1,M+11) ELSE P(Y,M-1); 08332100
P(26,|,2,-,10,IDV,D,+,XCH,P(DUP).[36:10],+,+,7,RDV,5,ISN);08332200
:: P(.DAYS,+,LOD); 08332300
M~M+1; 08332400
END ELSE P(WEEKDAY); 08332500
STREAM(M~[M],NMG,NCV,MDY~[ACTDATE],B,DATE,DW~[WEEKDAY]); 08333000
BEGIN NMG(JUMP OUT TO NOMSG); 08334000
SI~LOC M; SI~SI-16; 08334100
NCV(SI~SI+2; JUMP OUT TO NOCNV); 08334300
DS~WDS; SI~SI-6; 08334500
NOCNV: DI~B; DS~9 LIT" DATE IS "; DS~6 CHR; 08334700
DS~5 LIT"DAY, "; B~DI; NCV(JUMP OUT TO NULCV); 08334900
NOMSG: SI~M; NMG(DI~B; JUMP OUT TO NULMS); 08335000
DI~MDY; 08335200
NULMS: DS~4 DEC; DS~2 DEC; DS~2 DEC; 08335400
NMG(JUMP OUT TO OXIT); DI~B; 08335600
NULCV: SI~MDY; SI~SI+2; 08335800
DS~2 CHR; 2(DS~LIT "/"; DS~2 CHR); 08336000
DS:=2 LIT"-("; SI:=LOC DATE; 08336500
SI:=SI+3; DS:=5 CHR; DS:=2 LIT")~"; 08337000
SI:=B; 08337500
3(DI ~ B; DS ~ FILL; SI ~ SI+3; B ~SI);% 08338000
OXIT: END; 08339000
IF DT}0 THEN 08339500
IF NOT NMG THEN SPOUT(B INX MEMORY[B-1]); 08340000
P(XIT); 08340100
DAYS::: " MON"," TUES","WEDNES"," THURS"," FRI"," SATUR", 08340200
" SUN"; 08340300
END;% 08341000
DEFINE DATEOUT(DATEOUT1)=GIMEDATE(DATEOUT1,0)#; %CHANGE DATE & SPOUT IT 08342000
PROCEDURE SETDATE(BUFF); VALUE BUFF; REAL BUFF;% 08343000
BEGIN REAL DY,MN,YR; INTEGER D=DY; REAL B,T=MN; 08344000
REAL SUBROUTINE C; 08344100
BEGIN;STREAM(C~0:B~[B]); 08344200
BEGIN% 08345000
SI ~ B; SI ~ SI+5; SI ~ SC;% 08346000
L: IF SC < "0" THEN% 08347000
BEGIN IF SC = "~" THEN GO TO X;% 08348000
SI ~ SI+1; GO TO L;% 08349000
END;% 08350000
K: IF SC } "0" THEN% 08351000
BEGIN TALLY ~ TALLY+1;% 08352000
SI ~ SI+1; GO TO K END;% 08353000
DI ~ B; B ~ SI; SI ~ LOC B; DS ~ WDS;% 08354000
SI ~ B; B ~ TALLY; DI ~ LOC C;% 08355000
SI ~ SI-B; DS ~ B OCT;% 08356000
X:END;% 08357000
C~P;% 08358000
END C; 08358100
B ~ BUFF;% 08359000
MN~C; DY~C; YR~C;% 08360000
BUFF ~ BUFF.[15:15]-1;% 08361000
IF MN > 0 AND MN { 12 AND% 08362000
DY > 0 AND DY { 31 AND% 08363000
YR > 0 THEN% 08364000
BEGIN;STREAM(M~MN-1:X~0,Y~0,Z~0); 08365000
BEGIN DI~LOC X; DS~24 LIT"000~0%1.1Y2G2V3D3T4A4 5>";08365100
SI~LOC X; SI~SI+M; SI~SI+M; 08365200
DI~LOC M; DI~DI+6; DS~2 CHR; 08365300
END; 08365400
DY~P+DY; 08366000
IF YR MOD 4 = 0 AND MN > 2 AND(YR MOD 100 ! 0 OR% 08367000
YR MOD 400 = 0) THEN% 08368000
DY ~ DY+1;% 08369000
D ~ YR MOD 100 | 1000+DY;% 08370000
STREAM(D,A~[DATE]);% 08371000
BEGIN SI ~ LOC D; DS ~ 8 DEC END;% 08372000
CHANGEDATE(BUFF);% 08373000
END ELSE SPOUT(BUFF INX MEMORY[BUFF -1]); 08374000
END;% 08375000
PROCEDURE CHANGEDATE(BUFF); VALUE BUFF; REAL BUFF;% 08376000
BEGIN REAL B,C,D,T;% 08377000
SLEEP([TOGLE],HOLDMASK); 08378000
LOCKTOG(HOLDMASK); 08379000
B ~ SPACE(30);% 08380000
DISKWAIT(-B,-30,DIRECTORYTOP); 08381000
D:= M[B+1];% 08381100
M[B+1] ~ DATE;% 08383000
M[B+18]:=XCLOCK; 08383100
DISKIO(T,B-1,-30,DIRECTORYTOP); 08384000
IF BUFF!0 THEN 08384100
BEGIN% 08384200
DATEOUT (BUFF);% 08385000
C := TYPEDSPACE(5,MAINTBUFFAREAV);% %167-08385100
M[C ]:= M[C+2]:= 0;% 08385200
M[C+3]:= D;% 08385300
STREAM(DATE,A:=C+1); BEGIN SI:=LOC DATE; DS:=8 OCT; END;% 08385400
LINKUP(17,C);% 08385500
END;% 08385600
SLEEP([T],IOMASK);% 08386000
FORGETSPACE(B);% 08387000
UNLOCKTOG(HOLDMASK); 08388000
END;% 08389000
PROCEDURE SETIME(BUFF); VALUE BUFF; REAL BUFF;% 08390000
BEGIN REAL B=BUFF,T;% 08391000
REAL I,R;% 08392000
LABEL EXIT;% 08393000
REAL CLOCK=XCLOCK;% 08394000
INTEGER CLCK=CLOCK;;% 08395000
T ~ -1;% 08396000
STREAM(B,T~[T]);% 08397000
BEGIN SI ~ B;% 08398000
L: IF SC = " " THEN% 08399000
BEGIN SI ~ SI+1; GO TO L END;% 08400000
IF SC < "0" THEN GO TO X;% 08401000
K: IF SC } "0" THEN% 08402000
BEGIN SI ~ SI+1; TALLY ~ TALLY+1;% 08403000
GO TO K END;% 08404000
B ~ TALLY; SI ~ SI-B; DS ~ B OCT;% 08405000
X:% 08406000
END;% 08407000
BUFF ~ BUFF.[15:15]-1;% 08408000
IF T } 0 AND T DIV 100 < 24 AND T MOD 100 < 60 THEN% 08409000
BEGIN R := TYPEDSPACE(5,MAINTBUFFAREAV);% %167-08410000
M[R+2]:= XCLOCK;% 08410100
CLCK:= (T DIV 100 | 60 + T MOD 100)|3600;% 08410200
CLOCK ~ (CLOCK OR @77)+1;% 08411000
TIMEOUT (BUFF);% 08412000
M[R]:= M[R+3]:= 0;% 08412100
STREAM(DATE,A:=R+1);% 08412200
BEGIN SI:=LOC DATE; DS:=8 OCT; END;% 08412300
LINKUP(17,R);% 08412400
GO TO EXIT;% 08413000
END;% 08414000
SPOUT(BUFF INX MEMORY[BUFF-1]); 08415000
EXIT:% 08416000
END;% 08417000
REAL PROCEDURE FORMESS(BUFF,H1); VALUE BUFF,H1; REAL BUFF,H1; 08418000
BEGIN REAL B,H,U,M1; 08418500
INTEGER I; 08418700
LABEL AGAIN,EXIT,AWAY; 08419000
M1:=M[BUFF.[15:15]-2]; 08419100
STREAM(BUFF:); 08419200
BEGIN SI:=BUFF; 08419300
L: IF SC=" " THEN BEGIN SI:=SI+1; GO TO L END; 08419400
BUFF:=SI; 08419500
END; 08419600
BUFF:=P; 08419700
AGAIN: U:=FORMESS:=UNITIN(TINU,BUFF); 08420000
IF U{31 THEN BEGIN SLEEP([TOGLE],STATUSMASK); 08421000
IF LABELTABLE[U] < 0 THEN% 08422000
BEGIN STREAM(A:=TINU[U],B:=B:=SPACE(5)); 08424000
BEGIN SI ~ LOC A; SI ~ SI + 5; DS ~ 3 CHR;% 08425000
DS:=24LIT" IN USE(TO BE READIED)~"; 08426000
END;% 08427000
SAVEWORD := SAVEWORD AND NOT TWO(U); 08427100
SPOUT(B); 08428000
IF H1 THEN GO AWAY ELSE GO TO EXIT; 08429000
END; 08429500
LABELTABLE[U]:=@114&H1[1:47:1]; 08430000
MULTITABLE[U] ~ 0;% 08431000
I ~ TWO(U);% 08432000
IF H1 THEN B:=NOT 0 ELSE 08433000
BEGIN B:=NOT I; H:=I:=0; 08434000
IF U=23 THEN H:=P(.READERA); 08434100
IF U=24 THEN H:=P(.READERB); 08434200
IF H!0 THEN 08434300
BEGIN UNITCODE[U-23]:=-0; 08434400
IF (*H).[CF]!0 THEN 08434500
BEGIN FORGETSPACE(*H-2); 08434600
M[H]:=0; 08434700
END; 08434800
END; 08434900
END; 08434950
READY ~ READY AND B OR I;% 08435000
RRRMECH ~ RRRMECH AND B OR I;% 08436000
SAVEWORD ~ SAVEWORD AND B OR I;% 08437000
END; 08437050
EXIT: IF NOT H1 THEN 08437100
BEGIN IF U GTR 31 THEN 08437150
BEGIN STREAM(BUFF,B:=B:=SPACE(5)); 08437200
BEGIN DS:=10 LIT"INV KBD RY"; 08437250
SI:=BUFF; DS:=3 CHR; 08437300
DS:=LIT"~"; 08437350
END; 08437400
SPOUT(B INX M1); 08437450
END; 08437500
STREAM(OK:=0,BUFF:); 08437550
BEGIN SI:=BUFF; 08437600
3(IF SC=" " THEN JUMP OUT; 08437650
IF SC="," THEN JUMP OUT; 08437700
IF SC="~" THEN JUMP OUT TO L3; 08437750
SI:=SI+1); 08437800
L1: IF SC=" " THEN 08437850
L2: BEGIN SI:=SI+1; GO TO L1 END; 08437900
IF SC="," THEN GO TO L2; 08437950
BUFF:=SI; 08438000
IF SC!"~" THEN TALLY:=1; 08438050
L3: OK:=TALLY; 08438100
END; 08438150
BUFF:=P; 08438200
IF P THEN GO AGAIN; 08438250
AWAY: FORMESS:=-1; 08438300
END; 08438350
I:=SPACE(30); %146-08438400
DISKWAIT(-I,30,DIRECTORYTOP-SYSNO); %146-08438410
M[I+29]:=SAVEWORD; %146-08438420
DISKWAIT( I,30,DIRECTORYTOP-SYSNO); %146-08438430
FORGETSPACE(I); %146-08438440
END; 08438500
PROCEDURE SUSTATUS(A,DDD,B); VALUE A,DDD,B; REAL A,B; ARRAY DDD[*]; 08438900
FORWARD; 08438910
PROCEDURE OUTPUTLABEL(B); VALUE B; REAL B;% 08439000
BEGIN REAL BU=B,U,T,A;% 08440000
REAL G,Q;% 08441000
REAL TUSTA,TEMP; 08441050
BOOLEAN SCHTOG; 08441100
LABEL EXIT;% 08442000
SUBROUTINE DOIT;% 08443000
BEGIN; STREAM(A~TINU[U]:B);% 08444000
BEGIN SI ~ LOC A; SI ~ SI+5; DS ~ LIT" ";% 08445000
DS ! 3 CHR; DS ~ LIT " "; A ~ DI END;% 08446000
A ~ P; T ~ LABELTABLE[U];% 08447000
IF U LSS 16 THEN TEMP:=PRNTABLE[U].[30:18]; 08447100
IF T=0 THEN 08448000
STREAM(B:=TEMP,V:=(U LSS 16),A); 08448050
BEGIN SI:=LOC V;SI:=SI+7; 08448100
IF SC NEQ "0" THEN BEGIN SI:=LOC B;DS:=5DEC END; 08448110
DS:=9LIT" SCRATCH~" END 08448150
ELSE IF T = @114 OR T = @214 THEN% 08449000
BEGIN 08450000
STREAM(SAV:=((TWO)U) AND SAVEWORD) NEQ 0),A); 08450100
BEGIN 08450200
DS:=10LIT"NOT READY~"; 08450300
SAV(DI:=DI-1; DS:=8LIT"(SAVED)~"); 08450400
END 08450500
END 08450600
ELSE IF ABS(T)=@314 THEN 08451000
STREAM(B:=TEMP,V:=(U LSS 16),A); 08451100
BEGIN SI:=LOC V; SI:=SI+7; 08451200
IF SC NEQ "0" THEN BEGIN SI:=LOC B;DS:=5DEC END; 08451210
DS:=11 LIT " UNLABELED~"; 08452000
END 08452100
ELSE BEGIN;% 08453000
STREAM(K:=T<0: TEMP, V:=U<16, A); 08454000
BEGIN V(SI:=LOC TEMP; DS:=5 DEC; DS:=LIT" "); 08454500
CI:=CI+K; GO TO LAB; 08455000
DS:=6 LIT"IN USE"; GO TO L; 08455500
LAB: DS:=7 LIT"LABELED"; 08456000
L: DS:=LIT" "; K:=DI; 08457000
END; 08458000
A ~ P;% 08459000
IF (NT1 ~ RDCTABLE[U].[8:6]) ! 0 THEN% 08460000
IF JARROW[NT1] ! 0 THEN% 08461000
BEGIN;STREAM(J~JARROW[NT1]:NT1,A);% 08462000
BEGIN DS ~ 3 LIT "BY "; SI ~ J;% 08463000
SI ~ SI+1; DS ~ 7 CHR;% 08464000
DS ~ LIT "/"; SI ~ SI+1;% 08465000
DS ~ 7 CHR; DS ~ LIT "=";% 08466000
SI~LOC NT1; DS~2DEC; 08467000
DS ~ LIT ":"; J ~ DI;% 08468000
DI~DI-3; DS~FILL; 08468500
END;% 08469000
A ~ P;% 08470000
END ELSE ELSE 08471000
IF T<0 AND (U=23 OR U=24) THEN 08471010
BEGIN 08471020
STREAM(S:=0 : A); 08471030
BEGIN 08471040
DS:=22LIT"BY AUTO LOAD CONTROL: "; 08471050
S:=DI; 08471060
END; 08471070
A:=P; 08471080
END ELSE 08471090
IF U GEQ 20 AND U LEQ 22 THEN 08471100
IF LABELTABLE[U].[1:5]=@21 THEN 08471105
BEGIN STREAM(S:=0,A); 08471110
BEGIN 08471120
DS:=13 LIT "BY SCHEDULED "; 08471130
DS:=13 LIT "PRNPBT/DISK: "; 08471140
S:=DI; 08471150
END; 08471160
A:=P; 08471170
END; 08471180
STREAM(S~0:K~MULTITABLE[U],T,R~RDCTABLE[U]. 08472000
[14:10],D~RDCTABLE[U].[24:17],C~RDCTABLE[U].% 08473000
[41:7],A); BEGIN SI ~ LOC K;% 08474000
2(SI ~ SI+1; DS ~ 7 CHR; DS ~ LIT " ");% 08475000
DS ~ 3 DEC; DS ~ LIT " ";% 08476000
DS ~ 5 DEC; DS ~ LIT " ";% 08477000
DS ~ 2 DEC; DS ~ LIT "~";% 08478000
S~DI; 08478500
END; 08478600
A~P; 08478700
IF U}32 THEN IF CIDROW[U -32]!0 THEN 08478800
STREAM(DK~CIDTABLE[U -32,2],A); 08478900
BEGIN 08479000
DI~DI-1; 08479100
$ SET OMIT = NOT(PACKETS) 08479109
DS:=5 LIT ",PKT "; 08479110
$ POP OMIT 08479111
$ SET OMIT = PACKETS 08479199
SI~LOC DK; SI~SI+1; 08479300
DS~7 CHR; 08479400
END; 08479500
END; 08479600
SPOUT(B INX TUSTA); 08480000
B ~ 0;% 08481000
END;% 08482000
TUSTA~M[B.[15:15]-2]; 08482050
IF (U ~ UNITIN(TINU,B)){ PSEUDOMAXT THEN 08483000
BEGIN B ~ B.[15:15]-1;% 08484000
IF (U OR 1)=19 THEN SUSTATUS(B INX TUSTA,0,U) ELSE 08484500
DOIT;% 08485000
GO TO EXIT;% 08486000
END;% 08487000
$ SET OMIT = SHAREDISK 08487099
SCRTOG ~ U = PSEUDOMAXT + 1; 08487100
$ POP OMIT 08487101
$ SET OMIT = NOT(SHAREDISK) 08487199
STREAM(A~0:B);% 08488000
BEGIN SI ~ B;% 08489000
L: IF SC = " " THEN% 08490000
BEGIN SI ~ SI+1; GO TO L END;% 08491000
DI ~ LOC A; DI ~ DI+6; DS ~ 2 CHR;% 08492000
END;% 08493000
Q ~ P; B ~ B.[15:15]-1;% 08494000
FOR U ~ 0 STEP 1 UNTIL PSEUDOMAXT DO 08495000
IF TINU[U].[30:12] = Q THEN% 08496000
IF (G ~ LABELTABLE[U])!0 AND G!@114 AND G!@214 08497000
AND NOT SCRTOG OR G=0 AND SCRTOG THEN 08497100
BEGIN IF B = 0 THEN B ~ SPACE(10);% 08498000
DOIT;% 08499000
END;% 08500000
IF B ! 0 THEN% 08501000
BEGIN;STREAM(Q,R);% 08502000
BEGIN DS ~ 6 LIT " NULL ";% 08503000
SI ~ LOC Q; SI ~ SI+6; DS ~ 2 CHR;% 08504000
DS ~ 7 LIT " TABLE~";% 08505000
END;% 08506000
SPOUT(B INX TUSTA); 08507000
END;% 08508000
EXIT: END;% 08509000
PROCEDURE TIMEUSED(B, X); 08525000
VALUE B, X; 08526000
REAL B, X; 08527000
BEGIN INTEGER T, H, M, S, CPT, IOT, ET; 08528000
$ SET OMIT = NOT(PACKETS) 08528499
DEFINE UNITNO = PSEUDOMIX[X]#; 08528500
$ POP OMIT 08528501
REAL SUBROUTINE CONVERTIME; 08529000
BEGIN S ~ T-60|(T ~ T DIV 60); 08530000
M ~ T-60|(H ~ T DIV 60); 08531000
STREAM(R~0: A~[H]); 08532000
BEGIN DI~LOC R; DI~DI+2; SI~A; 3(DS~2 DEC) END; 08533000
CONVERTIME ~ POLISH 08533100
END; 08533200
T ~ JAR[X,3]+PROCTIME[X]; 08533400
$ SET OMIT = NEWLOGGING 08533499
IF X=P2MIX OR X=P1MIX THEN 08533500
$ POP OMIT 08533501
$ SET OMIT = NOT(NEWLOGGING) 08533599
T ! T+CLOCK+P(RTR); 08533700
T ~ T/60; CPT ~ CONVERTIME; 08534000
T ~ JAR[X,4]+IOTIME[X]; 08535000
WHILE T<0 DO T ~ T+CLOCK+P(RTR); 08536000
T ~ T/60; IOT ~ CONVERTIME; 08537000
T ~ ((CLOCK+P(RTR))/60)-NFO[(X-1)|NDX+2].[1:17]; 08538000
ET ~ CONVERTIME; 08538500
STREAM(J~JARROW[X],X,T~[CPT],B); 08540000
BEGIN DS~10 LIT " TIME FOR "; SI~J; SI~SI+1; DS~7 CHR; 08540100
SI~SI+1; DS~LIT "/"; DS~7 CHR; DS~LIT"="; 08540200
SI~LOC X; DS~2 DEC; X~DI; DI~DI-2; DS~FILL; 08540300
DI~X; DS~8 LIT " IS: CP="; SI~T; SI~SI+2; 08541000
3(DS~LIT ":"; DS~2 CHR); 08542000
X~DI; DI~DI-9; DS~8 FILL; DI~X; 08543000
DS~5 LIT ", IO="; SI~SI+2; 08544000
3(DS~LIT ":"; DS~2 CHR); 08544100
X~DI; DI~DI-9; DS~8 FILL; DI~X; 08544200
DS~3 LIT " IN"; SI~SI+2; 08544300
3(DS~LIT ":"; DS~2 CHR); DS~LIT "~"; 08544400
DI~DI-10; DS~8 FILL 08544500
END; 08544600
SPOUTER(B INX MEMORY[B-1],UNITNO,1); 08544700
COMMENT MESSAGE PRESENTLY 72 CHARACTERS LONG; 08544800
END; 08545000
REAL PROCEDURE ANVIL(IL,Z); VALUE IL,Z; REAL IL,Z;% 08546000
BEGIN REAL B=Z,U=+1;% 08547000
REAL ZZ; 08547050
LABEL EXIT; 08547100
ZZ:=Z; 08547200
NAMEID(U,ZZ); 08547300
NAMEID(U,ZZ); 08547400
IF U="/ " THEN 08547500
BEGIN U:=Z.[15:15]; GO EXIT END ELSE 08547600
IF (U ~ UNITIN(TINU,B)) { PSEUDOMAXT THEN 08548000
BEGIN% 08549000
IF LABELTABLE[U] = @114 OR LABELTABLE[U] = @214 THEN% 08550000
BEGIN 08551000
STREAM(A:=TINU[U],SAV:=((TWO(U) AND SAVEWORD) ! 0 ), 08551100
X:=Z.[15:15]-1); 08551200
BEGIN 08551300
SI:=LOC A; SI:=SI+5; DS:=3CHR; 08552000
DS:=11LIT" NOT READY~"; 08553000
SAV(DI:=DI-1; DS:=8LIT"(SAVED)~"); 08554000
END; 08554100
U ~ PSEUDOMAXT + 1; 08555000
END ELSE 08556000
IF LABELTABLE[U] < 0 THEN% 08557000
BEGIN;STREAM(A~TINU[U],X~Z.[15:15]-1);% 08558000
BEGIN SI ~ LOC A; SI ~ SI+5;% 08559000
DS ~ 3 CHR; DS ~ 8 LIT " IN USE~";% 08560000
END;% 08561000
U ~ PSEUDOMAXT + 1; 08562000
END;% 08563000
IF U { PSEUDOMAXT THEN 08564000
LABELTABLE[U] ~ -(IF IL THEN *P(DUP) ELSE @314);% 08565000
EXIT: END; END; 08566000
PROCEDURE LOGOUT(A); VALUE A; REAL A; 08568000
BEGIN REAL RCW=+0; 08568100
REAL MSCW=-2; 08568125
INTEGER I=RCW+1; 08568150
REAL J=I+1, L=J+1; % L MUST BE LAST DECLARATION. 08568200
LABEL EXIT; 08568300
P(0,0,SPACE(335)); % INITIALIZES L 08568600
IF (J:=DIRECTORYSEARCH("SYSTEM ","LOG ",4))=0 THEN 08568700
BEGIN; 08568800
STREAM(L); 08568900
BEGIN DS:=10 LIT "-NULL LOG~" END; 08569000
GO TO EXIT; 08569100
END; 08569200
IF LOGFREE GTR 0 THEN SLEEP([LOGFREE],-0); 08569300
LOGFREE:=ABS(LOGFREE); 08569400
$ SET OMIT = NOT(SHAREDISK) 08569499
MOVE(30,J INX 0,L); 08569600
M[L+10] ~ GETUSERDISK(-(M[L+8]~M[L+8]+10)); % GET XTRA TEN 08569700
DO BEGIN % TO MAKE COPY 08569800
DISKWAIT (-L-31,300,M[J+10]+I); % SIMPLER 08569900
DISKWAIT ( L+31,300,M[L+10]+I); 08569910
END UNTIL (I~I+10)}M[J+8]; 08569920
LOGFREE ~ M[J+10]; 08570000
J:=J INX 0; 08570300
M[J]:=M[J+2]:=M[J+3]:=0; 08570400
M[J+1]:=M[J+8]|6; 08570500
M[J+4]:="DISKLOG"; 08570600
M[J+5]:=4; 08570700
DISKWAIT(J,30,LOGFREE); 08570800
$ SET OMIT = NOT(SHAREDISK) 08570849
LOGFREE~NABS(LOGFREE); 08570870
P(DIRECTORYSEARCH(-"SYSTEM ","LOG ",14),DEL); 08570880
IF HOLDFREE=0 THEN SLEEP([TOGLE],HOLDMASK); 08571000
LOCKTOG(HOLDMASK); 08571100
DISKWAIT(-J,-30,DIRECTORYTOP); 08571200
I:=(M[J+20].[8:10]+1) MOD 1000; 08571300
M[J+20]:=(*P(DUP))&I[8:38:10]; 08571400
DISKWAIT(J,-30,DIRECTORYTOP); 08571500
UNLOCKTOG(HOLDMASK); 08571600
STREAM(J~[ACTDATE],D~[I]); 08571800
BEGIN SI:=D;DS:=8 DEC;DI:=DI-7;SI:=J; 08571900
SI~SI+2; DS~4 CHR; 08572000
END; 08572300
FORGETSPACE(J); 08572400
M[L+4]:=(*P(DUP))&0[1:43:5]&1[11:47:1]&0[12:44:4]; 08572500
M[L+1]~XCLOCK+P(RTR); 08572510
STREAM(DATE,A~0,B~L+1); 08572520
BEGIN SI~ LOC DATE;DI~LOC A;DS~8 OCT;SI~LOC A; 08572530
SI~SI+5;DI~B;DI~DI+1;DS~3 CHR; END; 08572540
ENTERUSERFILE(-I,"SYSLOG ",L-1); 08572600
STREAM(I,L); 08572700
BEGIN DS:=21 LIT"**** NEW LOG FILE IS ";SI:=LOC I;SI:=SI+1; 08572800
DS:=7 CHR;DS:=8 LIT"/SYSLOG~" ; 08572900
END; 08573000
EXIT: 08573100
SPOUT(L); 08573200
IF A THEN KILL([MSCW]); 08573300
END; 08573400
PROCEDURE SAVETHEUNIT(B); VALUE B; REAL B;% 08575000
BEGIN REAL A=B,T,U,I,M1; 08576000
LABEL AGAIN,EXIT; 08576100
M1:=M[B.[15:15]-2]; 08577000
STREAM(B:); 08577100
BEGIN SI:=B; 08577200
L: IF SC=" " THEN BEGIN SI:=SI+1; GO TO L END; 08577300
B:=SI; 08577400
END; 08577500
B:=P; 08577600
AGAIN: T:=SPACE(10); 08577700
IF (U:=UNITIN(TINU,A)) GTR 31 THEN 08578000
STREAM(A,T); 08578100
BEGIN DS:=10 LIT"INV KBD SV"; 08578200
SI:=A; DS:=3 CHR; 08578300
DS:=LIT"~"; 08578400
END ELSE 08578500
BEGIN I ~ TWO(U);% 08579000
SLEEP([TOGLE],STATUSMASK); 08580000
IF LABELTABLE[U] } 0 THEN% 08581000
BEGIN LABELTABLE[U] ~ @114;% 08582000
MULTITABLE[U]~RDCTABLE[U]~0; 08582100
RRRMECH ~ RRRMECH OR I;% 08583000
READY ~ READY OR I;% 08584000
SAVEWORD := SAVEWORD OR I; 08584100
I ~ " ";% 08585000
END% 08586000
ELSE BEGIN SAVEWORD ~ SAVEWORD OR I;% 08587000
I ~ " TO BE";% 08588000
END;% 08589000
STREAM(A~TINU[U],I,T);% 08590000
BEGIN DS ~ LIT " ";% 08591000
SI ~ LOC A; SI ~ SI+5; DS ~ 3 CHR;% 08592000
SI ~ SI+2; DS ~ 6 CHR;% 08593000
DS ~ 7 LIT " SAVED~";% 08594000
END;% 08595000
END;% 08596000
SPOUT(T INX M1); 08597000
STREAM(OK:=0,A:); 08597050
BEGIN SI:=A; 08597100
3(IF SC=" " THEN JUMP OUT; 08597150
IF SC="," THEN JUMP OUT; 08597200
IF SC="~" THEN JUMP OUT OT L3; 08597250
SI:=SI+1); 08597300
L1: IF SC=" " THEN 08597350
L2: BEGIN SI:=SI+1; GO TO L1 END; 08597400
IF SC="," THEN GO TO L2; 08597450
A:=SI; 08597500
IF SC!"~" THEN TALLY:=1; 08597550
L3: OK:=TALLY; 08597600
END; 08597650
A:=P; 08597700
IF P THEN GO AGAIN; 08597750
T:=SPACE(30); %146-08597800
DISKWAIT(-1,30,DIRECTORYTOP-SYSNO); %146-08597810
M[T+29]:=SAVEWORD; %146-08597820
DISKWAIT( T,30,DIRECTORYTOP-SYSNO); %146-08597830
FORGETSPACE(T); %146-08597840
END;% 08598000
BOOLEAN PROCEDURE WHYSLEEP(MASK); VALUE MASK; REAL MASK; 08599000
BEGIN 08600000
REAL A, B; 08601000
IF REPLY[P1MIX]=VWY THEN 08602000
BEGIN 08603000
B:=SPACE(KEYMSGSZ); 08604000
DISKWAIT(-B,KEYMSGSZ,MESSAGETABLE[2].[22:26]); 08604100
STREAM(B,MASK,T:=0,O:=0,D:=0,A:=A:=SPACE(4)); 08605000
BEGIN 08606000
SI:=LOC MASK; 08607000
8(IF SC="0" THEN GO TO NEXT; 08608000
IF SC=VWY THEN 08609000
BEGIN 08610000
DI:=A; DS:=3LIT" DS"; A:=DI; GO TO NEXT; 08611000
END; 08612000
T:=SI; DI:=LOC 0; DI:=DI+7; DS:=CHR; 08613000
SI:=LOC O; DI:=LOC D; DI:=DI+6; DS:=2DEC; 08614000
SI:=B; 08615000
R: SI:=SI+6; DI:=DI-2; 08616000
IF SC="*" THEN % END OF FIRST PART OF TABLE 08617000
BEGIN 08617500
SI:=T; GO TO NEXT; 08618000
END; 08618500
IF 2SC NEQ DC THEN GO TO R; 08619000
SI:=SI-6; DI:=A; DS:=LIT" "; DS:=2CHR; A:=DI; SI:=T; 08619500
NEXT: SI:=SI+1); 08620000
DI:=A; DS:=LIT"~"; 08620500
END STREAM STATEMENT; 08621000
SPOUT(A); 08621500
FORGETSPACE(B); 08621600
END % IF "WY" 08622000
ELSE WHYSLEEP:=TRUE; 08622500
END PROCEDURE WHYSLEEP; 08623000
PROCEDURE CHANGEOPTION(BUFF,RS);% 08624000
VALUE BUFF,RS;REAL BUFF,RS;% 08625000
BEGIN REAL B,T,OP,BUS,MASK,OPTER; 08626000
SLEEP([TOGLE],HOLDMASK); 08627000
LOCKTOG(HOLDMASK); 08628000
BUS ~ BUFF.[15:15]-1; B ~ SPACE(30);% 08629000
DISKIO(T,1-B,-30,DIRECTORYTOP-SYSNO); 08630000
OPTER ~ SPACE(OPTIONSZ); 08630100
DISKWAIT(-OPTER,OPTIONSZ,MESSAGETABLE[0].[22:26]); 08631000
STREAM(BUFF,T~0,OPTER,R~[OP]);% 08632000
BEGIN% 08633000
L0: SI~BUFF; %535-08634000
L1: IF SC=" " THEN BEGIN SI~SI+1; GO TO L1; END; %535-08635000
IF SC<"0" THEN %535-08636000
IF SC!"~" THEN %535-08637000
BEGIN TALLY~0; T~TALLY; DI~LOC T; %535-08638000
8(IF SC=" " THEN JUMP OUT ELSE %535-08639000
IF SC="~" THEN JUMP OUT ELSE %535-08640000
IF SC}"0" THEN JUMP OUT ELSE DS ~CHR); %535-08641000
BUFF~SI; SI~OPTER; %535-08642000
63(DI~LOC T; %535-08643000
IF 8 SC=DC THEDN JUMP OUT TO L2 ELSE %535-08644000
IF SC="~" THEN JUMP OUT TO L0 ELSE TALLY~TALLY+1);08645000
GO TO L3; %535-08646000
L2: IF SC="~" THEN GO TO L0; %535-08647000
END ELSE %535-08648000
L3: TALLY~48 ELSE %535-08649000
BEGIN DI~LOC T; SI~SI+1; %535-08650000
IF SC<"0" THEN BEGIN SI~SI-1; DS~1 OCT; END %535-08651000
ELSE BEGIN SI~SI-1; DS~2 OCT; END; %535-08652000
TALLY~47; T(TALLY~TALLY+63); %535-08653000
END; %535-08654000
T~TALLY; SI~LOC T; DI~R; DS~WDS; %535-08655000
END;% 08657000
IF OP<47 THEN 08658000
BEGIN;STREAM(A ~ IF RS THEN " RESET" ELSE " SET",% 08659000
O~OPTER INX OP,OP ~ 47-OP,BUS);% 08660000
BEGIN DS ~ LIT " "; SI ~ LOC OP; DS ~ 2 DEC;% 08661000
DS ~ LIT " "; SI ~ O;% 08662000
8(IF SC=0 THEN JUMP OUT TO L; DS~CHR);% 08663000
L: SI ~ LOC A; SI ~ SI+2; DS ~ 6 CHR;% 08664000
DS ~ LIT"~";% 08665000
END;% 08666000
MASK~TWO(OP);% 08667000
M[BUS-1].[9:9]:=0; 08667100
END;% 08668000
SPOUT(BUS INX M[BUS-1]); 08669000
SLEEP([T],IOMASK); 08670000
M[B]~OPTION~IF RS THEN OPTION AND NOT MASK ELSE OPTION OR MASK;08671000
DISKWAIT(B,-30,DIRECTORYTOP-SYSNO); 08673000
FORGETSPACE(OPTER);% 08674000
FORGETSPACE(B);% 08676000
UNLOCKTOG(HOLDMASK); 08677000
END;% 08678000
PROCEDURE TYPOP(KTR,PO); VALUE KTR,PO; REAL KTR,PO; 08679000
BEGIN REAL VASE,TUSTA,N,X,OPTER; 08680000
LABEL INCR; 08680500
REAL SUBROUTINE SETT; 08681000
BEGIN 08681100
STREAM(OPT:=[OPTION]:OPTER,N,NBS:=47-N,VASE); 08681200
BEGIN 08681300
DI:=DI+4; 08682000
SI~OPTER;N(SI~SI+8);IF SC="~" THEN GO TO EXIT;% 08683000
8(IF SC<"0" THEN DS~CHR ELSE DS~1 LIT" ");DS~2 LIT" ";% 08684000
SI:=OPT; SKIP NBS SB; 08684500
IF SB THEN TALLY:=1 ELSE 08685000
BEGIN DS:=3 LIT"NOT"; TALLY:=2; END; 08685500
DS~5 LIT" SET~";% 08686000
DI:=VASE; SI:=LOC NBS; DS:=LIT" "; DS:=2 DEC; DS:=LIT" "; 08686500
EXIT: OPT:=TALLY; 08687000
END; 08688000
SETT~P; 08689000
END SETT; 08689100
% 08689110
SLEEP([TOGLE],HOLDMASK); 08689200
LOCKTOG(HOLDMASK); 08689300
TUSTA:=M[(VASE:=KTR.[15:15]-1)-1]; 08689900
OPTER ~ SPACE(OPTIONSZ)&OPTIONSZ[8:38:10]; 08690000
DISKWAIT(-OPTER,OPTIONSZ,MESSAGETABLE[0].[22:26]); 08690020
IF PO THEN 08690080
BEGIN 08690090
STREAM(BUFF:=KTR, T:=0, OPTER, D:=[N]); 08690100
BEGIN SI~BUFF;63(IF SC=" " THEN SI~SI+1 ELSE JUMP OUT TO L);L: 08690110
IF SC GEQ "0" THEN GO TO L4; 08690120
DI~LOC T; 08690130
8(IF SC=" " THEN JUMP OUT TO L1 ELSE 08690140
IF SC="~" THEN JUMP OUT TO L1 ELSE 08690150
IF SC}"0" THEN JUMP OUT TO L1 ELSE 08690160
DS~1 CHR); L1: 08690170
TALLY~0; BUFF~SI; SI~OPTER; 08690180
63(DI~LOC T;IF 8 SC!DC THEN 08690190
BEGIN IF SC="~" THEN 08690200
BEGIN TALLY~48; JUMP OUT TO L3 END 08690210
ELSE TALLY~TALLY+1; 08690220
END ELSE JUMP OUT TO L2); TALLY~48;GO TO L3;L2: 08690230
IF SC="~" THEN BEGIN SI~BUFF;63(IF SC<"0" THEN SI~SI+1 08690240
ELSE JUMP OUT TO L4); L4: DI~LOC T; SI~SI+1; 08690250
IF SC<"0" THEN BEGIN SI~SI-1; SI~1 OCT END ELSE 08690260
BEGIN SI~SI-1; DS~2 OCT END; 08690270
TALLY~47; T(TALLY~TALLY+63); 08690280
END; 08690290
L3: T~TALLY; SI~LOC T; DI~D; DS~ WDS; 08690300
END; 08690310
IF N LSS OPTER.[8:10] THEN P(SETT,DEL); 08690400
SPOUT(VASE INX TUSTA); 08690600
END ELSE 08690800
BEGIN 08691000
STREAM(KTR:); 08691200
BEGIN SI:=KTR; 08691400
IF SC="S" THEN TALLY:=1 ELSE 08691600
IF SC="R" THEN TALLY:=2 ELSE TALLY:=3; 08691800
KTR:=TALLY; 08692000
END; 08692200
X:=P; N:=-1; 08692400
INCR: N:=N+1; 08692600
IF ((KTR:=SETT) AND X) ! 0 THEN 08692800
BEGIN SPOUT(VASE INX TUSTA); 08693000
VASE:=SPACE(3); 08693200
GO TO INCR; 08693400
END; 08693600
IF KTR=0 THEN 08693800
IF X!3 THEN 08694000
BEGIN STREAM(X:=X=1, VASE); 08694200
BEGIN DS:=12 LIT" ALL OTHERS "; 08694400
X(DS:=4 LIT"NOT "); 08694600
DS:=4 LIT"SET~"; 08694800
END; 08695000
SPOUT(VASE INX TUSTA); 08695200
END ELSE FORGETSPACE(VASE); 08695400
ELSE GO TO INCR; 08695600
END; 08695800
FORGETSPACE(OPTER);% 08696000
UNLOCK(HOLDMASK); 08696100
END;% 08697000
$ SET OMIT = NOT(DISKLOG) 08697099
% THE FOLLOWING THREE DEFINES MUST EACH BE CHANGED IF THE 08699000
% DISK ROW SIZE OF PBD AND PUD FILES IS TO BE CHANGED. 08699050
DEFINE PBDROWSZ = 08699100
300# % %732-08699150
% PBDROWSZ IS THE DISK ROW SIZE, IN SEGMENTS, OF PBD AND 08699200
% PUD FILES. PBDROWSZ MUST BE A MULTIPLE OF THREE. 08699250
,PBDRECS = 08699300
100# % %732-08699350
% PBDRECS=PBDROWSZ/3 : NO. OF LOGICAL RECORDS PER ROW. 08699400
,PBDTOTRECS = 08699450
2000# % %732-08699500
;% PBDTOTRECS=PBDRECS|20 : NO. OF TOTAL RECORDS PER BACK-UP FILE. 08699550
PROCEDURE PBIO(ALPHA,POINTER); VALUE ALPHA; REAL ALPHA,POINTER; %P 08700000
% 08700900
% THIS PROCEDURE HANDLES IO FOR THE CREATION OF BACK-UP FILES. FOR 08700910
% DISK, IT OBTAINS NEW ROWS AND NEW FILES AS NECESSARY. IF IT RUNS 08700920
% OUT OF FILES, HEADER[5].[4:1] IS SET AND THE JOB TERMINATED, LEAVING08700930
% ONE BLOCK FOR THE LABEL AND DS MESSAGE. 08700940
% 08700950
% ALPHA IS ADDRESS OF TOP I/O DESCRIPTOR. <0 MEANS READ %P 08701000
% POINTER IS FIB[14] %P 08702000
BEGIN NAME HEADER; 08703000
REAL T=-2,IOD,H,S; 08704000
INTEGER I=IOD; 08704100
LABEL OK; 08704500
POINTER.[FF]~POINTER INX 72; %P 08705000
IF (HEADER~POINTER.[3:15])!0 THEN %%%%PB ON DISK %%%%% %P 08706000
BEGIN 08707000
HEADER := [M[(*HEADER)]]; 08707500
IF HEADER[7] GEQ PBDTOTRECS-2 THEN % CHECK FOR NEW FILE 08708000
BEGIN 08708200
$ SET OMIT = PACKETS 08708400
IF HEADER[6].[42:6]="9" THEN 08709000
$ POP OMIT OMIT 08709200
IF HEADER[7] GEQ PBDTOTRECS THEN P(XIT) ELSE 08709400
IF HEADER[5].[4:1] THEN GO TO OK ELSE 08709500
BEGIN STREAM(F:=PRT[P1MIX,3] INX M[M[ALPHA-3] INX 4].08709600
[13:11], H:=H:=NABS(SPACE(12))); 08709800
BEGIN SI:=F; SI:=SI+1; 08710000
DS:=24 LIT"TOO MANY BACKUP RECS ON "; 08710200
DS:=7 CHR; DS:=LIT"/"; SI:=SI+1; DS:=7 CHR;08710400
DS:=2 LIT":~"; 08710600
END; 08710800
HEADER[5].[4:1]:=1; 08711000
GO TO OK; 08711200
END; 08711400
IF HEADER[7] GEQ PBDTOTRECS THEN % GET A NEW FILE 08711600
BEGIN 08711800
IF I:=HEADER[5].[3:1] THEN HEADER[5].[3:1]:=0; 08712000
H~SPACE(30); S~M[HEADER INX NOT 0]; 08712100
DISKWAIT(-H,30,S); 08712110
M[H+7]~HEADER[7]; 08712120
M[H+5].[2:1]~0; 08712130
DISKWAIT(H,30,S); 08712140
M[H+7]~M[H+9]~0; 08712150
MOVE(20,H+9,H+10); 08712160
M[H+5]~(*P(DUP)) OR H; 08712170
HEADER[5].[3:1]:=1; %SET CP BK UP TOG 08712200
HEADER[7] := 0; 08712500
HEADER[3] := XCLOCK + P(RTR); 08713000
STREAM(ONE:=1, H:=[HEADER[6]]); 08713250
BEGIN SI:=LOC ONE; DS:=8 ADD; 08713500
DI:=DI+24; 20(DS:=8 LIT"0"); 08713750
END; 08714000
M[H+7]~PBDROWSZ DIV 3; 08714110
HEADER[9]~M[H+9]~1; 08714120
HEADER[10]~M[H+10]~GETUSERDISK(-(PBDROWSZ+1)); 08714130
M[HEADER INX NOT 0] := EUF(-(IF I THEN "PUD " 08714140
ELSE "PBD "),HEADER[6],H-1); 08714150
FORGETSPACE(H); 08714170
$ SET OMIT = PACKETS 08714199
FILEMESSAGE((IF I THEN "PUD " ELSE 08714300
"PBD ")&HEADER[6][24:6:24], 08714310
"OUT " &HEADER[6][30:30:18], 08714320
0," ",0,0,0, 08714330
(PBDREL OR OPNMESS)); 08714340
END; 08714400
END ELSE 08714500
IF HEADER[7] MOD PBDRECS=0 THEN %GET NEW ROW 08715000
BEGIN H:=SPACE(30); S:=M[HEADER INX NOT 0]; 08715100
DISKWAIT(-H,30,S); 08715200
HEADER[9+HEADER[9]~*P(DUP)+1]~ 08716000
GETUSERDISK(-(PBDROWSZ+1)); 08716010
M[H+9+HEADER[9]]~HEADER[9+HEADER[9]]; 08716100
M[H+9]~HEADER[9]; 08716110
M[H+7]~HEADER[7] + PBDROWSZ DIV 3; 08716200
DISKWAIT(H,30,S); 08716300
FORGETSPACE(H); 08716500
END; 08716600
OK: 08716800
STREAM(A~1~HEADER[HEADER[9]+9]+(HEADER[7] MOD 08717000
PBDRECS)|3,D~POINTER.[CF]-1); 08718000
BEGIN SI~LOC A; DS~8 DEC END; %P 08720000
HEADER[7]~(*P(DUP))+1; %P 08721000
IOD~@141330100477777; 08722000
END ELSE %% ON TAPE %% %P 08723000
IOD~@21320500000000&M[POINTER INX NOT 1][3:14:4]; %P 08724000
IOREQUEST(M[ALPHA],POINTER INX IOD&ALPHA[24:1:1], %P 08726000
M[POINTER INX NOT 1]); 08727000
M[T]~IOD INX M[T]$0[26:26:7]&0[19:19:1] AND NOT M; 08728000
IF H LSS 0 THEN 08728500
BEGIN TERMINATE(P1MIX); 08728600
TERMINALMESSAGE(H); 08728700
END; 08728800
END PBIO; 08729000
PROCEDURE TIMERELAXER(KTR,TYPE,MIX);% 08730000
VALUE KTR,TYPE,MIX;% 08731000
REAL KTR,TYPE,MIX;% 08732000
BEGIN INTEGER BUFF,PRT,IOT,T,P1,I1;% 08733000
LABEL SPIT;% 08734000
DEFINE VCT = 29#, % CHANGE TIME LIMITS 08734010
VXT = 30#, % EXTEND TIME LIMITS 08734020
VTL = 31#; % PRINT TIME LIMITS 08734030
COMMENT: THIS ROUTINE SHOULD BE BLAMED ON WWF4;% 08734100
$ SET OMIT = NOT(PACKETS) 08734499
DEFINE UNITNO = PSEUDOMIX[MIX]#;% 08734500
$ POP OMIT 08734501
BUFF ~ KTR.[15:15]-1;% 08735000
IF TYPE NEQ VTL THEN BEGIN; 08736000
STREAM(IOT~0,PRT~0,CODE~0: KTR);% 08737000
BEGIN SI~KTR; IF SC=" " THEN BEGIN L1: SI~SI+1;% 08738000
IF SC=" " THEN GO L1; END; %534-08739000
IF SC="*" THEN BEGIN SI~SI+1; GO L5; END; %534-08739500
IF SC="," THEN GO L2; IF SC<"0" THEN GO EXIT;% 08740000
KTR~SI; L3: TALLY~TALLY+1; SI~SI+1; 08741000
IF SC}"0" THEN GO L3; SI~KTR; CODE~TALLY; 08742000
DI~LOC PRT; DS~CODE OCT; TALLY~0;% 08743000
L5: IF SC=" " THEN BEGIN L4: SI~SI+1;% 08744000
IF SC=" " THEN GO L4 END; IF SC="," THEN GO L2;% 08745000
IF SC="~" THEN TALLY~1; GO EXIT;% 08746000
L2: SI~SI+1; IF SC=" " THEN BEGIN L6: SI~SI+1;% 08747000
IF SC=" " THEN GO L6 END ; KTR~SI;% 08748000
IF SC="*" THEN BEGIN TALLY~1; GO EXIT END;% 08749000
IF SC="~" THEN BEGIN TALLY~1; GO EXIT; END; %534-08749500
IF SC<"0" THEN GO EXIT; L7: TALLY~TALLY+1;% 08750000
SI~SI+1; IF SC}"0" THEN GO L7; DI~ LOC IOT;% 08751000
SI~KTR; CODE~TALLY; DS~CODE OCT; TALLY~1;% 08752000
EXIT: CODE~TALLY;% 08753000
END STREAM;% 08754000
IF NOT P THEN GO SPIT;% 08755000
PRT ~ P|3600; IOT ~ P|3600;% 08756000
IF TYPE=VXT THEN BEGIN 08757000
IF PRT!0 THEN BEGIN% 08758000
PROCTIME[MIX] ~ *P(DUP)-PRT;% 08759000
JAR[MIX,3] ~ *P(DUP)+PRT;% 08760000
END;% 08761000
IF IOT!0 THEN BEGIN% 08762000
IOTIME[MIX] ~ *P(DUP)-IOT;% 08763000
JAR[MIX,4] ~ *P(DUP)+IOT;% 08764000
END END ELSE BEGIN% 08765000
IF PRT!0 THEN BEGIN% 08766000
PROCTIME[MIX] ~ *P(DUP)+JAR[MIX,3]-PRT;% 08767000
JAR[MIX,3] ~ PRT;% 08768000
END;% 08769000
IF IOT!0 THEN BEGIN% 08770000
IOTIME[MIX] ~ *P(DUP)+JAR[MIX,4]-IOT; 08771000
JAR[MIX,4] ~ IOT;% 08772000
END END; 08773000
STREAM(TEST~0: X~JARROW[MIX],MIX,Z~PRT!0,I~IOT!0,% 08774000
K:=TYPE=VXT,T:=T:=SPACE(10)); 08775000
BEGIN DS~LIT " "; Z(DS~4 LIT "PRT "; TALLY~1;% 08776000
I(DS~4 LIT"AND ")); I(DS~4 LIT "IOT "; TALLY~1);% 08777000
DS~8 LIT "ESTIMATE"; Z(I(DS~LIT "S"));% 08778000
DS~8LIT" CHANGED"; K(DI~DI-7; DS~8LIT"EXTENDED"0;% 08779000
DS~5LIT" FOR"; SI~S; SI~SI+1; DS~7CHR; SI~SI+1;% 08780000
DS~LIT"/"; DS~7CHR; DS~LIT"="; SI~LOC Z;% 08781000
SI~SI-8; DS~2DEC; DS~LIT"~"; TEST~TALLY; 08782000
DI~DI-3; DS~FILL; 08782500
END STREAM;% 08783000
IF P THEN SPOUTER(T INX M[BUFF-1],UNITNO,1) ELSE 08784000
FORGETSPACE(T); 08784100
END; 08785000
IOT ~ PRT ~ -0;% 08786000
IF P(JAR[MIX,3],DUP)=@377777777777 THEN P(DEL)ELSE% 08787000
P1 ~ (PRT ~ P DIV 3600)-60|(PRT ~ PRT DIV 60);% 08788000
IF P(JAR[MIX,4],DUP)=@377777777777 THEN P(DEL) ELSE% 08789000
I1 ~ (IOT ~ P DIV 3600)-60|(IOT ~ IOT DIV 60);% 08790000
STREAM(X~JARROW[MIX], MIX,PRT,P1,IOT,I1,BUFF); 08791000
BEGIN DS~17LIT" TIME LIMITS FOR"; SI~X; SI~SI+1; DS~7CHR;% 08792000
DS~LIT"/"; SI~SI+1; DS~7CHR; DS~LIT"="; DI~LOC MIX; 08793000
DS~2DEC; MIX~DI; DI~DI-2; DS~FILL; DI~MIX; 08793500
DS~10LIT" ARE: PRT="; IF SC="+" THEN 08794000
BEGIN SI~SI+16; DS~8LIT"NO LIMIT" END ELSE BEGIN% 08795000
DS~8DEC; DS~LIT":"; DS~2DEC; BUFF~DI; DI~DI-11;% 08795500
DS~7FILL; DI~BUFF END; DS~6LIT"; IOT="; IF SC="+" THEN 08796000
DS~10LIT"NO LIMIT.~" ELSE BEGIN DS~8DEC; DS~LIT":";% 08796500
DS~2DEC; DS~2LIT".~"; DI~DI-13; DS~7FILL END; 08797000
END STREAM;% 08797500
SPIT:% 08798000
SPOUTER(BUFF INX M[BUFF-1],UNITNO,1); 08798500
END TIMERELAXER; 08799000
PROCEDURE CHANGEFACTOR(BUFF,TF); VALUE BUFF,TF; REAL BUFF; BOOLEAN TF; 08800000
BEGIN REAL FACTOR,B,T; INTEGER TEMP=T; 08801000
LABEL TYPEOUT,EXIT; 08802000
BUFF ~ ((B~BUFF).[15:15]-1)&M[P(DUP)-1][9:9:9]; 08802500
IF TF THEN GO TYPEOUT; 08803000
STREAM(ANS~0:B); 08804000
BEGIN SI~B; DI~LOC B; DS~8LIT"00000000:; DI~DI-2; 08805000
L: IF SC = " " THEN BEGIN SI~SI+1; GO TO L END; 08806000
IF SC < "0" THEN GO TO L1; 08807000
IF SC > "9" THEN GO TO L1; 08808000
SI~SI+1; 08809000
IF SC < "0" THEN GO TO ONECHR; 08810000
IF SC { "9" 08810500
THEN BEGIN SI~SI-1; DI~DI-2; DS~2 CHR; END 08811000
ELSE ONECHR: BEGIN SI~SI-1; DI~DI-1; DS~1 CHR; END; 08812000
IF SC = "." THEN GO TO L2 ELSE GO TO L3; 08813000
L1: IF SC ! "." THEN GO TO ERROR; 08814000
L2: SI~SI+1; 08815000
IF SC < "0" THEN GO TO ERROR; 08816000
IF SC > "0" THEN GO TO ERROR; 08817000
DS~CHR; 08818000
IF SC } "0" THEN IF SC { "9" THEN DS~CHR; 08819000
L3: IF SC = " " THEN GO CONVERT; 08820000
IF SC = "~" THEN GO CONVERT; 08821000
ERROR:DI~LOC ANS; SKIP 1 DB; DS~ 10 SET; GO TO EXITS; 08822000
CONVERT: SI~LOC B; SI~SI+4; DI~LOC ANS; DS~4 OCT; 08823000
EXITS: 08824000
END STREAM; 08825000
P(.FACTOR,~); 08826000
IF FACTOR < 0 THEN GO TO EXIT; 08828000
CORE.[4:14] ~ FACTOR; 08829000
SLEEP([TOGLE],HOLDMASK); LOCKTOG(HOLDMASK); 08830000
B ~ SPACE(30); 08831000
DISKWAIT(-B,30,DIRECTORYTOP-SYSNO); 08832000
M[B+9] ~ CORE; % CHANGE FACTOR 08833000
DISKWAIT(B,-30,DIRECTORYTOP-SYSNO); 08834000
FORGETSPACE(B); 08835000
UNLOCKTOG(HOLDMASK); 08836000
SELECTION; 08836500
TYPEOUT: 08837000
STREAM(I~(FACTOR~CORE.[4:14]) DIV 100, FR~(TEMP~FACTOR MOD 100), 08838000
MX~(TEMP~CORE.[CF]|64|FCTOR/100),US~CORE.[FF]|64, %749-08839000
$ SET OMIT = NOT WORKSET %749-08839499
NOSELECT~WKSETNOSELECT, %749-08839500
$ POP OMIT %749-08839501
BUFF); %749-08839600
BEGIN DS~9 LIT"FACTOR = "; 08840000
SI~LOC I; DS~2 DEC; I~DI; DI~DI-2; DS~FILL; DI~I; 08841000
DS~LIT"."; DS~2 DEC; 08842000
DS~13 LIT", MAX CORE = "; DS~7 DEC; 08843000
I~DI; DI~DI-7; DS~6 FILL; DI~I; 08844000
DS~7LIT",USING "; DS~7 DEC; I~DI; DI~DI-7; DS~6 FILL;%749-08845000
DI:=I; %749-08845500
$ SET OMIT = NOT WORKSET %749-08845999
NOSELECT(DS:=14 LIT ",WKSETNOSELECT"); %749-08846000
$ POP OMIT %749-08846001
DS:=LIT"~"; %749-08846010
END STREAM; 08847000
EXIT: SPOUT(BUFF); 08848000
END CHANGEFACTOR; 08849000
PROCEDURE SHEETDIDDLER(BUFF,TYPE,STD); VALUE BUFF,TYPE,SID; 08850000
REAL BUFF,TYPE,SID; 08850100
COMMENT TYPE = 6: PS -- CHANGE PRIORITY OF JOB IN SCHEDULE 08850200
= 8: XS -- EXECUTE JOB IN SCHEDULE (FORCE SELECTION) 08850300
= 7: ES -- ELIMINATE JOB FROM SCHEDULE (FORCE SELECTION, 08850400
THEN "DS") 08850500
= 5: TS -- TYPE OUT SCHEDULE; 08850600
BEGIN REAL IOD,T,PRIORITY; 08851000
INTEGER LEVEL,NEXTLINK,THISLINK,LASTLINK; 08852000
INTEGER ES,EM,EH; DEFINE ET = EH#; 08852500
$ SET OMIT = NOT(DATACOM ) 08852599
BOOLEAN LASTPASED,ATLEASTONE; 08853000
ARRAY S[*],DLNK[*]; 08854000
$ SET OMIT = NOT(PACKETS) 08854499
DEFINE UNITNO = S[23].[2:6]#; % ORIGINATING UNIT 08854500
$ POP OMIT 08854501
LABEL CONTINUE,C1,READIN,GNX,TS,TS1,TS2, 08855000
XSES,ESLL,PS,PS1,PS2,SPIT,EXIT; 08856000
SUBROUTINE GETNEXT; % READS IN NEXT JOB SHEET ENTRY 08858000
BEGIN 08859000
CONTINUE: LASTLINK ~ THISLINK; 08860000
IF (THISLINK~NEXTLINK) ! 0 THEN GO TO READIN; 08860500
C1: IF (LEVEL~LEVEL+1) > MIXMAX THEN 08861000
BEGIN LASTPASSED ~ TRUE; GO TO GNX END; 08862000
LASTLINK ~ NEXTLINK ~ 0; 08863000
IF (THISLINK~SHEET[LEVEL].[CF]) = 0 THEN GO TO C1; 08864000
READIN: DISKIO(IOD,-(S INX 0-1),30,THISLINK); 08865000
SLEEP([IOD],IOMASK); 08866000
NEXTLINK ~ S[29]; 08867000
IF S[0].[36:6]=@14 THEN GO CONTINUE;%PASS LM ENTRY 08868000
GNX: 08869000
END GETNEXT; 08870000
SLEEP([TOGLE],SHEETMASK); LOCKTOG(SHEETMASK); 08880000
S := [M[TYPEDSPACE(31,SHEETAREAV)]] & 30[SIZE];% %167-08881000
LEVEL ~ -1; LASTPASSED ~ FALSE; 08882000
IF BUFF!0 THEN 08882050
BUFF ~ ((T~BUFF).[15:15]-1)&M[P(DUP)-1][9:9:9]; 08882500
$ SET OMIT = NOT(DATACOM ) 08882599
IF TYPE=5 THEN GO TS; IF TYPE GTR 6 THEN GO XSES; GO PS; 08883000
IS: ATLEASTONE ~ FALSE; 08884000
IS1: GETNEXT; IF LASTPASSED THEN GO TO TS2; 08885000
IF SID NEQ 63 THEN BEGIN IF S[3].[8:10]NEQ SID THEN GO TS; END ELSE 08885500
IF ATLEASTONE THEN BUFF.[CF]~SPACE(12); 08886000
ET~((CLOCK+P(RTR))/60)-S[23].[24:24]; 08886300
ES ~ ET MOD 60; ET ~ ET DIV 60; EM ~ ET MOD 60; EH ~ ET DIV 60; 08886600
STREAM(TU~S[23].[9:4],BUF~S[23].[14:4], 08887000
RT:=S[23].[9:4] NEQ 0,C:=LEVEL,J1:=(S[0] LSS 0) OR 08887001
(S[2].SSYSJOBF = LIBMAINCODE),J2:=S[27], 08887010
J~S[*],ID~S[3].[8:10],EH,EM,ES,A~S[20]|64,BUFF); % 08887100
BEGIN SI~LOC C; DS~6 DEC; DI~DI-6; DS~5 FILL; DI~BUFF; DI~DI+6; 08888000
DS~LIT":"; SI~J; SI~SI+1; DS~7 CHR; DS~LIT"/"; SI~SI+1; 08889000
DS:=7CHR;J1(DS:=LIT" ";SI:=LOC J2;SI:=SI+1;DS:=7CHR); 08890000
DS:=LIT"=";SI:=LOC ID;DS:=2 DEC; 08890010
RT(DS~6 LIT " FROM "; SI~LOC TU; DS~2 DEC; % 08890100
DS~1 LIT "/"; SI~LOC BUF; DS~2 DEC;); % 08890200
DS~7 LIT" IN FOR"; SI~LOC EM; 08891000
3(DS ~ LIT":"; DS~2 DEC); ES~DI; DI~DI-9; DS~8 FILL; 08892000
DI~ES; DS~8 LIT", NEEDS "; 08893000
SI~LOC A; DS~5 DEC; DS~LIT"~"; DI~DI-6; DS~4 FILL; 08899000
END STREAM; 08900000
SPOUTER(BUFF,IF SID!63 THEN UNITNO ELSE 0,1); 08901000
IF SID NEQ 63 THEN BEGIN TYPE:=5;GO EXIT END; 08901500
ATLEASTONE~TRUE; 08902000
GO TO TS; 08903000
TS2: IF ATLEASTONE THEN GO TO EXIT; 08904000
IF SID NEQ 63 THEN YTPE:=5 ELSE% 08904050
STREAM(BUFF); DS ~ 15 LIT " NULL SCHEDULE~";% %WF 08905000
SPOUT(BUFF); GO TO EXIT; 08906000
XSES: GETNEXT; 08910000
IF LASTPASSED THEN BEGIN IF BUFF!0 THEN SPOUT(BUFF); 08911000
GO TO EXIT; END; 08911050
IF S[3].[8:10]~SID THEN GO TO XSES; 08912000
$ SET OMIT = NOT(DATACOM ) 08912099
S[2].[1:2]:=(IF TYPE=8 THEN 2 ELSE 3); % 7=ES,8=XS 08913000
DISKIO(IOD,S INX 0-1,30,THISLINK); SLEEP([IOD],IOMASK); 08915000
GO TO SPIT; 08915100
PS: STREAM(PRIORITY:T); 08916000
BEGIN SI~T; 08917000
N: IF SC="~" THEN GO TO X; 08918000
IF SC<"0" THEN BEGIN SI~SI+1; GO TO N; END; T~SI; 08919000
K: IF SC}"0" THEN IF SC{"9" THEN 08920000
BEGIN TALLY~TALLY+1; SI~SI+1; GO TO K END; 08921000
SI~T; DI~LOC PRIORITY; T~TALLY; DS~T OCT; GO TO Z; 08922000
X: DI~LOC PRIORITY; SKIP DB; DS~11 SET; 08923000
Z: 08924000
END STREAM; 08925000
IF (PRIORITY~P)<0 THEN BEGIN SPOUT(BUFF); GO TO EXIT END; 08926000
PS1: GETNEXT; IF LASTPASSED THEN BEGIN SPOUT(BUFF); GO TO EXIT END; 08927000
IF S[3].[8:10]!SID THEN GO TO PS1; 08928000
% DELINK AND RELINK THIS SHEET ENTRY 08929000
DLNK := [M[TYPEDSPACE(31,SHEETAREAV)]] & 30[SIZE];% %167-08930000
IF NEXTLINK = 0 THEN SHEET[LEVEL].[FF] ~ LASTLINK; 08931000
IF LASTLINK = 0 THEN BEGIN SHEET[LEVEL].[CF]~ NEXTLINK;GO PS2 END;08932000
DISKIO(IOD,-(DLNK INX 0-1),30,LASTLINK); SLEEP([IOD],IOMASK); 08933000
DLNK[29] ~ NEXTLINK; 08934000
DISKIO(IOD,+(DLNK INX 0-1),30,LASTLINK); SLEEP([IOD],IOMASK); 08935000
PS2: S[2].[CF] ~ IF (S[18]~PRIORITY) > 32767 THEN 32767 ELSE PRIORITY; 08936000
LEVEL ~ IF PRIORITY > MIXMAX THEN MIXMAX ELSE PRIORITY; 08937000
IF SHEET[LEVEL].[CF] ~ 0 THEN 08938000
BEGIN DISKIO(IOD,-(DLNK INX 0-1),30,SHEET[LEVEL].[FF]); 08939000
SLEEP([IOD],IOMASK); 08940000
DLNK[29] ~ THISLINK; 08941000
DISKIO(IOD,+(DLNK INX 0-1),30,SHEET[LEVEL].[FF]); 08942000
SLEEP([IOD],IOMASK); 08943000
END ELSE SHEET[LEVEL] ~ THISLINK; 08944000
SHEET[LEVEL].[FF] ~ THISLINK; 08944500
S[29] ~ 0; S[3] ~ ABS(S[3]); % TO GET SELECTION TO PRINT MESSAGE; 08945000
DISKIO(IOD,+(S INX 0-1),30,THISLINK); SLEEP([IOD],IOMASK); 08946000
FORGETSPACE(DLNK); 08947000
SPIT: IF BUFF!0 THEN 08947100
$ SET OMIT = NOT(PACKETS) 08947199
IF UNITNO GEQ 32 THEN 08947200
BEGIN 08947300
MOVE(9,BUFF+1,BUFF); SPOUTER(BUFF,UNITNO,64); 08947400
END ELSE 08947500
$ POP OMIT 08947501
FORGETSPACE(BUFF); 08947600
EXIT: UNLOCKTOG(SHEETMASK); 08997000
FORGETSPACE(S); 08998000
IF TYPE!5 THEN BEGIN KEYBOARDCOUNTER ~ KEYBOARDCOUNTER-1; 08998200
SELECTION; 08998400
KEYBOARDCOUNTER ~ KEYBOARDCOUNTER+1; 08998600
END; 08998800
END SHEETDIDDLER; 08999000
$ SET OMIT = NOT(DCSPO AND DATACOM ) 08999999
$ SET OMIT = NOT(DISKLOG) 09299999
PROCEDURE WHATINTRNSIC(BUFF); VALUE BUFF; REAL BUFF; FORWARD; 09400000
$ SET OMIT = NOT(AUXMEM) 09400099
$ SET OMIT = NOT MONITOR 09410100
$ SET OMIT = NOT AUXMEM 09433590
PROCEDURE INTRINSICTABLEBUILDER(FH); VALUE FH; REAL FH; 09500000
BEGIN 09500500
% WHEN CALLED WITH FH= (-1), TRANSFER TO AUXMEM ONLY 09500510
REAL DISKADDR=+1,T=+2,INTLOC=+3,T17SIZE=+4,MAXINT=+5; 09501000
$ SET OMIT = NOT(AUXMEM) 09501500
P(0, 0, 0, 0, 0); 09504570
IF (T:=FH.[FF])=0 THEN T:=SPACE(30); 09505000
$ SET OMIT = NOT(AUXMEM) 09505100
DISKWAIT(-T, 30, DISKADDR:=M[FH INX 10]); 09505500
MAXINT := M[T] ~ 1; % NUMBER OF INTRINSICS + 1 09505600
T17SIZE := M[T INX 17].[8:10]+1; % INTR.#17 SIZE+1WD.FOR DISK.ADDR. 09505700
FORGETSPACE(T); 09505750
INTRNSC:=[M[INTLOC:=GETSPACE(MAXINT+I17SIZE,INTARRAYAREAV,1)+2]]& 09506000
(MAXINT+T17SIZE)[8:38:10]; % SPACE FOR INTRINSIC TABLE + INT.#17 09506100
DISKWAIT(-(INTRNSC INX 0),MAXINT,DISKADDR); 09506500
M[INTRNSC INX NOT 0] := 0; MAXINT := MAXINT -1; 09507000
FOR T := 1 STEP 1 UNTIL MAXINT DO 09507500
INTRNSC[T]:=NABS(([(*P(DUP),DUP).[8:10]+INTSIZE) & 09508000
(P(XCH) INX 0 + DISKADDR)[6:21:27]); 09508500
DISKWAIT(-(INTLOC:=INTLOC+MAXINT+2),(T17SIZE-1),INTRNSC[17].[6:27]); 09508600
INTRNSC[17] := (*P(DUP))&INTLOC[CTC]; % MARK PERCENT 09508700
M[INTLOC-1]:=0&(T17SIZE-1)[CTF]; % DUMMY MARKER FOR DUMP/ANALYZE 09508800
DISKADDR:=0&1[4:47:1]; 09509000
INTRNSC[2]:=*P(DUP) OR DISKADDR; 09509500
FOR T:=18 STEP 1 UNTIL 20 DO INTRNSC[T]:=*P(DUP) OR DISKADDR; 09510000
$ SET OMIT = NOT(AUXMEM) 09510500
INTSIZE:=(INTRNSC[0] + 3 ) DIV 4; 09534500
$ SET OMIT = NOT(PACKETS) 09534999
T:=SPACE(15); WHATINTRNSIC(T); 09535000
STREAM(S:=T,D:=3); 09535100
BEGIN 09535200
SI:=S; DI:=DI+4; % CMBIT IN M[3].[1:1] 09535300
63(IF SC="." THEN JUMP OUT; SI:=SI+1); S:=SI; 09535400
4(SI:=SI+1; IF SC="." THEN JUMP OUT); 09535500
IF TOGGLE THEN ELSE SI:=S; SI:=SI+1; 09535600
3(IF SC<"0" THEN JUMP OUT; TALLY:=TALLY+1; SI:=SI+1); 09535700
S:=TALLY; SI:=SI-S; DI:=DI-S; DS:=S CHR; 09535800
END; 09535900
FORGETSPACE(T); 09536000
$ POP OMIT 09536001
END INTRINSCI TABLE BUILDER; 09537000
PROCEDURE CHANGEINTRINSICFILE(BUFF); VALUE BUFF; REAL BUFF;% 09600000
BEGIN REAL A,B,IOD,I,J,K,L; 09601000
REAL FH,T,IT; LABEL FXIT,WITHOUT; 09602000
REAL SIZE=I,DISKADDR=T,LOC=IT,WI=J; 09602100
BOOLEAN SUBROUTINE NULLMIX;% 09603000
BEGIN POLISH(1);% 09604000
IF INTSIZE!0 THEN BEGIN INTSIZE ~ 0;% 09605000
FOR I~1 STEP 1 UNTIL MIXMAX DO% 09606000
IF JARROW[I]!0 THEN% 09607000
IF NOT (JAR[I,9].SYSJOBF) THEN % NOT "SYSTEM" JOB 09608000
BEGIN P(DEL, 0); I ~ MIXMAX; END;% 09611000
IF NOT P(DUP) THEN INTSIZE ~ (INTRNSC[0]+3) DIV 4;% 09612000
END;% 09613000
NULLMIX ~ POLISH;% 09614000
END NULLMIX;% 09615000
SUBROUTINE FORGETEM;% 09616000
BEGIN SLEEP([TOGLE],STOREMASK); LOCKTOG(STOREMASK); 09617000
WHILE (K ~ M[L]).[CF]!0 DO% 09618000
BEGIN IF K>0 THEN% 09619000
IF K.[3:12]=@700 THEN% 09620000
FORGETSPACE(L+2);% 09621000
L ~ K.[CF];% 09622000
END;% 09623000
UNLOCKTOG(STOREMASK); 09624000
$ SET OMIT = NOT(AUXMEM) 09624010
FORGETSPACE(INTRNSC INX 0); INTRNSC~0 09624100
END FORGETEM;% 09625000
DEFINE ERROR = GO TO EXIT#;% 09626000
SLEEP([TOGLE], FREEMASK); INTFREE ~ FALSE;% 09630000
T ~ BUFF;% 09631000
NAMEID(A,T); NAMEID(B,T); NAMEID(B,T);% 09632000
IF (FH:=DIRECTORYSEARCH(A,B,17))=0 THEN ERROR; 09633000
IF (J~M[FH+4].[36:6])!0 THEN 09633100
IF J!DCINTYPE AND J!TSSINTYPE THEN 09633200
BEGIN % DONT ALLOW CI ON KNOWN NON-INTRINSICS FILE 09633300
STREAM(A,B,NT1:=BUFF.[15:15]-1); 09633400
BEGIN DS:=2LIT"# "; SI:=LOC A; 09633500
SI:=SI+1; DS:=7CHR; DS:=LIT"/"; 09633600
SI:=SI+1; DS:=7 CHR; 09633700
DS:=24 LIT" NOT AN INTRINSICS FILE~"; 09633800
END; 09633900
FORGETSPACE(FH); 09634000
FORGETSPACE(DIRECTORYSEARCH(A,B,16)); 09634100
ERROR; 09634200
END; 09634300
IF NOT NULLMIX THEN COMPLEXSLEEP(NULLMIX); 09635000
IF INTRNSC!0 THEN FORGETEM; 09636000
$ SET OMIT = SHAREDISK 09636999
IF MCPFREE=0 THEN SLEEP([TOGLE],MCPMASK); 09637000
LOCKTOG(MCPMASK); 09638000
$ POP OMIT 09638001
T:=SPACE(30); 09639000
OKSEGZEROWRITE:=TRUE; %204-09639001
DISKWAIT(-T,-30,0); 09640000
I:=T+13+5|SYSNO; 09641000
IF (IT:=DIRECTORYSEARCH(M[I],M[I+1],16))!0 THEN 09642000
FORGETSPACE(T); 09643000
M[I]:=A; 09644000
M[I+1]:=B; 09645000
DISKWAIT(T,-30,0); 09646000
OKSEGZEROWRITE:=FALSE; %204-09646001
$ SET OMIT = SHAREDISK 09646999
UNLOCKTOG(MCPMASK); 09647000
$ POP OMIT 09647001
$ SET OMIT = NOT(AUXMEM) 09647999
FORGETSPACE(T); 09648000
INTRINSICTABLEBUILDER(FH.[CF]); 09657000
FORGETSPACE(FH); 09658000
WHATINTRNSIC(BUFF.[15:15]); 09659000
STREAM(B:=BUFF.[15:15]-1); DS:=8 LIT" NEW "; 09670000
EXIT: SPOUT(BUFF.[15:15]-1);% 09676000
INTFREE ~ TRUE;% 09677000
END CHANGING INTRINSIC FILES ON USER DISK WITH MANY PRECAUTIONS;% 09679000
PROCEDURE CHANGEMCP(BUFF); VALUE BUFF; REAL BUFF; 09679100
BEGIN 09679200
REAL A,B,T,Z,BASE; 09679300
LABEL EXIT; 09679400
T:=BUFF; 09679800
NAMEID(A,T); NAMEID(B,T); NAMEID(B,T); 09679900
$ SET OMIT = SHAREDISK 09679999
IF MCPFREE=0 THEN SLEEP([TOGLE],MCPMASK); 09680000
LOCKTOG(MCPMASK); 09680100
$ POP OMIT 09680101
Z:=SPACE(30); 09680200
OKSEGZEROWRITE:=TRUE; %204-09680229
DISKWAIT(-Z,-30); 09680300
BASE:=Z+10+5|SYSNO; 09680400
IF (A EQV M[BASE])!NOT 0 OR 09680500
(B EQV M[BASE+1])!NOT 0 THEN 09680600
BEGIN 09680700
IF (T:=DIRECTORYSEARCH(A,B,17))=0 THEN 09680800
BEGIN; 09680900
STREAM(A:=[A],T:=BUFF.[15:15]-1); 09681000
BEGIN DS:=13 LIT"#NO MCP FILE ";SI:=A;SI:=SI+1; 09681100
DS:=7 CHR;DS:=LIT"/";SI:=SI+1;DS:=7 CHR; 09681200
DS~LIT"~"; 09681250
END; 09681300
GO TO EXIT; 09681400
END; 09681500
IF (NT1~M[T+4].[36:6])!0 THEN IF NT1!MCPTYPE THEN 09681505
BEGIN % DONT ALLOW CM ON KNOWN NON-MCP FILE 09681510
STREAM(A:=[A],T:=BUFF.[15:15]-1); 09681515
BEGIN DS:=2LIT"# "; SI:=A; SI:=SI+1; 09681520
DS:=7CHR; DS:=LIT"/"; SI:=SI+1; 09681525
DS:=7CHR; DS:=12LIT" NOT AN MCP~"; 09681530
END; 09681535
FORGETSPACE(T); 09681540
FORGETSPACE(DIRECTORYSEARCH(A,B,16)); 09681545
GO TO EXIT; 09681550
END; 09681555
IF M[BASE+2]-2!MCPBASE THEN 09681600
FORGETSPACE(DIRECTORYSEARCH(M[BASE],M[BASE+1],16)); 09681650
M[BASE]:=A; 09681700
M[BASE+1]:=B; 09681800
M[BASE+2]:=M[T+10]; 09681900
$ SET OMIT = NOT(AUXMEM) 09681909
FORGETSPACE(T); 09682000
END; 09682100
STREAM(A:=[A],T:=BUFF.[15:15]-1); 09682200
BEGIN DS:=18 LIT " NEXT MCP WILL BE ";SI:=A;SI:=SI+1; 09682300
DS:=7 CHR;DS:=LIT"/";SI:=SI+1;DS:=7 CHR; 09682400
DS~LIT"~"; 09682450
END; 09682500
M[3]~NABS(*P(DUP)); % SET FLAG FOR WM 09682550
EXIT: 09682600
DISKWAIT(Z,-30,0); 09682610
OKSEGZEROWRITE:=FALSE; %204-09682611
$ SET OMIT = NOT(NOT SHAREDISK) 09682619
UNLOCKTOG(MCPMASK); 09682620
$ POP OMIT 09682621
FORGETSPACE(Z); 09682700
SPOUT(BUFF.[15:15]-1); 09682800
END CHANGING OF THE MCP; 09683100
BOOLEAN PROCEDURE SYSTEMFILE(A,B); VALUE A,B; REAL A,B;% 09700000
BEGIN LABEL DISK,LOG,TRUTH,DIR,SYS,REM,DECK,MASK,TEST; 09701000
LABEL DMP; 09701500
LABEL MAINT; 09701550
$ SET OMIT = NOT(STATISTICS) 09701599
DEFINE T=P(TRUTH)#;% 09702000
IF (B EQV P(DISK))=T THEN% 09703000
P(((A EQV P(DIR))=T) OR 09704000
((A EQV P(LOG))=T) OR 09704100
((A EQV P(DMP))=T)) 09704500
ELSE IF (B EQV P(LOG))=T THEN% 09705000
P(((A EQV P(SYS))=T) % 09706000
$ SET OMIT = SHAREDISK 09706049
OR ((A EQV P(MAINT))=T)% 09706050
OR ((A EQV P(REM))=T)% 09706100
$ POP OMIT 09706101
)% 09706150
$ SET OMIT = NOT(SHAREDISK) 09706199
ELSE IF (A EQV P(DECK))=T THEN% 09707000
P(((B AND P(MASK)) EQV P(TEST))=T)% 09708000
$ SET OMIT = NOT(STATISTICS) 09708099
ELSE P(0);% 09709000
P(RTN);% 09710000
DISK ::: "DISK ";% 09711000
LOG ::: "LOG ";% 09712000
TRUTH::: @3777777777777777;% 09713000
DIR ::: "DIRCTRY";% 09715000
SYS ::: "SYSTEM ";% 09716000
REM ::: "REMOTE ";% 09717000
DECK ::: "DECK ";% 09718000
MASK ::: @77000000007777;% 09719000
TEST ::: @12000000003714;% 09720000
DMP ::: "DMPAREA";% 09720500
MAINT::: "MAINT ";% 09720650
$ SET OMIT = NOT(STATISTICS) 09720699
END;% 09721000
$ SET OMIT = NOT(DEBUGGING) 09999999
$ SET OMIT = NOT(WORKSET) 12200000
12200500
PROCEDURE WKSETVALUES(KTRX); VALUE KTRX; REAL KTRX; 12201000
BEGIN 12201500
12202000
% ROUTINE FOR HANDLING KEYIN WORKSET REQUESTS. 12202500
12203000
REAL 12203500
BUFF, 12204000
CYCLETOG, 12204500
ERRORTOG, 12205000
INS, 12205500
INSTRUCT, 12206000
KTR, 12206500
$ SET OMIT = NOT(WORKSETMONITOR) OR OMIT 12207000
MONTOG, 12207500
$ POP OMIT % WORKSET MONITOR 12208000
N, 12208500
NAM, 12209000
NEXTNAME, 12209500
OLAYTOG, 12210000
STARTING, 12210500
TOLTOG, 12211000
USETOG, 12211500
VALU, 12212000
ZZSTA; 12212500
12213000
ARRAY NAMS[*]; 12213500
12214000
LABEL NU, NEW, SKAN, SKP, ERROR; 12214500
12215000
DEFINE 12215500
OLAYINDX = 1#, % CODE FOR "OLAY RATIO" 12216000
PRIORINDX = 2#, % CODE FOR "PRIORITY", 12216500
ETIMEINDX = 3#, % CODE FOR "ELAPSED TIME", 12217000
COREINDX = 4#, % CODE FOR "CORE USAGE" 12217500
SAVEINDX = 5#, % CODE FOR "SAVE CORE USAGE" 12218000
INFOSIZE = 5#, % NUMBER OF ENTRIES FOR EACH MIX 12218500
12219000
DEFINE PRINTDIGIT = % OUTPUT ROUTINE FOR STREAM STATEMENT 12219500
DV:=DI; DS:=5DEC; DI:=DV; DS:=4FILL; 12220000
DI:=DV; SI:=DV; 5(IF SC=" " THEN SI:=SI+1 ELSE DS:=CHR); 12220500
DS:=LIT","#; 12221000
12221500
BUFF := KTRX.[15:15]; % KEYIN BUFFER LOCATION 12222000
KTR := KTRX.[15:33]; % LOCATION OF REQUEST IN KEYIN BUFFER 12222500
ZZSTA := 0 & M[BUFF-2][9:9:9]; % REMOTE STATION 12223000
12223500
SKAN: % SCAN INPUT BUFFER FOR REQUEST ANALYSIS 12224000
12224500
STREAM(NAM :=0, VALU:=(-1), LOCN:=0, NEXTNAME:="~" : 12225000
TOG:=0, EQLTOG:=0, T:=0, KTR); 12225500
BEGIN 12226000
SI:=KTR; GO TO L2; 12226500
L0: 63(IF SC=ALPHA THEN SI:=SI+1 ELSE JUMP OUT TO L2); 12227000
L1: SI:=SI+1; 12227500
L2: IF SC="~" THEN GO TO L3; % END OF RECORD 12228000
IF SC=" " THEN GO TO L1; % IGNORE BLANKS 12228500
IF SC="," THEN GO TO L1; % COMMA IS OPTIONAL 12229000
IF SC="=" THEN % SET "EQUAL" TOGGLE 12229500
BEGIN 12230000
TALLY:=1; EQLTOG:=TALLY; GO TO L1; 12230500
END; 12231000
IF SC=ALPHA THEN ELSE GO TO XX0; % NO OTHER SPECIAL CHR.ALLOWED 12231500
% TREAT STRING AS NUMERIC ONLY IF PRECEEDED BY "=" 12232000
EQLTOG(IF SC GEQ "0" THEN IF SC LEQ "9" THEN JUMP OUT TO L4); 12232500
L3: TOG(DI:=LOC NEXTNAME; JUMP OUT TO LL1); % USE "NEXTNAME" 2ND.PASS 12233000
DI:=LOC NAM; % USE "NAM" ON FIRST PASS 12233500
GO TO LL1; GO TO L0; XX0: GO TO XXIT; LL1: % BRANCH POINT 12234000
DI:=DI+5; % NAME STORED IN LAST 3 CHRS. 12234500
IF SC="~" THEN % END OF RECORD,DONT MOVE SI; 12235000
BEGIN 12235500
DS:=3LIT"00~"; GO TO XXIT; 12236000
END; 12236500
T:=SI; DS:=CHR; 12237000
2(IF SC=ALPHA THEN DS:=CHR ELSE DS:=LIT" "); 12237500
TOG(SI:=T; JUMP OUT TO XXIT); % BRANCH OUT ON 2ND PASS 12238000
TALLY:=1; TOG:=TALLY; % SET SECOND PASS TOGGLE 12238500
GO TO LL0; 12239000
% NUMERICS CONVERTED AT "L4" 12239500
L4: LOCN:=SI; SI:=SI+1; TALLY:=0; EQLTOG:=TALLY; TALLY:=1; 12240000
7(IF SC GEQ "0" THEN IF SC LEQ "9" THEN; 12240500
IF TOGGLE THEN ELSE JUMP OUT; SI:=SI+1; TALLY:=TALLY+1; 12241000
SI:=LOCN; T:=TALLY; DI:=LOC VALU; DS:=T OCT; GO TO LL0; 12241500
XXIT: LOCN:=SI; 12242000
END STREAM STATEMENT; 12242500
12243000
NEXTNAME := P; % VALUE OF NEXT ITEM IN REQUEST 12243500
KTR := P; % ADDRESS OF NEXT ITEM IN KEYIN BUFFER 12244000
VALU := P; % NUMERIC VALUE OF REQUEST (-1 IF NONE GIVEN) 12244500
NAM := P; % REQUEST ITEM 12245000
12245500
IF NAM="~" THEN % NULL INPUT, TREAT AS "LIST" REQUEST 12246000
BEGIN 12246500
NU: USETOG := TOLTOG := OLAYTOG := CYCLETOG := 1; 12247000
GO TO NEW; 12247500
END 12248000
ELSE IF USETOG = 3 THEN % SETTING NEW OPTIONS 12248500
BEGIN 12249000
IF (N:=(IF (NAM="OLA" AND VALU=(-1)) THEN OLAYINDX ELSE 12249500
IF NAM="PRI" THEN PRIORINDX ELSE 12250000
IF NAM="TIM" THEN ETIMEINDX ELSE 12250500
IF NAM="COR" THEN COREINDX ELSE 12251000
IF NAM="SAV" THEN SAVEINDX ELSE 0)) NEQ 0 THEN 12251500
INSTRUCT := 0 & INSTRUCT[8:4:40] & N[4:44:4] 12252000
ELSE GO TO SKP; % MAY NOT BE PART OF "USE" COMMAND 12252500
END % IF USETOG = 3 12253000
ELSE 12253500
SKP: IF (NAM="ON " OR NAM="OFF") THEN 12254000
BEGIN 12254500
STARTING := 1 + (NAM="OFF"); 12255000
GO TO NU; 12255500
END 12256000
ELSE IF NAM="USE" THEN % SETTING NEW VALUES 12256500
BEGIN 12257000
INSTRUCT := 0; 12257500
USETOG := 3; 12258000
END 12258500
ELSE IF NAM="OPT" THEN USETOG := 1 % LISTING OPTIONS 12259000
ELSE IF NAM="TOL" THEN % TOLERANCE FOR OPTIONS 12259500
BEGIN 12260000
TOLTOG := 1; 12260500
IF VALU GEQ 0 THEN 12261000
BEGIN 12261500
IF VALU GTR 100 THEN GO TO ERROR; 12262000
WKSETTOLERANCE := VALU | 0.01; 12262500
END; 12263000
END 12263500
ELSE IF NAM = "OLA" THEN 12264000
BEGIN 12264500
OLAYTOG := 1; 12265000
IF VALU GEQ 0 THEN 12265500
BEGIN 12266000
WKSETMAXOLAY := VALU/100; 12266500
END; 12267000
END 12267500
ELSE IF NAM="CYC" THEN % CYCLE TIME 12268000
BEGIN 12268500
CYCLETOG := 1; 12269000
IF VALU GEQ 0 THEN % SETTING NEW VALUE 12269500
BEGIN 12270000
NEW: IF WKSETCYCLETIME=0 THEN % NO PREVIOUS VALUE 12270500
BEGIN 12271000
STFIRST := 0; STNEXT := 0; 12271500
IF WKSETINSTRUCT=0 THEN % SET DEFAULT OPTIONS 12272000
BEGIN 12272500
WKSETINSTRUCT := PRIORINDX & 12273000
OLAYINDX [40:44:4] & 12273500
COREINDX [36:44:4] & 12274000
ETIMEINDX[32:44:4] & 12274500
SAVEINDX [28:44:4]; 12275000
END; 12275500
IF WKSETOLERANCE=0 THEN WKSETOLERANCE := 0.10; 12276000
IF WKSETMAXOLAY=0 THEN WKSETMAXOLAY := 0.40; 12276500
END; % IF NOT PREVIOUS VALUE 12277000
IF STARTING NEQ 0 THEN % "WK ON" OR "WK OFF" 12277500
BEGIN 12278000
IF STARTING = 2 THEN % "OFF" 12278500
WKSETCYCLETIME := NABS(WKSETCYCLETIME) ELSE 12279000
BEGIN % "ON" 12279500
WKSETCYCLETIME:= 12280000
(IF WKSETCYCLETIME=0 THEN 20|64 ELSE 12280500
ABS(WKSETCYCLETIME)); 12281000
END; % IF STARTING = 1 12281500
STARTING := 0; 12282000
END; % IF STARTING GTR 0 12282500
IF VALU GEQ 0 THEN WKSETCYCLETIME := VALU|64; 12283000
IF WKSETCYCLETIME LEQ 0 THEN WKSETNOSELECT:=0; % TELL SELECTRUN12283500
END; % IF VALU GEQ 0 12284000
END % IF NAM="CYC" 12284500
$ SET OMIT = NOT(WORKSETMONITOR) OR OMIT 12285000
ELSE IF NAM="MON" THEN 12285500
BEGIN 12286000
IF (VALU LSS 0) OR (VALU GTR 1) THEN GO TO ERROR; 12286500
WKSETMONITOR :=VALU; MONTOG:=1; 12287000
END 12287500
$ POP OMIT % WORKSETMONITOR 12288000
ELSE GO TO ERROR; 12288500
12289000
IF NAM NEQ "~" THEN 12289500
IF NEXTNAME NEQ "~" THEN 12290000
GO TO SKAN; 12290500
12291000
IF FALSE THEN 12291500
ERROR: 12292000
ERRORTOG:=1; 12292500
12293000
IF USETOG THEN 12293500
BEGIN 12294000
IF USETOG=3 THEN % NEW OPTIONS SET 12294500
IF INSTRUCT NEQ 0 THEN % NEW INSTRUCTIONS OBTAINED 12295000
BEGIN 12295500
WHILE (INSTRUCT.[44:4]=0) DO INSTRUCT:=INSTRUCT.[4:40]; 12296000
WKSETINSTRUCT := INSTRUCT; 12296500
END; 12297000
INSTRUCT := WKSETINSTRUCT; 12297500
NAMS := [M[BUFF INX 20]]&20[8:38:10]; % USE PART OF KEYIN BUFFER 12298000
NAMS[0]:=0; 12298500
N:=(-1); 12299000
WHILE (INS := INSTRUCT.[44:4]) GTR 0 DO 12299500
BEGIN 12300000
INSTRUCT := INSTRUCT.[4:40]; 12300500
NAMS[N:=N+1] := 12301000
(IF INS=1 THEN "OLAY " ELSE 12301500
IF INS=2 THEN "PRIORTY" ELSE 12302000
IF INS=3 THEN "TIME " ELSE 12302500
IF INS=4 THEN "CORE " ELSE 12303000
IF INS=5 THEN "SAVCOR " ELSE 12303500
"UNKNOWN") & 1[5:47:1]; 12304000
NAMS[N+1]:=0; 12304500
END; 12305000
END; % IF USETOG 12305500
STREAM(CYCLETOG, NEG:=(WKSETCYCLETIME.[1:1]), 12306000
CYC:=(ABS[WKSETCYCLETIME)/64+0.5) DIV 1, 12306500
ERRORTOG, VALUTOG:=(VALU GEQ 0), NAM, VALU, 12307000
OLAYTOG, OLA:=(WKSETMAXOLAY|100+0.5) DIV 1, 12307500
TOLTOG, TOL:=(WKSETOLERANCE|100+0.5) DIV 1, 12308000
$ SET OMIT = NOT(WORKSETMONITOR) OR OMIT 12308500
MONTOG, MON:=WKSETMONITOR, 12309000
$ POP OMIT % WORKSETMONITOR 12309500
USETOG, NM:=NAMS INX 0, DV:=0, BUFF:=BUFF-1); 12310000
BEGIN 12310500
DS:=4LIT"WK:"; 12311000
ERRORTOG(DS:=7LIT" ERROR:"; SI:=LOC NAM; SI:=SI+5; DS:=3CHR; 12311500
VALUTOG(DS:=LIT"="; SI:=LOC VALU; DS:=8DEC; 12312000
DV:=DI; DI:=DI-8; DS:=7FILL; DI:=DV); DS:=LIT" "); 12312500
$ SET OMIT = NOT(WORKSETMONITOR) OR OMIT 12313000
MONTOG(DS:=4LIT"MON="; SI:=LOC MON; PRINTDIGIT); 12313500
$ POP OMIT % WORKSETMONITOR 12314000
CYCLETOG(DS:=6LIT"CYCLE="; NEG(DS:=LIT"-"); 12314500
SI:=LOC CYC; PRINTDIGIT); 12315000
OLAYTOG(DS:=5LIT"OLAY="; 12315500
SI:=LOC OLA; PRINTDIGIT); 12316000
TOLTOG(DS:=4LIT"TOL="; 12316500
SI:=LOC TOL; PRINTDIGIT); 12317000
USETOG(SI:=NM; DS:=9LIT"OPTIONS: "; 12317500
L1: IF SC="0" THEN JUMP OUT; 12318000
SI:=SI+1; 7(IF SC=" " THEN SI:=SI+1 ELSE DS:=CHR); 12318500
DS:=LIT","; GO TO L1); 12319000
DI:=DI-1; DS:=LIT"~"; 12319500
END STREAM STATEMENT; 12320000
12320500
SPOUT((BUFF-1) INX (0&ZZSTA[9:9:9])); 12321000
NAMS:=[M[NAM:=SPACE(30)]] & 30[8:38:10]; %143-12321100
DISKWAIT(-NAM,30,DIRECTORYTOP+1); %143-12321110
NAMS[N:=4|SYSNO+4]:=WKSETCYCLETIME; %143-12321120
NAMS[N+1 ]:=WKSETINSTRUCT; %143-12321130
NAMS[N+2 ]:=WKSETOLERANCE; %143-12321140
NAMS[N+3 ]:=WKSETMAXOLAY; %143-12321150
DISKWAIT( NAM,30,DIRECTORYTOP+1); %143-12321160
FORGETSPACE(NAM); %143-12321170
END PROCEDURE WKSETREQUESTS; 12321500
12350000
PROCEDURE WORKSET(N); VALUE N; REAL N; 12350500
BEGIN 12351000
REAL MSCW = -2; 12351500
REAL 12352000
DEVIATION, 12352500
INS, 12353000
INSTRUCT, 12353500
LINK, 12354000
LOC, 12354500
MAXMIX, 12355000
MAXOLAY, 12355500
MAXVALUE, 12356000
MIX, 12356500
NJOBS, 12357000
PTIME, 12357500
TOTALPTIME, 12358000
OLAY, 12358500
TOTALOLAY, 12359000
STARTING, 12359500
STOPMIX, 12360000
SIZE, 12360500
T1, 12361000
T2, 12361500
TOTALOLAYCORE, 12362000
TOTALSAVECORE, 12362500
TOTALSYSTEMCORE, 12363000
VALU; 12363500
12364000
ARRAY JOBINFO[*]; 12364500
ARRAY RUNNING[*]; 12365000
12365500
DEFINE 12366000
OLAYINDX = 1#, % CODE FOR "OLAY RATIO" 12366500
PRIORINDX = 2#, % CODE FOR "PRIORITY", 12367000
ETIMEINDX = 3#, % CODE FOR "ELAPSED TIME", 12367500
COREINDX = 4#, % CODE FOR "CORE USAGE" 12368000
SAVEINDX = 5#, % CODE FOR "SAVE CORE USAGE" 12368500
INFOSIZE = 5#; % NUMBER OF ENTRIES FOR EACH MIX 12369000
12369500
DEFINE INFO[INFO1,INFO2] = JOBINFO[INFO1|INFOSIZE+INFO2-1]#; 12370000
12370500
LABEL START, LOOP, FINISHED; 12371000
12371500
COMMENT 12372000
THE "INSTRUCTIONS" ARE STORED IN THE GLOBAL VARIABLE 12372500
"WKSETINSTRUCT", USING FIELDS FOUR BITS IN LENGTH. 12373000
THE FIRST "INSTRUCTION" WILL BE IN THE [44:4] FIELD, THE 12373500
SECOND "INSTRUCTION" WILL BE IN THE [40:4] FIELD, AN SO FORTH. 12374000
THESE "INSTRUCTIONS" ARE THE NUMERICAL VALUES CORRESPONDING TO 12374500
CODES DEFINED ABOVE. 12375000
12375500
AS AN EXAMPLE OF HOW THESE "INSTRUCTIONS" ARE USED, SUPPOSE THAT 12376000
WKSETINSTRUCT.[44:4] CONTAINED A VALUE OF 3, 12376500
WKSETINSTRUCT.[40:4] CONTAINED A VALUE OF 2, AND THE 12377000
REMAINDER OF THE WKSETINSTRUCT WORD WERE ZERO. IN THIS 12377500
INSTANCE, THIS ROUTINE WOULD FIRST EXAMINE ALL JOBS IN THE 12378000
MIX, FINDING THE JOB WHICH HAD BEEN RUNNING FOR THE LONGEST 12378500
PERIOD OF TIME. NEXT, ALL JOBS WHICH HAVE BEEN RUNNING FOR A 12379000
PERIOD OF TIME WHICH IS WITHIN THE "WKSETOLERANCE" (NORMALLY 12379500
WITHIN ABOUT 10% OF THE MAXIMUM VALUE FOUND ABOVE) ARE EXAMINED 12380000
FOR THE NEXT "INSTRUCTION", THAT IS, THE PRIORITY. 12380500
IN THIS MANNER, THE JOB WHICH HAS BEEN RUNNING FOR THE LONGEST 12381000
PERIOD OF TIME, AND WHICH HAS THE HIGHEST PRIORITY WILL BE 12381500
SELECTED FOR "STOPPING". 12382000
END OF COMMENT; 12382500
12383000
12383500
SUBROUTINE CORESEARCH; 12384000
BEGIN 12384500
MAXMIN := 0; 12385000
% SEARCH THE LINKS TO DETERMINE CORE USAGE 12385500
IF NOT STOREDY THEN SLEEP([TOGLE],STOREMASK); 12386000
LOC := 0; % START AT LOW WND OF MEMORY 12386500
TOTALSYSTEMCORE := TOTALOLAYCORE := TOTALSAVECORE := 0; 12387000
WHILE (SIZE:=(LINK:=M[LOC]).[CF] -LOC) GEQ 0 DO 12387500
BEGIN 12388000
TOTALSYSTEMCORE := TOTALSYSTEMCORE + SIZE; 12388500
IF NOT LINK.[1:1] THEN % IN-USE AREA 12389000
BEGIN 12389500
IF (MIX:=LINK.[9:6]) GTR MAXMIX THEN MAXMIX := MIX; 12390000
IF LINK.[2:1] THEN % SAVE AREA 12390500
BEGIN 12391000
TOTALSAVECORE := TOTALSAVECORE + SIZE; 12391500
INFO[MIX,SAVEINDX] := INFO[MIX,SAVEINDX] - SIZE; 12392000
% NOTE: JOBS SHOULD BE STOPPED IN INVERSE RELATION TO 12392500
% AMOUNT OF SAVE CORE USED 12393000
END 12393500
ELSE 12394000
BEGIN 12394500
TOTALOLAYCORE := TOTALOLAYCORE + SIZE; 12395000
INFO[MIX,COREINDX] := INFO[MIX,COREINDX] + SIZE; 12395500
END; 12396000
END; % IF IN-USE AREA 12396500
LOC := LINK.[CF]; % NEXT LINK 12397000
END; % WHILE STATEMENT 12397500
FOR MIX := 1 STEP 1 UNTIL MAXMIX DO 12398000
IF RUNNING[MIX] THEN 12398500
IF PRYOR[MIX] LSS 0 THEN % CHECK AGAIN (LOSS OF CNTRL,ABOVE)12399000
BEGIN 12399500
RUNNING[MIX] := 0; 12400000
NJOBS := NJOBS - 1; 12400500
END; 12401000
% DONT USE JOBS WHICH ARE TERMINATING OR JUST STARTING 12401500
IF NJOBS LSS 2 THEN GO TO FINISHED; 12402000
END SUBROUTINE CORESEARCH; 12402500
12403000
IF (CLOCK+P(RTR)-WKSETSWITCHTIME) LSS 960 THEN 12403500
BEGIN 12404000
% ALLOW 15 SECONDS AFTER THE LAST "BOJ" OR "EOJ" 12404500
% BEFORE TESTING THE OVERLAY RATE 12405000
WKSETCLOCK:=(P(DUP)) + 960; 12405500
GO TO FINISHED; 12406000
END; 12406500
RUNNING := [M[T1:=SPACE(MIXMAX+1)]] & 12407000
(MIXMAX+1)[8:38:10]; 12407500
JOBINFO := [M[T2:=SPACE((MIXMAX+1)|INFOSIZE)]] & 12408000
((MIXMAX+1)|INFOSIZE)[8:38:10]; 12408500
12409000
START: 12409500
12410000
STREAM(F1:=T1-1,SZ1:=MIXMAX+1,F1:=T2-1, 12410500
SZ2 := (MIXMAX+1)|INFOSIZE, T1,T2); 12411000
BEGIN % ZERO OUT THE ARRAYS 12411500
SI:=F2; DS:=SZ2 WDS; SI:=F1; DI:=T1, DS:=SZ1 WDS; 12412000
END; 12412500
NJOBS := TOTALPTIME := TOTALOLAY := MAXOLAY := 0; 12413000
FOR MIX:=1 STEP 1 UNTIL MIXMAX DO 12413500
IF JARROW[MIX] NEQ 0 THEN % RUNNING JOB 12414000
IF NOT(JAR[MIX,9].[3:1]) THEN % NOT ALREADY STOPPED 12414500
IF (PRYOR[MIX] GEQ 0) AND (REPLY[MIX]=0) THEN 12415000
BEGIN 12415500
IF NOT(JAR[MIX,9].SYSJOBF) THEN %NOT "SYSTEM JOB 12416000
BEGIN 12416500
RUNNING[MIX] := 1; 12417000
NJOBS := NJOBS + 1; % COUNT THE NUMBER OF JOBS 12417500
END; 12418000
INFO[MIX,ETIMEINDX]:= 12418500
NABS(CLOCK+P(RTR)-NFO[MIX-1)|NXD+2].[1:17]|60); 12419000
PTIME := JAR[MIX,3] + PROCTIME[MIX]; 12419500
$ SET OMIT = NEWLOGGING OR OMIT 12419599
IF (P1MIX=MIX OR P2MIX=MIX) THEN 12419600
$ POP OMIT 12419601
$ SET OMIT = NOT(NEWLOGGING) OR OMIT 12419699
PTIME := PTIME+CLOCK+P(RTR); 12420000
IF (INFO[MIX,OLAYINDX]:= 12420500
OLAYTIME[MIX]/PTIME) GTR MAXOLAY THEN 12421000
IF RUNNING[MIX] THEN 12421500
MAXOLAY:=INFO[MIX,OLAYINDX]; % FIND MAX.VALUE 12422000
INFO[MIX,PRIORINDX] := PRYOR[MIX].[CF]; 12422500
TOTALOLAY := TOTALOLAY + OLAYTIME[MIX]; 12423000
TOTALPTIME:= TOTALPTIME + PTIME; 12423500
END; % MIX LOOP; 12424000
12424500
MIX~WKSETNOSELECT; %525-12424700
WKSETNOSELECT:=((OLAY:=TOTALOLAY/TOTALPTIME) GEQ (WKSETMAXOLAY|.85));12425000
IF MIX AND NOT WKSETNOSELECT THEN SELECTION; % SEE IF ANYTHING CAN GO 12425200
% NOTE: WKSETNOSELECT IS A FLAG TO PROCEDURE SELECTRUN TO 12425500
% PREVENT ENTERING ADDITIONAL JOBS INTO THE MIX 12426000
IF (OLAY GTR WKSETMAXOLAY) OR (MAXOLAY GTR (WKSETMAXOLAY|4)) THEN 12426500
% SUSPEND SOMETHING IF THE TOTAL OLAY RATE EXCEEDS MAX. VALUE 12427000
% SPECIFIED, OR ANY INDIVIDUAL RATE EXCEEDS 4 TIMES THE MAX. 12427500
% RATE SPECIFIED. 12428000
IF NJOBS GTR1 THEN % MORE THAN ONE JOB IS RUNNING 12428500
BEGIN 12429000
CORESEARCH; % SEARCH MEMORY TO DETERMINE CORE USAGE 12429500
% NOW DETERMINE WHICH JOB TO STOP BASED ON THE PRIORITY OF 12430000
% THE INSTRUCTIONS IN "WKSETINSTRUCT" 12430500
STOPMIX := -1; 12431000
INSTRUCT := WKSETINSTRUCT; 12431500
STARTING := TRUE; 12432000
12432500
LOOP: 12433000
12433500
IF (INS:=INSTRUCT.[44:4]) NEQ 0 THEN % MORE INSTRUCTIONS 12434000
BEGIN 12434500
INSTRUCT := 0 & INSTRUCT[8:4:40]; % SHIFT RIGHT FOR NXT.INSTR. 12435000
MAXVALUE := (IF STARTING THEN (-33000) ELSE INFO[STOPMIX,INS]);12435500
STARTING := FALSE; 12436000
% FIRST, FIND THEMAXIMUM VALUE 12436500
FOR MIX:=1 STEP 1 UNTIL MAXMIX DO 12437000
IF RUNNING[MIX] THEN 12437500
IF (VALU := INFO[MIX,INS]) GTR MAXVALUE THEN 12438000
BEGIN 12438500
MAXVALUE := VALU; 12439000
STOPMIX := MIX; 12439500
END; 12440000
12440500
% NEXT, FIND THE VALUES WITHIN THE WORK SET TOLERANCE 12441000
12441500
FOR MIX:=1 STEP 1 UNTIL MAXMIX DO 12442000
IF MIX NEQ STOPMIX THEN 12442500
IF RUNNING[MIX] THEN 12443000
BEGIN 12443500
DEVIATION := (MAXVALUE-INFO[MIX,INS])/MAXVALUE; 12444000
IF ABS(DEVIATION) GTR WKSETOLERANCE THEN 12444500
BEGIN 12445000
RUNNING[MIX]:=0; 12445500
NJOBS := NJOBS -1; 12446000
END; 12446500
END; 12447000
IF NJOBS GTR 1 THEN GO TO LOOP; 12447500
END; % IF THERE WERE MORE INSTRUCTIONS 12448000
12448500
IF STOPMIX GTR 0 THEN % SOMETHING SHOULD BE STOPPED 12449000
BEGIN 12449500
IF NOTERMSET(STOPMIX) THEN % JOB IS NOT TERMINATING 12451000
BEGIN 12451500
PRTROW[STOPMIX].[PSF]:=2; % MARK IT STOPPED 12452000
WKSETSWITCHTIME:=CLOCK+P(RTR); 12452500
WKSETSTOPJOBS:=WKSETSTOPJOBS OR TWO(STOPMIX); % MARK AUTO-ST12453000
WKSETNOSELECT:=TRUE; %138-12453100
JAR[STOPMIX,9].[3:1]:=1; % MARK IT STOPPED 12453500
STQUE[STNEXT]:=STOPMIX; % PUT IT IN THE STQUE 12454000
STNEXT := (STNEXT+1).[44:4]; % CIRCULAR QUEUE, 16 ENTRIES 12454500
END; % IF WE ARE STOPPING THE JOB 12455000
END; % IF SOMETHING SHOULD BE STOPPED 12455500
$ SET OMIT = NOT(WORKSETMONITOR) OR OMIT 12456000
IF WKSETMONITOR THEN 12456500
IF STOPMIX GTR 0 THEN 12457000
FOR STOPMIX:=1 STEP 1 UNTIL MIXMAX DO 12457500
IF JARROW[STOPMIX] NEQ 0 THEN 12458000
IF PRTROW[STOPMIX] NEQ 0 THEN 12458500
IF INFO[STOPMIX,OLAYINDX] GTR 0 THEN 12459000
BEGIN 12459500
STREAM( 12460000
V1:="MIX=", 12460500
V2:=STOPMIX, 12461000
V3:="RAT=", 12461500
V4:=(INFO[STOPMIX,OLAYINDX]|100+0.5) DIV 1, 12462000
V5:="PRI=", 12462500
V6:=INFO[STOPMIX,PRIORINDX], 12463000
V7:="TIM=", 12463500
V8:=(ABS(INFO[STOPMIX,ETIMEINDX])/64+ 0.5) DIV 1, 12464000
V9:="COR=", 12464500
V10:=INFO[STOPMIX,COREINDX], 12465000
V11:="SAV=", 12465500
V12:=ABS(INFO[STOPMIX,SVEINDX]), 12466000
V13 := "TOT=", 12466500
V14 := (TOTALOLAY/TOTALPTIME|100+0.5) DIV 1, 12467000
DV:=0, 12467500
D:=T1:=SPACE(15)); 12468000
BEGIN 12468500
SI:=LOC V1; DS:=LIT" "; 12469000
7(SI:=SI+4; DS:=4CHR; DS:=5DEC; 12469500
DV:=DI; DI:=DI-5; DS:=4FILL; DS:=DV; DS:=LIT" "); 12470000
DS:=LIT"~"; 12470500
END STREAM; 12471000
SPOUT(T1); 12471500
END; 12472000
$ POP OMIT % WORKSETMONITOR 12472500
END %142-12473000
ELSE %142-12473010
ELSE %142-12473020
IF WKSETSTOPJOBS GTR 0 THEN %142-12473030
IF (OLAY LSS (WKSETMAXOLAY/2)) THEN % START SOMETHING %142-12473040
BEGIN %142-12473050
STNEXT:=IF STNEXT=0 THEN STQUEMAX ELSE STNEXT-1; %142-12473060
STOPMIX:=STQUE[STNEXT]; %142-12473070
STQUE[STNEXT]:=0; %142-12473080
IF (STOPMIX GTR 0) AND (STOPMIX LEQ MIXMAX) THEN %142-12473090
IF JARROW[STOPMIX] NEQ 0 THEN %142-12473100
BEGIN %142-12473110
IF STOPSET(STOPMIX) THEN % NOT YET STOPPED %142-12473120
BEGIN %142-12473130
PRTROW[STOPMIX].[PSF]:=0; %142-12473140
WKSETSTOPJOBS:=WKSETSTOPJOBS AND NOT(TWO(STOPMIX)); %142-12473150
JAR[STOPMIX,9].[3:1]:=0; %142-12473160
END ELSE %142-12473170
BEGIN %142-12473180
REPLY[STOPMIX]:=VOK; % WAKE IT UP %142-12473190
STREAM(J:=JARROW[STOPMIX], STOPMIX, %142-12473200
D:=T1:=SPACE(10)); %142-12473210
BEGIN %142-12473220
SI:=J; DS:=9 LIT" AUTO-OK "; %142-12473230
2(SI:=SI+1; DS:=7 CHR; DS:=LIT "/"); %142-12473240
DI:=DI-1; DS:=LIT"="; SI:=LOC STOPMIX; %142-12473250
DS:=2 DEC; DS:=LIT"~"; DI:=DI-3; DS:=FILL; %142-12473260
END STREAM STATEMENT; %142-12473270
SPOUTER(T1,PSEUDOMIX[STOPMIX],1); %525-12473280
END; %142-12473290
END; %142-12473300
END; %142-12473310
FINISHED: 12473500
IF JOBINFO NEQ 0 THEN FORGETSPACE(JOBINFO INX 0); 12474000
IF RUNNING NEQ 0 THEN FORGETSPACE(RUNNING INX 0); 12474500
WKSETRUNNING := 0; % READY FOR NEXT CYCLE 12475000
KILL([MSCW]); 12475500
END; 12476000
$ POP OMIT % WORKSET 12477000
REAL PROCEDURE PRNPBTSPECASE1(Z); 12500000
% 12500100
% THIS PROCEDURE HANDLES THE FOLLOWING FUNCTIONS FOR COM19, DEPENDING 12500110
% ON THE VALUE OF Z: 12500120
% 0 FINDS THE NEXT REEL OF TAPE. 12500130
% 1 FINDS THE NEXT REEL OF A BACK-UP DISK FILE. 12500140
% 2 HANDLES THE QT + OR - MESSAGE. 12500150
% 3 INITAILIZES A NEW FILE (OR PACKET). 12500160
% 4 HANDLES TERMINATION OF A FILE. 12500170
% 12500180
VALUE Z; REAL Z; 12500500
BEGIN 12501000
REAL RCW=+0, MSCW=-2, COMMON=-4; 12501500
ARRAY INREC=+1[*]; 12502000
ARRAY FPB=INREC+1[*], LOGINFO=FPB+1[*], HEADER=LOGINFO+1[*]; 12502500
REAL UNIT=HEADER+1, V=UNIT+1, COPY=V+1, MFID=COPY+1, FID=MFID+1, 12503000
IOD=FID+1, T=IOD+1, B=T+1; 12503500
REAL SEARCHVAL=B+1, CURROW=SEARCHVAL+1, FIRSTFID=CURROW+1, 12504000
SEGNR=FIRSTFID+1; 12504500
REAL X=SEARCHVAL, NUM=CURROW, RECOUNT=SEGNR; 12505000
BOOLEAN SIGNEDON=SEGNR+1, FORMTOG=SIGNEDON+1, ABORTED=FORMTOG+1; 12505500
BOOLEAN TERMFLAG=LOGINFO, NOCONT=FIRSTFID; 12506000
$ SET OMIT = NOT PACKETS 12506500
BOOLEAN STOG=ABORTED+1; 12507000
REAL PCOPY=STOG+1, PFIRSTFID=PCOPY+1; 12507500
$SET OMIT = NOT (RJE AND PACKETS) 12508000
$ SET OMIT = PACKETS 12509500
12512000
LABEL RD, RED, SPACEND, NOMORE, NOFILE, AUT, BOMBER, NEXTFILE, 12512500
PNCHLK, PRINTITAGAIN, EOF, PRNTDS, PNCHDS, TAPEND, CONTINUE,12513000
RETURNFALSE, REMOVEM, TEST, TAPECL, STOPTIME, RETURNTRUE, 12513500
RETURNTOCOM19; 12513750
LABEL LOOK4TAPE, NOMOREELS, QTSPEC, INITIALIZE, STARTANEWFILE; 12514000
SWITCH SW := 12514500
LOOK4TAPE, NOMOREELS, QTSPEC, INITIALIZE, STARTANEWFILE; 12515000
DEFINE DSED = TERMSET(P1MIX)#, 12515500
QTED = (PRT[P1MIX,@25]!0)#, 12516000
VF = 43:5#, 12516100
UNITE = 38:5#, 12516150
COPYF = 30:8#, 12516200
NUMF = 22:8#, 12516250
NOTP = 29:1#, 12516300
COPY0 = 21:1#, 12516350
$ SET OMIT = PACKETS 12516500
REELNO = 42:6#, 12518000
$ POP OMIT OMIT 12518500
$ SET OMIT = RJE 12518600
STA = 0#, 12518700
$ POP OMIT 12518800
SEPARATION = 46#; % FOR 6 LPI. SET IT TO 70 FOR 8 LPI. 12519000
%***********************************************************************12519500
12520000
SUBROUTINE RDYTAPE; 12520500
BEGIN 12521000
B.[18:9]:=@54; 12521500
P(WAITIO(@4200000000,0,UNIT),DEL); 12522000
P(WAITIO(B,0,UNIT),WAITIO(B,@40,UNIT),DEL,DEL); 12522500
RECOUNT:=@77777; 12523000
END; 12523500
12524000
%***********************************************************************12524500
12525000
SUBROUTINE REWIND; 12525500
BEGIN 12526000
STOPIMING(1,1023); 12526500
P(WAITIO(@4200000000,0,UNIT),DEL); 12527000
IF (SAVEWORD AND TWO(UNIT))=0 AND PRNTABLE[UNIT].[1:1] 12527500
AND NOT (SVPBT OR QTED OR NOCONT) THEN 12528000
BEGIN RDCTABLE[UNIT].[8:6]~0; %539-12528400
INDEPENDENTRUNNER(P(.PURGEIT),UNIT,64) 12528500
END %539-12528600
ELSE 12529000
BEGIN LABELTABLE[UNIT]~@114; 12529500
MULTITABLE[UNIT]~RDCTABLE[UNIT]~0; 12530000
SLEEP([TOGLE],STATUSMASK); 12530500
READY~READY AND NOT NT1~TWO(UNIT); 12531000
RRRMECH~NOT NT1 AND RRRMECH OR NT1 AND SAVEWORD; 12531500
END; 12532000
END; 12532500
12533000
%***********************************************************************12533500
12534000
BOOLEAN PROCEDURE LOOKFORTAPE; 12534500
BEGIN 12535000
T:=RDCTABLE[UNIT]; 12535500
REWIND; 12536000
IF SIGNEDON THEN FPB[4]:=FPB[4]-LOGINFO[24]-CLOCK-P(RTR); 12536500
IF P((T:=FINDINPUT(MFID,@122212342546447,T.[14:10]+1,T.[24:17],12537000
-0,0,T:=0,0,0,0)) GEQ 0, DUP) THEN 12537500
BEGIN 12538000
RDCTABLE[UNIT:=T].[8:6]:=P1MIX; 12538500
LABELTABLE[UNIT]:=FID; 12539000
FPB:=PRT[P1MIX,3]; % FINDINPUT CALLS STARTIMING 12539500
IF SIGNEDON THEN FPB[4]:=FPB[4]+LOGINFO[24]+CLOCK+P(RTR); 12540000
RDYTAPE; 12540500
END; 12541000
LOOKFORTAPE:=P; 12541500
END; 12542000
12542500
%***********************************************************************12543000
12543500
REAL SUBROUTINE READTAPE; 12544000
BEGIN 12544500
RD: IF DSED OR PRT[P1MIX,@25]=5 THEN BEGIN P(5); GO TO RED END; 12545000
IF WAITIO(B,@2000040,UNIT).[42:1] THEN 12545500
BEGIN 12546000
P(WAITIO(B,@3000040,UNIT),DEL); 12546500
IF M[B INX 3] THEN 12547000
IF LOOKFORTAPE THEN GO TO RD; 12547500
P(3); 12548000
GO TO RED; 12548500
END; 12549000
FOR T:=17 STEP 18 UNTIL 89 DO 12549500
IF M[B INX T].[20:1] THEN T:=256; 12550000
P(T>200); 12550500
RED: READTAPE:=P; 12551000
END; 12551500
12552000
%***********************************************************************12552500
12553000
BOOLEAN SUBROUTINE SPACETOFILE; 12553500
BEGIN 12554000
X:=NUM; 12554500
WHILE (X:=X-1) GEQ 0 DO 12555000
BEGIN 12555500
DO UNTIL (T:=READTAPE); 12556000
IF T GEQ 3 THEN BEGIN P(1) GO TO SPACEND END; 12556500
END; 12557000
P(0); 12557500
SPACEND: 12558000
SPACETOFILE:=P; 12558500
END; 12559000
12559500
%***********************************************************************12560000
12560500
BOOLEAN SUBROUTINE FINDFILE; 12561000
BEGIN 12561500
IF HEADER.[CF] GEQ 64 THEN FORGETSPACE(HEADER); %159-12561600
IF (HEADER:=DIRECTORYSEARCH(MFID,-FID,SEARCHVAL)) LSS 64 THEN 12562000
GO TO NOMORE; 12562500
HEADER:=[M[HEADER]]&30[8:38:10]; 12563000
SEGNR:=0; 12563500
CURROW:=10; 12564000
IF ABORTED:=HEADER[5].[2:1] THEN 12564500
IF HEADER[7]=0 THEN 12565000
BEGIN 12565500
NOMORE: P(1); 12566000
GO TO NOFILE; 12566500
END; 12567000
LABELTABLE[V]:=NABS(FID); 12567500
P(0); 12568000
NOFILE: FINDFILE:=P; 12568500
END; 12569000
12569500
%***********************************************************************12570000
12570500
BOOLEAN SUBROUTINE NOMOREREELS; 12571000
BEGIN 12571500
IF FID.[REELNO]=0 THEN 12572500
P(1) %159-12573500
ELSE %159-12574000
BEGIN 12574500
STREAM[ONE:=1, F:=[FID]); 12575000
BEGIN SI:=LOC ONE; DS:=8 ADD END; 12575500
P(FINDFILE); 12576000
END; 12576500
NOMOREREELS:=P; 12577000
END; 12577500
$ SET OMIT = NOT PACKETS 12578000
12578500
%***********************************************************************12579000
12579500
BOOLEAN SUBROUTINE NOMOREFILES; 12580000
BEGIN 12580500
IF NOT P(FID.[30:12]="99" OR COMMON.[NOTP],DUP) THEN 12581000
BEGIN 12581500
P(DEL); 12582000
STREAM(ONE:=1, F:=[FID]); 12582500
BEGIN SI:=LOC ONE; SI:=SI+6; SI:=SI+5; 12583000
DS:=2 ADD; DS:=LIT"1"; 12583500
END; 12584000
FIRSTFID:=FID; 12584500
P(FINDFILE); 12585000
END; 12585500
NOMOREFILES:=P; 12586000
END; 12586500
$ POP OMIT 12587000
12587500
%***********************************************************************12588000
12588500
SUBROUTINE REMOVEIT; 12589000
BEGIN 12589500
T:=DIRECTORYSEARCH(-MFID,-(FID:=PFIRSTFID),SEARCHVAL); 12590000
IF T GEQ 64 THEN 12590500
$ SET OMIT = NOT PACKETS 12591000
DO BEGIN 12591500
$ POP OMIT 12592000
DO IF FID=IOD THEN GO AUT UNTIL NOMOREREELS; 12592500
$ SET OMIT = NOT PACKETS 12593000
END UNTIL NOMOREFILES; 12593500
$ POP OMIT 12594000
AUT: 12594500
END; 12595000
12595500
%***********************************************************************12596000
12596500
SUBROUTINE PAGEJECT; 12597000
BEGIN 12597500
$ SET OMIT = NOT RJE 12598000
P(WAITIO(@4000100000,0,V), DEL); 12600500
END; 12601000
12601500
%***********************************************************************12602000
12602500
SUBROUTINE WRITER; 12603000
BEGIN 12603500
$ SET OMIT = NOT RJE 12604000
P(WAITIO(B INX @210104000000,0,V), DEL); 12607000
END; 12607500
12608000
%***********************************************************************12608500
12609000
SUBROUTINE IDLETIMER; 12609500
BEGIN 12610000
STOPLOG(P1MIX,1); 12610100
P(P1MIX); P1MIX:=0; 12610500
IDLETIME; 12611000
P1MIX:=P; 12611500
$ SET OMIT = NOT(NEWLOGGING) 12611899
STARTLOG(P1MIX); 12612000
END IDLETIMER; 12612500
12613000
%***********************************************************************12613500
12614000
SUBROUTINE SETUPINREC; 12614500
BEGIN 12615000
INREC:=[M[B INX (UNIT=18)]]&18[8:38:10]; 12615500
INREC[17]:=0; 12616000
END; 12616500
12617000
%***********************************************************************12617500
12618000
SUBROUTINE INVALIDNUM; 12618500
BEGIN 12618750
FILEMESS("INVALID","FILE ",0,"NUMB #",NUM+1,0,0); 12619000
END; 12619250
12619500
%***********************************************************************12620000
12620500
P(DEL,Z,MSCW,STF); 12621000
GO TO SW[P]; % LOOK4TAPE,NOMOREELS,QTSPEC,INITIALIZE,STARTANEWFILE12621500
% 12621900
% LOOKFORTAPE FINDS THE NEXT REEL. THE FIRST RECORD IS A LABEL SO 12621910
% INREC IS MOVED DOWN TO SKIP IT. 12621920
12621930
LOOK4TAPE: 12622000
12622100
P(LOOKFORTAPE); 12622500
IF M[B+89].[1:11]=0 THEN % LABEL RECORD 12623000
BEGIN 12623100
INREC~(NOT 17) INX INREC; 12623200
RECOUNT~0; 12623300
END; 12623400
GO RETURNTOCOM19; 12624000
12624400
NOMOREELS: 12624500
12624600
P(NOMOREREELS); 12625000
GO RETURNTOCOM19; 12625500
12625900
QTSPEC: 12626000
12626100
PRT[P1MIX,@25]:=0; 12626250
P(T); % BE CAREFUL OF THIS. 12626500
IF UNIT=18 THEN % DISK PORTION 12626750
BEGIN NT2:=(T.[9:24] DIV 5)&T[1:2:1]; 12627000
IOD:=(HEADER[8] DIV 3)|3; % CALCULATE TRUE ROW SIZE 12627500
IF (T:=3|NT2+SEGNR) LSS 0 THEN % SPACE BACKWARD 12628000
DO IF (CURROW:=CURROW-1) LSS 10 THEN 12628500
BEGIN 12629000
IF FID=FIRSTFID THEN GO TO BOMBER; 12629500
IF SEARCHVAL=3 THEN P(DIRECTORYSEARCH(-MFID,FID,13),DEL); 12630000
FORGETSPACE(HEADER); 12630500
STREAM(ONE:=1, F:=[FID]); 12631000
BEGIN SI:=LOC ONE; DS:=8 SUB END; 12631500
IF (HEADER:=DIRECTORYSEARCH(MFID,FID,5)) LSS 64 12632000
THEN GO BOMBER; 12632002
HEADER:=[M[HEADER]]&30[8:38:10]; 12632500
CURROW:=HEADER[9].[43:5]+9; 12633000
WHILE HEADER[CURROW]=0 DO CURROW:=CURROW-1; 12633500
IF CURROW<10 THEN 12634000
BEGIN 12634500
BOMBER: NT1:="RANGE +"; 12635000
IF (NT2:=P).[2:1] THEN % LEFT AT 12626500%168-12635500
NT1:=NT1&"-"[42:42:6]; 12636000
FILEMESS("INVALID","QT ",0, 12636500
NT1,NT2.[9:24],0,0); 12637000
PRT[P1MIX,@25]:=5; % FORCE A QT 12637500
GO RETURNFALSE; 12638500
END; 12639000
END UNTIL (T:=IOD+T) GEQ 0 12639500
ELSE % SPACE DISK FORWARD 12640000
BEGIN 12640500
IF T GEQ IOD THEN % TO ANOTHER ROW, 12641000
DO % CHECKING FOR NEW FILE12641500
IF (CURROW:=CURROW+1) GEQ (HEADER[9].[43:5]+10) THEN 12642000
NEXTFILE: IF NOMOREREELS THEN GO TO BOMBER 12642500
UNTIL (T:=T-IOD) LSS 100; 12643000
IF (CURROW-10)|IOD+T GTR HEADER[7]|3 THEN 12643500
GO TO NEXTFILE; 12644000
END; 12644500
SEGNR:=T; 12645000
P(19); 12645500
END ELSE % TAPE PORTION 12646000
BEGIN 12646500
IF T.[2:1] THEN % SPACE BACKWARD 12647000
IF (T:=T.[9:24]) LSS INREC[17].[CF] THEN 12647500
BEGIN IOD:=(I+4) DIV 5; 12648000
DO P(WAITIO((89 INX B)&7[22:45:3],0,UNIT),DEL) 12648500
UNTIL (IOD:=IOD-1) LEQ 0 OR DSED OR QTED; 12649000
RECOUNT:=5; 12649500
END ELSE GO TO BOMBER % REEL SWITCH NOT ALLOWED 12650000
ELSE 12650250
BEGIN IF (IOD:=T.[9:24] DIV 5) ! 0 THEN % SPACE FORWARD %168-12650500
DO UNTIL (X:=READTAPE) OR (IOD:=IOD-1)=0; 12651000
IF IOD!0 THEN 12651500
IF X!5 THEN GO TO BOMBER; % 5=DS-ED, LET IT FALL THRU.12652000
RECOUNT:=0; 12652500
END; 12653000
RECOUNT:=(M[B INX 17] INX NOT RECOUNT).[CF]; 12653500
P(18); 12654000
END; 12654500
% 12654900
% FIX UP INREC, BUILD IO DESC AND QT MESSAGE AS NEXT TO BE WRITTEN. 12654910
% 12654920
P(T:=B INX P(XCH)); 12655000
INREC:=INREC&P(XCH)[CTC]; 12655500
M[T-1]:=(RECOUNT+1)&74[11:41:7]&(V!22)[29:44:4]; 12656000
NT1:=P; % LEFT AT 12626500 12656500
STREAM(A:=NT1.[9:24], C:=NT1.[2:1], PNCH:=V=22, B:=T-18); 12657000
BEGIN DS:=16 LIT"<<<<<<<<<<<<<<< "; 12657500
CI:=CI+PNCH; GO TO PRNT; DS:=7 LIT" PUNCH"; GO TO L1; 12658000
PRNT:DS:=7 LIT"PRINTER"; 12658500
L1: DS:=21 LIT" BACK UP FILE SPACED "; 12659000
CI:=CI+C; GO TO FER; DS:=4 LIT"BACK"; GO TO L2; 12659500
FER: DS:=4 LIT" FOR"; 12660000
L2: DS:=4 LIT"WARD"; 12660500
SI:=LOC A; DS:=6 DEC; B:=DI; DI:=DI-6; 12661000
DS:=5 FILL; DI:=B; 12661500
CI:=CI+PNCH; GO TO LIN; DS:=5 LIT" CARD"; GO TO L3; 12662000
LIN: DS:=5 LIT" LINE"; 12662500
L3: DS:=17 LIT"S. >>>>>>>>>>>>>>"; 12663000
B:=DI; SI:=B; SI:=SI-8; DS:=7 WDS; 12663500
END; 12664000
GO RETURNTRUE; 12664500
12664900
INITIALIZE: 12665000
12665100
% HANDLES MISCELLANEOUS SETUP TASKS, INCLUDING STARTING THE TIMING FOR12665110
% LOGGING, CHECKING AND READYING THE INPUT FILE AND SPREADING COMMON. 12665120
% 12665130
RCW.[CF]:=P(.COM19,LOD) INX 1; 12665500
$ SET OMIT = NOT RJE 12665750
V:=COMMON.[VF]; 12667750
IF P(.INREC,LOD)=0 THEN 12668000
BEGIN 12668250
$ SET OMIT = NOT RJE 12668500
BEGIN 12669250
IF LABELTABLE[V].[1:5]!@21 THEN % PRINTER CL-ED 12669500
BEGIN 12669750
IF (UNIT:=COMMON.[UNITF])<16 THEN 12670000
IF LABELTABLE[UNIT]=@2100000060606060& 12670250
TINU[V][6:30:18] THEN SETNOTINUSE(UNIT,0); 12670500
GO TO INITIATE; 12670750
END; 12671000
LABELTABLE[C].[5:1]:=0; 12671250
END; 12671500
PRT[P1MIX,@25]:=0; 12672000
P:=(GETSPACE[91,IOBUFFERAREAV,1)+2)&90[8:38:10];% %167-12672500
END; 12673000
$ SET OMIT = NOT RJE 12673500
RDCTABLE[V].[8:6]:=P1MIX; 12675000
STARTIMING(5,V); 12675250
STARTIMING(0,UNIT:=COMMON.[UNITF]); 12675500
FPB:=PRT[P1MIX,3]; 12675750
COPY:=COMMON.[COPYF]; 12676000
IF UNIT=18 THEN 12676500
BEGIN 12677000
MFID:=IF V=22 THEN "PUD " ELSE "PBD "; 12677500
$ SET OMIT = NOT RJE 12678000
FIRSTFID:=LABELTABLE[V].[6:42]; 12679500
$ SET OMIT = NOT PACKETS 12680000
IF NOT COMMON.[NOTP] THEN BEGIN PCOPY:=COPY; COPY:=0 END; 12680250
PFIRSTFID:= 12680500
$ POP OMIT 12681000
FID:=FIRSTFID; 12681500
SEARCHVAL:=3; 12682000
IF FINDFILE THEN GO RETURNFALSE; 12682500
END ELSE 12684000
BEGIN 12684500
ABORTED:=0; 12686000
NOCONT:=((NUM:=COMMON.[NUMF]) OR COPY)!0; 12686500
MFID:=MULTITABLE[UNIT]; 12687000
IF LABELTABLE[UNIT].[1:5]!@21 THEN % UNIT WAS CL-ED WHILE 12687300
BEGIN ABORTED:=2; % WE WERE SCHEDULED. 12687400
GO RETURNFALSE; 12687500
END; 12687600
FID:=LABELTABLE[UNIT]:=(*P(DUP))&0[5:47:1]; 12687700
RDCTABLE[UNIT].[8:6]:=P1MIX; 12688000
RDYTAPE; 12689000
IF SPACETOFILE THEN 12690500
BEGIN 12691000
IF T=3 THEN INVALIDNUM; % SET BY READTAPE IF EOT. 12691500
GO RETURNFALSE; 12692000
END; 12692500
END; 12693000
SETUPINREC; 12693500
GO RETURNTRUE; 12694000
12694400
STARTANEWFILE: 12694500
12694600
% HANDLES THE END OF A FILE AND FIGURES OUT WHAT TO DO NEXT. BUT 12694610
% FIRST, THE LOG MUST BE TAKEN CARE OF. (DONT USE T BETWEEN HERE AND 12694620
% THE TEST AT 12705750.) 12694630
% 12694640
IF ABORTED=2 THEN GO TO TAPECL; 12694800
IF SIGNEDON THEN 12695000
BEGIN 12695500
LOGINFO[12]:=-P(DUP)+PROCTIME[P1MIX]+CLOCK+P(RTR); 12696000
LOGINFO[13]:=IOTIME[P1MIX]-(IOTIME[P1MIX]:=LOGINFO[13]); 12696500
OLDIDLETIME:=OLDIDLETIME+LOGINFO[12]; 12697000
PROCTIME[P1MIX]:=*P(DUP)-LOGINFO[12]; 12697500
IDLETIMER; 12698000
LOGINFO[14]:=JAR[P1MIX,7]-(JAR[P1MIX,7]:=LOGINFO[14]); 12698500
LOGINFO[17]:=XCLOCK+P(RTR); 12699000
LOGINFO[18]:=(DSED|2)&DATE[1:18:30]; 12699500
LOGINFO[23]:=FPB[3]&TINU[UNIT][24:18:12]; 12700000
LOGINFO[28]:=FPB[8]&TINU[V][24:18:12]&FORMTOG[42:47:1]; %750-12700500
TINU[UNIT].[18:12]:=0; TINU[V].[18:12]:=0; 12701000
SIGNEDON:=LOGINFO[24]+CLOCK+P(RTR); 12701500
LOGINFO[24]:=LOGINFO[29]:=SIGNEDON; 12702000
FPB[4]:=(*P(DUP))-SIGNEDON; 12702500
FPB[9]:=(*P(DUP))-SIGNEDON; 12703000
LOGSPACE([LOGINFO[0]],30); 12703500
FORGETSPACE(LOGINFO); 12704000
SIGNEDON:=0; 12704500
END; 12705000
% 12705100
% IF DSED OR QTED, SKIP THE CHECKS FOR COPIES. 12705110
% 12705120
IF (TERMFLAG:=DSED OR QTED|3) THEN 12705250
IF V=22 THEN GO TO PNCHDS ELSE GO TO PRNTDS; 12705500
% 12705600
% T IS SET IF THE FIRST GET FAILS. THIS SHOULD ONLY HAPPEN AT THE END 12705610
% OF A BACK-UP TAPE. NOTE THAT IF A FILE NUMBER IS SPECIFIED, INITIAL-12705620
% IZE ONLY SPACES TO ITS START, SO WE MAY CATCH AN INVALID NUMBER 12705630
% HERE. SINCE ONLY ONE FILE IS PRINTED WHEN A NUMBER IS GIVEN, IF WE 12705640
% ARRIVE HERE, IT MUST HAVE BEEN A BAD NUMBER. IF IT IS DESIRED TO 12705650
% CONTINUE DOWN THE TAPE AFTER THE SPECIFIED FILE, THIS TEST WILL NEED12705660
% TO BE CHANGED. 12705670
% 12705680
IF T THEN % FIRST GET FAILED 12705750
IF UNIT!18 THEN 12706000
BEGIN 12706250
IF COMMON.[NUMF]!0 THEN INVALIDNUM; 12706500
GO TO TAPEND; 12706750
END ELSE GO REMOVEM; 12707000
% 12707100
IF (COPY:=COPY-1) GTR 0 THEN % MORE COPIES OF FILE RQD. 12707250
BEGIN 12707500
IF V=22 AND PUNCHLCK THEN 12707750
BEGIN 12708000
PUNCHLK: STREAM(P1MIX, T:=T:=SPACE(10)); 12708250
BEGIN DS:=25 LIT"#PNCH LOCKED;PRNPBT/DISK="; 12708500
SI:=LOC P1MIX; DS:=2 DEC; DS:=LIT"~"; 12708750
DI:=DI-3; DS:=FILL; 12709000
END; 12709250
SPOUT(T); 12709500
REPLY[P1MIX]:=NABS(T:=VOK&VWY[36:42:6]&VQT[30:42:6]); 12709750
COMPLEXSLEEP(REPLY[P1MIX]>0 OR DSED); 12710000
IF NOT WHYSLEEP(T) THEN GO TO PNCHLK; 12710250
IF DSED OR QTED THEN GO STARTANEWFILE; 12710500
END; 12710750
IF UNIT=18 THEN % DISK 12711000
BEGIN 12711250
$ SET OMIT = NOT PACKETS 12711500
IF NOT STOG THEN STOG:=SEARCHVAL=3; 12712000
$ POP OMIT 12712500
PRINTITAGAIN: 12713000
FID:=FIRSTFID; 12713500
SEARCHVAL:=5; 12714000
IF FINDFILE THEN GO TO EOF ELSE GO TO CONTINUE; 12714500
END; 12715000
% % TAPE 12715400
IF RDCTABLE[UNIT].[14:10]!1 THEN % THIS ISNT FIRST REEL 12715500
BEGIN 12716000
RDCTABLE[UNIT].[14:10]:=0; 12716500
IF NOT LOOKFORTAPE THEN GO TO EOF; 12717000
END ELSE 12717500
RDYTAPE; 12718000
IF SPACETOFILE THEN GO TO EOF ELSE GO TO CONTINUE; 12718500
END; 12719000
$ SET OMIT = NOT PACKETS 12719500
IF UNIT=18 THEN % CHECK FOR COPIES OF PACKET 12720000
BEGIN 12720500
IF STOG THEN BEGIN SEARCHVAL:=3; STOG:=0 END; 12721000
IF NOMOREFILES THEN 12721500
IF (PCOPY:=PCOPY-1) GTR 0 THEN 12722000
BEGIN 12722500
FIRSTFID:=PFIRSTFID; 12723000
GO PRINTAGAIN; 12723500
END ELSE 12724000
ELSE GO CONTINUE; 12724500
END; 12725000
$ POP OMIT 12725500
12725900
EOF: 12726000
12726100
% AT THIS POINT, WE ARE THROUGH WITH THIS FILE OR PACKET. CLEAN UP 12726110
% THE OUTPUT BEFORE COING ON. 12726120
% 12726130
PRNTDS: 12728000
PNCHDS: 12740000
IF UNIT!18 THEN % TAPE 12740500
BEGIN 12741000
IF TERMFLAG OR NOCONT OR ABORTED THEN 12741500
BEGIN 12742000
TAPEND: 12742500
REWIND; 12743000
GO TO TEST; 12743500
END ELSE 12744000
BEGIN % TRY THE NEXT FILE 12744500
NUM:=NUM+1; 12745000
RECOUNT:=@77777; 12745500
CONTINUE: SETUPINREC; 12746000
RETURNFALSE: 12746500
P(0); 12747000
GO RETURNTOCOM19; 12747500
END; 12748000
END; 12748500
12748900
REMOVEM: 12749000
12749100
% DISK - CLOSE THE OPENED FILES AND, IF NOT QTED, REMOVE THEM. 12749110
% 12749120
IOD:=IF SEARCHVAL=3 THEN FID ELSE NOT 0; 12749500
SEARCHVAL:=13; REMOVEIT; 12750000
FPB[4]:=(*P(DUP))+CLOCK+P(RTR); 12750250
IF TERMFLAG!3 THEN % NOT QT-ED 12750500
BEGIN 12751000
IOD:=NOT 0; 12751500
SEARCHVAL:=7; REMOVEIT; 12752000
TEST: % FOR CONTINUATION FOR AUTOPRINT OR RJE. 12752500
IF AUTOPRINT AND NOT (FORMTOG OR TERMFLAG) AND 12753000
(TWO(V) AND SAVWORD)=0 12753500
$ SET OMIT = NOT RJE 12753750
THEN 12755000
IF (COMMON:=PRINTORPUNCHWAIT(-V,-STA))!0 THEN GO TO STOPTIME;12755500
END; 12756000
TAPECL: 12756400
COMMON:=0; 12756500
FORGETSPACE(B); 12757000
$ SET OMIT = NOT RJE 12757350
SETNOTINUSE(V,FORMTOG); 12757500
STOPTIME: 12757750
STOPTIMING(5,1023); 12758000
RETURNTRUE: 12758250
P(1); 12758500
RETURNTOCOM19: 12759000
P(0,RDS,1,SUB,0,XCH,CFX,STF); 12759500
END OF FIRST PRINTER BACKUP SPECIAL CASES PROCEDURE; 12760000
PROCEDURE PRNPBTSPECASE2(Z); 12800000
% 12800100
% THIS PROCEDURE HANDLES ADDITIONAL THINGS FOR COM19. VALUES OF Z ARE:12800110
% 0 INITIALIZE LOGGING. 12800120
% 1 WRITE ABORT OR DSED MESSAGE AND CONSTRUCT ENDING LABEL. 12800130
% 2 HANDLE PARITY ON INPUT FILE. 12800140
% 12800150
VALUE Z; REAL Z; 12800500
BEGIN 12801000
REAL RCW=+0, MSCW=-2, COMMON=-4; 12801500
ARRAY INREC=+1[*]; 12802000
ARRAY FPB=INREC+1[*], LOGINFO=FPB+1[*], HEADER=LOGINFO+1[*]; 12802500
REAL UNIT=HEADER+1, V=UNIT+1, COPY=V+1, MFID=COPY+1, FID=MFID+1, 12803000
IOD=FID+1, T=IOD+1, B=T+1; 12803500
REAL SEARCHVAL=B+1, CURROW=SEARCHVAL+1, FIRSTFID=CURROW+1, 12804000
SEGNR=FIRSTFID+1; 12804500
REAL X=SEARCHVAL, NUM=CURROW, RECOUNT=SEGNR; 12805000
BOOLEAN SIGNEDON=SEGNR+1, FORMTOG=SIGNEDON+1, ABORTED=FORMTOG+1; 12805500
BOOLEAN NOCOUNT=FIRSTFID; 12806000
$ SET OMIT = NOT PACKETS 12806500
BOOLEAN STOG=ABORTED+1; 12807000
REAL PCOPY=STOG+1, PFIRSTFID=PCOPY+1; 12807500
$SET OMIT = NOT (RJE AND PACKETS) 12808000
$ SET OMIT = PACKETS 12809500
12812000
LABEL SLEAP, WHY, EXITTOCOM19; 12812500
LABEL SIGNIN, ABORTMSG, PARERR; 12813000
SWITCH SW := 12813500
SIGNIN, ABORTMSG, PARERR; 12814000
DEFINE DSED = TERMSET(P1MIX)#, 12814500
QTED = (PRT[P1MIX,@25]!0)#, 12815000
VF = 43:5#, 12815100
UNITF = 38:5#, 12815200
COPYF = 30:8#, 12815300
NUMF = 22:8#, 12815400
NOTP = 29:1#, 12815500
COPY0 = 21:1#; 12815600
12815900
%***********************************************************************12816000
12816500
SUBROUTINE IDELTIMER; 12817000
BEGIN 12817500
STOPLOG(P1MIX,1); 12817600
P(P1MIX); P1MIX:=0; 12818000
IDLETIME; 12818500
P1MIX:=P; 12819000
$ SET OMIT = NOT(NEWLOGGING) 12819399
STARTLOG(P1MIX); 12819500
END IDLETIMER; 12820000
12820500
%***********************************************************************12821000
12821500
SUBROUTINE FM; %% BUILD AND SPOUT FORMS MESSAGE %% 12822000
BEGIN 12822500
STREAM(U:=TINU[V], P1MIX, INREC, D:=T:=SPACE(10)); 12823000
BEGIN DS:=LIT"#"; 12823500
SI:=LOC U; SI:=SI+5; DS:=3 CHR; 12824000
DS:=20 LIT" FM RQD:PRNPBT/DISK="; DS:=2 DEC; 12824500
U:=DI; DI:=DI-2; DS:=FILL; DI:=U; 12825000
SI:=INREC; DS:=5 LIT" FOR "; 12825500
SI:=SI+1; DS:=7 CHR; DS:=LIT"/"; 12826000
SI:=SI+1; DS:=7 CHR; DS:=4 LIT" OF "; 12826500
SI:=SI+1; DS:=7 CHR; DS:=LIT"/"; 12827000
SI:=SI+1; DS:=7 CHR; 12827500
DS:=LIT"~"; 12828000
END; 12828500
SPOUT(T); 12829000
REPLY[P1MIX] := 12829500
NABS(T:=VOK&VWY[36:42:6]&VQT[30:42:6]&VFM[24:42:6]); 12830000
END FM SUBROUTIN; 12830500
12831000
%***********************************************************************12831500
SUBROUTINE BADFM; %BUILD AND SPOUT BAD FM MESSAGE % 12832000
BEGIN 12832500
STREAM(A:=TINU[T],MX:=P1MIX,T:=T:=SPACE(10)); 12833000
BEGIN DS:=19 LIT"INVALID INPUT UNIT "; 12833500
SI:=LOC MX; DS:=2 DEC;DS:=2 LIT"FM"; 12834000
SI:=LOC A; SI:=SI+5; DS:=3 CHR; 12834500
DS:=LIT "~"; DI:=DI-8; DS:=FILL; 12835000
END; 12835500
SPOUT(T); 12836000
END BADFM SUBROUTINE; 12836500
12837000
%***********************************************************************12837500
12838000
SUBROUTINE WRITEBANDEJECT; 12838500
BEGIN 12839000
$ SET OMIT = NOT RJE 12839500
BEGIN 12842500
P(WAITIO(B INX @210104000000,0,V),DEL); 12843000
IF V!22 THEN % %150-12843500
IF SEPARATE THEN P(WAITIO(@4000100000,0,V),DEL) %150-12843600
ELSE P(WAITIO(@4002000000,0,V),DEL);%150-12843700
END; 12844000
END; 12844500
12845000
%***********************************************************************12845500
12846000
% 12846500
P(Z,MSCW,STF); 12847000
GO TO SW[P]; 12847500
12847600
SIGNIN: 12848000
12848100
% HANDLES FIRST RECORD OF FILE, PICKING UP LOGGING INFO AS WELL AS 12848110
% COPIES OR FORM SPECIFICATIONS. NOTE THAT LABEL INFO IS SAVED IN 12848120
% LOGARRAY FOR USE AT ABORTMSG. TIMING IS STARTED AT INITIALIZE AND 12848130
% STOPPED IN REWIND, AT REMOVEM OR AT STOPTIME FOR TAPE, DISK AND THE 12848140
% OUTPUT UNIT RESPECTIVELY. LOGARRAY IS USED TO REMOVE THE TIME 12848150
% ASSOCIATED WITH A GIVEN BACK UP FILE FROM THE TIMING IN THE FPB AND 12848160
% LOG IT TO THE USER. THAT IS DONE IN SIGNOUT. THUS, THE TIME LOGGED 12848170
% AT PRNPBT/DISK EOJ IS OVERHEAD TIME OCURRING DURING SWITCHING FROM 12848180
% FILE TO FILE. 12848190
% 12848200
LOGINFO := SAVEARRAYDESC(31,LOGAREAV); %167-12848500
IF FORMTOG:=INREC[13] THEN FM; 12849000
IF COPY LEQ 0 AND NOT COMMON.[COPY0] THEN 12849500
COPY:=IF (INREC[14] AND NOT @377)=0 THEN INREC[14]+1 ELSE 0; 12850000
LOGINFO[0]:=3; 12850500
STREAM(S:=[INREC[4]],D:=[LOGINFO[1]]); 12851000
BEGIN SI:=S; DS:=9 WDS; END; 12851500
LOGINFO[10]:=5; 12852000
LOGINFO[11]:=2; 12852500
LOGINFO[12]:=-(PROCTIME[P1MIX]+CLOCK+P(RTR)); 12853000
LOGINFO[13]:= IOTIME[P1MIX]; 12853500
IDLETIMER; LOGINFO[14]:=JAR[P1MIX,7]; 12854000
LOGINFO[15]:=DATE; 12854500
LOGINFO[16]:=XCLOCK+P(RTR); 12855000
LOGINFO[19]:=INREC[15]; %132-12855500
LOGINFO[20]:="PRINTER"; 12856000
LOGINFO[21]:="BACK-UP"; 12856500
LOGINFO[22]:=LOGINFO[27]:=0; 12857000
LOGINFO[24]:=-CLOCK-P(RTR); 12857500
LOGINFO[25]:=INREC[0]; % SAVE LABEL INFO FOR ABORT 12858000
LOGINFO[26]:=INREC[1]; 12858500
LOGINFO[28]:=M[INREC INX NOT 14]; 12859000
LOGINFO[29]~INREC[2]; 12859500
LOGINFO[30]~INREC[3]; 12860000
RDCTABLE[V].[47:1]~INREC[0]="FULLPGE"; % LINES66 OPTION %724-12860100
IF FORMTOG THEN 12860500
SLEAP: 12861000
BEGIN COMPLEXSLEEP(REPLY[P1MIX] GEQ 0 OR DSED OR QTED); 12861500
IF NOT WHYSLEEP(I) THEN 12862000
BEGIN FM; GO TO SLEAP END; 12862500
IF REPLY[P1MIX].[CF]=VFM THEN 12863000
IF (T:=REPLY[P1MIX].[FF]) NEQ 20 AND T NEQ 21 THEN 12863500
BEGIN % ILLEGAL UNIT. 12864000
LABELTABLE[T]:=@114; 12864500
BADFM; 12865000
READY:=READY AND (T:=NOT TWO(T)); 12865500
RRRMECH:=RRRMECH AND T; 12866000
SAVEWORD:=SAVEWORD AND T; FM; GO SLEAP 12866500
$ SET OMIT = NOT(RJE AND DATACOM ) 12867000
END ELSE 12873000
IF T!V THEN 12873500
BEGIN % SWITCH UNITS. 12874000
LABELTABLE[T] := LABELTABLE[V]; 12874500
RDCTABLE[T] := RDCTABLE[V]; 12875000
MULTITABLE[T] := MULTITABLE[V]; 12875500
LABELTABLE[V] := MULTITABLE[V] := RDCTABLE[V] := 0; 12876000
FPB[8].[36:6]:=(V:=T)+1; 12876500
END; 12877000
END; 12877500
FORMTOG:=(FORMTOG OR PUNCHLCK AND V=22) AND NOT (DSED OR QTED); 12878000
SIGNEDON:=TRUE; 12878500
GO EXITTOCOM19; 12879000
12879100
ABORTMSG: 12879500
12879600
% ABORTED=3 IMPLIES ABORT HAS OCCURRED. CURRENTLY, NOTHING ATTEMPTS TO12879610
% DISTINGUISH BETWEEN 1 AND 3, BUT ABORTED MUST BE SET HERE FOR TAPE 12879620
% SO WHY NOT MAKE IT DIFFERENT. 12879630
% 12879640
ABORTED:=3; 12880000
STREAM(T:=DSED OR QTED, B); 12880500
BEGIN 12881000
DS:=8 LIT"#"; SI:=B; DS:=16 WDS; DI:=B; 12881500
CI:=CI+T; GO TO AB; 12882000
DI:=DI+24; 12882500
DS:=34 LIT" BACK-UP TERMINATED BY OPERATOR "; 12883000
GO TO LEND; 12883500
AB: DI:=DI+34; DS:=11 LIT" ABORTED "; 12884000
LEND: 12884500
END; 12885000
WRITEBANDEJECT; 12885500
IF V!22 AND SIGNEDON THEN 12886000
BEGIN 12886500
STREAM(S~[LOGINFO[1]],T~0,B); 12887000
BEGIN DS~ 8LIT" LABEL "; SI~S; 24(SI~SI+8); DS~16CHR; 12887500
SI~SI+8; DS~8CHR; T~SI; SI~S; DS~9WDS; SI~T; 12888000
SI~SI+1; DS~LIT" "; DS~7CHR; DS~LIT"/"; DI~SI+1; DS~7CHR;12888500
DS~ 12 LIT " "; 12889000
END; 12889500
WRITEBANDEJECT; 12890000
IF NOT SEPARATE THEN P(WAITIO(@4000100000,0,V),DEL); %150-12890100
END; 12890500
GO TO EXITTOCOM19; 12891000
12891100
PARERR: 12891500
12891600
% BUILDS ERROR MESSAGE FOR OUTPUT AND ALLOWS OPERATOR TO OK OR DS. 12891610
% T IS USED TO PASS BACK WHETHER OR NOT TO TERMINATE. 12891620
% 12891630
IF V=22 THEN GO TO WHY; 12892000
STREAM(A:=UNIT, T:=T:=SPACE(15)); 12892500
BEGIN 22(DS:=2 LIT ">>");SI:=LOC A;SI:=SI+7; 12893000
IF SC="B" THEN DS:=6 LIT " DISK " ELSE 12893500
DS:=6 LIT " TAPE "; 12894000
DS:=26 LIT "PARITY ON PRINTER BACK UP "; 12894500
22(DS:=2 LIT ">>"); 12895000
END STREAM; 12895500
$ SET OMIT = NOT(RJE AND DATACOM ) 12896000
P(WAITIO(T&16[CTF],0,V),DEL); 12897500
FORGETSPACE(T); 12898000
WHY: 12898500
FILEMESS("#PARITY",0,0,"ERROR ",0,0,0); 12899000
REPLY[P1MIX]:=-VQT&VWY[36:42:6]&VOK[30:42:6]; 12899500
COMPLEXSNOOZE(MIXMAX,REPLY[P1MIX] GEQ 0 OR DSED OR QTED); 12900000
IF NOT WHYSLEEP(VQT&VWY[36:42:6]&VOK[30:42:6]) THEN GO TO WHY; 12900500
T:=DSED OR QTED; 12901000
EXITTOCOM19: 12901500
P(0,RDS,0,XCH,CFX,STF); 12902000
END OF SECOND GROUP OF PRINTER BACKUP SPECIAL CASES; 12902500
PROCEDURE COM19; 13000000
% 13000100
% COM19, TOGETHER WITH PRNPBTSPECASE1 AND PRNPBTSPECASE2 WHICH SHARE 13000110
% ITS STACK, ARE THE WORKING PART OF PRINTER BACK-UP. INFORMATION IS 13000120
% PASSED TO COM19 IN COMMON AND LABELTABLE, AS FOLLOWS: 13000130
% COMMON.[43:5] LOGICAL UNIT NUMBER OF OUTPUT UNIT. 13000140
% [38:5] INPUT UNIT NUMBER. IF DISK, THE LABELTABLE ENTRY FOR 13000160
% THE OUTPUT UNIT CONTAINS THE FILE ID. 13000170
% [30:8] NUMBER OF COPIES SPECIFIED IN PB MESSAGE. 13000180
% [22:8] IF TAPE, STARTING FILE NUMBER GIVEN IN PB MESSAGE. 13000190
% IF DISK, =0 IF ENTIRE PACKET IS TO BE PRINTED, =1 IF 13000200
% NOT. 13000210
% [21:1] ON IF "=0" APPEARED IN PB MESSAGE. 13000215
% FOR RJE, COMMON IS THE ADDRESS OF A TWO WORD ARRAY. THE FIRST WORD 13000220
% CONTAINS THE INFORMATION DESCRIBED ABOVE AND THE SECOND CONTAINS THE13000230
% FILE ID FOR DISK (WHICH IS IN LABELTABLE FOR NON-RJE FILES). 13000240
% 13000250
BEGIN 13001000
REAL RCW=+0, COMMON=-4; 13002000
ARRAY INREC[*], FPB[*], LOGINFO[*], HEADER[*]; 13003000
REAL UNIT, V, COPY, MFID, FID, IOD, T, B; 13004000
REAL SEARCHVAL, CURROW, FIRSTFID, SEGNR; 13005000
REAL X=SEARCHVAL, NUM=CURROW, RECOUNT=SEGNR; 13006000
BOOLEAN SIGNEDON, FORMTOG, ABORTED; 13007000
BOOLEAN NOCONT=FIRSTFID; 13008000
$ SET OMIT = NOT PACKETS 13009000
BOOLEAN STOG; 13010000
REAL PCOPY, PFIRSTFID; 13011000
$ SET OMIT = PACKETS 13012000
$ SET OMIT = NOT RJE 13015000
% 13017100
% THE LOCAL VARIABLES ARE USED AS FOLLOWS: 13017110
% ARRAYS 13017120
% INREC ARRAY DESCRIPTOR FOR THE CURRENT RECORD. 13017130
% FPB FPB ARRAY. INPUT IS THE FIRST FILE; OUTPUT THE 2ND. 13017140
% LOGINFO ARRAY IN WHICH THE LOG ENTRY IS BUILT. THE FIRST TEN 13017150
% WORDS ARE THE CONTROL CARD ENTRY; THE NEXT 10, THE 13017160
% PRINTER BACK-UP ENTRY AND THE LAST 10, THE FILE ENTRIES.13017170
% HEADER DISK FILE HEADER. 13017180
% REALS 13017190
% UNIT LOGICAL UNIT NUMBER FOR INPUT. 13017200
% V LOGICAL UNIT NUMBER FOR OUTPUT. 13017210
% COPY NUMBER OF COPIES OF THIS FILE TO BE PRINTED. IF IT IS 13017220
% NOT SPECIFIED, IT EQUALS 0. 13017230
% MFID MULTI-FILE ID OF INPUT FILE. 13017240
% FID FILE ID OF INPUT FILE. 13017250
% IOD, T TEMPORARY STORAGE. 13017260
% B ADDRESS OF 90 WORD BUFFER FOR INPUT. 13017270
% BOOLEANS 13017280
% SIGNEDON ON IF LOGGING IS INITIALIZED. THIS SHOULD BE OFF ONLY 13017290
% FOR FILES WHICH DO NOT START AT THE BEGINING, E.G., 13017300
% WHEN A STARTING REEL IS SPECIFIED ON DISK. 13017310
% FORMTOG ON IF FORM IS SPECIFIED OR PNCHLOCK IS SET. 13017320
% ABORTED =1, DISK ABORTED BY H/L. CHECK IN GET TO FIND OUT WHERE.13017330
% =2, TERMINATION DUE TO CL OF INPUT TAPE WHILE SCHEDULED.13017335
% =3, TAPE ABORTED BY H/L. FOUND BY RECOUNT MISMATCH. 13017340
% 13017350
% THE FOLLOWING APPLY ONLY TO DISK FILES: 13017360
% SEARCHVAL THIRD PARAMETER FOR DIRECTORYSEARCH. IT IS 3 OR 5 DURING13017370
% PRINTING, DEPENDING ON WHETHER IT IS THE FIRST COPY OR 13017380
% NOT, AND 13 OR 7 DURING FILE TERMINATION. 13017390
% CURROW INDEX OF THE ROW CURRENTLY BEING PRINTED. 13017400
% FIRSTFID FILE ID OF FIRST REEL, USED FOR MULTIPLE COPIES OF 13017410
% MULTI-REEL FILES. 13017420
% SEGNR NUMBER OF NEXT SEGMENT TO READ FROM THE CURRENT ROW. 13017430
% 13017440
% THE FOLLOWING APPLY ONLY TO TAPES: 13017450
% X TEMPORARY STORAGE. 13017460
% NUM NUMBER OF CURRENT FILE ON TAPE, USED FOR COPIES. 13017470
% RECOUNT NUMBER OF RECORDS PRINTED IN THIS FILE. THIS IS CHECKED 13017480
% AGAINST THE C-FIELD OF THE IO DESCRIPTORS IN THE FILE TO13017490
% SPOT ABORTS. 13017500
% NOCONT TRUE IF CONTINUATION FROM FILE TO FILE IS NOT ALLOWED. 13017510
% 13017520
% THE FOLLOWING APPLY ONLY TO PACKETS: 13017530
% PCOPY NUMBER OF COPIES FROM PB MESSAGE, WHICH MAY APPLY TO THE13017540
% ENTIRE PACKET. "COPY" IS SET ONLY FROM LABEL EQUATION. 13017550
% PFIRSTFID FILE ID OF FIRST FILE IN THE PACKET, USED FOR COPIES OF 13017560
% THE PACKET. FIRSTFID APPLIES TO INDIVIDUAL FILES WITHIN 13017570
% THE PACKET AND IS USED FOR COPIES SPECIFIED VIA LABEL 13017580
% EQUATION. 13017590
% STOG SET DURING THE FIRST PRINTING OF THE PACKET IF ONE OF 13017600
% THE FILES SPECIFIES MULTIPLE COPIES. IT IS USED TO 13017610
% RESTORE THE VALUE OF 3 TO SEARCHVAL WHEN THE FILE IS 13017620
% COMPLETED. 13017630
% 13017640
% THE FOLLOWING APPLIES ONLY TO RJE: 13017650
% STA TERMINAL UNIT AND BUFFER NUMBER OF THE RJE TERMINAL. 13017660
% 13017670
LABEL TRYNEXT, TAPERDR, TAPERD, TAPECHK, ABORT, NOGET, GOTTEN, 13018000
START, RESTART, MAINLOOP, GOTIT, QUIT, TESTEND; 13019000
DEFINE DSED = TERMSET(P1MIX)#, 13020000
QTED = (PRT[P1MIX,@25]!0)#; 13021000
DEFINE LINECT = LOGINFO[27]#; % %750-13021900
DEFINE LOOKFORTAPE = PRNPBTSPECASE1(0)#, 13022000
NOMOREREELS = PRNPBTSPECASE1(1)#, 13023000
QTSPEC = P(PRNPBTSPECASE1(2),DEL)#, 13024000
INITIALIZE = PRNPBTSPECASE1(3)#, 13025000
STARTANEWFILE = PRNPBTSPECASE1(4)#, 13026000
SIGNIN = PRNPBTSPECASE2(0)#, 13027000
ABORTMSG = PRNPBTSPECASE2(1)#, 13028000
PARERR = PRNPBTSPECASE2(2)#; 13029000
13030000
%***********************************************************************13031000
13032000
BOOLEAN SUBROUTINE GET; 13033000
BEGIN 13034000
IF INREC[17].[20:1] THEN GO TO NOGET; 13035000
IF (INREC:=(NOT 17) INX INREC).[CF] GEQ B.[CF] THEN 13036000
IF UNIT!18 THEN GO TO TAPECHK ELSE 13037000
ELSE % READ NEXT BLOCK 13038000
IF UNIT=18 THEN 13039000
BEGIN 13040000
IF SEGNR > HEADER[7]|3 THEN GO TRYNEXT; % END OF FILE 13041000
IF (SEGNR GEQ HEADER[8]-1) THEN 13042000
BEGIN % END OF ROW 13043000
IF (CURROW:=CURROW+1) GEQ HEADER[9].[43:5]+10 THEN 13044000
TRYNEXT: IF NOMOREREELS THEN GO TO NOGET; 13045000
SEGNR:=0; 13046000
END; 13047000
INREC:=90 INX INREC; 13048000
DISKIO(IOD,-B,90,HEADER[CURROW]+SEGNR); 13049000
SEGNR:=SEGNR+3; 13050000
SLEEP([IOD],IOMASK); 13051000
IF IOD.[28:1] THEN 13052000
BEGIN PARERR; 13053000
IF T THEN GO TO NOGET; % DSED OR QTED 13054000
END; 13055000
IF ABORTED THEN % TEST FOR BAD IO DESC. 13056000
IF (M[B INX 18].[6:42] EQV " ")=NOT 0 THEN 13057000
GO ABORT; 13058000
END ELSE 13059000
BEGIN % TAPE 13060000
TAPERDR: X:=0; 13061000
TAPERD: IF (IOD:=WAITIO(B,@2000040,UNIT)).[43:1] THEN 13062000
BEGIN PARERR; 13063000
IF T THEN GO TO NOGET; % DSED OR QTED 13064000
END; 13065000
IF IOD.[42:1] OR X THEN 13066000
BEGIN 13067000
IF (X:=NOT X) THEN GO TO TAPERD; 13068000
IF M[B INX 3] THEN 13069000
IF LOOKFORTAPE THEN GO TO TAPERDR ELSE GO NOGET; 13070000
END; 13071000
IF (X:=M[B INX NOT 0])!90 THEN 13072000
IF (X AND @7775)=16 THEN % OLD FORMAT TAPE 13073000
BEGIN 13074000
INREC.[CF]:=B INX 1; 13075000
INREC[17]:=M[B]&0[20:20:7]; 13076000
END ELSE GO TO NOGET 13077000
ELSE 13078000
BEGIN 13079000
INREC:=90 INX INREC; 13080000
IF RECOUNT=@77777 THEN RECOUNT~INREC[17].[CF] ELSE 13080100
TAPECHK: IF (RECOUNT:=RECOUNT INX 1) ! INREC[17].[CF] THEN 13081000
BEGIN 13082000
ABORT: ABORTMSG; 13083000
NOGET: P(0); 13084000
GO TO GOTTEN; 13085000
END; 13086000
END; 13087000
END; 13088000
P(1); 13089000
GOTTEN: GET:=P; 13090000
END; 13091000
% -13091500
%%%%% START OF CODE %%%%% -13091600
% 13092000
% START IS USED FOR A NEW FILE (OR NEW PACKET), RESTART ISUSED FOR 13092010
% A COPY (OR A NEW FILE WITHIN A PACKET). 13092020
13092030
START: 13093000
IF COMMON=0 THEN GO TO INITIATE; 13094000
IF INITIALIZE THEN 13095000
BEGIN 13096000
RESTART: IF GET THEN 13097000
BEGIN 13098000
IF INREC[17].[1:11]=0 THEN SIGNIN ELSE GO GOTIT; 13099000
IF UNIT!18 THEN RECOUNT:=INREC[17].[CF]; 13101000
END ELSE % BAD FIRST BLOCK, USUALLY EOT. 13102000
BEGIN P(1); 13103000
GO TO TESTEND; 13104000
END; 13105000
MAINLOOP: 13106000
IF STOPSET(P1MIX) THEN STOPM(0); 13107000
IF (T:=PRT[P1MIX,@25])!0 OR DSED THEN 13108000
BEGIN 13109000
IF T<0 THEN % + OR - SPECIFIED. 13110000
BEGIN 13111000
QTSPEC; 13112000
GO TO MAINLOOP; 13113000
END; 13114000
ABORTMSG; % DSED OR QTED 13115000
GO TO QUIT; 13116000
END; 13117000
IF GET THEN % VALID REC. WRITE IT & CONTINUE 13118000
BEGIN 13119000
GOTIT: 13119100
$ SET OMIT = NOT RJE 13120000
IF V EQL 22 AND INREC[17].[18:1] THEN ELSE %206-13127899
BEGIN % %750-13127990
P(WAITIO(INREC[17]&(INREC)[CTC]&8[21:42:6],0,V),DEL); 13128000
LINECT~*P(DUP) + 1; % %750-13128010
END; % %750-13128020
GO TO MAINLOOP; 13129000
END; 13130000
END; 13131000
QUIT: 13132000
P(0); 13133000
TESTEND: 13134000
P:=P; % I=1 IF FIRST GET FAILS, ELSE 0.13135000
IF STARTANEWFILE THEN GO TO START ELSE GO TO RESTART; 13136000
END OF PRINTING BACKUP TAPE AND DISK FILES; 13137000
$ SET OMIT = NOT(DATACOM ) 13198999
$ SET OMIT = NOT(DATACOM AND RJE ) 13299999
REAL PROCEDURE ANALYSIS;% 14000000
BEGIN% 14001000
REAL ICW,IRCW,INCW,CL,T1,C,T2=SYLLABLE ;% 14002000
$ SET OMIT = NOT(NEWLOGGING) 14002099
LABEL GETOUT;% 14003000
COMMENT ANALYSIS EXAMINS THE SYLLABLE WHICH CAUSED THE INTURRUPT AND% 14004000
FROM THE RELATIVE ADDRESS OF THE SYLLABLE (INCLUDING% 14005000
VARIENT OPERATOR CONSIDERATIONS) COMPUTES THE LOCATION,C, 14006000
OF A COPY OF THE DESCRIPTOR ON THE TOP OF THE STACK.% 14007000
THE PREVIOUS TWO SYLLABLES ARE FETCHED BY THE STREAM% 14008000
STATEMENT GETSYLLABLES WHICH ALSO ADJUSTS THE C-L REGIST- 14009000
ERS PROPERLY.% 14010000
FINALLY THE STACK IS ADJUSTED AS FOLLOWS:% 14011000
DECREASE S BY 1,IF OPDC OR DESC% 14012000
XCH A AND B REGISTERS,IF COC OR CDC% 14013000
OTHERWISE LEAVE THE SAME. ;14014000
CHECKSTACKSPACE;% %WF 14014100
$ SET OMIT = NOT(NEWLOGGING) 14014199
INCW = PRT[P1MIX,8];% 14015000
IF INCW.[CF]<@1777 THEN % SOMETHING VERY WRONG %602-14015200
BEGIN JAR[P1MIX,6].[1:1]~1; % SD BIT %602-14015210
FILEMESS(-"SEE MCP"," PATCH ",0,0,0,0,602)%KLUGE MSG&DS14015220
END; 14015240
POLISH(.INCW,IOR);% 14016000
IRCW ~ * INCW ;% 14017000
ICW ~ *( (NOT 0) INX INCW);% 14018000
CL ~ (IRCW INX 0) & IRCW[30:10:2];% 14019000
STREAM (T1~0,T2~0,CL:X~0);% 14020000
BEGIN% 14021000
SI~CL; SI~SI-2 ; CL ~ SI; DI ~ LOC T2; DI~DI+6;% 14022000
DS ~ 2 CHR; SI ~ SI-3;% 14023000
IF SC = "/" THEN% 14024000
BEGIN% 14025000
SI~SI-1; IF SC ="0" THEN% 14026000
BEGIN TALLY~1; T1~TALLY ;CL ~ SI END;% 14027000
END;% 14028000
END GETSYLLABLE ;% 14029000
POLISH(.CL,~,.T2,~,.T1,~);% 14030000
IF INCW.[32:1] THEN% 14031000
BEGIN COMMENT P-BIT IN CHARACTER MODE ;% 14032000
IF T2 = @4441 THEN% 14033000
BEGIN COMMENT ENTER CHARACTER MODE;% 14034000
P(M[(IRCW ~ *(NOT 0 INX INCW ~ PRT[P1MIX,8] ~% 14035000
(NOT 1 INX INCW)&0[32:1:1])).[18:15]]&% 14036000
1[16:47:1]&0[18:18:15],(NOT 0)INX INCW,~); 14037000
C ~ INCW INX 0 -2;% 14038000
END ELSE BEGIN% 14039000
IF MEMORY[ C ~ IRCW.[18:15]-T2.[36:6]].[1:3] = 4% 14040000
THEN% 14041000
BEGIN% 14042000
IF T2.[42:6]= @53 THEN BEGIN% 14043000
COMMENT CONTROL WORD MEANS CHARACTER MODE RELEASE;% 14044000
T1~PRT[P1MIX,9]~M[(*((NOT 1)INX INCW)).[18:15]].[33:15];% 14045000
POLISH(M[T1],0,0);% 14046000
IF M[T1].[20:1] THEN CONTINUITYBIT;% 14047000
PROGRAMRELEASE;% 14048000
END% 14049000
END;% 14050000
IF T2 = 0 THEN GO TO GETOUT;% 14051000
END% 14052000
END% 14053000
ELSE% 14054000
BEGIN% 14055000
IF T2.[46:1] THEN% 14056000
BEGIN% 14057000
C ~ ICW.[33:15];% 14058000
POLISH(ICW, (NOT 1)INX INCW, ~,IRCW,% 14059000
PRT[P1MIX,8]~INCW ~ (NOT 0)INX INCW ,~);% 14060000
END OPDC DESC PART% 14061000
ELSE% 14062000
BEGIN% 14063000
C ~ INCW INX 0 -2;% 14064000
IF (NT1 ~ T2 AND @77) = @41 THEN% 14065000
BEGIN C ~C-1 ;% 14066000
POLISH(MEMORY[C],MEMORY[C+1],[MEMORY[C]], ~ ,[MEMORY[C+1] 14067000
],~);% 14068000
END COC CDC PART% 14069000
ELSE IF NT1 = @31 THEN% 14070000
BEGIN COMMENT THIS IS A BRANCH;% 14071000
GETOUT: CL ~ P([PRT[P1MIX,1]],DUP,T2,XCH,~) INX @600000;14072000
END BRANCH PART% 14073000
ELSE IF NT1 = @35 THEN GO TO GETOUT; COMMENT RETURN;% 14074000
END ALL SYLLABLES BUT OPDC DESC ;% 14075000
END WORD MODE INTERRUPT ;% 14076000
POLISH(IRCW & CL[33:33:15]&CL[10:30:2],INCW,~) ;% 14077000
ANALYSIS ~ C ;% 14078000
$ SET OMIT = NOT(NEWLOGGING) 14078099
END ANALYSIS OF P BIT ;% 14079000
SAVE INTEGER PROCEDURE ACTUALOVERLAYADDRESS(TYPE, MIX, LOC); 14105000
VALUE TYPE, MIX, LOC; 14106000
INTEGER TYPE, MIX, LOC; 14107000
BEGIN INTEGER T = +1; 14108000
$ SET OMIT = NOT(AUXMEM) 14108999
IF TYPE THEN % CODE... 14110000
BEGIN 14110100
$ SET OMIT = NOT(AUXMEM) 14110999
LOC := LOC INX 0; 14112000
T := JAR[MIX,LOC DIV (T:=JAR[MIX,8])+10]+LOC MOD T; 14113000
END ELSE % BETTER BE DATA... 14114000
$ SET OMIT = NOT(AUXMEM) 14114999
T~DALOC[MIX,LOC.[33:6]+P(DUP)-1]+LOC.[39:9] 14117000
$ SET OMIT = NOT(AUXMEM) 14117999
END; 14119000
$ SET OMIT = NOT(AUXMEM) 14119999
COMMENT THE SEGMENT DICTIONARY IS CONSTRUCTED BY THE% 14125000
COMPILERS AND EACH ENTRY HAS THE FORMAT:% 14126000
[ 1: 1] = 1 FOR TYPE 2 SEGMENTS, =0 OTHERWISE,% 14127000
[ 2: 1] = 1 FOR INTRINSICS , = 0 OTHERWISE.% 14128000
[ 3: 1] = 1 IF BEING MADE PRESENT, = 0 OTHERWISE 14128100
(INTERLOCK FOR RE-ENTRANT CODE) 14128200
[ 4: 2] = 0 FOR NORMAL SEGMENTS 14128300
= 3 FOR SEGMENTS OVERLAID TO AUX. MEM. 14128400
= 2 FOR SEGMENTS TO BE OVERLAID TO 14128500
AUXILIARY MEMORY WHICH HAVEN"T BEEN 14128600
[ 6: 1] = 1 FOR COBOL68 FILE TANK, 14128700
[ 7: 1] = 1 FOR COBOL68 READ ONLY ARRAY. 14128800
[ 8:10] = LINK TO PRT FOR 1ST DESCRIPTOR FOR% 14129000
THIS SEGMENT.% 14130000
[16:15] = SEGMENT SIZE(<1024) FOR ABSENT 14131000
SEGMENTS.% 14132000
= CORE ADDRESS OF PRESENT SEGMENTS.% 14133000
= 1 FOR NEVER-PRESENT INTRINSICS.% 14134000
[33:15] = DISK ADDRESS OF SEGMENT.% 14135000
= INTRINSIC-NUMBER FOR INTRINSICS.% 14136000
THE PRT FOR PROGRAM SEGMENTS IS CONSTRUCTED BY THE% 14137000
COMPILERS IN THE FORMAT :% 14138000
[ 0:5] = PROGRAM DESCRIPTOR BITS.% 14139000
[ 6:1] = STOPPER BIT WHICH DEFINES THE [ 7:11]% 14140000
FIELD.% 14141000
[ 7:11] = LINK TO NEXT DESCRIPTOR THAT BELONGS TO% 14142000
THIS SEGMENT, IF STOPPER BIT FALSE.% 14143000
= SEGMENT NUMBBER, IF STOPPER TRUE.% 14144000
[18:15] = F-REGISTER FIELD USED AT RUN TIME IN% 14145000
LABEL AND ACCIDENTAL DESCRIPTORS.% 14146000
= SEGMENT NUMBER FOR WORD MODE AND% 14147000
CHARACTER MODE DESCRIPTORS.% 14148000
[33:15] = CORE ADDRESS FOR PRESENT SEGMENTS.% 14149000
= RELATIVE ADDRESS FOR ABSENT SEGMENTS.% 14150000
I.E. RELATIVE TO BEGINNING OF SEGMENT.% 14151000
EACH PRT (R+4) CONTAINS A DESCRIPTOR WHICH POINTS 14152000
TO THE SEGMENT DICTIONARY.% 14153000
;% 14154000
PROCEDURE MAKEPRESENT(C); VALUE C; REAL C;% 14155000
BEGIN% 14156000
REAL SAVEBIT, MINE;% 14157000
REAL D,MOTHER,MOM,LOC,SIZE;% 14158000
INTEGER DISKADDR = SAVEBIT;% 14159000
DEFINE LINK= [ 7:11]#,STOPPER=[ 6: 1]#,PROGRAMDESC=[5:1]#;% 14160000
DEFINE NOTOPEN =[25:1] #;% 14161000
ARRAY NAME DD ;% 14162000
ARRAY AIT[*]; 14162500
ARRAY PRTR[*] ;% 14163000
REAL SEGNO=MOTHER, X=MOM,IOD ;% 14164000
REAL SPACE;% SPACE FOR SEGMENT NUMBERS (INTRINSICS) BY MIX 14164100
REAL MES,SAGE,GM; % SPACE FOR NO MEM MESSAGE. 14164200
REAL I,J; %101-14164300
$ SET OMIT = NOT(NEWLOGGING) 14164399
LABEL EXIT; % ALL AVENUES MUST LEAD TO HERE 14164500
LABEL WRAP,AROUND,TESTREADY;% 14165000
LABEL OPEN,CLOSE;% 14166000
LABEL CODEIN,INT; 14166100
LABEL DLOOP, NG; 14166200
DEFINE REVERSE =[22:1]#,READY =[19:1]#,PRESENT =[2:1]#;% 14167000
COMMENT MAKEPRESENT HAS THE FOLLOWING ACTIONS,DEPENDING ON THE TYPE% 14168000
OF DESCRIPTOR CAUSING PRESENCE BIT :% 14169000
DATA DESCRIPTOR :% 14170000
IF MOTHER ABSENT THEN GET CORE SPACE AND SET% 14171000
MOTHER PRESENT WITH PROPER CORE ADDRESS% 14172000
THEN IF INITIAL ACCESS,ZERO THE SPACE ELSE% 14173000
READ IN FROM DISK AND RETURN DISK SPACE% 14174000
THEN SET 1ST MEMORY LINK TO SAVE OR NOT SAVE% 14175000
AND SET 2ND LINK TO ADDRESS OF MOTHER% 14176000
IN ANY EVENT, SET COPY PRESENT WITH CORRECT CORE% 14177000
ADDRESS.% 14178000
IO DESCRIPTOR:% 14179000
PROGRAM DESCRIPTOR:% 14180000
;% 14181000
SUBROUTINE RUNAROUND;% 14182000
BEGIN WHILE NOT (PRTR[X] ~ ((LOC+2) INX PRTR[X])% 14183000
OR MEMORY).STOPPER DO X ~ PRTR[X].LINK;% 14184000
END RUNAROUND;% 14185000
% 14185100
$ SET OMIT = NOT(NEWLOGGING) 14185199
IF (D ~ M[C]).[1:1] THEN% 14186000
IF D.[6:2]=1 THEN % TYPE 13 INTRINSIC 14186010
BEGIN X:=[INTRINSC[SEGNO~MINE~NFLAG(D) INX 0]]; 14186020
SEGNO:=SEGNO-1; 14186030
STREAM(T:=SEGNO AND 3, I:=[INTABLE[P1MIX,SEGNO DIV 4]]); 14186100
BEGIN DI:=DI+T;DI:=DI+T;SKIP 1 DB;DS:=SET;END;%MARK TYPE 13 BIT14186110
IF X>0 THEN SLEEP([X],-0); 14186120
$ SET OMIT = NOT MONITOR 14186121
IF (X INX 0){1023 THEN 14186130
BEGIN P(ABS(X),[X],~); SIZE~X INX 0; 14186140
$ SET OMIT = NOT(AUXMEM) 14186143
DISKADDR := X.[6:27]; 14186148
MINE~MINE&SIZE[8:38:10]&3[1:46:2]; 14186150
IOD:=13; GO TO CODEIN; 14186152
END ELSE BEGIN M[C].[CF]~INTRNSC[MINE].[CF]; 14186160
M[C].[2:1]:=1; 14186170
GO EXIT; 14186180
END 14186190
END ELSE 14186200
BEGIN PRTR ~ PRT[P1MIX,*]; LOC ~ NFLAG(D)&0[5:5:1]; 14187000
DO IF LOC.PROGRAMDESC THEN SEGNO ~ LOC.[18:15]% 14188000
ELSE IF LOC.STOPPER THEN SEGNO ~ LOC.LINK% 14189000
ELSE LOC ~ NFLAG(PRTR[LOC.LINK])% 14190000
UNTIL SEGNO!0;% 14191000
DD ~ SEGNO INX PRTR[4];% 14192000
IF DD[0].[3:1] AND NOTERMSET(P1MIX) THEN 14193000
COMPLEXSLEEP((TERMSET(P1MIX) OR NOT DD[0].[3:1])); 14193100
IF TERMSET(P1MIX) THEN GO INITIATE; 14193200
IF (SIZE ~ (MINE ~ DD[0]).[18:15]){1023 THEN% 14194000
BEGIN DD[0].[3:1] ~ `;% 14195000
IF MINE<0 THEN% 14196000
IF PRTR[X ~ MINE.[8:10]].[2:1] THEN GO AROUND;% 14197000
IF MINE.[2:1] THEN% 14198000
BEGIN X ~ [INTRNSC[MINE INX 0]];% 14198100
IF X>0 THEN SLEEP([X],-0);% 14198200
IF (X INX 0){1023 THEN BEGIN P(ABS(X),[X],~);% 14198300
SIZE ~ X INX 0; 14198400
$ SET OMIT = NOT MONITOR 14198410
$ SET OMIT = NOT(AUXMEM) 14198499
DISKADDR ~ X.[6:27]; 14198700
END ELSE BEGIN LOC ~ (SIZE ~ X INX 0)-2; 14198800
DD[0].[FF] ~ SIZE; GO AROUND;% 14199000
END;% 14200000
END ELSE IF JAR[P1MIX,10]=0 THEN% 14201000
DISKADDR := DATADDRESS(P1MIX, MINE) 14202000
ELSE DISKADDR := CODEADDRESS(P1MIX, MINE); 14203000
IOD:=6|MINE.[2:1]+(MINE LSS 0)+1; 14203010
CODEIN:: WHILE (LOC~GETSPACE(SIZE,IOD,(MINE<0 AND MINE.[6:1])+66)) 14203020
= 0 DO 14203021
BEGIN IF TERMSET(P1MIX) THEN 14203100
BEGIN IF MINE.[2:1] THEN 14203200
INTRNSC[MINE]:=NABS(*P(DUP)); 14203300
IF D.[6:2]=1 THEN 14203400
INTRNSC[D]:=NABS(*P(DUP)); 14203500
DD[0].[3:1]:=0; GO TO INITIATE; 14203600
END; 14203700
IF(SPACE:=SPACE+1)=5 THEN 14204000
BEGIN STREAM(P1MIX,SIZE,T:=[MES]); 14204100
BEGIN SI:=LOC P1MIX; DS:=2 DEC; 14204200
DS:=8LIT" NO MEM ";DS:=5 DEC; 14204300
DS:=5 LIT " WDS~"; 14204400
END; 14204500
P(WAITIO([MES],@177,25),DEL); 14204600
END; 14204700
SLEEP([CLOCK],NOT CLOCK); 14205000
END; 14205100
IF MES NEQ 0 THEN 14205200
BEGIN STREAM(T:=[MES]); 14205300
BEGIN DI:=DI+3;DS:=7LIT"OK MEM~" END; 14205400
P(WAITIO([MES],@177,25),DEL); 14205500
END; 14205600
DISKIO(IOD, -LOC-1, SIZE, DISKADDR); X ~ MINE.[8:10];% 14206000
SLEEP([IOD],IOMASK); 14206100
IF IOD.[26:7] NEQ 0 THEN 14206110
BEGIN 14206120
IF MINE.[2:1] THEN INTRNSC[MINE]:=NABS(*P(DUP)); 14206135
DD[0].[3:1] := 0; 14206140
GO TO NG; 14206145
END; 14206160
$ SET OMIT = NOT(STATISTICS) 14206299
IF D.[6:2]=1 THEN 14206310
BEGIN M[C].[CF]~LOC+2; 14206320
M[C].[2:1]~1; 14206330
GO TO INT; 14206340
END; 14206350
IF MINE>0 THEN BEGIN RUNAROUND;% 14207000
M[C] ~ ((LOC+2) INX D) OR MEMORY;% 14208000
INT: 14208010
IF MINE.[2:1] THEN% 14209100
BEGIN M[LOC] ~ (*P(DUP))&0[9:9:6];% 14209200
INTRNSC[MINE INX 0] ~ -(*P(DUP))&(LOC+2)[CTC];% 14209300
END ELSE% 14209500
IF (X ~ PRTR[4].[18:6])!0 THEN% 14210000
M[LOC] ~ (*P(DUP))&X[9:42:6];% 14211000
IF DISKADDR>0 THEN M[LOC+1] := 0 & SIZE[CTF]; 14212000
M[LOC+1] := (*P(DUP)) & SEGNO[CTC]; 14212010
IF MINE.[2:1] THEN M[LOC+1] ~ (*P(DUP))&MINE[8:38:10];% 14212100
IF D.[6:2]=1 THEN 14212200
BEGIN M[LOC].[2:1]~0; GO EXIT; 14212300
END; 14212400
DD[0].[18:15] ~ LOC+2;% 14213000
END PROGRAM CODE SEGMENTS% 14214000
ELSE BEGIN 14215000
M[C] ~ PRTR[X] ~ M OR ((LOC+2)% 14216000
&(M[LOC+1] ~ [PRTR[X]] INX 0)[18:33:15]% 14217000
& (MINE.[7:1]|24) [3:43:5] % COBOL68 READ ONLY 14217500
&SIZE[8:38:10]);% 14218000
IF MINE.[6:1] THEN % COBOL68 FILE TANK 14218010
IF NOT P(M[LOC+4],TOP,XCH,DEL) THEN% BUILD FIB PTR14218025
BEGIN 14218027
P([M[LOC+4]],DUP,DUP,LOD,XCH,INX,M[C],FFX, 14218030
@100026,DIA 32,DIB 2 TRB 16,XCH,~); 14218035
WHILE (AIT~PRTR[AITNDX]).PBIT=0 14218040
DO MAKEPRESENT([PRTR[AITNDX]] INX 0); 14218045
IF AIT.[8:10] < AIT[0]+2 THEN 14218050
BEGIN P(AIT,0,0); INTERRUPT(1);% PHONEY INVALID14218055
P(DEL,DEL,DEL); % INDEX ON AIT 14218060
AIT ~ PRTR[AITNDX]; 14218065
END; 14218070
IF AIT[AIT[0]].[8:10] NEQ 1 THEN %101-14218072
BEGIN %101-14218074
I := 1; %101-14218076
WHILE AIT[I].[8:10] = 1 DO I := I + 1;%101-14218078
FOR J := AIT[0] STEP -1 UNTIL I DO %101-14218080
AIT[J+1] := AIT[J]; %101-14218082
END ELSE I := AIT[0] + 1; %101-14218084
AIT[0] := *P(DUP) + 1; %101-14218086
AIT[I] := -(1 & 1[8:38:10] & M[C][FTF]); %101-14218088
END; 14218090
$ SET OMIT = NOT(STATISTICS) 14218099
END TYUPE TWO DATA SEGMENTS;% 14219000
IF NOT MINE.[6:1] THEN M[LOC].[2:1] ~ 0; 14220000
END ABSENT SEGMENTS% 14221000
ELSE BEGIN LOC ~ SIZE-2;% 14222000
AROUND: IF DD[0]>0 THEN% 14223000
IF NOT PRTR[X ~ DD[0].[8:10]].[2:1] THEN RUNAROUND;% 14224000
M[C] ~ IF DD[0]>0 THEN ((SIZE INX D) OR M)% 14225000
ELSE PRTR[DD[0].[8:10]];% 14226000
END;% 14227000
IF DD[0].[2:1] THEN% 14227100
BEGIN % INTRINSIC 14227200
IF (SIZE:=(DD[0] INX 0)-1) NEQ 16 THEN %NOT INTRINSIC 17 14227210
BEGIN 14227220
STREAM(SEGNO, T ~ SIZE AND 3,% 14227300
I ~ [INTABLE[P1MIX,SIZE DIV 4]]);% 14227400
BEGIN 14227500
SI:=I; SI:=SI+T; SI:=SI+T; SKIP 1 SB; 14227520
IF SB THEN; % REMEMBER TYPE 13 REFERENCE 14227540
DI:=DI+T; DI:=TI+T; T:=DI; SI:=LOC T; 14227560
SI:=SI-2; DS:=2 CHR; 14227580
IF TOGGLE THEN BEGIN DI:=T; SKIP 1 DB; DS:=SET; END; 14227600
END; 14227620
END; 14227630
END;% 14227700
DD[0].[3:1] ~ 0; GO EXIT; 14228000
END;% 14229000
IF (MOM:=D.[3:5])!0 AND (MOM AND @33)!@30 THEN 14230000
BEGIN% 14231000
COMMENT I/O DESCRIPTOR;% 14232000
IF JAR[P1MIX,2] < 0 THEN 14233000
BEGIN TERMINATE(P1MIX); 14233100
TERMINALMESSAGE(25); 14233200
END; 14233300
MOM~ MEMORY[D INX (IF D.REVERSE THEN 2 ELSE NOT 1)]% 14234000
INX 0;% 14235000
TESTREADY: IF NOT MEMORY[MOM].READY THEN% 14236000
SLEEP([MEMORY[MOM]],IOMASK);% 14237000
IF MEMORY[MOM].PRESENT THEN% 14238000
MEMORY[C]~MEMORY[MOM]% 14239000
ELSE% 14240000
BEGIN% 14241000
IF MEMORY[MOM].NOTOPEN THEN% 14242000
OPEN: BEGIN SAVEOPEN(MOM); IF TERMSET(P1MIX) THEN GO EXIT; 14243000
GO TESTREADY END 14244000
ELSE BEGIN% 14245000
COMMENT READY AND NOT PRESENT INDICATES REEL-SWITCH OR TERMINATE;% 14246000
PRTR~M[MOM-3];% 14247000
LOC~PRTR[15].[25:5];% 14248000
SIZE~PRTR[4].[8:4];% 14249000
IF M[MOM].[27:1] THEN% 14250000
IF M[MOM].[24:1] THEN% 14251000
BEGIN IF SIZE=2 AND NOT PRTR[4].[2:1]% 14252000
AND NOT M[MOM].[22:1] THEN% 14253000
BEGIN BLASTQ(LOC);% 14254000
P(WAITIO(M[MOM-2],0,LOC),DEL);% 14255000
P(WAITIO(@1000000340000005,0,LOC),DEL);% 14256000
IF M[M[MOM-2] INX 4].[42:6]=1 THEN% 14257000
CLOSE: BEGIN LOC~PRTR[13].[28:10];% 14258000
FILECLOSE(MOM&@12[18:33:15]);% 14259000
PRTR[13].[28:10]~LOC+1;% 14260000
GO TO OPEN;% 14261000
END;% 14262000
END;% 14263000
END ELSE% 14264000
BEGIN IF SIZE=2 OR SIZE=7 OR SIZE=8 THEN% 14265000
BEGIN IF NOT PRTR[4].[2:1] THEN% 14266000
M[M[MOM-2] INX 4].[42:6]~1;% 14267000
GO TO CLOSE;% 14268000
END;% 14269000
END;% 14270000
P(MOM,M[MOM].[27:1]+1,0,0,);% 14271000
COM11;% 14272000
END;% 14273000
END;% 14274000
END% 14275000
ELSE% 14276000
BEGIN% 14277000
COMMENT DATA DESCRIPTOR;% 14278000
DLOOP: 14278100
IF (MOTHER~MEMORY[MOM ~ D.[18:15]]).[2:1] THEN GO WRAP;% 14279000
IF (MOTHER INX 0) = 6 THEN % I/O ERROR FROM OLAY 14279150
BEGIN 14279200
TERMINATE(P1MIX & 20[CTF]); 14279250
GO TO INITIATE; 14279350
END; 14279400
IF (MOTHER INX 0) = 5 THEN % INTERLOCK FROM OLAY 14279450
BEGIN 14279500
COMPLEXSLEEP(((M[MOM] INX 0) NEQ 5)); 14279550
GO TO DLOOP; 14279600
END; 14279650
SAVEBIT ~ MOTHER.[CF]=1; 14280000
MEMORY[MOM] ~ MOTHER&((LOC ~GETSPACE(SIZED~MOTHER.[8:10],2,% 14281000
SAVEBIT+64))+2)[CTC]&1[2:47:1]; 14282000
$ SET OMIT = NOT(AUXMEM) 14282099
IF MOTHER.[CF]{3 THEN 14283000
STREAM(L~LOC+2, S~SIZE-1, T~0, W~(MOTHER.[CF]=2)); 14284000
BEGIN SI ~ LOC S;SI~SI+6;DI~LOC T;DI~DI+7;DS~CHR;% 14285000
DI~L; SI~LOC W; SI~WDS; 14286000
SI~L; T(DS~32 WDS; DS~32 WDS); DS~S WDS;% 14287000
END ZERO SPACE% 14288000
ELSE% 14289000
BEGIN% 14290000
COMMENT READ ARRAY FROM DISK AND RETURN DISK SPACE;% 14291000
$ SET OMIT = NOT(STATISTICS) 14291099
DISKIO(IOD,-LOC-1,MOTHER.[8:10],% 14292000
DATADDRESS(P1MIX, MOTHER)); 14292100
SLEEP([IOD],IOMASK); 14292110
IF IOD.[26:7] NEQ 0 THEN 14292120
BEGIN 14292130
NG: FORGETSPACE(LOC+2); 14292140
COMPLEXSLEEP(TERMSET(P1MIX)); 14292150
GO TO INITIATE; 14292160
END; 14292170
$ SET OMIT = NOT(STATISTICS) 14292199
MOM~MOM&MOTHER[CTF]; 14293000
END ;% 14295000
MEMORY[LOC].[2:1] ~ SAVEBIT;% 14296000
MEMORY[LOC+1] ~ MOM ;% 14297000
$ SET OMIT = NOT(STATISTICS) 14297099
WRAP:% 14298000
MEMORY[C] ~ IF D.[8:10] = 0 THEN P(M[MOM],0,CDC,D,XCH,INX)% 14299000
ELSE MEMORY[MOM];% 14300000
END;% 14301000
EXIT: 14301100
$ SET OMIT = NOT(NEWLOGGING) 14301199
END MAKEPRESENT ;% 14302000
REAL ADDRS=NT1;% 14342000
PROCEDURE ZIPPER(A,B,C);VALUE A,B,C; REAL A,B,C; FORWARD; 14342100
PROCEDURE COM5;% 14343000
BEGIN% 14344000
REAL RCW=+0,% 14345000
ERTOG=+2,% 14346000
I =+3,% 14347000
T =+4,% 14348000
INTEGER J=1;% 14349000
ARRAY VECTOR=+5[*],S=+6[*];% 14350000
INTEGER Q=S; 14350100
ARRAY FILEBLOCK=+7[*];% 14351000
ARRAY TSKA=+13[*]; 14351050
INTEGER LINK; LABEL RETURNEM; 14351100
INTEGER MOTHER=+8, NEXTMOM=+9, MOMMIX=+10, CATCH=+11;% 14351200
REAL ENDAIT=MOMMIX,A=MOMMIX,K=NEXTMOM; 14351205
REAL CHAIN=+12,ABSEVT=CHAIN; 14351210
REAL MSCW = -1; 14351220
REAL JAR9 = TSKA+1; %519-14351230
$ SET OMIT = NOT(WORKSET) 14351240
REAL STOPMIX=JAR9+1; LABEL STOPLOOP; 14351250
$ POP OMIT % WORKSET 14351260
SUBROUTINE DELINKIT; 14351300
BEGIN T:=M[I] INX 0; 14351310
IF NOT M[T].[4:1] THEN SLEEP([M[T]],@200000000000000); 14351320
M[T].[4:1]:=0; 14351330
IF M[I].[2:1] THEN%IN CONTROL 14351340
BEGIN M[T].[CF]:=M[I].[FF]; 14351350
IF (M[T] INX 0) NEQ 0 THEN M[M[T] INX 0].[2:1]:=1 14351360
ELSE M[T]:=ABS(M[T]);%UNLOCK IT 14351370
END ELSE% IN WAIT QUEUE 14351380
BEGIN T:=M[T] INX 0; 14351390
WHILE M[T].[FF] NEQ (I INX 0) DO 14351400
T:=M[T].[FF]; 14351410
M[T].[FF]:=M[I].[FF]; 14351420
END; 14351430
M[T].[4:1]:=1; 14351440
END; 14351450
PRYOR[P1MIX] ~ -1; 14351500
P((ADDRS:=GETSPACE(196,12,0))+1,STS,.COM5,RCW,0,RDS,0,XCH,CFX, 14353000
STF); 14353002
P(P&[MSCW][CTF],0,0,0,0,0,0); 14354000
P(0,0,0,0,0,0,0); % ZERO FILEBLOCK THRU JAR9... %172-14355000
$ SET OMIT = NOT(WORKSET) 14355020
P(0); % STOPMIX 14355030
$ POP OMIT % WORKSET 14355040
M[(FILEBLOCK~PRT[P1MIX,3]) INX 0-2].[9:6] ~ 0;% 14356000
M[ADDRS]~(*P(DUP))&0[9:9:6]; 14357000
M[(VECTOR~JARROW[P1MIX]) INX 0-2]~(*P(DUP))&0[9:9:6]; 14358000
IF VECTOR[0]<0 THEN% 14358100
BEGIN CATCH~PRT[P1MIX,@26]; 14358150
ERTOG ~ (VECTOR[1]>0) OR (PRT[P1MIX,@25]!0);% 14358200
END; 14358300
IF VECTOR[2].[6:1] THEN % IPC 14358310
BEGIN IF VECTOR[1]<0 THEN % DS-ED TASK 14358315
BEGIN WHILE (S~PRT[P1MIX,AITNDX]).PBIT=0 DO % SEARCH AIT FOR 14358320
MAKEPRESENT( PRTROW[P1MIX] INX AITNDX); % TASK ARRAYS 14358325
MEMORY[S INX NOT 1].[2:1] ~ 1; % MARK SAVE 14358330
ENDAIT ~ S[0]; 14358335
FOR K~1 STEP 1 UNTIL ENDAIT DO 14358340
BEGIN TSKA ~ MEMORY[(NT1~S[K]).MOM]; 14358345
IF NT1.[1:2]=3 THEN IF % DEPENDENT TASK 14358355
((NT2~TSKA[3])=1 OR (NT2=2 AND TSKA[4]!P1MIX)) THEN 14358360
% TASK ARRAY OF A SCHEDULED OR RUNNING OFFSPRING14358365
BEGIN IF NT2=1 THEN 14358370
BEGIN 14358373
SHEETDIDDLER(0,20,TSKA[4]); % ES14358375
END; 14358377
IF TSKA[3]=2 THEN % RUNNING 14358380
BEGIN 14358382
TERMINATE(TSKA[4]&86[CTF]); HALT; % DS14358383
NOPROCESSTOG ~ NOPROCESSTOG-1; 14358384
END; 14358385
COMPLEXSLEEP((TSKA[3] LSS 0)); 14358386
END; 14358389
END; 14358390
END; IF VECTOR[2].[5:1] THEN SOFTI ~ SOFTI-1; 14358391
IF (TSKA~PRT[P1MIX,TSX]).PBIT THEN 14358392
BEGIN IF TSKA[6]=1 THEN TSKA[7]:=1; 14358393
IF (I:=TSKA[5]) NEQ 0 THEN BEGIN I:=[PRT[P1MIX,I]] INX 0; 14358394
DELINKIT;WHILE(I:=M[I].[8:10]) NEQ 0 DO 14358395
BEGIN I:=[PRT[P1MIX,I]]INX 0;DELINKIT END END; 14358397
IF (I~TSKA[8].[CF])!0 THEN % SOFTWARE INTERRUPTS DECLARED 14358398
BEGIN IF NOT TSKA[8].[4:1] THEN 14358400
SLEEP([TSKA[8]],@200000000000000); 14358450
TSKA[8].[4:1] ~ 0; 14358460
DO % DETACH SOFTWARE INTERRUPTS 14358550
BEGIN IF (ABSEVT~PRT[P1MIX,I].[FF])!0 THEN 14358580
BEGIN WHILE NOT M[ABSEVT].[5:1] DO 14358582
ABSEVT ~ M[ABSEVT].[FF]; 14358584
IF M[ABSEVT]}0 THEN 14358586
SLEEP([M[ABSEVT]],@2000000000000000);14358588
M[ABSEVT] ~ P(LOD,DUP,SSP); 14358590
T ~ (K~PRT[P1MIX,I]).[FF]; 14358595
A ~ [PRT[P1MIX,I]] INX 0; 14358597
WHILE M[T].[FF]!A DO T ~ M[T].[FF]; 14358598
M[T].[FF] ~ K.[FF]; 14358600
M[ABSEVT] ~ P(DUP,LOD,SSN); 14358605
END; 14358610
I ~ PRT[P1MIX,I].[CF]; 14358615
END UNTIL I=0; 14358620
TSKA[8].[4:1] ~ 1; 14358625
END; 14358630
TSKA[3]:=-1; 14358640
END; 14358650
END; 14358700
JAR9 := VECTOR[9]; 14358710
CHAIN ~ 0&VECTOR[9][FTC]&VECTOR[1][1:1:1]; VECTOR[9].[FF] ~ 0; 14358800
$ SET OMIT = NOT(BREAKOUT) 14358999
IF VECTOR[2]<0 THEN % COBOL 14360100
IF VECTOR[1]>0 THEN % NOT DS-ED 14360200
WHILE PRT[P1MIX,16]>0 DO ASR;%CLEAN OUT AIT 14360300
IF VECTOR[1]>0 THEN % NOT DS-ED 14360310
FOR MOMMIX:=6 STEP 5 UNTIL 11 DO 14360320
BEGIN Q:=NFLAG(PRT[P1MIX,MOMMIX]); % AIT OR OAT ENTRY 14360330
IF Q.[2:1] THEN % PRESENT, GRAB ADDRESS FROM LINK 14360340
Q := Q & M[Q INX NOT 0];[FTC]; 14360350
IF Q.[33:3]=7 THEN % AUXILIARY MEMORY IN THE ACT 14360360
DISKRTN(Q.[CF], Q.[8:10]); 14360370
IF VECTOR[2]<0 THEN MOMMIX:=11; % COBOL HAS NOT OAT 14360380
END; 14360390
SLEEP([OLAYMASK],MOMMIX~TWO(P1MIX)); 14360400
OLAYMASK ~ NOT MOMMIX AND OLAYMASK; 14360500
MOTHER ~ DALOC[P1MIX,0].[CF]; 14360600
NEXTMOM := -1; S := DALOCROW[P1MIX]; 14360700
WHILE (NEXTMOM := NEXTMOM+2)<MOTHER DO 14360800
FORGETUSERDISK(S[NEXTMOM],-500); 14360900
SLEEP([TOGLE],STOREMASK); 14361000
MOTHER ~ (MOMMIX ~ (NEXTMOM ~% 14361100
PRT[P1MIX,4].[18:12]).[36:6])=P1MIX;% 14361200
NEXTMOM ~ NEXTMOM AND @77;% 14361300
$ SET OMIT = NOT(AUXMEM) 14361309
$ SET OMIT = NOT(DEBUGGING AND AUXMEM) 14361512
WHILE(T~M[I]).[CF] ! 0 DO% 14362000
BEGIN% 14363000
IF T > 0 THEN % IN USE AREA %167-14364100
IF T.AREAMIXF = P1MIX THEN % IN USE BY THIS MIX 14364200
IF MOTHER AND (P(T.AREATYPEF,DUP) = CODEAREAV 14364300
OR P(XCH) = SEGDICTAREAV) THEN % GIVE CODE 14364400
M[I].AREAMIXF := NEXTMOM % TO NEW MOM %167-14364500
ELSE %167-14364600
FORGETSPACE(I INX 2); %167-14364700
I := T.AREAFWDLINKF; %167-14364800
END;% 14367000
INTABLEROW[P1MIX] ~ 0;% 14367100
$ SET OMIT = NOT(BREAKOUT) 14367199
$ SET OMIT = NOT(BREAKOUT) 14367999
IF NEXTMOM!0 THEN BEGIN% 14370010
IF MOTHER THEN% 14370020
IF PRT[NEXTMOM,4].[24:6]=@77 THEN% 14370030
NFO[(NEXTMOM-1)|NDX+1] ~% 14370035
PRT[NEXTMOM,4] ~ (*P(DUP))&0[18:18:15]% 14370040
ELSE BEGIN MOTHER ~ NEXTMOM;% 14370050
DO UNTIL (MOTHER ~ (PRT[MOTHER,4] ~% 14370060
NFO[(MOTHER-1)|NXD+1] ~% 14370065
(*P(DUP))&NEXTMOM[18:42:6]).[24:6])=@77;% 14370070
END% 14370080
ELSE BEGIN% 14370090
IF (PRT[MOMMIX,4].[24:6]=P1MIX) AND% 14370100
NEXTMOM=@77 THEN NFO[(MOMMIX-1)|NDX+1] ~% 14370110
PRT[MOMMIX,4] ~ (*P(DUP))&0[18:18:15]% 14370115
ELSE BEGIN% 14370120
DO BEGIN MOTHER ~ MOMMIX; 14370130
MOMMIX ~ PRT[MOMMIX,4].[24:6];% 14370140
END UNTIL MOMMIX=P1MIX;% 14370150
NFO[(MOTHER-1)|NDX+1] ~% 14370155
PRT[MOTHER,4] ~% 14370160
(*P(DUP))&NEXTMOM[24:42:6];% 14370165
END END;% 14370170
NFO[(P1MIX-1)|NDX+1] ~% 14370180
PRT[P1MIX,4] ~ (*P(DUP))&0[18:18:15];% 14370190
END;% 14370200
$ SET OMIT = NOT(AUXMEM) 14370299
IF VECTOR[2].[8:10]! 0 THEN% 14371000
$ SET OMIT = STATISTICS 14371999
FORGETSPACE(DIRECTORYSEARCH(ABS(VECTOR[0]),IF VECTOR[0]<0 14372000
THEN "DISK " ELSE ABS(VECTOR[1]),13)); 14373000
$ POP OMIT 14373001
$ SET OMIT = NOT(STATISTICS) 14373099
IF VECTOR[2].[8:10] = 1 THEN % COMPILER ON COMPILE AND GO 14374000
BEGIN% 14375000
IF ERTOG=0 THEN% 14376000
BEGIN% 14377000
COMPLEXSLEEP((SCHEDULEIDS!NOT 0) AND 14378000
SHEETFREE); 14378100
LOCKTOG(SHEETMASK); 14379000
S~[M[GETSPACE(31,2,0)+2]]&30[8:38:10];14380000
DISKIO(T,-(S INX 0-1),30, 14381000
VECTOR[2].[FF]); 14382000
SLEEP([T],IOMASK); 14383000
STREAM(A~0:B~P(.SCHEDULEIDS)); 14383100
BEGIN SI~B; 14383200
47(SKIP SB; SKIP DB; TALLY~TALLY+1;14383300
IF SB THEN BEGIN END % -14383400
ELSE JUMP OUT); 14383450
DS~SET; A~TALLY; 14383500
END STREAM; 14383600
T ~ P; S[3] ~ D&T[8:38:10]; 14383700
S[25] ~ CATCH; 14383740
S[23].[24:24]~(CLOCK+P(RTR))DIV 60; 14383750
DISKIO(T,+(S INX 0-1),30, 14383800
VECTOR[2].[FF]); 14383900
SLEEP([T],IOMASK); 14384000
I ~ IF S[18] > MIXMAX THEN MIXMAX 14385000
ELSE S[18]; 14386000
IF SHEET[I].[CF] ! 0 THEN 14387000
BEGIN DISKIO(T,-(S INX 0-1),30, 14388000
SHEET[I].[FF]); 14389000
SLEEP([T],IOMASK); 14390000
S[29] ~ VECTOR[2].[FF]; 14391000
DISKIO(T,+(S INX 0-1),30, 14392000
SHEET[I].[FF]); 14392500
SLEEP([T],IOMASK); 14393000
END ELSE SHEET[I] ~ VECTOR[2].[FF]; 14394000
SHEET[I].[FF] ~ VECTOR[2].[FF]; 14395000
UNLOCKTOG(SHEETMASK); 14396000
FORGETSPACE(S INX 0);% %165-14396100
END% 14397000
ELSE BEGIN% 14398000
RETURNEM: 14398500
S~[M[GETSPACE(31,2,0)+2]]&30[8:38:10]; 14398600
DISKIO(T,-(S INX 0-1),30,VECTOR[2].[FF]); 14398700
SLEEP([T],IOMASK); 14398800
FORGETESPDISK(VECTOR[2].[18:15]);% 14399000
LINK ~ S[13]; 14399100
WHILE LINK!0 DO 14399200
BEGIN DISKIO(T,-(S INX 0-1),30,LINK); 14399300
SLEEP([T],IOMASK); 14399400
FORGETESPDISK(LINK); LINK ~ S[29]; 14399500
END; 14399600
FORGETSPACE(S); 14399700
END 14400000
END ELSE% 14401000
IF VECTOR[2].[8:10] = 0 THEN% 14402000
BEGIN% 14403000
VECTOR[9]:=VECTOR[9].[CF]; 14403900
FOR I~1 STEP 1 UNTIL VECTOR[9] DO% 14404000
IF VECTOR[9+I] ! 0 THEN% 14405000
FORGETUSERDISK[VECTOR[9+I],-VECTOR[8]); 14406000
IF VECTOR[2].[7:1] THEN VECTOR[2].[8:10]~2;%FOR TASK LOG 14406100
END ELSE 14407000
IF VECTOR[2].[8:10]=4% 14407100
THEN GO TO RETURNEM; 14407200
IF VECTOR[0]<0 THEN 14408000
IF ERTOG ! 0 THEN% 14409000
VECTOR[2].[8:10] ~ 3;% 14410000
I ~ P1MIX;% 14411000
COMMENT SUBTRACT CORE REQUIREMENTS FROM CORE WORD; 14411100
CORE.[18:15]~CORE.[18:15] - NFO[(P1MIX-1)|NDX+2].[18:15]; 14411200
$ SET OMIT = NOT(AUXMEM) 14411309
$ SET OMIT = NOT(DATACOM ) 14411499
IF CHAIN GTR 0 THEN 14411620
BEGIN S:=[M[SPACE(5)]]&5[8:38:10]; 14411640
DISKWAIT(-(S INX 0),5,CHAIN); 14411660
ZIPPER(S[1],S[2],S[3]); 14411680
FORGETSPACE(S); 14411700
END; 14411720
IF CHAIN ! 0 THEN FORGETESPDISK(ABS(CHAIN)); 14411740
IF VECTOR[2].[3:1] THEN 14411800
BEGIN 14411810
NT1:=TYPEDSPACE(5,MAINTBUFFAREAV);% %167-14411820
M[NT1-2].[9:6] := 0; 14411830
M[NT1 ]:= 0 & P1MIX[20:43:5]; 14411840
M[NT1+1]:= VECTOR[5].[1:23]; 14411850
M[NT1+2]:= XCLOCK & VECTOR[2][1:1:17] & 14411860
(VECTOR[1]<0)[18:42:6]; 14411870
M[NT1+3]:= VECTOR[0]; 14411880
M[NT1+4]:= VECTOR[1]; 14411890
LINKUP(14,NT1); 14411900
END; 14411910
$ SET OMIT = PACKETS 14411999
BEGIN; STREAM(TK~VECTOR[2].[7:1],B~IF VECTOR[1] <0 THEN 2 ELSE%110-14414000
VECTOR[2].[8:10]!3,I,Q~Q~((NT1~(XCLOCK DIV 3600)14415000
) MOD 60 + (NT1 DIV 60)|100), V:=VECTOR 14415100
$ SET OMIT = NOT PACKETS 14415150
,T:=T:=SPACE(10) 14415200
$ POP OMIT 14415250
); 14415300
BEGIN% 14416000
$ SET OMIT = PACKETS 14416999
$ SET OMIT = NOT(PACKETS) 14418099
SI:=V;SI:=SI+1;DS:=LIT" ";DS:=7CHR; 14418100
SI:=SI+1;DS:=LIT"/";DS:=7CHR; 14418110
$ POP OMIT 14418111
DS~LIT"="; SI~LOC I; DS~2DEC; 14419000
I~DI; DI~DI-2; DS~FILL; DI~I; 14419500
CI ~ CI+B;% 14420000
GO TO E;% 14421000
GO TO OK;% 14422000
DS~7 LIT " DS-ED "; 14423000
GO TO X;% 14424000
OK:% 14425000
DS~5 LIT " EOJ "; 14426000
TK(DI~DI-2; DS~2 LIT "T "); % END OF TASK %110-14426100
GO TO X;% 14427000
E: DS~11 LIT " SYNTX ERR "; 14428000
X: DS~ 4 DEC; DS~LIT "~"; 14429000
END; 14429100
$ SET OMIT = PACKETS 14429150
$ SET OMIT = NOT RJE OR OMIT 14430190
SPOUTER(T,0,(EOJMESS AND NOT(JAR9.[2:1]))); 14430400
END; 14430600
SIGNOFF(VECTOR,FILEBLOCK,0); 14430800
FORGETSPACE(VECTOR); 14431000
$ POP OMIT OMIT 14431010
$ SET OMIT = NOT(AUXMEM) 14431299
$ SET OMIT = NOT(WORKSET) 14431400
STOPLOOP: 14431410
IF WKSETSTOPJOBS NEQ 0 THEN % JOB WAS AUTO-STOPPED 14431420
IF NOT(JAR9.SYSJOBF) THEN % NOT EOJ FOR "SYSTEM" JOB 14431425
BEGIN 14431430
STNEXT:=IF STNEXT=0 THEN STQUEMAX ELSE STNEXT-1; %138-14431440
STOPMIX:=STQUE[STNEXT]; %138-14431450
STQUE[STNEXT]:=0; %138-14431460
STFIRST := (STFIRST+1).[44:4]; % POINT TO NEXT CELL 14431470
IF (STOPMIX GTR 0) AND (STOPMIX LEQ MIXMAX) THEN 14431480
IF JARROW[STOPMIX] NEQ 0 THEN 14431490
BEGIN 14431500
IF STOPSET(STOPMIX) THEN % NOT YET STOPPED 14431502
BEGIN 14431504
PRTROW[STOPMIX,X].[PSF]:=0; 14431506
WKSETSTOPJOBS:=WKSETSTOPJOBS AND 14431508
NOT (TWO(STOPMIX)); 14431510
JAR[STOPMIX,9].[3:1]:=0; 14431512
GO STOPLOOP; 14431514
END ELSE 14431516
BEGIN REPLY[STOPMIX]:=VOK; % WAKE IT UP 14431518
STREAM(J:=JARROW[STOPMIX],STOPMIX, 14431520
D:=Q:=SPACE(10)); 14431530
BEGIN 14431540
SI:=J; DS:=9LIT" AUTO-OK "; 14431550
2(SI:=SI+1; DS:=7CHR; DS:=LIT"/"); 14431560
DI:=DI-1; DS:=LIT"="; SI:=LOC STOPMIX; 14431570
DS:=2DEC; DS:=LIT"~"; DI:=DI-3; DS:=FILL; 14431580
END STREAM STATEMENT; 14431590
SPOUTER(Q,PSEUDOMIX[STOPMIX],1); %525-14431600
END; 14431602
END % IF AWAKENING A JOB 14431610
ELSE GO TO STOPLOOP 14431620
ELSE GO TO STOPLOOP; 14431630
END; % IF JOBS WHERE AUTO-STOPPED 14431640
WKSETSWITCHTIME := CLOCK + P(RTR); 14431650
$ POP OMIT % WORKSET 14431660
$ SET OMIT = NOT(WORKSET) 14431970
WKSETNOSELECT~(WKSETNOSELECT AND (WKSETSTOPJOBS ! 0)); 14431975
IF WKSETSTOPJOBS=0 THEN 14431980
$ POP OMIT % WORKSET 14431990
SELECTION;% 14432000
KILL([MSCW]); 14433000
END L5COM;% 14434000
PROCEDURE ZIPPER(W1,W2,USERSTA);VALUE W1,W2,USERSTA; 14531000
REAL W1,W2,USERSTA; 14531100
BEGIN REAL T,I; 14532000
T ~ GETSPACE(12,CONTROLCARDAREAV,0)+4;% %167-14533000
M[T-4].[9:6]~0;% 14534000
IF (I~USERCODE[P1MIX])=ABS(NOT 0) THEN I~ 0; 14534500
STREAM(K~@14,A~[W1],C~I,B~T); 14535000
BEGIN 14536000
SI~LOC K; SI~SI+7; DS~ CHR; 14537000
DS:= 5 LIT "USER="; SI:=LOC C; SI:=SI+1; DS:= 7 CHR; 14537100
DS~ 9 LIT ";EXECUTE "; SI~A; SI~SI+1; 14537200
DS~ 7 CHR; DS~ LIT "/"; SI~SI+1); DS~ 7 CHR; 14538000
DS~ 6 LIT ";END.~"; 37(DS~ LIT " "); 14539000
END; 14540000
IF USERSTA!0 THEN 14540100
BEGIN 14540200
I:=30; 14540300
IF USERSTA.[19:1] THEN ELSE T:=T&USERSTA[9:15:9]; 14540350
END 14540400
ELSE 14540500
I~IF P1MIX=0 OR USERCODE[P1MIX]=MCP THEN 31 ELSE 26; 14541000
$ SET OMIT = PACKETS 14541049
$ SET OMIT = NOT(PACKETS) 14541089
IF PSEUDOMIX[P1MIX] NEQ 0 THEN NYLONZIPPER[P1MIX].[2:1]:=0; 14541090
INDEPENDENTRUNNER(P(.CONTROLCARD),T&I[2:42:6] 14541100
&P1MIX[18:42:6]&PSEUDOMIX[P1MIX][24:39:9],192); 14541110
IF PSEUDOMIX[P1MIX] NEQ 0 THEN 14541120
SLEEP([NYLONZIPPER[P1MIX]],@1000000000000000); 14541130
$ POP OMIT 14541131
END ZIPPER;% 14542000
REAL PROCEDURE EUF(A,B,L); VALUE A,B,L; REAL A,B,L; 14543000
BEGIN% 14544000
REAL I,J,R,T,Z;% 14545000
REAL H; 14545100
ARRAY X[*];% 14546000
INTEGER S; 14546100
$ SET OMIT = SHAREDISK 14546199
DEFINE R1=R#, X1=X#; 14546200
$ POP OMIT 14546201
$ SET OMIT = NOT SHAREDISK 14546299
LABEL LL,FOUND,WHY,BYE; 14547000
LABEL CHECK,DOWN,BOMBOUT,DSD; 14548000
% 14548900
REAL SUBROUTINE THERE;% 14549000
% 14549100
% ON EXIT, X IS THE LAST BYPASS BLOCK READ AND J IS ITS ADDRESS. 14549110
% IF THERE IS TRUE, I IS THE INDEX OF THE ENTRY FOR THE FILE AND,14549120
% FOR SECURITYCHECK, H IS THE NEGATIVE OF ITS HEADER ADDRESS. 14549125
% IF THERE IS FALSE, T IS THE ADDRESS OF THE FIRST BLOCK WHICH 14549130
% HAS A VACANT SLOT. 14549140
% 14549150
BEGIN% 14550000
T:=0; 14550500
LL: FOR I:=0 STEP 3 UNTIL 57 DO 14551000
BEGIN IF (X[I] EQV A) = NOT 0 THEN 14551500
IF (X[I+1] EQV B) = NOT 0 THEN 14552000
BEGIN P(1); 14552500
H:=NABS(X[I+2]); 14552750
GO DOWN; 14553000
END; 14553500
IF (X[I] EQV @14) = NOT 0 THEN 14554000
IF T=0 THEN T:=J; 14554500
END; 14555000
IF (Z:=X[2].[FF])!0 THEN 14555500
BEGIN DISKWAIT(-R,60,J:=Z); 14556000
GO TO LL; 14556500
END; 14557000
IF T=0 THEN T:=J; 14557500
P(0); 14558000
DOWN: THERE:=P; 14558500
END;% 14559000
$ SET OMIT = NOT(SHAREDISK) 14559099
A:=ABS(A); 14559200
X:=[M[R:=SPACE(60)]]&60[8:38:10]; 14559250
IF (A OR B).[1:5]!0 OR A=@14 OR A=@114 THEN 14559300
BEGIN 14559400
TERMINATE(P1MIX&75[18:33:15]); GO DSD; 14559500
END; 14559600
$ SET OMIT = SHAREDISK 14559990
LOCKDIRECTORY; 14560000
$ POP OMIT 14560010
S:=SCRAMBLE(A,B); 14562000
CHECK: DISKWAIT(-R,-60,(J:=S)); 14563000
IF P1MIX !0 THEN 14564000
IF THERE THEN% 14567000
BEGIN 14568000
$ SET OMIT = NOT SHAREDISK 14568890
UNLOCKDIRECTORY; 14569000
$ POP OMIT OMIT 14569010
H~SECURITYCHECK(A,B,USERCODE[P1MIX],H)!7; 14569200
Z:=VWY&VOK[36:42:6]&(IF H THEN 0 ELSE VRM)[30:42:6]; 14569500
WHY: STREAM(A:=[A], B:=JAR[P1MIX], C:=P1MIX, UC:=H, 14570000
D:=J:=SPACE(10)); 14570100
BEGIN% 14571000
DS~13LIT"#DUP LIBRARY ";% 14572000
UC(DS~15LIT"(ILLEGAL USER) "); 14572100
SI~A ;SI~SI+1;DS~7CHR;% 14573000
DS~LIT"/" ;SI~SI+1;DS~7CHR;% 14574000
DS~LIT":";% 14575000
SI~B ;SI~SI+1;DS~7CHR;% 14576000
DS~LIT" " ;SI~SI+1;DS~7CHR;% 14577000
DS:=LIT"="; SI:=LOC C; DS:=2 DEC; DS:=LIT"~": 14578000
DI~DI-3; DS~FILL; 14578500
END;% 14579000
SPOUT(J); 14580000
REPLY[P1MIX]:=-Z; 14581000
IF AUTODS THEN %747-14581500
IF H=1 THEN TERMINATE(P1MIX&61[CTF]) ELSE REPLY[P1MIX]~VRM%747-14581700
ELSE %757-14581800
COMPLEXSLEEP(TERMSET(P1MIX) OR (REPLY[P1MIX] GTR 0)); 14582000
IF TERMSET(P1MIX) THEN 14583000
DSD: BEGIN FOR I:=M[L+10]+10 STEP -1 UNTIL 11 DO 14583100
IF M[L+I]!0 THEN FORGETUSERDISK(M[L+I],-M[L+9]); 14583200
GO TO BOMBOUT; 14583300
END; 14583400
IF NOT WHYSLEEP(Z) THEN GO TO WHY; 14584000
IF REPLY[P1MIX].[18:30]=VRM THEN 14585000
$ SET OMIT = NOT(DATACOM ) 14585050
BEGIN 14585200
IF P(DIRECTORYSEARCH(-A,B,7),DUP)=2 14585300
THEN BEGIN P(DEL); % ALWAYS TO SPO %589-14585350
LBMESS( A, B, -7, 25, 0, 0, 1 ); END %589-14585360
ELSE IF P=3 THEN GO DSD; 14585400
$ SET OMIT = NOT DATACOM 14585490
END; 14587200
REPLY[P1MIX]:=0; 14588000
$ SET OMIT = SHAREDISK 14588090
LOCKDIRECTORY; 14588100
$ POP OMIT 14588110
GO TO CHECK;% 14589000
END ELSE ELSE T:=S; % SETS UP FOR P1MIX=0 14590000
% 14590900
% THE FILE IS NOT THERE. WE SEARCH FOR A VACANCY. IF ONE IS FOUND14590910
% Z AND T ARE ITS ADDRESS. IF THERE ISNT ONE, Z IS THE ADDRESS OF14590920
% THE LAST BLOCK AND T IS SET TO THE ADDRESS OF THE NEW BLOCK. 14590930
% 14590940
$ SET OMIT = NOT SHAREDISK 14590990
DO BEGIN 14591500
IF (Z:=T)!J THEN DISKWAIT(-R,60,Z); 14592000
FOR I~0 STEP 3 UNTIL 57 DO 14593000
IF (X[I] EQV @14)= NOT 0 THEN GO TO FOUND; 14594000
END UNTIL (T:=X[2].[FF])=0; 14595000
X[2].[FF]~ BYPASS ~ BYPASS-2; 14596000
IF BYPASS.[CF] LEQ BYPASS.[FF] THEN GO TO BYE; 14598000
$ SET OMIT = SHAREDISK 14598090
DISKWAIT(R,60,Z); % WRITE OUT POINTER TO NEW BLOCK 14598100
$ POP OMIT 14598110
T:=BYPASS.[CF]; 14598200
X1[0]:=@14; MOVE(59,X1,X1 INX 1); 14598300
$ SET OMIT = NOT SHAREDISK 14598390
T:=0; 14598500
FOUND:% 14599000
PBCOUNT~PBCOUNT+((((A EQV"PBD ")=NOT 0) OR 14599900
((A EQV"PUD ")=NOT 0)) AND (B.[CF]=1)); 14599910
X[I]~A; X[I+1]~B; X[I+2].[CF]~NEXTSLOT; 14600000
$ SET OMIT = NOT SHAREDISK 14600290
DISKWAIT(R1,60,T); 14600500
% 14600900
% UPDATE THE NAME SEGMENT, BUT DONT WRITE IT OUT UNTIL THE NEW 14600910
% HEADER IS WRITTEN. 14600920
% 14600930
J~(NEXTSLOT-DIRECTORYTOP-3)&0[44:44:4]+DIRECTORYTOP+19; 14601000
I:=((T:=NEXTSLOT)-J)|2+30; 14601500
DISKWAIT(-R1,-30,J); 14602000
NEXTSLOT:=X1[I+1]; 14602500
X1[I]:=A; X1[I+1]:=B; 14603000
IF NEXTSLOT=0 THEN % GOING TO USE EOF RECORD 14603100
IF I=0 THEN % WRITE NEW EOF RECORD BEFORE 14603110
BEGIN P(X1[28],X1[29]); % DESTROYING CURRENT ONE 14603200
X1[28]:=@114; 14603300
X1[29]:=0; 14603310
NEXTSLOT:=T+30; 14603320
BYPASS.[FF] ~ J+16; 14603330
DISKWAIT(R1,30,J+16); 14603400
P([X1[29]],~,[X1[28]],~); % RESTORE CLOBBERED NAME 14603600
IF J~16 GEQ BYPASS.[CF] THEN 14603700
BYE: BYBY("DIRECTORY FULL~",15); 14603750
END ELSE 14603800
BEGIN X1[I-2]:=@114; X1[I-2]:=0; NEXTSLOT:=T-1 END; 14604000
% 14604900
% NOW WE CAN WRITE EVERYTHING OUT, NOTE THAT IN ORDER TO MINIMIZE14604910
% THE DAMAGE CAUSED BY AN UNTIMELY HANG, THE MAIN AND (FOR 14604920
% SHAREDISK) THE BYPASS DIRECTORIES ARE CORRECT AT ALL TIMES. 14604930
% 14604940
$ SET OMIT = NOT SHAREDISK 14605490
DISKWAIT(L+1,-30,T); % FILE HEADER 14607000
$ SET OMIT = NOT SHAREDISK 14608490
DISKWAIT(R1,-30,J); % NAME SEGMENT 14609000
$ SET OMIT = NOT SHAREDISK 14609990
$ SET OMIT = SHAREDISK 14617990
UNLOCKDIRECTORY; 14618000
$ POP OMIT 14618010
EUF:=T; 14619000
BOMBOUT:% 14620000
FORGETSPACE(R); 14621000
END ENTERUSERFILE ;% 14622000
PROCEDURE COM11; COMMENT ALGOL I/O COMMUNICATE;% 14623000
BEGIN %740-14624000
REAL CODE=-4, TANK=-5, ROW=-6, FID=-7, MID=-8, %740-14624100
STA=-6, RESULT=-7, TIMEOUT=-7 ; %740-14624200
NAME PHYL=-5; % %740-14624300
ARRAY HEADER=-5[*], FINAL=-6[*]; % %740-14624400
REAL B, T, F, S; % %740-14624450
NAME A; % % SAME STACK LOCATIONS AS BEFORE %740-14624500
REAL INFO, LOC, USASI, I; % %740-14624550
ARRAY FPB[*], FIB[*] ; % %740-14624600
$ SET OMIT = NOT DATACOM%740-14624990
LABEL PARITY, EOF, EOT, RDATA, SELERR, MESSAGE,%740-14627200
DISKSPACE,OPEN, CLOSE, HEADC, GIN, NG, %740-14627300
SLEAP, GRABIT, READSOUGHT, READSOUGHT2, %740-14627400
BACK, SEEKDC, DCWRITER, WHILOOP, COBOLDCWR,FINDBUF,%740-14628000
PURGELOCK,SPACE, REFILL, HEADLABEL,IOREQ, DCBUFRLS, 14628100
ROTATE, ABN; % %740-14629000
%740-14630000
SWITCH FUNCTION ~ OPEN, PARITY, EOF, EOT, DISKSPACE, 14631000
SEEKDC, CLOSE, RDATA, SELERR, SPACE, %740-14632000
REFILL, READLABEL,IOREQ, ROTATE, READC, %740-14632100
READSOUGHT,DCBUFRLS,DCWRITER, FINDBUF, COBOLDCWR, 14632200
PURGELOCK ; % %740-14632900
%740-14633000
GO TO FUNCTION [CODE] ; % %740-14634000
%740-14635000
PARITY: INFO~"PARITY "; B~"ERROR~ "; % %740-14636000
GO TO MESSAGE; % %740-14636100
EOF: INFO~"END FO "; B~"FILE~ "; % %740-14637000
GO TO MESSAGE; % %740-14639000
EOT: INFO~"FILE TO"; B~"O SMALL"; I~"~ "; % %740-14640000
GO TO MESSAGE; %740-14641000
:: % AT PURGELOCK, GO TO RDATA SHOULD BE TO MESSAGE ON WORD BOUNDY14641999
RDATA: INFO~"DATA ER"; B~"ROR, FM"; T~"T=R,~ "; % %740-14642000
GO TO MESSAGE; % %740-14642100
SELERR: INFO~"INVALID"; B~" OPERAT"; T~"ION ON~"; % %740-14643000
% %740-14643100
MESSAGE: FPB~PRT[P1MIX,3]; FIB~M[P(.TANK,LOD).[33:15]-3]; %740-14644000
IF FIB[5].[1:1] THEN INFO ~ -" INV" OR M; % %740-14644400
STREAM ( X ~ INFO, B, T, % THESE 3 MUST BE THIS ORDER 14645000
Z ~ 0, Q ~ TANK!0, % %740-14645400
F ~ IF TANK=0 THEN 0 ELSE [FPB[FIB[4].[13:11]]], 14645600
D ~( CODE ~ GETSPACE(12,2,0) +2) ); % %740-14645800
BEGIN DS ~ LIT "-"; SI ~ LOC X; % %740-14646000
IF SC = 0 THEN % MESSAGES WITH NEW WORDING %740-14646200
BEGIN 3( SI~SI+1; % CHARS IN INFO, B & T IN STACK 14646400
7( IF SC!"~" THEN DS~CHR ELSE JUMP OUT 2 TO L) ); 14646600
L: DS~LIT " "; % %740-14646800
END ELSE % UNCHANGED MESSAGES %740-14647000
BEGIN SI~SI+5; DS~3 CHR; SI~LOC X; %740-14647200
IF SC!"8" THEN DS ~ 11 LIT % %740-14647400
"WRITE TU 0 " % %740-14647600
ELSE IF SC=@30 THEN DS ~ 10 LIT % "INV" %740-14648000
"ALID USER " % %740-14648200
ELSE IF SC=@20 THEN DS ~ 10 LIT % %740-14648400
" WRT/SEEK " % %740-14648600
END; % NEXT, OPTIONALLY ADD <FILE SPECIFIER> %740-14649000
Q( SI~F; X~DI; DI~LOC Z; % %740-14650000
IF 8 SC!DC THEN % MFID ! "0000000" %740-14650200
BEGIN SI~F; SI~SI+1; DI~X; % %740-14650400
DS~7 CHR; DS~LIT "/"; X~DI; % %740-14650600
END; % %740-14650800
DI~X; SI~SI+1; DS~7 CHR ); % %740-14651000
DS ~ 2 LIT ":~"; % %740-14654000
END OF STREAM; % %740-14655000
TERMINATE(P1MIX); TERMINALMESSAGE((-CODE));% 14658000
DISKSPACE:OPEN:CLOSE: GO TO INITIATE;% 14659000
$ SET OMIT = DATACOM 14660499
SEEKDC:READC:READSOURGHT:DCBUFRLS:DCWRITER:FINDBUF:COBOLDCWR: 14660500
GO INITIATE; 14660525
$ POP OMIT 14660526
$ SET OMIT = NOT(DATACOM) 14660999
GO INITIATE; :: 14670600
PURGELOCK: SAVEWORD ~ SAVEWORD OR TWO(ROW); % RDATA USED TO FOLLOW 14671000
GO TO RDATA; :: % SPACE NEEDS TO BE ON WORD BOUNDARY %740-14673000
SPACE: FIB~M[P(.TANK,LOD).[33:15]-3]; LOC~FIB[15].[25:5];% 14675000
BLASTQ(LOC);% 14676000
FPB~[MEMORY[5]]&3[23:46:2]&ROW[22:1:1];% 14677000
ROW~ABS(ROW);% 14678000
WHILE (ROW~ROW-1)}0 DO INFO~WAITIO(FPB,@40,LOC);% 14679000
GO TO INITIATE; :: 14680000
REFILL: FIB~M[(TANK~P(.TANK,LOD).[33:15])-3];% 14681000
CODE~FIB[13].[10:9]-1;% 14682000
LOC~FIB[19].[33:15]-FIB[16].[33:15];% 14683000
FPB~MEMORY[FIB[16] INX 0+ROW];% 14684000
INFO~FPB.[18:15];% 14685000
FOR I~1 STEP 1 UNTIL CODE DO% 14686000
BEGIN IOREQUEST(FLAG(FIB[19]&(INFO+LOC)[33:33:15]),% 14687000
FIB[16]&INFO[33:33:15],FPB);% 14688000
MEMORY[TANK]~MEMORY[TANK]&0[2:2:1]&0[19:19:1]% 14689000
&0[26:26:7]&INFO[33:33:15];% 14690000
STREAM(CODE,T~MEMORY[TANK],TANK);% 14691000
BEGIN SI~TANK; SI~SI+8; DS~CODE WDS;% 14692000
SI~LOC T; DS~WDS;% 14693000
END;% 14694000
INFO~MEMORY[INFO+ROW].[18:15];% 14695000
END;% 14696000
GO TO INITIATE; :: 14697000
READLABEL: FIB~M[(TANK~P(.TANK,LOD).[33:15])-3];% 14698000
LOC~FIB[15].[25:5];% 14699000
BLASTQ(LOC);% 14700000
P(WAITIO((FIB[5].[44:1]|(M[TANK-2].[8:10]-1) INX M[TANK-2]) 14701000
&M[TANK][21:21:4],@37700000,LOC),DEL); 14702000
STREAM(Y:=0:X:=0;X1:=0,X2:=0,Z:=M[TANK-2]); 14702025
BEGIN DI:=LOC X; DS:=24 LIT "VOL1HDR1HDR2EOF1EOF2EOV1"; 14702050
DI:=LOC X; 14702100
6(TALLY:=TALLY+1; 14702150
SI:=Z; 14702200
IF 4 SC=DC THEN 14702250
JUMP OUT TO A); 14702300
TALLY:=0; 14702350
A: 14702400
Y:=TALLY; 14702450
END; 14702500
IF (USASI:=P)>0 THEN 14702550
USASITAPE(M[TANK-2].[CF],USASI,3,LOC,FIB[5].[44:1]); 14702600
P(WAITIO([M[5]]&3[23:46:2]&(NOT FIB[5])[22:44:1], 14703000
@37700000,LOC),DEL); 14703100
GO TO INITIATE; :: 14704000
IOREQ: FPB~MEMORY[(IF (INFO~NFLAG(MEMORY[P(TANK,DUP,[M],INX,PRL)]))14705000
.[22:1] THEN 2 ELSE NOT 1) INX INFO];% 14706000
IOREQUEST(FINAL,INFO,FPB);% 14707000
MEMORY[TANK]~MEMORY[TANK]&0[26:26:7]&0[19:47:1];% 14708000
GO TO INITIATE;% 14709000
$ SET OMIT = NOT(DATACOM ) 14709099
:: 14709300
ROTATE: TANK~P(.TANK,LOD).[33:15];% 14710000
STREAM(T~M[TANK],N~ROW-1,D~TANK);% 14711000
BEGIN SI~D; SI~SI+8; DS~N WDS; SI~LOC T; DS~WDS END;% 14712000
IF M[TANK].[3:5]=16 THEN 14712100
IF M[TANK].[24:1] THEN 14712200
IF (I~P(M[TANK-3],14,COC))!0 THEN 14712300
BEGIN 14712350
PHYL ~ TANK INX M; 14712400
FOR LOC ~ ROW-1 STEP -1 UNTIL 0 DO 14712450
BEGIN 14712500
INFO ~ NFLAG(PHYL[LOC]); %[19:2]=0 THEN I/O IN-PROCESS 14712510
IF (B~M[INFO INX NOT(2+(INFO.[19:2]=0))])!0 THEN 14712550
BEGIN 14712600
$ SET OMIT = NOT(DATACOM ) 14712649
IF (I~I-1) { 0 THEN 14712750
LOC ~ -1; 14712800
END; 14712850
END; 14712900
END; 14712950
GO TO INITIATE;% 14713000
END COM11;% 14714000
$ SET OMIT = NOT(DATACOM ) 14715000
PROCEDURE DISPLAY(X); VALUE X; REAL X;% 14719000
BEGIN REAL T; 14720000
STREAM(X:J~JARROW[P1MIX],P1MIX,% 14721000
Y ~T~SPACE(25));% 14722000
BEGIN DS ~ LIT "#";% 14723000
2(DS ~ J; SI ~ SI+1; DS ~ 7 CHR; J ~ SI;% 14724000
L: SI ~ SI-1;% 14725000
IF SC = " " THEN% 14726000
BEGIN DI ~ DI-1; GO TO L END;% 14727000
DS ~ LIT "/";);% 14728000
DI ~ DI-1; DS ~ LIT "=";% 14729000
SI~LOC P1MIX; DS~2DEC; P1MIX~DI; DI~DI-2; 14730000
DS~FILL; DI~P1MIX; DS~2LIT": "; 14730500
SI ~ X;% 14731000
H: 4(40(IF SC="~" THEN JUMP OUT 2 TO HH; 14732000
DS~CHR)); HH: 14733000
J ~ DI; DI ~ DI+8; SI~J;% 14734000
S: SI ~ SI-1; IF SC = " " THEN GO TO S;% 14735000
SI ~ SI+1; J ~ SI; DI ~ J; DS ~ LIT "~";% 14736000
X~ DI; 14737000
END; 14738000
X~ (((X~P) INX 0) -T)|8+X.[30:31]-1; 14739000
SPOUT(P(X,T)); 14740000
END;% 14741000
PROCEDURE COM13 ;% 15060000
BEGIN% 15061000
% COBOL IO INTERFACE COMMUNICATE% 15062000
REAL CODE = -4, REEL = -6 ;% 15063000
NAME FLOC = -5 ;% 15064000
ARRAY FIB [*];% 15065000
REAL T, COB68; 15066000
LABEL L0,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,% 15067000
L15,L17;% 15068000
SWITCH TYPE ~ L0,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,% 15069000
L12,L13,L14,L15,L16,L17;% 15070000
DEFINE INOUT=FIB[13].[27:1]#,DIREC=FIB[13].[25:1]#,% 15071000
SORTFILE=FIB[14].[7:1]#,LABELSOMITTED=FIB[4].[2:1]#;% 15072000
COB68 ~ (FIB ~ *(FLOC)).[8:10] = 22; 15073000
GO TO TYPE[CODE];% 15074000
L0:% 15075000
DO UNTIL FALSE;% 15076000
L1:% 15077000
L2:% 15078000
L3:% 15079000
INOUT~CODE!3; DIREC~ CODE=2;% 15080000
IF NOT COB68 THEN 15080900
IF FIB[5].[46:2]=3 THEN BEGIN% 15081000
FIB[18].[18:15]~FIB[18].[3:15];% 15082000
IF CODE=3 THEN 15082100
FIB[18].[3:15]~FIB[18].[33:15]+FIB[18].[3:15]; END;% 15083000
NT1:=FLOC INX 3; 15084000
P(0,STF,PRT[P1MIX,8],STS); 15085000
FILEOPEN(1,NT1); 15086000
L16:% 15088000
L17:% 15089000
DO UNTIL FALSE;% 15090000
L5: L6:L7:L8:L9:L10:L11:L12:L13:L14:L15:% 15091000
DO UNTIL FALSE;% 15092000
L4:% 15093000
CODE ~ IF (CODE~ABS(REEL))=0 THEN 6 ELSE% 15094000
(IF CODE=1 THEN 7 ELSE% 15095000
(IF CODE=2 THEN 10 ELSE% 15096000
(IF CODE=4 THEN @22 ELSE %KRUNCH 15097000
(IF CODE=64 THEN @52 ELSE 0)))); %KRUNCH 15097500
IF (T~FIB[4].[8:4])!2 AND T!4 AND T!8 THEN CODE~0;% 15098000
IF T=4 AND CODE=0 THEN CODE~10 ;% 15099000
FILECLOSE(( FLOC INX 3 )& CODE[18:33:15]);% 15100000
IF CODE=0 OR CODE=10 OR CODE=@22 THEN FIB[5].[42:1]~1 15101000
ELSE FIB[5].[40:2]~(CODE=7)|2+1;% 15102000
IF NOT COB68 THEN 15102900
IF FIB[5].[46:2]=3 THEN BEGIN% 15103000
FIB[18].[3:15]~FIB[18].[18:15];FIB[18].[18:15]~0 END;% 15104000
GO TO INITIATE;% 15105000
END COM13;% 15106000
PROCEDURE REELCHANGER(U); 15110000
VALUE U; REAL U; 15110100
% 15110200
% THE PURPOSE OF THIS ROUTINE IS TO ALLOW REEL CHANGE FOR 15110300
% OUTPUT TAPE FILES BY OPERATOR REQUEST. THIS ROUTINE IS 15110400
% INITIATED FROM THE SPO WITH A KEYBOARD INPUT REQUEST OF 15110500
% "RC" FOLLOWED BY A THREE CHARACTER TAPE UNIT IDENTIFIER. 15110600
% 15110700
% IF THE WRITEPARITYREELSWITCH ROUTINE IS RUNNING 15110800
% CONCURRENTLY WHEN THE "RC" MESSAGE IS RECEIVED, 15110900
% THEN THIS ROUTINE WILL ABORT. OTHERWISE IT WILL 15111000
% CALL WRITEPARITYREELSWITCH IN ORDER TO AFFECT THE 15111100
% NECESSARY REEL CHANGE. 15111200
% 15111300
% THE PARAMETER IS USED AS FOLLOWS: 15111400
% U THE LOGICAL UNIT NUMBER OF THE TAPE UNIT TO SWITCH 15111500
% 15111600
BEGIN 15111700
REAL RCW=+0, MKSW=-2; 15111800
REAL MIX,TOPIOD,T2; 15111900
% 15112000
% THE LOCAL VARIABLES ARE USED AS FOLLOWS: 15112100
% REALS 15112200
% MIX MIX INDEX OF JOB USING TAPE UNIT U 15112300
% TOPIOD LOCATION OF TOP I/O DESCRIPTOR IN TANK 15112400
% T2 TEMPORARY 15112500
% 15112600
LABEL RESETJAR,ERROROUT,EXIT; 15112700
$ SET OMIT = NOT(PACKETS) 15112800
DEFINE UNITNO = PSEUDOMIX[MIX]#; 15112900
$ POP OMIT 15113000
MIX ~ RDCTABLE[U].[8:6]; 15113100
TOPIOD ~ PRNTABLE[U].[15:15]; 15113200
IF (MIX=0) OR (TOPIOD=0) OR TERMSET(MIX) THEN GO ERROROUT; 15113300
JAR[MIX,9] ~ (*P(DUP)) & 1[1:47:1]; 15113400
IF JAR[MIX,9].SYSJOBF = LIBMAINCODE THEN 15113500
BEGIN 15113700
STREAM(A~TINU[U], T~T2~SPACE(4)); 15113800
BEGIN 15113900
DS ~ 23 LIT"#REEL CHANGE MARKED ON "; 15114000
SI ~ LOC A; SI ~ SI+5; DS ~ 3 CHR; DS ~ LIT"~"; 15114100
END; 15114200
SPOUTER(T2,UNITNO,1); 15114300
GO EXIT; 15114400
END; 15114500
IF NOTERMSET(MIX) THEN PRTROW[MIX].[PSF] ~ 2; 15114600
COMPLEXSLEEP(NOT(STOPSET(MIX)) AND UNIT[U].[FF]=@77777); 15114700
% IF UNIT NOT ASSIGNED AT THIS POINT THEN 15114800
% WRITEPARITYREELSWITCH HAS ALREADY BEEN RUN. 15114900
IF RDCTABLE[U].[8:6]=0 OR TERMSET(MIX) THEN GO RESETJAR; 15115000
T2~NFLAG(M[TOPIOD])&TINU[U][3:3:5]; 15115100
P(WRITEPARITYREELSWITCH(T2,1),DEL); 15115200
RESETJAR: 15115300
IF NOTERMSET(MIX) THEN JAR[MIX,9] ~ (*P(DUP)) & 0[1:47:1]; 15115400
GO EXIT; 15115500
ERROROUT: 15115600
STREAM(T~T2~SPACE(3)); 15115700
DS ~ 21 LIT"#REEL CHANGE ABORTED~"; 15115800
SPOUTER(T2,UNITNO,1); 15115900
EXIT: 15116000
KILL([MKSW]); 15116100
END REELCHANGER; 15116200
BOOLEAN PROCEDURE CONQUER(C,N,L,S,G); 15168000
VALUE C,N,L,S,G; 15168100
REAL C,N,L; ARRAY S[*]; 15169000
INTEGER G; 15169100
BEGIN ARRAY B=C[*];% 15170000
REAL T,I=T;% 15171000
LABEL X;% 15172000
IF G THEN 15172500
IF N|L > 512 THEN GO TO X;% 15173000
IF (T ~ GETSPACE(N|L,2,3)) = 0 THEN% 15174000
BEGIN IF NOT G THEN P(0,RTN); 15175000
X: IF NOT N THEN 15175900
BEGIN G~CONQUER(C,N~N DIV 2,L,N INX S,1); 15176000
G~CONQUER(S INX N,N,L,X,1); 15177000
P(1,RTN); 15177800
P(XIT);% 15178000
END;% 15179000
T ~ GETSPACE(L,2,1);% 15180000
END;% 15181000
B ~ [M[T+2]]&L[8:38:10]&C[18:33:15];% 15182000
N ~ N-1;% 15183000
FOR I ~ 0 STEP 1 UNTIL N DO% 15184000
BEGIN S[I] ~ B;% 15185000
B ~ L INX B;% 15186000
END;% 15187000
CONQUER~1; 15187500
END;% 15188000
BOOLEAN PROCEDURE PRTGAMES(BUFF,MIX); VALUE BUFF,MIX; REAL BUFF,MIX; 15400000
COMMENT PRTGAMES IS THE BUSINESS END OF "IN" OR "OT" MESSAGES; 15401000
BEGIN REAL NX,INDEX,DATA; 15402000
$ SET OMIT = NOT(PACKETS) 15402499
DEFINE UNITNO = PSEUDOMIX[MIX]#; 15402500
$ POP OMIT 15402501
LABEL ECH, X;;; 15403000
STREAM(BUFF,G~MIX=63,F~BUFF<0,D~[DATA],I~[INDEX]);% %844-15404000
BEGIN SI~BUFF; 15405000
L: IF SC=" " THEN BEGIN SI~SI+1; GO L END; 15406000
G(IF SC!" " THEN IF SC!"~" THEN IF SC!"=" THEN %844-15406100
BEGIN TALLY~TALLY+1; SI~SI+1 END); %844-15406200
4(IF SC!" " THEN IF SC!"~" THEN IF SC!"=" THEN 15407000
BEGIN TALLY~TALLY+1; SI~SI+1; END); 15408000
I~TALLY; DI~DI+8; DI~DI-I; SI~SI-I; DS~I CHR; 15409000
F( 15410000
M: IF SC=" " THEN BEGIN SI~SI+1; GO M END; 15411000
IF SC!"=" THEN BEGIN E:DI~DI-1;DS~LIT""";JUMP OUT END; 15412000
SI~SI+1; 15413000
N: IF SC=" " THEN BEGIN SI~SI+1; GO N END; TALLY~0; 15414000
8(IF SC}"0" THEN BEGIN TALLY~TALLY+1; SI~SI+1 END 15415000
ELSE JUMP OUT); IF SC!" " THEN IF SC!"~" THEN GO E; 15416000
I~TALLY; DI~D; SI~SI-1; DS~I OCT); 15417000
END; IF M[X!63 THEN BEGIN % NOT ABSOLUTE CORE ADDRESS %844-15418000
IF (INDEX AND NOT @1070707)!0 THEN GO ECH; %844-15418500
IF JARROW[MIX]=0 THEN GO ECH; 15419000
IF (NX~INDEX.[45:3]&INDEX[42:39:3]&INDEX[39:33:3]&INDEX[38:29:115420000
]){20 THEN GO ECH; 15421000
IF (PRTROW[MIX] INX NX)>M[PRT[MIX,10].MOM-3].[CF] THEN GO ECH; 15422000
IF BUFF<0 THEN 15423000
IF P(PRT[MIX,NX],TOP,XCH,DEL) THEN PRT[MIX,NX]~DATA ELSE 15424000
GO ECH ELSE 15425000
BEGIN; STREAM(J~JARROW[MIX],MIX,INDEX,R~[PRT[MIX,NX]], 15426000
D~ DATA~ BUFF.[15:15]-1); 15427000
BEGIN SI~J; SI~SI+1; DS~LIT" ";% %WF 15428000
DS~7 CHR; DS~LIT"/"; SI~SI+1;% %WF 15428100
DS~7CHR; DS~LIT"="; SI~LOC MIX; DS~2DEC; 15429000
MIX~DI; DI~DI-2; DS~FILL; DI~MIX; 15429500
DS~3LIT":R+"; SI~SI+4; DS~4 CHR; D~DI; DI~DI-4; 15430000
DS~3 FILL; DI~D; DS~LIT"="; SI~R; 15431000
IF SB THEN % DESCRIPTOR:TYPE OCTAL 15432000
16(DS~3 RESET; 3(IF SB THEN DS~SET ELSE DS~ 15433000
RESET; SKIP SB)) ELSE 15434000
DS~8 DEC; 15435000
DS~LIT"~"; DI~D; DI~DI+1; DS~7 FILL; 15436000
END; 15437000
SPOUTER(DATA INX M[BUFF.[15:15]-2],UNITNO,1); 15437100
END; % %844-15438000
END ELSE BEGIN % ABSOLUTE CORE ADDRESS OUTPUT REQUIRED %844-15438010
IF (INDEX AND NOT @707070707)!0 THEN GO ECH ELSE %844-15438020
BEGIN % %844-15438030
NX~INDEX.[45:3]&INDEX[42:39:3]&INDEX[39:33:3] %844-15438040
&INDEX[36:27:3]&INDEX[33:21:3];% %844-15438050
STREAM(INDEX,R~NX,D~DATA~BUFF.[15:15]-1);% %844-15438060
BEGIN DS~15 LIT" CORE LOCATION "; SI~LOC INDEX;% %844-15438070
SI~SI+3; DS~5 CHR; D~DI; DI~DI-5; DS~4 FILL;% 15438080
DI~D; DS~LIT"="; SI~R;% %844-15438090
16(DS~3 RESET; 3(IF SB THEN DS~SET ELSE %844-15438105
DS~RESET; SKIP SB)); %844-15438120
DS~LIT"~"; DS~D; DI~DI+1; DS~15 FILL; %844-15438130
END;% %844-15438140
SPOUT(DATA INX M[BUFF.[15:15]-2]);% %844-15438150
END % %844-15438160
END; GO X; % %844-15438170
ECH: PRTGAMES~1; 15439000
X: END; 15440000
$ SET OMIT = NOT(DCLOG AND DATACOM ) 15440999
PROCEDURE WHATMCP(BUFF); REAL BUFF; % FORMATS WM MESSAGE 15500000
BEGIN REAL X; 15501000
DEFINE BUFFSIZE=36#; % INCREASE THIS WITH MORE OPTIONS 15501100
X:=(BUFF:=SPACE(BUFFSIZE+30))+BUFFSIZE; 15501200
DISKWAIT(-X,30,MCPNAMESEG); 15501300
STREAM(ML:=MARKLEVEL,PL:=PATCHLEVEL,LL:=LOCALLEVEL 15501500
,N:=X+20+2|SYSNO,A:=BUFF); 15501600
BEGIN DS~LIT" "; SI~N; SI~SI+1; DS~7 CHR; DS~LIT"/"; 15502000
SI~SI+1; DS~7 CHR; DS~6 LIT" MARK "; 15502100
SI:=LOC ML; IF SC GEQ " " THEN; 15502200
8(IF TOGGLE THEN IF SC="0" THEN SI:=SI+1 ELSE DS:=CHR 15502300
ELSE DS:=CHR); DS:=LIT"."; 15502400
SI:=LOC PL; IF SC GEQ " " THEN; 15502500
6(IF TOGGLE THEN IF SC="0" THEN SI:=SI+1 ELSE DS:=CHR 15502600
ELSE DS:=CHR); DS:=2CHR; 15502700
SI:=LOC LL; IF SC GEQ " " THEN; 15502800
8(IF TOGGLE THEN IF SC="0" THEN SI:=SI+1 ELSE DS:=CHR 15502900
ELSE DS:=CHR); 15503000
DS ~ 10 LIT " INCLUDES ";% 15504000
$ SET OMIT = NOT(AUTODUMP) 15504999
DS ~ 9 LIT "AUTODUMP,"; 15505000
$ POP OMIT 15505001
$ SET OMIT = NOT(AUXMEM) 15505499
$ SET OMIT = NOT(BREAKOUT) 15505999
$ SET OMIT = NOT(B6500LOAD) 15506499
$ SET OMIT = NOT(CHECKLINK OR DEBUGGING) 15506999
$ SET OMIT = NOT(DATACOM) 15507499
$ SET OMIT = NOT(DCLOG AND DATACOM) 15507999
$ SET OMIT = NOT(DCSPO AND DATACOM) 15508499
$ SET OMIT = NOT(DEBUGGING) 15508999
$ SET OMIT = NOT(DFX) 15509499
$ SET OMIT = NOT(DISKLOG) 15509999
$ SET OMIT = NOT(DKBNODFX) 15510499
$ SET OMIT = NOT(DUMP OR DEBUGGING) 15510999
DS ~ 5 LIT "DUMP,"; 15511000
$ POP OMIT 15511001
$ SET OMIT = NOT(MONITOR) 15511499
$ SET OMIT = NOT(NEWLOGGING) 15511999
$ SET OMIT = NOT(PACKETS) 15512499
DS ~ 8 LIT "PACKETS,"; 15512500
$ POP OMIT 15512501
$ SET OMIT = NOT(RJE AND DATACOM) 15512999
$ SET OMIT = NOT(SAVERESULTS) 15513499
$ SET OMIT = NOT(SEPTICTANK) 15513999
$ SET OMIT = NOT(SHAREDISK) 15514499
$ SET OMIT = NOT(STATISTICS) 15514999
$ SET OMIT = NOT(WORKSET) 15515499
DS ~ 8 LIT "WORKSET,"; 15515500
$ POP OMIT 15515501
$ SET OMIT = NOT(WORKSETMONITOR) 15515999
DS ~ 15 LIT "WORKSETMONITOR,"; 15516000
$ POP OMIT 15516001
DI ~ DI-1; 15523000
A~ DI; 15524000
SI~ A; DI~ A; 15525000
IF SC!"," THEN 15526000
DI~ DI- 9; 15527000
DS~ LIT "~" 15528000
END; 15529000
IF M[3].[1:1] THEN % CM HAS BEEN DONE 15530000
BEGIN DISKWAIT(-X,30,0); 15530100
STREAM(N~X+10+5|SYSNO,BUFF); 15530200
BEGIN SI~BUFF; SI~SI+16; 15530300
L: IF SC NEQ "~" THEN BEGIN SI~SI+1; GO L; END; 15530400
BUFF~SI; DI~BUFF; 15530500
DS~18 LIT"-NEXT MCP WILL BE "; 15530600
SI~N; SI~SI+1; DS~7 CHR; DS~LIT"/"; 15530700
SI~SI+1; DS~7 CHR; DS~LIT"~"; 15530800
END; END; 15530900
END WHATMCP; 15533000
PROCEDURE WHATINTRINSIC(BUFF); VALUE BUFF; REAL BUFF; 15534000
BEGIN 15535000
REAL SIZE,LOC,INTWORD,WI,I; 15536000
LABEL EXIT; 15537000
IF INTSIZE=0 THEN 15539000
BEGIN ; 15540000
STREAM(BUFF); DS~14 LIT "NO INTRINSICS~"; 15541000
GO EXIT; 15542000
END; 15543000
COMMENT MAKE WI INTRINSIC PRESENT; 15544000
SIZE := (INTWORD:=INTRNSC[INTRNSC[0]]) INX 0; 15545000
LOC := SPACE(SIZE); 15546000
$ SET OMIT = NOT(AUXMEM) 15547000
DISKWAIT(-LOC,SIZE,INTWORD.[6:27]); 15548000
DISKWAIT(-(I:=SPACE(30)),30,0); 15549000
STREAM(X:=I+13+5|SYSNO,LOK:=LOC,BUFF); 15550000
BEGIN 15551000
SI:=LOK; SI:=SI+8; 15552000
10(SI:=SI+1; 15552100
7(IF SC="~" THEN JUMP OUT 2 TO L1; 15552200
IF SC="@" THEN SI:=SI+1 ELSE DS:=CHR)); 15552300
L1: SI:=X;DS:=3LIT" ("; 15552400
SI:=SI+1; DS:=7 CHR;DS:=LIT"/"; 15552500
SI:=SI+1; DS:=7 CHR;DS:=2LIT")~"; 15552600
END STREAM; 15552700
FORGETSPACE(LOC); FORGETSPACE(I); 15552800
EXIT: 15554000
END WHATINTRNSIC; 15555000
PROCEDURE COREPRINT(Q); VALUE Q; REAL Q; 15600000
COMMENT : THIS PROCEDURE COMPUTES AND TYPES THE AMOUNTS OF SAVE 15600050
AND OVERLAYABLE CORE IN USE FOR A GIVEN MIX OR ALL MIXES; 15600100
COMMENT : Q.[1:1] = 1 IF ALL MIXES DESIRED 15600120
Q.[CF] = MIX, Q.[9:9] = REMOTE TU/BU; 15600140
BEGIN REAL LINK,SIZE,D;% 15600300
ARRAY C[*]; 15600400
INTEGER A,N; 15600500
LABEL NXT; 15600600
C ~ [M[SPACE(MIXMAX+1)]] & (MIXMAX+1) [8:38:10]; 15600800
FOR A ~ 0 STEP 1 UNTIL MIXMAX DO C[A] ~ 0;% 15600950
C[0].[FF] ~ A ~ MSTART;% 15601000
WHILE A!0 DO % STEP THROUGH MEMORY LINKS 15601150
BEGIN IF (LINK ~ M[A]).[1:1] THEN GO TO NXT; 15601200
SIZE ~ LINK.[CF] - A; 15601400
IF LINK.[2:1] THEN SIZE ~ 0 & SIZE [CTF];% SAVE 15601500
C[LINK.[9:6]] ~ (*P*DUP)) + SIZE;% 15601600
NXT: A ~ LINK.[CF];% 15602200
END;% 15602300
A ~ -1; WHILE (A~A+1) { MIXMAX DO% 15602400
BEGIN IF Q.[1:1] OR Q.[CF] = A THEN IF C[A] ! 0 THEN 15602500
BEGIN; STREAM(N~N~C[A].[FF],D~[SIZE]);% 15602600
BEGIN SI ~ LOC N; DS ~ 8 DEC; END;% 15602620
STREAM(N~N~C[A].[CF],D~[LINK]);% 15602640
BEGIN SI ~ LOC N; DS ~ 8 DEC; END;% 15602660
JOBMESS(A,Q,":SAVE=",SIZE," OLAY=",LINK);% 15602680
END;% 15602690
END;% 15602700
IF Q.[1:1] THEN% DO TOTAL 15603900
BEGIN P(C[0]); 15604000
FOR A~1 STEP 1 UNTIL MIXMAX DO P(C[A],ADD);% 15604100
N ~ P; N ~ N.[FF] + N.[CF];% 15604200
STREAM(N,D~D~SPACE(4));% 15604250
BEGIN SI ~ LOC N; DS ~ 18 LIT "TOTAL MEM IN USE= "; 15604275
DS ~ 5 DEC; DS ~ LIT "~"; 15604300
DI ~ DI = 6; DS ~ 4 FILL;% 15604400
END STREAM; 15604500
SPOUT(D & Q[9:9:9]);% 15604600
END; 15604700
FORGETSPACE(C INX 0); 15604800
END COREPRINT; 15604900
$ SET OMIT = NOT(AUXMEM) 15604999
PROCEDURE LOGCOMMENT (Q); VALUE Q; REAL Q; 15610000
BEGIN 15611000
REAL I,J,K,L; 15612000
ARRAY LOG[*]; 15613000
L ~ SPACE(72); 15614000
STREAM (Q:D~L+5); 15615000
BEGIN SI ~ Q; 15616000
L: IF SC!"~" THEN BEGIN DS ~ CHR; GO TO L; END; 15617000
5(DS ~ 8 LIT " "); DI ~ DI-32; Q ~ DI; 15618000
END; 15619000
I ~ P.[33:15]; LOG ~ [M[L]] & (I=L+4)[8:38:10]; 15620000
LOG[3] ~ I ~ I-L-5; % NUMBER OF WORDS IN COMMENT 15621000
WHILE (J:=XCLOCK+P(RTR)) GEQ WITCHINGHOUR DO MIDNIGHT; 15622000
LOG[2] ~ DATE.[18:30]; 15623000
LOG[1] ~ J; 15624000
LOG[0] ~ 99; 15625000
LOGSPACE([LOG[0]],I+9); 15626000
FORGETSPACE(LOG); 15627000
END; 15628000
REAL PROCEDURE KEYINSCAN(KTR,MIX); REAL KTR,MIX; 16034900
BEGIN 16035000
REAL TYPE=+1, TBLADDR; 16035100
% SCANS IN PUT BUFFER FROM SPO 16035200
% RETURNS ERROR FLAG IN MIX.[1:3] ... 16035300
% MIX.[1:1]=FLAG FOR EMPTY BUFFER (GROUP MARK ONLY) 16035400
% MIX.[2:1]=FLAG FOR NO INFO AFTER MIX INDEX 16035500
% MIX.[3:1]=FLAG FOR QMARK (CC) INPUT AS FIRST CHARACTER 16035600
% KTR IS INITIALLY THE ADDRESS OF SPO INPUT BUFFER 16035700
% KTR IS ASSIGNED NEXT CHARACTER LOCATION AFTER SCAN 16035800
% TYPE.[CF] IS ASSIGNED TABLE LOCATION (MIXMSG OR INFOMSG) 16035900
% TYPE.[1:5] IS ASSIGNED PROCEDURE NUMBER 16036000
% TYPE.[6:6] IS ASSIGNED MIXCODE 16036100
STREAM(MIX:=63, BUFF:=KTR :); % SCAN INPUT BUFFER 16036200
BEGIN 16036300
SI:=BUFF; 16036400
DI:=BUFF; DI:=DI-1; DS:=LIT"<"; % BACKSPACE CHARACTER 16036500
8(60(IF SC="~" THEN % END OF INPUT STRING 16036600
BEGIN 16036700
DS:=CHR; JUMP OUT 2 TO L; 16036800
END; 16036900
IF SC="<" THEN % BACK SPACE CHARACTER 16037000
BEGIN 16037100
DI:=DI-1; IF SC NEQ DC THEN DI:=DI-1; 16037200
END 16037300
ELSE DS:=CHR)); % END OF BACKSPACE CHECK 16037400
L: SI:=BUFF; DI:=LOC MIX; % CHECK FOR MIX INDEX 16037500
L1: IF SC=" " THEN 16037600
BEGIN 16037700
SI:=SI+1; GO TO L1; 16037800
END; 16037900
IF SC="~" THEN % EMPTY BUFFER 16038000
BEGIN 16038100
SKIP DB; DS:=SET; GO TO XXIT; % MIX.[1:1]=EMPTY BUFFER FLAG 16038200
END; 16038300
IF SC LSS "0" THEN GO TO XXIT; % NO MIX INDEX, SET "MIX"=63 16038400
IF SC GTR "9" THEN % QUESTION MARK, SET MIX.[3:1] 16038500
BEGIN 16038600
SI:=SI+1; SKIP 3DB; DS:=SET; GO TO XXIT; % MIX.[3:1]=QMARK FLAG16038700
END; 16038800
SI:=SI+1; IF SC LSS "0" THEN GO TO ONE; 16038900
IF SC LEQ "9" THEN 16039000
BEGIN 16039100
SI:=SI-1; DS:=2OCT; 16039200
END 16039300
ELSE 16039400
BEGIN 16039500
ONE: SI:=SI-1; DS:=OCT; 16039600
END; 16039700
L2: IF SC=" " THEN % SCAN TO NEXT VISIBLE CHARACTER 16039800
BEGIN 16039900
SI:=SI+1; GO TO L2; 16040000
END; 16040100
IF SC="~" THEN % NO INFORMATION AFTER MIX INDEX 16040200
BEGIN 16040300
DI:=LOC MIX; SKIP 2DB; DS:=SET; % MIX.[2:1]=ERROR FLAG 16040400
END; 16040500
XXIT: DI:=BUFF; DI:=DI-8; DS:=8LIT"INV KBD "; 16040600
BUFF:=SI; % SAVE LOCATION OF NEXT CHARACTER IN BUFFER 16040700
END STREAM; 16040800
IF P([KTR],STD,[MIX],SND).[1:3]=0 THEN % NOT QMARK,EMPTY OR ERROR 16040900
BEGIN 16041000
TBLADDR:=TYPE:=SPACE(KEYMSGSZ); 16041100
DISKWAIT(-TYPE,KEYMSGSZ,MESSAGETABLE[2].[22:26]); 16041110
STREAM(TBBL:=TYPE, BUFF:=KTR : TOG:=(MIX NEQ 63)); 16041200
BEGIN 16041300
SI:=TBBL; SI:=SI+1; DI:=BUFF; DI:=DI+2; 16041400
NEXT: CI:=CI+TOG; GO TO NOMIX; 16041500
MIX: IF SC GEQ 1 THEN GO TO OK ELSE % MIX SPECIFIED 16041550
BEGIN % BUT THIS IS NOT 16041600
SI:=SI+8; GO TO MIX; % A MIX MESSAGE. 16041650
END; 16041700
NOMIX: IF SC GTR 1 THEN % MIX NOT SPECIFIED 16041750
BEGIN % BUT THIS IS A 16041800
SI:=SI+8; GO TO NOMIX; % MIX MESSAGE. 16041850
END; 16041900
OK: SI:=SI+1; DI:=DI-2; 16042000
IF SC="~" THEN % END OF TABLE 16042100
BEGIN 16042200
TBBL:=TALLY; GO TO XT; 16042300
END; 16042400
IF 2 SC!DC THEN % NOT MATCHING ENTRY 16042450
BEGIN 16042500
SI:=SI+5; GO TO NEXT; 16042550
END; 16042600
TOG:=DI; DI:=LOC TBBL; SI:=SI+2; DS:=2 OCT; % SWITCH VALUE 16042650
SI:=SI-4; DI:=LOC TBBL; DS:=2CHR; % PROCED & MIXCODE 16042700
SI:=TOG; 16042800
L: IF SC=" " THEN 16042900
BEGIN 16043000
SI:=SI+1; GO TO L; 16043100
END; 16043200
BUFF:=SI; 16043300
XT: END STREAM STATEMENT; 16043400
P( [KTR],STD, .TYPE,STD); 16043500
FORGETSPACE(TBLADDR); 16043550
END % IF NOT QMARK, EMPTY OR ERROR 16043600
ELSE % QMARK, EMPTY OR ERROR 16043620
IF MIX.[3:1] THEN % QMARK 16043640
BEGIN MIX:=63; 16043660
TYPE:=VCC&@104[1:37:11]; 16043680
END 16043700
ELSE TYPE:=0; 16043750
END PROCEDURE KEYINSCAN; 16043800
PROCEDURE KEYIN0(B,KTRX); VALUE B,KTRX; REAL B,KTRX; 16044000
16045000
BEGIN 16046000
INTEGER ZZSTA; 16047000
REAL BUFF, KTR, TYPE, MIX, A, I, J, K; 16048000
REAL U = A; 16048100
ARRAY BUFA = BUFF[*]; 16049000
16050000
16051000
16052000
LABEL DSM, CUTY, FORGET, ERROR, EXIT 16053000
,AX ,IL ,QT ,OU ,WY ,RY ,DS ,TF ,RM ,DP 16054000
,DD ,ST ,CM ,SV ,CL ,BK ,TI ,PR ,RO ,IT 16055000
,WI ,RXIT ,RC 16056000
16057000
16058000
16059000
; 16060000
SWITCH S:= ERROR 16061000
,AX ,IL ,IL ,QT ,OU ,WY ,RY ,DS ,DS ,TF 16062000
,TF ,RM ,DP ,DD ,DD ,DD ,ST ,CM ,SV ,CL 16063000
,BK ,RXIT ,RY ,RXIT ,RXIT ,RI ,PR ,RO ,RO ,IT 16064000
,WI ,RXIT ,RC 16065000
16066000
16067000
16068000
; 16069000
SUBROUTINE SPOIT; M[BUFF-1]:=B AND @7570000000000; 16070000
16071000
BUFF :=KTRX.[15:15]; 16072000
MIX :=KTRX.[ 9:6 ]; 16073000
TYPE :=KTRX.[ 2:7 ]; 16074000
KTR :=KTRX.[15:33]; 16075000
ZZSTA :=0 & (M[BUFF-2])[9:9:9]; 16076000
GO TO S[TYPE]; 16077000
AX: 16078000
I := BUFF; 16079000
GO TO RXIT; 16080000
IL: 16081000
IF (I:=ANVIL(TYPE=2,KTR)) GTR PSEUDOMAXT THEN % IL=2, UL=3 16082000
IF I LSS 70 THEN GO TO ERROR; 16083000
TYPE := 2; % IL 16084000
IF I GTR PSEUDOMAXT THE BUFF:=1; 16085000
GO TO RXIT; 16086000
OU: 16087000
STREAM(A:="LP" : B:="MT", C:="DK", D:="CP", KTR); 16088000
BEGIN 16089000
SI := KTR; 16090000
DI := LOC A; DI := DI+6; 16091000
TALLY:=1; IF SC="~" THEN GO TO XT; 16092000
TALLY:=2; IF 2 SC=DC THEN GO TO XT; 16093000
TALLY:=3; SI:=SI-2; DI:=DI+14; IF 2 SC=DC THEN GO TO XT; 16094000
TALLY:=4; SI:=SI-2; DI:=DI+6; IF 2 SC=DC THEN GO TO XT; 16095000
TALLY:=5; SI:=SI-2; DI:=DI+6; IF 2 SC=DC THEN GO TO XT; 16096000
TALLY:=0; 16097000
XT: A := TALLY; 16098000
END; 16099000
IF(I:=P) = 0 THEN GO TO ERROR; 16100000
GO TO RXIT; 16101000
WY: 16102000
IF MIX LSS 63 THEN GO TO RXIT; % <MIX> WY 16103000
SPOIT; 16104000
A:=0; 16105000
FOR I:=1 STEP 1 UNTIL MIXMAX DO 16106000
IF *[JARROW[I]] NEQ 0 THEN 16107000
IF REPLY[I] LSS 0 THEN REPLY[A:=I]:=VWY; 16108000
IF A!0 THEN GO TO FORGET; 16109000
M[BUFF-1]:=FLAG(-"NULL "); 16109500
GO TO ERROR; 16110000
DS: 16111000
IF MIX=63 THEN % "DS A/B" 16112000
BEGIN 16113000
NAMEID(J,KTR); NAMEID(K,KTR); NAMEID(K,KTR); 16114000
FOR MIX:=1 STEP 1 UNTIL MIXMAX DO 16115000
IF *[JARROW[MIX]] NEQ 0 THEN 16116000
IF (J EQV ABS(JAR[MIX,0]))=(NOT 0) THEN 16117000
IF (K EQV ABS(JAR[MIX,1]))=NOT 0 THEN 16118000
BEGIN 16118100
TABCNT[MIX]:=TABCNT[MIX]+1; 16118200
GO TO DSM; 16118300
END; 16118400
GO TO ERROR; % NOT FOUND 16119000
END; % IF MIX NOT GIVEN 16120000
IF JARROW[MIX] NEQ 0 THEN 16121000
BEGIN 16122000
DSM: JAR[MIX,6].[1:1]:=((TYPE=9) OR (TYPE=20)); % DS=8,SD=9,CL=20 16123000
TERMINATE(MIX&(IF B.[9:9] GTR 0 THEN 61 ELSE 3)[CTF]); 16124000
HALT; 16125000
NOPROCESSTOG:= NOPROCESSTOG-1; 16126000
GO TO FORGET; 16127000
END; 16128000
GO TO ERROR; 16129000
TF: 16130000
IF TYPE=11 THEN SPOIT; % SF=11 16131000
CHANGEFACTOR(KTR,TYPE=10); % TF=10,SF=11 16132000
GO TO EXIT; 16133000
RM: 16134000
TYPE:=TYPE&B[9:9:9]; 16135000
GO TO RXIT; 16136000
DP: 16137000
$ SET OMIT = NOT(DEBUGGING OR DUMP) 16138000
STREAM(A:="LP", KTR : B:="MT"); 16139000
BEGIN 16140000
SI := KTR; 16141000
DI := LOC A; DI := DI + 6; TALLY:=1; 16142000
IF 2 SC=DC THEN GO TO XT; 16143000
DI := DI + 22; SI := SI - 2; TALLY:=2; 16144000
IF 2 SC=DC THEN GO TO XT; 16145000
TALLY:=0; 16146000
XT: A := TALLY; KTR := SI; 16147000
END STREAM STATEMENT; 16148000
IF (A:=P([KTR],STD))=0 THEN GO TO ERROR; 16149000
IF A=1 THEN 16150000
$ SET OMIT = DEBUGGING %763-16150099
GO TO ERROR; %763-16150100
$ POP OMIT %763-16150101
$ SET OMIT = NOT DEBUGGING %763-16150999
DUMPCORE(KTR&BUFF[15:33:15]); 16154000
$ POP OMIT 16154001
GO TO EXIT; 16155000
DD: 16156000
$ SET OMIT = NOT(DEBUGGING) 16157000
GO TO FORGET; 16161000
ST: 16162000
IF -REPLY[MIX] = (VWY&VOK[36:42:6]) OR JARROW[MIX]=0 THEN GO ERROR; 16163000
$ SET OMIT = NOT(WORKSET) 16163100
IF JAR[MIX,9].[3:1] THEN GO TO ERROR; % ALREADY ST-ED 16163200
$ POP OMIT % WORKSET 16163300
IF NOTERMSET(MIX) THEN PRTROW[MIX].[PSF]:=2; 16164000
GO TO FORGET; 16166000
CM: 16167000
CHANGEMCP(KTR); 16168000
GO TO EXIT; 16169000
SV: 16170000
SAVETHEUNIT(KTR); 16171000
GO FORGET; 16172000
QT: 16173000
IF MIX LSS 63 THEN % MIX INDEX SPECIFIED 16176000
CUTY: IF JAR[MIX,9].SYSJOBF = PRNPBTCODE THEN 16178000
BEGIN 16180000
REPLY[MIX]:=TYPE; 16181000
STREAM(A:=0, B:=0 : KTR); 16187000
BEGIN 16188000
SI:=KTR; 16189000
IF SC="+" THEN TALLY:=2 ELSE 16190000
IF SC="-" THEN TALLY:=3 ELSE GO XT; 16191000
B2: SI:=SI+1; IF SC=" " THEN GO TO B2; 16192000
B:=TALLY; TALLY:=0; 16193000
6(IF SC LSS "0" THEN JUMP OUT; SI:=SI+1; TALLY:=TALLY+1);16194000
KTR:=TALLY; DI:=LOC A; SI:=SI-KTR; DS:=KTR OCT; 16195000
XT: END STREAM STATEMENT; 16196000
NT2:=P; 16197000
NT1:=P; 16198000
PRT[MIX,@25]:=5&NT1[9:24:24]&NT2[1:46:2]; 16199000
GO TO FORGET; 16200000
END 16201000
ELSE GO TO ERROR; % NOT PRNPBT 16202000
CL: % MUST FOLLOW QT 16203000
IF (I:=UNITIN(TINU, KTR)) LSS 64 THEN % UNIT ] MTX 16204000
IF (MIX:=RDCTABLE[I].[8:6]) NEQ 0 THEN 16205000
BEGIN 16206000
TABCNT[MIX]:=TABCNT[MIX]+1; 16206100
IF TYPE=4 THEN GO TO QT ELSE GO TO DSM; 16206200
END; 16206300
$ SET OMIT = NOT(SHAREDISK) 16207000
IF TYPE=4 OR (I GTR 29) THEN GO TO ERROR; % QT OR PSEUDO UNIT 16215000
LABELTABLE[I] := P(DUP,LOC,SSP); % MARK IT NOT IN USE 16216000
MIX:=63; 16217000
GO TO RY; 16218000
BK: 16219000
$ SET OMIT = NOT(DATACOM AND DCSPO) 16220000
BEGIN 16223000
IF (I:= MESSAGEHOLDER.[CF]) NEQ 0 THEN 16224000
IF (J:= M[I].[FF]) NEQ 0 THEN 16225000
BEGIN 16226000
DO BEGIN 16227000
A:=M[J]; 16228000
IF (A.[4:5]=0 AND MIX=63) OR (A.[4:5]=MIX AND MIX NEQ 63) 16229000
$ SET OMIT = NOT(DATACOM AND DCSPO) 16230000
THEN 16232000
BEGIN 16233000
M[I]:= P(DUP,LOC)&A[18:18:15]; 16234000
NUMESS:= NUMESS-1; 16235000
FORGETSPACE(J+1); 16236000
END ELSE I:=J; 16237000
END UNTIL (J:= A.[FF])=0; 16238000
MESSAGEHOLDER.[FF]:= I; 16239000
END; 16240000
END; 16241000
MIX:=63; 16241500
GO TO FORGET; 16242000
RY: 16243000
IF (I:=FORMESS(KTR,TYPE=VFM)) LSS 0 THEN GO TO FORGET; 16244000
IF I GTR 31 THEN GO TO ERROR ELSE GO TO RXIT; 16245000
TI: 16246000
TIMEUSED(BUFF-1,MIX); 16247000
GO TO EXIT; 16248000
PR: 16249000
SPOIT; 16250000
CHANGEPRIORITY(KTR,MIX); 16251000
GO TO EXIT; 16252000
RO: 16253000
CHANGEOPTION(KTR,TYPE=28); % RO=28,SO=29 16254000
GO TO EXIT; 16255000
IT: 16256000
IF NOT JAR[MIX,9].[4:1] THEN GO ERROR; 16257000
JAR[MIX,9]~(*P(DUP)) & 1[5:47:1]; 16258000
GO FORGET; 16259000
WI: 16260000
WHATINTRINSIC(BUFF-1); 16261000
GO TO ERROR; 16262000
RC: 16263000
U ~ UNITIN(TINU,KTR); 16263100
IF U > 15 THEN GO ERROR; 16263200
IF (I~RDCTABLE[U].[8:6])=0 OR 16263300
PRNTABLE[U].[15:15]=0 OR NOT PRNTABLE[U].[1:1] THEN GO ERROR; 16263350
INDEPENDENTRUNNER(P(..REELCHANGER),U,204); 16263600
GO FORGET; 16263700
RXIT: 16343000
REPLY[MIX] := TYPE&I[18:33:15]; 16343100
IF I NEQ BUFF THEN 16343200
BEGIN 16343300
FORGET: 16343400
STREAM(T:=BUFF-1); DS:= LIT "~"; 16343500
ERROR: 16343600
SPOUT((BUFF-1) INX (0&ZZSTA[9:9:9])); 16343700
END; 16343800
EXIT: 16343900
IF(MIX>0)AND(MIX{MIXMAX)THEN TABCNT[MIX]~TABCNT[MIX]-1; %113-16343950
END PROCEDURE KEYIN0; 16344000
PROCEDURE KEYIN1(B,KTRX); VALUE B,KTRX; REAL B,KTRX; 16345000
16346000
BEGIN 16347000
INTEGER ZZSTA; 16348000
REAL BUFF, KTR, TYPE, MIX, A, I, J, K; 16349000
ARRAY BUFA = BUFF[*]; 16350000
16351000
16352000
16353000
LABEL FORGET, ERROR, EXIT 16354000
,BO ,LI ,SS ,BS ,SC ,VQ ,RR ,CA ,DT ,WD 16355000
,TR ,WT ,WM ,CC ,OL ,PB ,RN ,LD ,RD ,ED 16356000
,SI ,LR ,OT ,IN ,FE ,OC ,SQ ,CS ,HS ,WK 16357000
16358000
16359000
16360000
; 16361000
SWITCH S:= ERROR 16362000
,BO ,LI ,LI ,LI ,SS ,SS ,SS ,SS ,BS ,BS 16363000
,SC ,VQ ,RR ,CA ,CA ,DT ,WD ,TR ,WT ,WM 16364000
,CC ,OL ,PB ,RN ,LD ,RD ,RD ,ED ,SI ,LR 16365000
,OT ,IN ,FE ,OC ,SQ ,CS ,HS ,WK 16366000
16367000
16368000
16369000
; 16370000
SUBROUTINE SPOIT; M[BUFF-2]:=B AND @7570000000000; 16371000
16372000
BUFF :=KTRX.[15:15]; 16373000
MIX :=KTRX.[ 9:6 ]; 16374000
TYPE :=KTRX.[ 2:7 ]; 16375000
KTR :=KTRX.[15:33]; 16376000
ZZSTA :=0 & (M[BUFF-2])[9:9:9]; 16377000
GO TO S[TYPE]; 16378000
BO: 16379000
$ SET OMIT = NOT(DCSPO AND DATACOM) 16380000
LI: 16386000
$ SET OMIT = NOT(DCSPO AND DATACOM) 16387000
GO TO EXIT; 16390000
SS: 16391000
$ SET OMIT = NOT(DCSPO AND DATACOM) 16392000
GO TO EXIT; 16394000
BS: 16395000
$ SET OMIT = NOT(DCSPO AND DATACOM) 16396000
GO EXIT; 16406000
SC: 16407000
$ SET OMIT = NOT(DCSPO AND DATACOM) 16408000
GO TO EXIT; 16410000
RR: 16411000
$ SET OMIT = NOT(DATACOM) 16412000
VQ: 16456000
$ SET OMIT = NOT(DCSPO AND DATACOM) 16457000
GO TO EXIT; 16485000
CA: 16486000
$ SET OMIT = NOT(AUXMEM) 16487000
GO TO ERROR; % SPOUT AUX MESSAGE OR ERROR MESSAGE 16489000
DT: 16490000
SETDATE(KTR); 16491000
GO TO EXIT; 16492000
WD: 16493000
GIMEDATE(BUFF-1,1); 16494000
GO TO EXTI; 16495000
TR: 16496000
SETIMER(KTR); 16497000
GO TO EXIT; 16498000
WT: 16499000
TIMEOUT (BUFF-1); 16500000
GO TO EXIT; 16501000
WM: 16502000
FORGETSPACE(BUFF-1); 16503000
WHATMCP(BUFF); 16503100
BUFF:=BUFF+1; % FAKE OUT ERROR 16503200
GO TO ERROR; % SPOUT MESSAGE 16504000
CC: 16505000
A:=M[BUFF-3].[CF]-BUFF; % WDS IN MESSAGE 16505100
STREAM(BUFF, BL:=A>8, KTR:=(KTR:=SPACE(A+2)+2)); 16506000
BEGIN 16507000
SI:=BUFF; 16508000
BL(36(DS:=2LIT" "); DI:=KTR); 16508100
IF SC NEQ "~" THEN 16509000
BEGIN 16510000
DS:=CHR; 16511000
L: IF SC NEQ "~" THEN 16512000
BEGIN 16513000
IF SC NEQ @14 THEN DS:=CHR ELSE SI:=SI+1; 16514000
GO TO L; 16515000
END; 16516000
END; 16517000
DS:=CHR; 16518000
END; 16519000
M[KTR-4].[9:6]:=0; 16520000
IF ABS(B) GTR 1 THEN 16521000
INDEPENDENTRUNNER(P(.CONTROLCARD),KTR&30[2:42:6]&ZZSTA[9:9:9], 16522000
192) 16522100
ELSE INDEPENDENTRUNNER(P(.CONTROLCARD),KTR&25[2:42:6],192); 16523000
GO TO FORGET; 16524000
OL: 16525000
OUTPUTLABEL(KTR); 16526000
GO TO EXIT; 16527000
PB: 16528000
PRINTBACKUP(KTR&[6:9:9]); 16529000
GO TO EXIT; 16530000
RN: 16531000
SPOIT; 16532000
RUNTHEDECK(KTR); 16533000
GO TO EXIT; 16534000
LD: 16535000
STARTLOADN(KTR); 16536000
GO TO EXIT; 16537000
RD: 16538000
DECKREMOVER(KTR); 16539000
GO TO EXIT; 16540000
FD: 16541000
EXTERNALEND(KTR); 16542000
GO TO EXIT; 16543000
SI: 16544000
$ SET OMIT = NOT(STATISTICS) 16545000
GO TO ERROR; % SPOUT MESSAGE 16576000
LR: 16577000
$ SET OMIT = NOT(DCLOG AND DATACOM) 16578000
GO TO FORGET; 16580000
IN: 16580600
KTR:=-KTR; 16580800
OT: 16581000
$ SET OMIT = NOT(BREAKOUT) 16582000
IF PRTGAMES(KTR,MIX) THEN GO ERROR ELSE 16588000
IF KTR LSS 0 THEN GO FORGET ELSE GO EXIT; 16589000
FE: 16590000
J:= GETSPACE(35,9,0)+2; 16591000
STREAM(KTR:D:=J+2); 16592000
BEGIN 16593000
SI:=KTR; 16594000
4(63(IF SC NEQ "~" THEN DS:=CHR ELSE JUMP OUT 2 TO LL)); 16595000
LL: DS:=LIT"~"; DI:=DI-1; KTR:=DI; 16596000
END; 16597000
I:= P INX 0; 16598000
M[J]:= (I-J) DIV 5; 16599000
STREAM(DATE, A:=J+1); 16600000
BEGIN 16601000
SI:=LOC DATE; DS:=8 OCT; 16602000
END; 16603000
LINKUP(19,J); 16604000
GO TO FORGET; 16605000
OC: 16606000
LOGCOMMENT(KTR); 16607000
GO TO FORGET; 16608000
SQ: 16609000
STREAM(TYPE:=0:INFO1:="STOP0KN",INFO2:=@2567630000000000, 16609100
KTR); 16609200
BEGIN 16609300
SI:=KTR; DI:=LOC INFO1; DI:=DI+1; TALLY:=1; 16609400
IF 4 SC=DC THEN GO TO EXT; 16609500
SI:=SI-4; TALLY:=TALLY+1; 16609600
IF 2 SC=DC THEN GO EXT; 16609700
SI:=SI-2; TALLY:=TALLY+2; 16609800
IF 4 SC=DC THEN GO TO EXT; 16609900
TALLY:=TALLY+4; 16610000
EXT: TYPE:=TALLY; 16610100
END; 16610200
IF P(M[P(.DISKSQUASH)],TOP) THEN IF P(P.[FF] AND P,DUP)!0 THEN 16610300
P(.DISKSQUASH,STD) ELSE GO TO ERROR ELSE IF P(XCH)=8 THEN 16610400
BEGIN 16610500
INDEPENDENTRUNNER(P(.DISKSQUASH),KTR,128); 16610600
GO TO EXIT; 16610700
END ELSE GO TO ERROR; 16610800
GO TO FORGET; 16610900
HS: 16611000
$ SET OMIT = NOT SEPTICTANK 16611990
CS: 16613000
$ SET OMIT = NOT SEPTICTANK 16613990
GO TO EXIT; 16615000
WK: % WORKSET REQUESTS 16615100
$ SET OMIT = NOT(WORKSET) 16615110
WKSETVALUES(KTRX); GO TO EXIT; 16615200
$ POP OMIT % WORKSET 16615210
FORGET: 16689000
STREAM(T:=BUFF-1); DS:= LIT "~"; 16689100
ERROR: 16689200
SPOUT((BUFF-1) INX (0&ZZSTA[9:9:9])); 16689300
EXIT: 16689400
IF(MIX>0)AND(MIX{MIXMAX)THEN TABCNT[MIX]~TABCNT[MIX]-1; %113-16689450
END PROCEDURE KEYIN1; 16689500
PROCEDURE KEYIN2(KTRX); VALUE KTRX; REAL KTRX; 16690000
16690500
BEGIN 16691000
REAL RCW = + 0; 16691500
REAL MSCW=-2; 16691550
INTEGER ZZSTA = RCW + 1; 16692000
REAL BUFF = ZZSTA + 1, 16692500
KTR = BUFF + 1, 16693000
TYPE = KTR + 1, 16693500
MIX = TYPE + 1, 16694000
A = MIX + 1, 16694500
I = A + 1, 16695000
J = I + 1, 16695500
K = J + 1, 16696000
B = K + 1, 16696100
R = B + 1, 16696200
R1 = R + 1, 16696300
R2 = R1 + 1, 16696400
R3 = R2 + 1, 16696500
R4 = R3 + 1; 16696600
REAL UNITNO= R4 + 1; 16696650
INTEGER INT1 = NT1 , 16696700
INT2 = A , 16696800
INT3 = J , 16696900
INT4 = R4 ; 16697000
ARRAY BUFA = BUFF[*] , 16697100
UT = R3[*] 16697200
$ SET OMIT = NOT SHAREDISK 16697300
; 16697600
$ SET OMIT = SHAREDISK 16697700
DEFINE U = AVTABLE# ; 16697800
$ POP OMIT 16697900
REAL HN1 = MIX , 16698000
HN2 = TYPE ; 16698100
REAL SEG = I, 16698200
ADR = J, 16698210
LOCN = K, 16698220
HALTED= R1; 16698230
NAME SEGDICT = R3; 16698240
LABEL RR, PGA, FERGIT, FORGET, ERROR, EXIT 16698500
,WU ,WP ,WR ,MX ,TS ,LF ,LC ,LS ,EX ,PD 16699000
,SM ,PO ,PG ,AU ,MS ,LN ,CD ,CU ,SY ,SL 16699500
,RW ,CI ,CT ,XD ,MC ,RS ,HD ,RA ,EI %139-16700000
16700500
16701000
16701500
; 16702000
SWITCH S := ERROR 16702500
,WU ,WP ,WR ,MX ,TS ,TS ,TS ,TS ,LF ,LC 16703000
,LX ,EX ,PD ,SM ,PO ,PO ,PG ,AU ,MS ,LN 16703500
,CD ,CD ,CD ,CU ,SY ,SL ,RW ,CI ,CT ,CT 16704000
,CT ,XD ,XD ,MC ,RS ,HD ,RA ,EI %139-16704500
16705000
16705500
16706000
16706500
; 16707000
16707500
SUBROUTINE SPOIT; M[BUFF-2]:=B AND @7570000000000; 16708000
16708500
P(0, 0, 0, 0, 0, 0, 0, 0, 0, 0); 16710000
P(0, 0, 0, 0, 0, 0); 16710100
BUFF :=KTRX.[15:15]; 16710500
MIX :=KTRX.[ 9:6 ]; 16711000
TYPE :=KTRX.[ 2:7 ]; 16711500
KTR :=KTRX.[15:33]; 16712000
ZZSTA :=0 & (M[BUFF-2])[9:9:9]; 16712500
B := M[BUFF-1]; 16713000
$ SET OMIT = NOT(PACKETS) 16713499
IF MIX!63 THEN UNITNO:=PSEUDOMIX[MIX]; 16713500
$ POP OMIT 16713501
STREAM(B:=BUFF-1); DS:=8LIT"INV KBD "; 16714000
GO TO S[TYPE]; 16714500
WU: 16715000
$ SET OMIT = NOT(DCSPO AND DATACOM) 16715500
WP: 16719500
$ SET OMIT = NOT(DCSPO AND DATACOM) 16720000
RR: 16721500
$ SET OMIT = NOT(DCSPO AND DATACOM) 16722000
GO TO EXIT; 16737000
WR: 16737500
$ SET OMIT = NOT(DCSPO AND DCLOG AND DATACOM) 16738000
MX: 16739000
MIXPRINT(ZZSTA); 16739500
GO TO FORGET; 16740000
TS: 16740500
SHEETDIDDLER(KTR,TYPE,MIX); % TS=5, PS=6, ES=7, XS=8 16741000
MIX:=63; 16741250
GO TO EXIT; 16741500
LF: 16742000
I:=3; GO TO PD; 16742500
LC: 16743000
I:=2; GO TO PD; 16743500
LS: 16744000
I:=4; GO TO PD; 16744500
EX: 16745000
KTR:= -KTR; I:=1; 16745500
PD: 16746000
PRINTDIRECTORY(KTR,I); 16746500
GO TO EXIT; 16747000
SM: 16747500
$ SET OMIT = NOT(DCSPO AND DATACOM) 16748000
GO TO EXIT; 16749000
PO: 16749500
TYPOP(KTR,TYPE=16); % TO=15, PO=16 16750000
GO TO EXIT; 16750500
PG: 16751000
STREAM(Y:=KTR); 16751500
BEGIN 16752000
SI:=Y; 16752500
LA: IF SC NEQ "~" THEN 16753000
BEGIN 16753500
SI:=SI+1; DI:=DI+1; GO TO LA; 16754000
END 16754500
ELSE DS:=4LIT"~~~~"; 16755000
END; 16755500
PGA: STREAM(Y:=0, KTR: A:=A:=SPACE(12)+1); 16756000
BEGIN 16756500
SI:=KTR; 16757000
L: IF SC=" " THEN 16757500
BEGIN 16758000
SI:=SI+1; GO TO L; 16758500
END; 16759000
IF SC="~" THEN TALLY := 1 ELSE 16759500
IF SC="0" THEN TALLY := 1 ELSE 16760000
BEGIN 16760500
DS:=3CHR; 16761000
IF SC="-" THEN 16761500
BEGIN 16762000
DS:=CHR; 16762500
LL: IF SC=" " THEN 16763000
BEGIN 16763500
SI:=SI+1; GO TO LL; 16764000
END; 16764500
5(IF SC GEQ 0 THEN DS:=CHR ELSE JUMP OUT); 16765000
END; 16765500
DS:=LIT"~"; KTR:=SI; 16766000
END; 16766500
Y:= TALLY; 16767000
END STREAM STATEMENT; 16767500
IF P([KTR],STD) THEN 16768000
BEGIN 16768500
FORGETSPACE(A-1); GO TO FORGET; 16769000
END; 16769500
A:=A&A[15:33:15]; 16770000
TAPEPURGE(A); 16770500
GO TO PGA; 16771000
AU: 16771500
$ SET OMIT = NOT(AUXMEM) 16772000
GO TO FORGET; 16773000
MS: 16773500
$ SET OMIT = NOT MONITOR 16774000
GO TO FORGET; 16779500
LN: 16780000
STREAM(A:=0:KTR); 16780500
BEGIN SI:=KTR; DI:=LOC A; DI:=DI+6; 16781000
DS:=2 CHR; 16781500
END; 16782000
IF (I:=P).[36:6]=@37 THEN 16782500
LOGOUT(0) ELSE 16783000
$ SET OMIT = NOT(DISKLOG) 16783500
IF I="ML" THEN INDEPENDENTRUNNER(P(.LOGOUTMAINT),0,128) ELSE 16784500
GO TO ERROR; 16785000
GO TO FORGET; 16785500
CD: 16786000
TABLEOFCONTENTS(KTR, TYPE=23); % CD=21, PP=22, PC=23 16786500
GO TO FORGET; 16787000
CU: 16787500
COREPRINT((IF MIX=63 THEN -0 ELSE MIX)&ZZSTA[9:9:9]); 16788000
GO TO FORGET; 16788500
SY: 16789000
$ SET OMIT = NOT(STATISTICS) 16789500
GO TO FORGET; 16792000
SL: 16792500
$ SET OMIT = NOT(STATISTICS) 16793000
GO TO FORGET; 16795500
RW: 16796000
SPOIT; 16796500
REWINDANDLOCK(KTR); 16797000
GO TO EXIT; 16797500
CI: 16798000
$ SET OMIT = NOT(BREAKOUT) 16798500
CHANGEINTRINSICFILE(KTR); 16801500
GO TO EXIT; 16802000
CT: 16802500
TIMRELAXER(KTR,TYPE,MIX); % CT=29, XT=30, TL=31 16803000
GO TO EXIT; 16803500
XD: 16804000
IF TYPE=33 THEN KTR.[CF]:=0; % XD=32, MR=33 16804500
DKBUSINESS(P(1,KTR)); 16805000
GO TO EXIT; 16805500
MC: 16806000
NAMID(1,KTR); NAMID(J,KTR); NAMEID(J,KTR); 16806500
IF J.[6:6]="~" THEN GO TO ERROR; 16807000
IF (A:=DIRECTORYSEARCH(I,-J,4)) GEQ 64 THEN 16807500
BEGIN 16808000
IF J NEQ "DISK " THEN 16808500
IF(K:=DIRECTORYSEARCH(I,"DISK ",5)) NEQ 0 THEN 16809000
BEGIN 16809500
P(DIRECTORYSEARCH(-I,J,14),DEL); 16810000
FORGETSPACE(A); 16810500
FORGETSPACE(K); 16811000
LPMESS(I,J,-9,29,0,0,1); 16811500
GO FERGIT; 16812000
END 16812500
ELSE 16813000
BEGIN 16813500
M[A INX 4]:=(*P(DUP))&2[1:46:2]&1[8:47:1]; 16814000
A:=A&EUF(-I,"DISK ",A INX 0-1)[18:33:15]; 16815000
FORGETSPACE(DIRECTORYSEARCH(I,J,8)); 16815500
END ELSE M[A INX 4]:=(*P(DUP))&2[1:46:2]&1[8:47:1]; 16816000
HEADERUNLOCK(I,"DISK ",A); 16816500
LBMESS(I,J,54,I,"DISK ",0,1); 16817000
END 16817500
ELSE LBMESS(I,J,-9,IF A=1 THEN 45 ELSE 15,0,0,1); 16818000
FERGIT: 16819300
FORGETSPACE(BUFF-1); 16819400
GO TO EXIT; 16819500
RS: 16820000
$ SET OMIT = NOT(BREAKOUT) 16820500
GO TO EXIT; 16822000
HD: 16823000
STREAM(EU:=-1,ERRTOG:=0:EULIT:=@2564000000000000,CX:=0, 16823100
K:=KTR); 16823200
BEGIN 16823300
SI:=K; DO GO L1; 16823400
L0: IF SC=" " THEN BEGIN SI:=SI+1; GO TO L0 END; CI:=CX; 16823500
L1: CS:=CI; GO TO L0; 16823600
IF SC="~" THEN GO EXT; 16823700
DI:=LOC EULIT; TALLY:=1; 16823800
IF 2 SC=DC THEN % AN EU SPECIFIED 16823900
BEGIN 16824000
CS:=CI; GO TO L0; 16824100
IF SC GEQ 0 THEN IF SC<12 THEN 16824200
BEGIN 16824300
SI:=SI+1; DI:=LOC EU; 16824400
IF SC GEQ 0 THEN IF SC<12 THEN 16824500
TALLY:=2 ELSE GO TO ERR; 16824600
SI:=SI-1; CX:=TALLY; 16824700
DS:=CX OCT; GO TO EXT; 16824800
END ; 16824900
END; 16825000
ERR: ERRTOG:=TALLY; 16825100
EXT: 16825200
END; 16825300
IF P THEN GO TO ERROR; 16825400
IF (HN1:=P+1)>0 THEN IF HN1 LEQ NEUP.[FF] THEN 16825500
HN2:=HN1 ELSE GO TO ERROR ELSE 16825600
BEGIN 16825700
HN1:=1; 16825800
HN2:=NEUP.[FF]; 16825900
END; 16826000
$ SET OMIT = NOT SHAREDISK 16826100
FOR I:=HN1 STEP 1 UNTIL HN2 DO 16826500
IF NOT (NT2:=U[I]).EUNP THEN % NOT A DUMMY EU 16826600
BEGIN 16826700
INT4:=(INT1:=NT2.STARTWRD) MOD 30; 16826800
INT2:=30-(K:=(NT2 AND NUMENTM)+R4) MOD 30+K; 16826900
J:=NT1 DIV 30+USERDISKBOTTOM; 16827000
FIXARRAY(UT,R,A); 16827100
$ SET OMIT = NOT SHAREDISK 16827200
DISKWAIT(-R,A,J); J:=0; 16827900
FOR NT1:=K-2 STEP -1 UNTIL R4 DO INT3:=J+UT[NT1].[3:19]; 16828000
STREAM(A:=I-1,B:=IF U[I].SPEED=1 THEN "F" ELSE "S", 16828100
C:=U[I].[38:10]-1,D:=J,E:=U[I].[1:20], 16828200
F:=A:=SPACE(10)); 16828300
BEGIN 16828400
SI:=LOC A; DS:=4 LIT" EU "; DS:=2 DEC; 16828500
A:=DI; DI:=DI-2; DS:=FILL; DI:=A; 16828600
DS:=LIT"("; SI:=SI+7; DS:=CHR; 16828700
DS:=10 LIT"), NO. AV="; DS:=3 DEC; 16828800
A:=DI; DI:=DI-3; DS:=2 FILL; DI:=A; 16828900
DS:=11 LIT", TOTAL AV="; DS:=6 DEC; 16829000
A:=DI; DI:=DI-6; DS:=5 FILL; DI:=A; 16829100
DS:=14 LIT" SEGS, MAX AV="; DS:=6 DEC; 16829200
A:=DI; DI:=DI-6; DS:=5 FILL; DI:=A; 16829300
DS:=6 LIT" SEGS~"; 16829400
END; 16829500
FORGETSPACE(R); 16829550
SPOUT(A&ZZSTA[9:9:9]); 16829600
END; % ELSE IF HN1=HN2 THEN GO TO ERROR; 16829700
$ SET OMIT = NOT SHAREDISK 16829800
HN1:=KTRX.[9:6]; % SET "MIX" BACK TO ORIGINAL VALUE 16830100
GO TO FORGET; 16830200
RA: 16830300
IF MIX=P2MIX THEN 16830700
BEGIN 16830800
HALT; HALTED := TRUE; 16830900
END; 16831000
SEGDICT := PRT[MIX,4]; 16831100
IF P( M[LOCN:=PRT[MIX,8].[CF]], TOP, XCH, DEL ) THEN SEG:=ADR:=0 16831200
ELSE 16831300
DO BEGIN 16831400
IF P(M[LOCN], TOP, XCH, 0, INX, .ADR, STD) THEN % OVERLAID RCW 16831500
BEGIN 16831600
IF NOT M[LOCN].[33:1] THEN % NOT TYPE 13 INTRINSIC 16831700
BEGIN 16831800
SEG:=ADR; % SEGNO IN RCW 16831900
R:=0; % ADJUST FOR SUBSTRACTION BELOW 16832000
ADR:=M[M[LOCN].MOM].[CF]; % REL.ADR.IN MSCW 16832100
END 16832200
ELSE SEG := (-1); 16832300
END 16832400
ELSE 16832500
BEGIN % PRESENT RCW, CHECK THE LINKS 16832600
R:=0; 16832700
WHILE (SEG:=M[R].[CF]) LSS ADR DO 16832800
IF SEG GTR R THEN R:= SEG ELSE PUNT([PUNTER[25]]); 16832900
SEG:=IF M[R].AREATYPEF=CODEAREAV THEN M[R+1].[CF] ELSE 0; % 16833000
IF P(PRTROW[MIX],0,INX,DUP) GTR R AND P(XCH) LSS M[R].[CF] THEN16833100
R4 := "PRT "; 16833200
R:=R+2; 16833300
END; 16833400
IF PRT[MIX,8].[CF] NEQ LOCN OR M[LOCN-1].MSFF THEN % MARKED 16833500
DO LOCN:=M[LOCN].MOM UNTIL NOT M[LOCN].MSFF; % GET LAST MSCW 16833600
LOCN:=M[LOCN].MOM; % POINT LOCN TO NEXT RCW,JUST IN CASE. 16833700
END 16833800
UNTIL 16833900
(IF SEG NEQ 0 THEN IF SEG = (-1) THEN 0 16834000
ELSE (SEGDICT[0] LSS SEG OR NOT SEGDICT[SEG].PBIT) 16834100
ELSE P(M[R-2].[3:12], DUP) NEQ @700 AND P(XCH) NEQ @1500) 16834200
OR LOCN=0; 16834300
ADR := ADR-R; 16834400
STREAM(MIX, NAM:=[JAR[MIX,0]], T:=0, SEG, ADR, 16834600
SYL:=M[PRT[MIX,8]].[10:2], TOG1:=(R4 NEQ 0), R4, 16834700
TOG2:=(SEG LEQ 0), D:=BUFF-1); 16834800
BEGIN 16834900
DS:=LIT" "; 16835000
SI:=NAM; 2(SI:=SI+1; DS:=7CHR; DS:=LIT"/"); DI:=DI-1; 16835100
DS:=2LIT" ="; SI:=LOC MIX; DS:=2DEC; 16835200
TOG1(SI:=LOC R4; SI:=SI+1; DS:=LIT" "; DS:=7CHR;JUMP OUT TO XXIT);16835300
TOG2(DS:=14LIT" NOT AVAILABLE"; JUMP OUT TO XXIT); 16835400
DS:=5LIT" SEG="; SI:=LOC SEG; DS:=4DEC; 16835500
T:=DI; DI:=DI-4; DS:=3FILL; DI:=T; 16835600
DS:=5LIT" ADR="; DS:=4DEC; 16835700
T:=DI; DI:=DI-4; DS:=3FILL; DI:=T; 16835800
DS:=LIT":"; SI:=SI+7; DS:=CHR; 16835900
XXIT: DS:=LIT"~"; 16836000
END STREAM STATEMENT; 16836100
IF HALTED THEN NOPROCESSTOG := NOPROCESSTOG -1; 16836200
GO TO ERROR; 16836300
EI: %139-16836400
$ SET OMIT = NOT(BREAKOUT) %139-16836405
GO TO FORGET; %139-16866530
FORGET: 16902500
STREAM(T:=BUFF-1); DS:= LIT "~"; 16902600
$ SET OMIT = NOT(PACKETS) 16902649
UNITNO:=0; 16902650
$ POP OMIT 16902651
ERROR: 16902700
SPOUTER(BUFF-1) INX ZZSTA,UNITNO,1); 16902800
EXIT: 16902900
IF(MIX>0)AND(MIX{MIXMAX)THEN TABCNT[MIX]~TABCNT[MIX]-1; %113-16902950
KILL([MSCW]); 16903000
END PROCEDURE KEYIN2; 16903100
REAL PROCEDURE KEYIN(B); VALUE B; REAL B; 16904000
% THIS PROCEDURE FUNCTIONS AS A DRIVER FOR AUXILIARY PROCEDURES 16904500
% "KEYIN0","KEYIN1" AND "KEYIN2". PROCEDURES "KEYIN0" AND "KEYIN1" 16905000
% ARE CALLED DIRECTLY, AND PROCEDURE "KEYIN2" IS CALLED AS AN 16905500
% INDEPENDENT RUNNER. 16906000
BEGIN 16906500
REAL RCW = + 0; 16907000
REAL MSCW=-2; 16907250
INTEGER ZZSTA = RCW + 2; 16907500
REAL BUFF = ZZSTA + 1, 16908000
KTR = BUFF + 1, 16908500
TYPE = KTR + 1, 16909000
MIX = TYPE + 1, 16909500
A = MIX + 1, MIXCODE = A, KTRX = A, 16910000
I = A + 1, 16910500
J = I + 1, RJEOK = J, 16911000
K = J + 1, PROCED = K; 16911500
NAME ADDR = K + 1; ARRAY BUFA = BUFFER[*]; 16912000
INTEGER T = ADDR + 1; %801-16912100
16912500
$ SET OMIT = NOT(PACKETS) 16912999
DEFINE UNITNO = PSEUDOMIX[MIX]#; 16913000
$ POP OMIT 16913001
16913500
LABEL START, CHECK, SWITCHIT, FORGET, ERROR, TBLERR, EXIT; 16914000
LABEL RESTART; %801-16914100
16914500
P(B, 0, 0, 0, 0, 0, 0, 0, 0, 0); % NOTE P(B)=ZZSTA 16917500
P(0); % T %801-16917600
START:: 16918000
IF ABS(B) GTR 1 THEN BUFF:=B.[FF] ELSE 16918500
BEGIN 16919000
BUFF := GETSPACE(60,KEYINBUFFAREAV,0)=3; % %167-16919500
$ SET OMIT = NOT(DCSPO AND DATACOM) 16920000
M[BUFF INX NOT 2].[9:6] := 0; 16921000
P(WAITIO(BUFF&1[24:47:1],0,25), DEL); 16921500
END; 16922000
$ SET OMIT = NOT(DCSPO AND DATACOM) 16922499
RESTART: %801-16925100
M[BUFF-2]:=0&ZZSTA[9:9:9]; 16925500
KTR := BUFF; 16926000
TYPE ~ KEYINSCAN(KTR,MIX); %801-16926010
IF (PROCED~TYPE.[1:5])=1 AND ((I~TYPE.[CF])=8 OR I=VCC %801-16926020
OR I=33 OR I=34) OR (PROCED=0 AND I=1) THEN ELSE % SS,CC,OC,FF,AX 16926022
BEGIN %801-16926030
STREAM(KTR,I:); %801-16926040
BEGIN SI~KTR; %801-16926050
8(60(IF SC=""" THEN %801-16926060
BEGIN L: SI~SI+1; %801-16926070
63(SI~SI+1; IF SC=""" THEN JUMP OUT); %801-16926080
IF SC="~" THEN JUMP OUT 3 TO YECH); 16926090
SI~SI+1; %801-16926100
IF SC=""" THEN GO TO L; %801-16926110
END; %801-16926120
IF SC="~" THEN JUMP OUT 2 TO YECH; %801-16926125
IF SC=";" THEN %801-16926130
BEGIN %801-16926140
I~SI; TALLY~1; %801-16926150
DI~I; DS~LIT "~"; %801-16926152
X: SI~SI+1; IF SC=";" THEN GO TO X; I~SI; %801-16926154
JUMP OUT 2 TO YECH; %801-16926160
END; SI~SI+1)); %801-16926170
YECH: KTR~TALLY; %801-16926180
END STREAM; %801-16926190
I~P; IF P THEN %801-16926200
STREAM(I, T~T~GETSPACE(62,0,0)+3); %801-16926210
BEGIN %801-16926220
SI~I; %801-16926230
8(60(IF SC="~" THEN JUMP OUT 2 TO L ELSE DS~CHR)); L:DS~LIT"~";16926240
END STREAM; %801-16926250
END CHECK FOR KEYIN RECYCLE; %801-16926270
IF PROCED=7 THEN GO TO TBLERR; %801-16926500
KTR := KTR & BUFF[15:33:15]; 16927000
RJEOK := (MIXCODE:=TYPE.[6:6]) GEQ 4; 16927500
MIXCODE := (MIXCODE |(MIX NEQ 63)) AND 3; % ACTUAL MIX CODE 16928000
TYPE := TYPE.[CF]; 16928500
IF TYPE=0 OR MIX.[1:2]!0 THEN % EMPTY OR ERROR 16929000
BEGIN 16929500
IF MIX.[1:1] THEN % EMPTY BUFFER 16930000
BEGIN 16930500
KEYIN:=TRUE; GO TO FORGET; 16931000
END 16933500
ELSE GO TO ERROR; % TYPE=0 OR MIX.[2:1] 16934000
END; 16934500
$ SET OMIT = NOT(DCSPO AND DATACOM) 16935000
CHECK: 16946600
IF MIXCODE=1 OR MIXCODE=2 THEN % MIX INDEX REQUIRED 16947000
BEGIN 16947500
IF MIX GTR MIXMAX THEN GO TO ERROR; 16948000
IF JAR[MIX,*]=0 THEN GO TO ERROR; % JOB MUST BE RUNNING 16948500
IF MIXCODE=1 THEN % JOB SHOULD BE WAITING FOR THIS INPUT 16949000
BEGIN 16949500
J:=REPLY[MIX]; 16950000
WHILE J LSS 0 DO 16950500
BEGIN 16951000
IF J.[42:6]=TYPE THEN GO TO SWITCHIT; 16951500
J:=-J.[6:36]; % SHIFT RIGHT 16952000
END; 16952500
IF TYPE=VWY THEN % "WY", NOT WAITING FOR IT 16953000
BEGIN 16953500
M[BUFF-1]:=FLAG(-"WY NOT"&MIX[6:42:6]); 16954000
M[BUFF] :=0&(@1437)[1:37:11]; 16954500
END; 16955000
GO TO ERROR; 16955500
END; % IF MIXCODE = 1 OR 2 16955600
SWITCHIT: 16955800
TABCNT[MIX]:=TABCNT[MIX]+1; 16956000
$ SET OMIT = NOT(PACKETS) 16956019
IF PSEUDOMIX[MIX]!0 THEN 16956020
BEGIN 16956030
STREAM(BUFF, J ~ J ~ SPACE(16)) ; % %712-16956040
BEGIN SI~BUFF; DS~20 LIT "+OPERATOR KEYED IN: "; %712-16956050
2(50(IF SC="~" THEN JUMP OUT 2 TO AXET; DS~CHR));%712-16956060
AXET: DS~LIT "~" ; % %712-16956070
END ; % %712-16956080
SPOUTER(J,UNITNO,64); % %712-16956090
END ; % %712-16956100
$ POP OMIT 16956121
END; % IF MIX INDEX REQUIRED 16956500
KTRX := KTR & MIX[9:42:6] & TYPE[2:41:7]; 16957500
IF PROCED=2 THEN 16958000
BEGIN 16958500
IF JOBNUM } JOBNUMAX-10 THEN % BED IS GETTING FULL %801-16958600
BEGIN % LETS IGNORE THIS MESSAGE %801-16958610
M[BUFF-1]~-FLAG("WAIT..."); %801-16958620
GO TO ERROR; %801-16958630
END; %801-16958640
M[BUFF-1] := B; % PASS VALUE TO PROCEDURE 16959000
INDEPENDENTRUNNER(NT1:=P(..KEYIN2),KTRX,140); 16959500
END 16960000
ELSE IF PROCED=1 THEN KEYIN1(B,KTRX) ELSE KEYIN0(B,KTRX); 16960500
GO TO EXIT; 16961000
TBLERR: 16961500
STREAM(KTR,B:=BUFF-1); 16962000
BEGIN 16962500
SI:=KTR; SI:=SI-2; DS:=LIT"*"; DS:=2CHR; 16963000
DS:=21LIT" NOT COMPILED IN MCP~"; 16963500
END; 16964000
ERROR: 16964500
SPOUT( (BUFF-1) INX (0&ZZSTA[9:9:9])); 16965000
KEYIN := TRUE; 16965500
GO TO EXIT; 16966000
FORGET: 16966500
STREAM(T:=BUFF:=BUFF-1); DS:=LIT"~"; 16967000
SPOUT(BUFF INX (0&ZZSTA[9:9:9])); 16967500
EXIT: 16968000
IF T>0 THEN % ANOTHER MESSAGE %801-16968100
BEGIN %801-16968110
BUFF~T; T~0; %801-16968120
GO RESTART; %801-16968130
END; %801-16968140
IF ABS(B) LEQ 1 THEN 16968500
BEGIN 16969000
IF (KEYBOARDCOUNTER:=KEYBOARDCOUNTER-1) GTR 0 THEN GO TO START; 16969500
KEYBOARDCOUNTER:=0; 16970000
END; 16970500
IF B THEN KILL([MSCW]); 16971000
END PROCEDURE KEYIN; 16971500
REAL LBMSGCONTROL; 16995000
PROCEDURE LBMESS(EN,SN,I1,I2,E,UNITNO,X); 17000000
VALUE FN,SN,I1,I2,E,UNITNO,X; 17000200
REAL FN,SN,I1,I2,E,UNITNO,X; 17000400
%********************************************************************** 17000405
% PARAMETERS 17000410
% I1 I2 E FORM OF MESSAGE 17000420
% ------ ------ ------ --------------- 17000430
% LSS 0 0 . FN/SN I1 17000440
% LSS 0 GTR 0 0 . FN/SN NOT I1(I2) 17000450
% LSS 0 GTR 0 NEQ 0 . FN/SN NOT I1(I2), E 17000460
% GTR 0 0 0 FN/SN I1 17000470
% GTR 0 0 NEQ 0 FN/SN I1, E 17000480
% GTR 0 GTR 0 FN/SN I1 I2 17000490
% 52 OR 54 FN/SN I1 I2/E 17000500
%NOTE: IF I1 IS NEITHER 52 NOR 54 THEN I1 AND I2 ARE INDICES INTO TABL 17000510
% ELSE I2 AND E ARE MFID AND FID. 17000520
%********************************************************************* 17000530
BEGIN 17000600
REAL T, A, COUNT; 17000800
LBMSGCONTROL.[FF] := COUNT := LBMSGCONTROL.[FF] + 1; 17000900
IF NOT (LBMSGCONTROL.[2:1]) THEN % ITS NOT IN CORE -- 17001000
IF COUNT > 1 THEN BEGIN 17001300
SLEEP([LBMSGCONTROL], @1000000000000000); 17001400
% WAIT - SOMEONE ELSE IS GETTING IT 17001500
END ELSE BEGIN % GET IT YOURSELF 17001600
A := MESSAGETABLE[4].[8:10]; 17002000
LBMSGCONTROL := (GETSPACE(A,2,0)+2) & LBMSGCONTROL[FTF]; 17002600
$ VOID 17002800
DISKWAIT(-(LBMSGCONTROL,[CF]), A, MESSAGETABLE[4].[22:26]); 17003000
LBMSGCONTROL.[2:1] := 1; % MARK PRESENT 17003050
M[LBMSGCONTROL-1] := P(..LBMSGCONTROL) & A[CTF]; %LINK WD 2 17003100
M[LBMSGCONTROL-2] := (*P(DUP)) & @200[2:35:13];% LINK WORD 1 17003130
END; 17003150
STREAM 17003200
(A := [FN], I := I1<0, TBL1 := LBMSGCONTROL INX ABS(I1), E, 17003250
L := I1 < 0 AND I2 ! 0, J := I1=52 OR I1=54, 17003300
B := IF P(DUP) THEN [I2] ELSE (LBMSGCONTROL INX I2), 17003400
T := T := SPACE(10)); 17003450
BEGIN I(DS:=LIT","); DS:=LIB" "; SI:=A; 17003500
IF SC="+" THEN BEGIN DS:=LIT"="; SI:=SI+8; END 17003550
ELSE BEGIN SI:=SI+1; DS:=7CHR; END; DS:=LIT"/"; 17003600
IF SC="+" THEN BEGIN DS:=LIT"="; SI:=SI+8; END 17003700
ELSE BEGIN SI:=SI+1; DS:=7CHR; END; 17003750
DS:=LIT" "; L(DS:=4LIT"NOT "); SI:=TBL1; 17003800
63(SI:=SI+1; 7(IF SC="~" THEN JUMP OUT 2 TO L1 ELSE DS:=CHR)); 17003850
L1: SI:=B; 17003900
J(IF SC="+" THEN BEGIN DS:=LIT"="; SI:=SI+8; END 17003950
ELSE BEGIN SI:=SI+1; DS:=7CHR END; DS:=LIT"/"; 17004000
IF SC="+" THEN BEGIN DS:=LIT"="; SI:=SI+8; END 17004050
ELSE BEGIN SI:=SI+1; DS:=7CHR END; JUMP OUT TO L3); 17004100
L(DS:=LIT"("); 17004150
63(SI:=SI+1; 7(IF SC="~" THEN JUMP OUT 2 TO L2 ELSE DS:=CHR)); 17004200
L2: L(DS:=LIT")"); SI:=LOC E; SI:=SI+5; 17004250
IF SC NEQ "0" THEN BEGIN DS:=2LIT", "; DS:=3CHR; END; 17004300
L3: DS:=LIT"~"; 17004600
END; %STREAM 17005200
SPOUTER(T&UNITNO[9:9:9],UNITNO,X); 17005400
LBMSGCONTROL.[FF] := LBMSGCONTROL.[FF] - 1; 17005600
END; %LIBMSG 17006000
PROCEDURE STOPM(NCS); VALUE NCS; REAL NCS; 17900000
17900500
BEGIN 17901000
INTEGER PROTY; 17901500
REAL B; 17902000
LABEL AROUND,OUTIT; 17902500
$ SET OMIT = NOT(WORKSET) 17903000
REAL N, AUTOSTOP; 17903500
AUTOSTOP := (WKSETSTOPJOBS AND TWO(P1MIX)) NEQ 0; 17904000
JAR[P1MIX,9].[3:1]:=1; % MARK IT STOPPED 17904500
WKSETSWITCHTIME := CLOCK + P(RTR); 17904600
$ POP OMIT % WORKSET 17905000
PROTY := PRYOR[P1MIX]; % SAVE THE PRIORITY LEVEL 17905500
PRYOR[P1MIX]:=@1777; 17906000
IF NOTERMSET(P1MIX) THEN PRTROW[P1MIX].[PSF]:=0; 17906100
IF JAR[P1MIX,9].[1:1] THEN 17906150
BEGIN 17906200
COMPLEXSLEEP((TERMSET(P1MIX) OR JAR[P1MIX,9].[1:1]=0)); 17906250
GO OUTIT; 17906300
END; 17906350
AROUND: 17906500
STREAM(J:=JARROW[P1MIX], P1MIX, 17907000
$ SET OMIT = NOT(WORKSET) 17907500
AUTOSTOP, 17908000
$ POP OMIT % WORKSET 17908500
B := B := SPACE(10)); 17909000
BEGIN 17909500
$ SET OMIT = NOT(WORKSET) 17910000
AUTOSTOP(DS:=11LIT"#AUTO-STOP "; JUMP OUT TO L1); 17910500
$ POP OMIT % WORKSET 17911000
DS:=13LIT"#OPRTR ST-ED "; 17911500
L1: SI:=J; 2(SI:=SI+1; DS:=7CHR; DS:=LIT"/"); 17912000
DI:=DI-1; DS:=LIT"="; SI:=LOC P1MIX; DS:=2DEC; 17912500
DS:=LIT"~"; DI:=DI-3; DS:=FILL; 17913000
END STREAM STATEMENT; 17913500
SPOUT(B); 17914000
IF AUTODS THEN REPLY[P1MIX]~VOK ELSE %747-17914100
BEGIN %747-17914200
REPLY[P1MIX]:= -VWY & VOK[36:42:6]; 17914500
COMPLEXSLEEP((TERMSET(P1MIX) OR REPLY[P1MIX] GEQ 0)); 17915000
END; %747-17915100
IF NOTERMSET(P1MIX) THEN % MUST BE "WY" OR "OK" 17915500
BEGIN 17916000
$ SET OMIT = NOT(WORKSET) 17916500
IF AUTOSTOP THEN 17917000
IF REPLY[P1MIX]=VWY THEN GO AROUND ELSE ELSE 17917500
$ POP OMIT % WORKSET 17918000
IF NOT WHYSLEEP(VWY&VOK[36:42:6]) THEN GO AROUND; 17918500
REPLY[P1MIX]:=0; 17919000
OUTIT: 17919100
PRYOR[P1MIX]:=PROTY; 17919500
$ SET OMIT = WORKSET 17920000
$ SET OMIT = NOT(WORKSET) 17921500
JAR[P1MIX,9].[3:1]:=0; % MARK IT RUNNING 17922000
OLAYTIME[P1MIX]:= (*P(DUP)) | 0.80; 17922500
% SET THE OLAY TIME BACK NOW TO PREVENT THIS 17923500
% JOB FROM BEING IMMEDIATELY ST-ED AGAIN 17924000
END 17924500
; %138-17925000
FOR N:=0 STEP 1 UNTIL STQUEMAX DO 17925500
IF STQUE[N] = P1MIX THEN STQUE[N] := 0; % REMOVE FROM QUEUE 17926000
WKSETSWITCHTIME := CLOCK+P(RTR); 17926100
WKSETSTOPJOBS:=WKSETSTOPJOBS AND NOT(TWO(P1MIX)); 17926500
$ POP OMIT % WROKSET 17927000
IF NCS THEN GO TO INITIATE; 17927500
END PROCEDURE STOPM; 17928000
PROCEDURE TISKTASK; FORWARD; 17928500
PROCEDURE FILEHOLD(A,B,TOG,LOC,HOLD); 18000000
VALUE LOC,HOLD; 18001000
REAL A,B,TOG,LOC,HOLD; 18002000
BEGIN 18003000
REAL SZ,Y,T; 18004000
$ SET OMIT = NOIT SHAREDISK 18004490
ARRAY HOLDLIST[*]; 18005000
LABEL SLEPE; 18006000
DEFINE DSED=TERMSET(P1MIX)#; 18007000
IF HOLD THEN 18008000
BEGIN 18009000
IF TOG THEN TOG~TOG+1 ELSE 18010000
BEGIN % MAKE AN ENTRY INTHE HOLDLIST 18011000
$ SET OMIT = NOT SHAREDISK 18011490
IF (SZ:=(Y:=HOLDER.[FF])+1) GTR HOLDMAX THEN 18012000
BYBY("HOLD LIST OVERFLOW~",19); 18013000
HOLDLIST:=[M[SPACE(SZ)]]&SZ[8:38:10]; 18014000
IF Y!0 THEN 18014100
DISKWAIT(-(HOLDLIST INX 0),Y,HOLDER.[CF]); 18015000
HOLDER.[FF]:=SZ; 18016000
HOLDLIST[Y]:=LOC.[FF]&[TOG][CTF]&SYSNO[2:46:2]; 18017000
DISKWAIT(HOLDLIST INX 0,SZ,HOLDER.[CF]); 18018000
$ SET OMIT = NOT SHAREDISK 18018490
FORGETSPACE(HOLDLIST); 18019000
END; 18019500
IF M[LOC+4].[3:1] THEN 18020000
$ SET OMIT = NOT SHAREDISK 18020490
ELSE 18021000
BEGIN M[LOC+4].[3:1]:=1; 18021500
DISKWAIT(LOC.[CF],-30,LOC.[FF]); 18022000
END; 18022500
$ SET OMIT = SHAREDISK 18022990
UNLOCKDIRECTORY; 18023000
$ POP OMIT 18023010
IF P1MIX!0 THEN 18024000
BEGIN T:=VWY&(VIF|A.[3:1])[36:42:6]; 18025000
IF TOG=0 THEN 18026000
SLEPE: FILEMESS("# ",A,B," IN USE",0,0,0); 18027000
REPLY[P1MIX]:=-T; 18028000
COMPLEXSLEEP(REPLY[P1MIX]}0 OR DSED OR TOG); 18029000
IF NOT WHYSLEEP(T) THEN GO TO SLEPE; 18030000
END ELSE 18031000
WHILE NOT TOG DO %815-18031400
BEGIN LBMESS(ABS(A),B,45,0,"MCP",0,1); 18031500
COMPLEXSLEEP((CLOCK AND @17777)=0 OR TOG); %815-18032000
SLEEP([CLOCK],NOT CLOCK); %815-18032010
END; 18032500
$ SET OMIT = SHAREDISK 18032990
LOCKDIRECTORY; 18033000
$ POP OMIT 18033010
TOG:=TRUE; 18033500
IF P((P1MIX NEQ 0 AND DSED),DUP) 18034000
THEN FILEHOLD(A,B,TOG,LOC,2); 18035000
P(RTN); % 1 ON TOP OF STACK IF DSED 18037000
END; 18045000
$ SET OMIT = NOT SHAREDISK 18045490
IF (SZ:=HOLDER.[FF])=0 THEN 18046000
$ SET OMIT = NOT SHAREDISK 18046490
ELSE 18047000
BEGIN IF HOLD=2 THEN DISKWAIT(-LOC.[CF],-30,LOC.[FF]); 18047500
HOLDLIST:=[M[SPACE(SZ)]]&SZ[8:38:10]; 18048000
DISKWAIT(-(HOLDLIST INX 0),SZ,HOLDER.[CF]); 18049000
IF TOG THEN FOR T:=0 STEP 1 UNTIL SZ-1 DO 18050000
$ SET OMIT = NOT(SHAREDISK) 18051000
IF HOLDLIST[T].[FF]=[TOG].[CF] THEN 18053000
IF (SZ:=SZ-1) ! T THEN 18054000
BEGIN 18055000
MOVE(SZ-T,[HOLDLIST[T+1]],[HOLDLIST[T]]); 18056000
T:=SZ; 18057000
END; 18058000
HOLDER.[FF]:=Y:=SZ; 18059000
IF SZ!0 THEN 18060000
BEGIN 18061000
FOR Y~0 STEP 1 UNTIL SZ-1 DO 18062000
IF HOLDLIST[Y].[CF]=LOC.[FF] THEN 18063000
BEGIN 18064000
$ SET OMIT = NOT(SHAREDISK) 18065000
M[HOLDLIST[Y].[FF]]~1; 18068000
Y:=SZ; 18069000
END; 18070000
DISKWAIT(HOLDLIST INX 0,SZ,HOLDER.[CF]); 18071000
END; 18072000
$ SET OMIT = NOT SHAREDISK 18072490
IF SZ=Y THEN 18073000
BEGIN 18074000
M[LOC+4].[3:1]:=0; 18075000
IF HOLD=2 THEN DISKWAIT(LOC.[CF],-30,LOC.[FF]); 18075500
$ SET OMIT = NOT SHAREDISK 18075990
END; 18077500
FORGETSPACE(HOLDLIST); 18078000
END; 18079000
END; % OF FILEHOLDER 18080000
%COMMENT THE DISK FILE HEADER CONTAINS THE FOLLOWING INFORMATION: 18081000
%H[0].[0:15] RECORD LENGTH 18083000
% .[15:15] BLOCK LENGTH 18084000
% .[30:12] RECORD/BLOCK 18085000
% .[42:6] SEGMENTS/BLOCK 18086000
%H[1].[6:18] CREATION DATE FOR LOGGING (WHEN ON DISK) 18087000
% .[25:23] CREATION TIME FOR LOGGING (WHEN ON DISK) 18088000
% .[1:47] NUMBER OF LOGICAL RECORDS PER ROW (WHEN IN CORE) 18089000
%H[2].[0:48] =0 FREE FILE 18090000
% .[1:1] =0 SOLE USER, PUBLIC OR PRIVATE FILE 18091000
% .[1:1] =1 SECURITY FILE 18092000
% .[6:42] PRIMARY USER"S CODE 18093000
%H[3].[1:1] =1 NEW FILE HEADER FORMAT 18094000
% .[2:10] SAVE FACTOR (BINARY) 18095000
% .[12:18] DATE OF LAST ACCESS (BINARY) 18096000
% .[30:18] CREATION DATE (BINARY) 18097000
%H[4].[1:1] =1 FILE IS BEING LOADED OR NAME IS BEING CHANGED 18098000
% .[2:1] =1 FILE IS OPENED BY AN EXCLUSIVE USER 18099000
% .[3:1] =1 A PROGRAM IS WAITING TO USE THE FILE 18100000
% .[4:2] SYSTEM NUMBER OF EXCLUSIVE USER 18101000
% .[6:1] USED BY AUTOPRINT TO MARK A PBD FILE 18102000
% .[7:1] USED TO MARK PSEUDO DECKS THAT WERE CREATD ON 18103000
% .[8:1] USED TO MARK SPECIAL COMPILERS 18104000
% .[9:2] =2 FILE IS DATA 18105000
% =3 FILE IS PROGRAM 18106000
% =0 DON"T KNOW IF DATA OR PROGRAM 18107000
% .[11:1] FILE ACCESSED BIT 18108000
% .[12:4] FILE SYSTEM TOGGLES 18109000
% .[16:5] OPEN COUNT 2 FOR SYSTEM 0 (A) 18110000
% .[21:5] OPEN COUNT 2 FOR SYSTEM 1 (B) 18111000
% .[26:5] OPEN COUNT 2 FOR SYSTEM 2 (C) 18112000
% .[31:5] OPEN COUNT 2 FOR SYSTEM 3 (D) 18113000
% .[36:6] =0 TYPE IS UNKNOWN 18114000
% =1 BASIC 18115000
% =2 ALGOL 18116000
% =3 COBOL 18117000
% =4 FORTRAN 18118000
% =5 TSPOL 18119000
% =6 XALGOL 18120000
% =7 SEQ 18121000
% =8 DATA 18122000
% =9 LOCK 18123000
% .[42:1] USED TO MARK FILES WHICH CANT BE MOVED 18123100
% .[43:2] SENSITIVE DATA - ZEROING BITS 18124000
% .[45:1] COLD START FILE 18124100
% .[46:2] NOT USED 18124200
%H[5].[0:48] =0 SOLE USER FILE 18125000
% .[1:1] =1 PRIVATE FILE 18126000
% =12 IF H[6]=12 THEN INFO FILE ELSE PUBLIC FILE 18127000
%H[7] NUMBER OF LOGICAL RECORDS (EOF POINTER) 18128000
%H[8] NUMBER OF SEGMENTS PER ROW 18129000
%H[9].[1:1] TOGGLE 1 FOR SYSTEM 0 (A) 18130000
% .[2:1] TOGGLE 1 FOR SYSTEM 1 (B) 18131000
% .[3:1] TOGGLE 1 FOR SYSTEM 2 (C) 18132000
% .[4:1] TOGGLE 1 FOR SYSTEM 3 (D) 18133000
% .[5:1] TOGGLE 2 FOR SYSTEM 0 (A) 18134000
% .[6:1] TOGGLE 2 FOR SYSTEM 1 (B) 18135000
% .[7:1] TOGGLE 2 FOR SYSTEM 2 (C) 18136000
% .[8:1] TOGGLE 2 FOR SYSTEM 3 (D) 18137000
% .[9:5] OPEN COUNT 1 FOR SYSTEM 0 (A) 18138000
% .[14:5] OPEN COUNT 1 FOR SYSTEM 1 (B) 18139000
% .[19:5] OPEN COUNT 1 FOR SYSTEM 2 (C) 18140000
% .[24:5] OPEN COUNT 1 FOR SYSTEM 3 (D) 18141000
% .[29:14] NOT USED 18142000
% .[43:5] MAXIMUM NUMBER OF ROWS 18143000
%H[10]-H[29] DISK ADDRESSES OF ROWS (0 IF NOT ASSIGNED) 18144000
% 18145000
% 18146000
%THE OPEN COUNTS AND TOGGLES ARE USED IN THE FOLLOWING MANNER: 18147000
% 18148000
% TOGGLE 1 TOGGLE 2 OPEN COUNT 1 OPEN COUNT 2 18149000
% 0 0 INPUT ONLY INPUT 18150000
% 0 1 (OUTPUT) NOT USED INPUT 18151000
% 1 0 SHARED INPUT 18152000
% 1 1 PROTECT INPUT 18152100
% 18153000
%END COMMENT; 18154000
REAL PROCEDURE DIRECTORYSEARCH(A,B,OPTN);% 18155000
VALUE A,B,OPTN; REAL A,B,OPTN;% 18156000
% OPTN= 0 OPENS FOR SHARED USE 18157000
% OPTN= 1 OPENS FOR INPUT 18158000
% OPTN= 2 OPENS FOR OUTPUT 18159000
% OPTN= 3 OPENS FOR WRITELOCK 18160000
% OPTN= 4 OPENS FOR EXCLUSIVE USE 18161000
% OPTN= 5 RETURNS FILE HEADER (UNCHANGED) 18162000
% OPTN= 6 REMOVES FILE FROM DISK UNCONDITIONALLY 18163000
% OPTN= 7 REMOVES FILE FROM DISK AS SOON AS IT IS NOT IN USE 18164000
% OPTN= 8 REMOVES FILE HEADER ONLY 18165000
% OPTN= 9 HEADERUNLOCK--WRITES HEADER POINTED TO BY (F-4).[CF] 18166000
% BACK OUT ON (F-4).[FF], TURNS OFF INTERLOCK & DOES 18167000
% FORGETSPACE(F-4). 18168000
% OPTN=10 CLOSE SHARED 18169000
% OPTN=11 CLOSE INPUT 18170000
% OPTN=12 CLOSE OUTPUT 18171000
% OPTN=13 CLOSE WRITELOCK 18172000
% OPTN=14 CLOSE EXCLUSIVE 18173000
% OPTN=15 LOGS THE FILE AND RESETS ITS CREATION DATE AND TIME 18174000
% OPTN=16 MAKES THE FILE NOT A SYSTEM FILE 18175000
% OPTN=17 MAKES THE FILE A SYSTEM FILE 18176000
% OPTN=18 WILL INTERLOCK SYSTEM FILES 18177000
% OPTN=19 RETURNS FILE HEADER (UNCHANGED AND LOCKED...IT IS UP TO 18178000
% THE CALLING ROUTINE TO CLEAN UP) 18178100
% OPTN=20 CLOSE A FILE GIVEN JUST THE DISK ADDRESS OF ITS HEADER 18179000
% A CONTAINS THE DISK ADDRESS 18179010
% B CONTAINS THE OPTN NUMBER OF THE DESIRED CLOSE 18179020
% OPTN=21 OPENS PROTECT 18179100
% OPTN=22 CLOSE PROTECT 18179200
% OPTN>512 FILECLOSE--ADDRESS OF HEADER IN OPTN.[CF] 18180000
% CLOSE OPTION-10 IS IN OPTN.[FF] 18181000
% OPTN< 0 RETURNS AN AREA OF USER DISK AND UPDATES CORE COPY 18182000
% OF FILE HEADER--ADDRESS OF HEADER IS IN OPTN.[CF]-- 18183000
% NUMBER OF THE ROW TO BE FILLED IS IN OPTN.[FF] 18184000
% IS IN OPTN.[CF] 18185000
% A.[1:1] DIRECTORYSEARCH WILL FORGET THE MEMORY SPACE 18186000
% OCCUPIED BY THE FILE HEADER 18187000
% A.[2:1] IS DIALED INTO FH[4].[1:1] WHEN OPTN=4 18188000
% A.[3:1] IF A CONFLICT OCCURS, AN "IF" WILL BE ENABLED. IF THE 18189000
% OPERATOR ENTERS AN "IF", DIRECTORYSEARCH WILL RETURN A 18190000
% VALUE OF 1. CURRENTLY, THIS IS USED ONLY BY LIBMAIN. 18191000
% B.[1:1] DIRECTORYSEARCH WILL RETURN A VALUE OF 1 IF THE 18192000
% FILE IS IN USE 18193000
% B.[2:1] WILL NOT UPDATE DATE OF LAST ACCESS 18194000
% B.[3:1] WILL SET FILE ACCESSED BIT FOR CLOSE 18195000
BEGIN 18196000
REAL OLDONE=-4; 18197000
REAL TEMP,I,T,TOG,J,K,N,F,X; 18198000
INTEGER S,I1,I2,I3; 18199000
REAL UNITNO; 18199100
ARRAY FH[*],NB[*]; 18200000
$ SET OMIT = NOT SHAREDISK 18200490
DEFINE DSED=TERMSET(P1MIX)#; 18201000
$ SET OMIT = SHAREDISK 18201490
DEFINE UNLOCKHDR = EXIT#; 18201500
$ POP OMIT 18201510
LABEL LL,EXT,CHECK,LWS; 18202000
LABEL OPENSHARED,OPENINPUT,OPENOUTPUT,OPENWRITELOCK, 18203000
OPENEXCLUSIVE,L6,L7,L8,EXIT,LWRITE,FOUND, 18204000
THU,CLOSE,LW,BOMB,GETAROW,EX, 18205000
CLOSESHARED,CLOSEINPUT,CLOSEOUTPUT,CLOSEWRITELOCK, 18206000
CLOSEXCLUSIVE,ZER,UNSYS,SYS, 18207000
SEE,LOCKSYS,DONTWAIT,NOFILE,COMPLETE,LEAVLKD,UNUSED; 18208000
$ SET OMIT = NOT(DISKLOG) 18209000
LABEL OPENPROTECT,CLOSEPROTECT; 18210300
SWITCH Q~OPENSHARED,OPENINPUT,OPENOUTPUT,OPENWRITELOCK, 18211000
OPENEXCLUSIVE,EXIT,L6,L7,L8,EXIT, 18212000
CLOSESHARED,CLOSEINPUT, 18213000
CLOSEOUTPUT,CLOSEWRITELOCK,CLOSEEXCLUSIVE 18214000
$ SET OMIT = NOT(DISKLOG) 18215000
$ SET OMIT = DISKLOG 18217000
,EXIT 18218000
$ POP OMIT 18218001
,UNSYS,SYS 18219000
,LOCKSYS,LEAVELKD,UNUSED,OPENPROTECT,CLOSEPROTECT 18220000
; 18221000
%************************************************* 18222000
REAL SUBROUTINE SEARCH; 18223000
BEGIN 18224000
$ SET OMIT = NOT SHAREDISK 18224490
S:=SCRAMBLE(A,B); 18225000
DISKWAIT(-N,-60,S); 18226000
LL: FOR X:=0 STEP 3 UNTIL 57 DO 18227000
IF (NB[X] EQV A.[6:42]) = NOT 0 THEN 18227500
IF (NB[X+1] EQV B.[6:42]) = NOT 0 THEN GO TO FOUND; 18228000
IF (S:=NB[2].[FF])!0 THEN 18228500
BEGIN DISKWAIT(-N,60,S); 18229000
GO TO LL; 18229500
END ELSE 18230000
$ SET OMIT = NOT SHAREDISK 18230490
GO TO EXT; 18231000
FOUND: I~(K~NB[X+2].[CF]-DIRECTORYTOP-4).[44:4]|2; 18232000
J ~(K AND NOT 15)+DIRECTORYTOP+19; 18233000
K ~ K+DIRECTORYTOP+4; 18234000
EXT: SEARCH ~ S; 18235000
END; 18236000
%************************************************* 18237000
SUBROUTINE HEADER; 18238000
BEGIN 18239000
DISKWAIT(-F,30 18240000
$ SET OMIT = NOT SHAREDISK 18240090
,K); 18240200
$ SET OMIT = NOT SHAREDISK 18240490
TEMP:=F&K[CTF]&I[8:38:10]; 18241000
END; 18242000
%************************************************* 18243000
SUBROUTINE REMOVER; % CANT BE CALLED FROM OTHER SUBROUTINES. 18244000
BEGIN NB[X]~@14; 18245000
DISKWAIT(N,-60,S); 18245500
$ SET OMIT = NOT SHAREDISK 18245990
DISKWAIT(-N,-30,J); 18247500
NB[I]~@14; NB[I+1]~NEXTSLOT; NEXTSLOT~K; 18248000
DISKWAIT(N,-30,J); 18248500
$ SET OMIT = NOT SHAREDISK 18248990
END; 18250000
%************************************************* 18251000
SUBROUTINE HOLD; 18252000
BEGIN 18253000
$ SET OMIT = NOT SHAREDISK 18253490
IF B.[1:1] THEN GO DONTWAIT; 18254000
$ POP OMIT OMIT 18254010
FILEHOLD(A,B,TOG,TEMP,1); 18255000
IF P THEN % 0 OR 1 IS LEFT ON TOP OF STACK IN FILEHOLD 18255100
BEGIN TEMP:=3; A:=-1; GO EXIT; END % DS-ED IN FILEHOLD 18255200
ELSE 18255300
IF P1MIX!0 THEN 18256000
IF REPLY[P1MIX]=VIF THEN 18258000
BEGIN 18259000
FILEHOLD(A,B,TOG,TEMP,2); 18260000
DONTWAIT: 18260500
TEMP:=1; % IN USE 18261000
GO TO FXIT; 18262000
END; 18263000
IF SEARCH=0 THEN 18264000
BEGIN FILEHOLD(A,B,TOG,TEMP,0); 18265000
NOFILE: TEMP:=0; A:=-1; GO EXIT; 18266000
END; 18269000
HEADER; 18270000
END; % OF HOLD 18271000
%************************************************* 18272000
$ SET OMIT = NOT(PACKETS) 18272199
IF OPTN.[CF] LSS 512 THEN 18272200
BEGIN UNITNO:=OPTN.[9:21]; OPTN:=OPTN INX 0; END; 18272300
$ POP OMIT 18272301
$ SET OMIT = SHAREDISK 18272990
LOCKDIRECTORY; 18273000
$ POP OMIT 18273010
IF OPTN=20 THEN 18273020
BEGIN OPTN:=B.[CF]; 18273030
DISKWAIT(-(F:=SPACE(30)),-30,(K:=A.[CF])); 18273040
FH:=[M[F]]&30[8:38:10]; 18273050
TEMP := F & K [CTF]; %155-18273055
GO Q[OPTN]; 18273060
END; 18273070
IF OPTN=9 THEN 18274000
BEGIN 18275000
DISKWAIT(-(N:=SPACE(30)),-30,(K:=OLDONE.[FF])); 18276000
FH:=[M[F:=(TEMP:=OLDONE).[CF]]]&30[8:38:10]; 18276500
A:=NABS(A); 18277000
FH[4]:=(*P(DUP))&M[N+4][3:3:1]; 18277500
GO TO CLOSEEXCLUSIVE; 18278000
END; 18279000
NB:=[M[N:=SPACE(60)]]&60[8:38:10]; 18280000
IF SEARCH=0 THEN 18281000
BEGIN 18282000
A:=0; 18283000
GO TO EXIT; 18284000
END; 18285000
$ SET OMIT = NOT SHAREDISK 18285099
$ SET OMIT = SHAREDISK 18285999
FH:=[M[F:=TYPEDSPACE(30,DISKHEADERAREAV)]]&30[8:38:10]; % %167-18286000
$ POP OMIT 18286001
HEADER; 18287000
IF OPTN<0 THEN GO GETAROW; 18288000
IF OPTN}512 THEN GO TO Q[OPTN.[FF]+10]; 18289000
$ SET OMIT = SHAREDISK 18289999
IF OPTN LSS 5 OR OPTN=17 OR OPTN=7 THEN 18290000
$ POP OMIT 18290001
$ SET OMIT = NOT SHAREDISK 18290099
CHECK: 18291000
BEGIN 18292000
IF FH[4].[44:1] AND OPTN LSS 5 THEN 18292100
BEGIN % TRYING TO OPEN WHILE FILE IS BEING BLANKED 18292200
$ SET OMIT = NOT SHAREDISK 18292300
GO NOFILE; 18292600
END; 18292700
$ SET OMIT = SHAREDISK 18292999
IF NOT OPTN OR OPTN=7 THEN 18293000
$ POP OMIT 18293001
$ SET OMIT = NOT SHAREDISK 18293099
IF FH[4].[12:4]! 0 THEN 18293200
BEGIN % IT IS A SYSTEM FILE 18294000
TEMP:=2; % SYSTEM FILE 18295000
$ SET OMIT = NOT SHAREDISK 18295490
GO TO EXIT; 18296000
END; 18297000
SEE: 18298000
IF (FH[4].[2:2] AND (NOT TOG OR 2))!0 THEN 18299000
BEGIN 18300000
HOLD; 18301000
GO CHECK; 18302000
END; 18303000
END; 18305000
GO TO Q[OPTN]; 18306000
OPENSHARED: 18307000
IF FH[9].[5:4]=0 THEN 18308000
IF FH[9].[1:4]!0 OR FH[9].[9:20]=0 THEN 18309000
BEGIN 18310000
$ SET OMIT = NOT(SHAREDISK) 18310999
$ SET OMIT = SHAREDISK 18314099
FH[9].[9:5]:=P(DUP).[9:5]+1; 18314100
FH[9].[1:1]:=1; 18314200
$ POP OMIT 18314201
GO TO LWRITE; 18315000
END; 18316000
HOLD; 18317000
GO TO OPENSHARED; 18318000
OPENINPUT: 18319000
$ SET OMIT = NOT(SHAREDISK) 18319999
$ SET OMIT = SHAREDISK 18321099
FH[4].[16:5]:=P(DUP).[16:5]+1; 18321100
$ POP OMIT 18321101
GO TO LWRITE; 18322000
OPENOUTPUT: 18323000
IF FH[9].[5:24]=0 THEN 18324000
BEGIN 18325000
$ SET OMIT = NOT(SHAREDISK) 18325999
$ SET OMIT = SHAREDISK 18327099
FH[9].[5:1]:=1; 18327100
$ POP OMIT 18327101
GO TO LWRITE; 18328000
END; 18329000
HOLD; 18330000
GO TO OPENOUTPUT; 18331000
OPENWRITELOCK: 18332000
IF FH[9].[1:8]=0 THEN 18333000
BEGIN 18334000
$ SET OMIT = NOT(SHAREDISK) 18334999
$ SET OMIT = SHAREDISK 18336099
FH[9].[9:5]:=P(DUP).[9:5]+1; 18336100
$ POP OMIT 18336101
GO TO LWRITE; 18337000
END; 18338000
HOLD; 18339000
GO TO OPENWRITELOCK; 18340000
OPENEXCLUSIVE: 18341000
IF FH[9].[5:24]=0 THEN 18342000
IF FH[4].[16:20]=0 THEN 18343000
BEGIN 18344000
COMPLETE: FH[4]:=(P(DUP,LOD))&SYSNO[4:46:2]&1[2:47:1]&A[1:2:1]; 18345000
GO TO LWRITE; 18346000
END; 18347000
HOLD; 18348000
GO TO OPENEXCLUSIVE; 18349000
OPENPROTECT: 18349100
$ SET OMIT = NOT SHAREDISK 18349149
$ SET OMIT = SHAREDISK 18349799
GO TO OPENEXCLUSIVE; 18349800
$ POP OMIT 18349801
CLOSESHARED: 18350000
$ SET OMIT = NOT(SHAREDISK) 18350999
$ SET OMIT = SHAREDISK 18357099
IF (I:=FH[9].[9:5]-1)=0 THEN 18357100
FH[9].[1:1]:=0; 18357200
FH[9].[9:5]:=I; 18357300
$ POP OMIT 18357301
GO TO CLOSE; 18358000
CLOSEINPUT: 18359000
$ SET OMIT = NOT(SHAREDISK) 18359999
$ SET OMIT = SHAREDISK 18361099
FH[4].[16:5]:=P(DUP).[16:5]-1; 18361100
$ POP OMIT 18361101
FH[4].[6:1]:=0; 18361200
GO TO LW; 18362000
CLOSEOUTPUT: 18363000
$ SET OMIT = NOT(SHAREDISK) 18363999
$ SET OMIT = SHAREDISK 18365099
FH[9].[5:1]:=0; 18365100
$ POP OMIT 18365101
GO TO CLOSE; 18366000
CLOSEWRITELOCK; 18367000
$ SET OMIT = NOT(SHAREDISK) 18367999
$ SET OMIT = SHAREDISK 18369099
FH[9].[9:5]:=P(DUP).[9:5]-1; 18369100
$ POP OMIT 18369101
GO TO LW; 18370000
CLOSEEXCLUSIVE: 18371000
FH[4].[1:2]~0; 18372000
GO TO CLOSE; 18373000
CLOSEPROTECT: 18374000
$ SET OMIT = NOT SHAREDISK 18374001
$ SET OMIT = SHAREDISK 18374599
GO TO CLOSEEXCLUSIVE; 18374600
$ POP OMIT 18374601
$ SET OMIT = NOT SHAREDISK 18374999
SYS: 18388000
IF FH[9].[1:8]=0 THEN 18389000
BEGIN 18390000
$ SET OMIT = NOT(SHAREDISK) 18390999
$ SET OMIT = SHAREDISK 18392099
FH[4].[12:1]:=1; 18392100
$ POP OMIT 18392101
GO TO LWRITE; 18393000
END; 18394000
HOLD; 18395000
GO TO SYS; 18396000
UNSYS: 18397000
$ SET OMIT = NOT(SHAREDISK) 18397999
$ SET OMIT = SHAREDISK 18399099
FH[4].[12:1]:=0; 18399100
$ POP OMIT 18399101
GO TO LW; 18400000
LOCKSYS: 18401000
OPTN:=4; 18402000
GO SEE; 18403000
$ SET OMIT = NOT(SHAREDISK) 18403999
$ SET OMIT = NOT(DISKLOG) 18411000
GETAROW: 18421000
IF FH[I2:=OPTN.[FF]]=0 THEN 18422000
BEGIN 18423000
$ SET OMIT = NOT(DISKLOG) 18424000
IF (FH[I2]:=GETUSERDISK(FH[8]&3[1:46:2]))=0 THEN 18425100
BEGIN 18425150
$ SET OMIT = SHAREDISK 18425175
UNLOCKDIRECTORY; 18425200
$ SET OMIT = NOT SHAREDISK 18425225
I1:=GETUSERDISK(-FH[8]); 18425300
$ SET OMIT = SHAREDISK 18425390
LOCKDIRECTORY; 18425400
$ POP OMIT 18425410
IF SEARCH=0 THEN 18425500
BEGIN FORGETUSERDISK(I1,FH[8]); 18425600
TEMP:=0; A:=-1; 18425700
GO TO EXIT; 18425800
END; 18425900
HEADER; 18426000
FH[12]:=I1; 18426100
END; 18426200
END; 18427000
FOR I2:=FH[9].[43:5]+9 STEP -1 UNTIL 10 DO 18428000
M[OPTN INX I2]:=FH[I2]; 18429000
GO TO LW; 18430000
CLOSE: 18431000
IF B.[3:1] THEN FH[4].[11:1] ~ 1; 18431050
IF OPTN GTR 511 THEN 18431100
BEGIN 18431200
IF (FH[0] EQV M[OPTN])!NOT 0 THEN 18431300
IF (I1:=(((I1:=((((I2:=FH[7]+1) DIV (I3:=FH[0]).[30:2]) 18431400
|I3.[42:6])|30)+(I2 MOD I3.[30:12]) 18431500
|(IF (I2:=I3.[1:14])=0 THEN 30 ELSE I2)) DIV 30) 18431600
DIV (I3:=M[OPTN]).[42:6])|I3.[30:12] 18431700
+((((I1 DIV 30) MOD I3.[42:6])|30 18431800
+I1 MOD 30+I3.[1:14]-1) DIV I3.[1:14])-1) 18431900
=M[OPTN+7] THEN GO TO LW; 18432000
FH[0]:=M[OPTN]; 18432100
FH[4]:=(*P(DUP)) OR (M[OPTN+4] AND 16); 18432150
FH[7]:=M[OPTN+7]; 18432200
END; 18432300
GO TO LW; 18432400
L7:% 18432500
IF NOT (FH[4] AND @1400777777770000)!NOT 0 OR 18432600
FH[9].[1:28]!0 THEN 18433000
BEGIN 18434000
HOLD; 18435000
GO TO L7; 18436000
END; 18437000
L6:% 18438000
IF FH[4].[43:2] NEQ 0 THEN % TEST FILE SENSITIVE 18438100
BEGIN 18438110
STREAM(A,B,T:=T:=TYPEDSPACE(10,CONTROLCARDAREAV)+2);% %167-18438120
BEGIN 18438130
DS:=10LIT"CC REMOVE "; SI:=LOC A; SI:=SI+1; DS:=7CHR; 18438140
DS:=LIT"/"; SI:=LOC B; SI:=SI+1; DS:=7CHR; 18438150
DS:=6LIT";END.~"; 18438155
END; 18438160
FH[4].[43:2]:=1; 18438170
INDEPENDENTRUNNER(P(..CONTROLCARD),T&(IF UNITNO NEQ 0 18438180
THEN UNITNO ELSE 31)[2:46:6]&1[8:47:1],192); 18438190
IF UNITNO}32 AND UNITNO{63 THEN PSEUDOCOPY~PSUEDOCOPY+1; 18438195
M[T-4].[9:6]:=0; 18438200
$ SET OMIT = NOT(SHAREDISK) 18438202
GO COMPLETE; 18438210
END; 18438220
$ SET OMIT = PACKETS 18439000
LBMESS(ABS(A),ABS(B),7,0,0,UNITNO,LIBMSG); 18439125
$ SET OMIT = NOT(DISKLOG) 18440000
PBCOUNT:=PBCOUNT-((((A.[6:42] EQV "PBD ")=NOT 0) OR 18442000
((A.[5:42] EQV "PUD ")=NOT 0)) AND B.[CF]=1); 18443000
L8: REMOVER; 18444000
IF OPTN!8 THEN 18444500
FOR I ~ 1 STEP 1 UNTIL FH[9] DO% 18445000
IF FH[9+I]!0 THEN FORGETUSERDISK(FH[I+9],FH[8]);% 18446000
GO TO LW; 18447000
LWRITE: 18453500
IF NOT B.[2:1] THEN 18454000
STREAM(A~[DATE],B~[FH[3]],C~0); 18455000
BEGIN SI~A;DI~LOC C;DS~8 OCT;SI~LOC C;SI~SI+5; 18456000
DI~B;DI~DI+2;DS~3 CHR; 18457000
END; 18458000
LW: 18459000
IF FH[4].[3:1] OR TOG THEN FILEHOLD(A,B,TOG,TEMP,0); 18460000
IF OPTN<6 OR OPTN>8 THEN 18460500
LWS: DISKWAIT(F,-30,K); 18461000
EX: FH[9]:=(*P(DUP)) AND 31; 18462000
EXIT:% 18463000
IF A.[1:1] OR TEMP<64 AND TEMP>0 THEN FORGETSPACE(F); 18465000
$ SET OMIT = SHAREDISK 18465990
UNLOCKDIRECTORY; 18466000
$ POP OMIT 18466010
LEAVELKD: 18466100
UNUSED: 18466101
IF N NEQ 0 THEN FORGETSPACE(N); 18466200
DIRECTORYSEARCH~TEMP; 18467000
END; % OF DIRECTORYSEARCH 18468000
PROCEDURE PICKTHELOCK; FORWARD; 18468100
PROCEDURE EVENTANDINTERRUPT; FORWARD; 18468200
PROCEDURE COMMUNICATE1; 18500000
BEGIN REAL R4=-4,R5=-5,R6=-6,R7=-7,R8=-8; 18500100
INTEGER I4=-4,I5=-5,I6=-6; 18500200
ARRAY A4=-4[*],A5=-5[*],A6=-6[*]; 18500300
ARRAY A7=-7[*]; 18500400
NAME N4=-4,N5=-5,N6=-6; 18500500
LABEL C0,C1,C2,C3,C4,C5,C6,C7,C8,C9,C10,C11,C12,C13,C14,C15,C16, 18500600
C17,C18,C19,C20,C21,C22,C23,C24,C25,C26; 18500700
LABEL C27,C28,C29,C30,C31,C32; 18500800
LABEL C33,C34,C35,C36,C37,C38,C39,C45,C47,C48,C49, 18500900
C30A,C30B,C49A, 18501000
INIT,AC0,AC1,AC2,AC3,AC4,AC5,CHANGENAME; 18501100
$ SET OMIT = NOT SHAREDISK 18501200
SWITCH AC:=AC0,AC1,AC2,AC3,AC4,AC5; 18501700
SWITCH C:=C0,INIT,INIT,INIT,C4,INIT,INIT,INIT,INIT,INIT,INIT, 18501800
INIT,INIT,INIT,INIT,C15,C16,INIT,INIT,INIT,INIT, 18501900
INIT,INIT,INIT,INIT,INIT,INIT,INIT,INIT,INIT,C30, 18502000
C31,C32,C33,INIT,INIT,INIT,INIT,INIT,INIT,INIT, 18502100
INIT,INIT,INIT,INIT,C45,INIT,INIT,INIT,C49; 18502200
REAL RCW=+0,O,I,J,T; 18502300
ARRAY A[*],FIB=A[*],FPB[*],H[*]; 18502400
BOOLEAN SUBROUTINE DELAYOK; 18503000
% CHECKS FOR TIMEOUT, DS, OR CONDITION SATISFIED FOR COMMUNICATE 31.18503100
BEGIN 18503200
DELAYOK := CLOCK+P(RTR)>I4 OR TERMSET(P1MIX) OR 18503300
(I := NOT(M[A6] AND R5)!NOT(0)); 18503400
END; 18503500
% 18503600
GO TO C[PRT[P1MIX,9]]; 18504000
INIT: GO TO INITIATE; 18505000
% COBOL INVALID EOJ 18510000
C0: TERMINATE(P1MIX); TERMINALMESSAGE(28); 18510100
% GENERALIZED ZIP 18520000
C4: IF (I~A4.[8:10]!0 THEN BEGIN 18520100
$ SET OMIT = PACKETS 18520200
$ SET OMIT = NOT(PACKETS) 18520500
M[(T:=TYPEDSPACE(I+5,CONTROLCARDAREAV)+2)-4].[AREAMIXF]:=0;% %167-18520600
$ POP OMIT 18520700
IF NOT A.[2:1] THEN MAKEPRESENT(NFLAG(NOT 3 INX [RCW])); 18520800
IF (J~USERCODE[P1MIX])=NOT(-0) THEN J~0; 18520900
STREAM(C~J,A4,I1~I.[36:6],I,Q~0,T); 18521000
BEGIN SI:=A4; SI:=SI-1; 18521100
L: SI:=SI+1; IF SC=" " THEN GO TO L; Q:=SI; DI:=Q; 18521200
IF SC=@14 THEN DS:=LIT" " ELSE DS:=2LIT" "; DI:=T; 18521300
DS:=8LIT"CC USER="; SI:=LOC C; SI:=SI+1; DS:=7 CHR; 18521400
DS:= LIT";" ; SI:=A4; 18521500
I1(DS:=32WDS; DS:=32WDS); DS:= I WDS; 18521600
$ SET OMIT = NOT(PACKETS) 18521700
DS:=8 LIT"~"; 18521800
$ POP OMIT 18521900
TALLY:=12;I:=TALLY; 18522000
DI:=Q;SI:=LOC I;SI:=SI+7;DS:=CHR; 18522100
END STREAM; 18522200
J!IF USERCODE[P1MIX]=MCP THEN 31 ELSE 26; 18522300
$ SET OMIT = NOT(PACKETS) 18522400
IF PSEUDOMIX[P1MIX] NEQ 0 THEN NYLONZIPPER[P1MIX].[2:1]:=0; 18522500
$ POP OMIT 18522600
INDEPENDENTRUNNER(P(.CONTROLCARD),T&P1MIX[18:42:6] 18522700
$ SET OMIT = NOT(DATACOM AND RJE ) 18522800
&J[3:43:5],192); 18523100
$ SET OMIT = NOT(PACKETS) 18523200
IF PSEUDOMIX[P1MIX] NEQ 0 THEN 18523300
SLEEP([NYLONZIPPER[P1MIX]],@1000000000000000); 18523400
$ POP OMIT 18523500
END ELSE 18523600
BEGIN FIB~N4[NOT 2]; 18523700
FPB~PRT[P1MIX,3]; 18523800
I~IF FIB[4].[12:1] THEN FIB[4].[13:11] 18523900
ELSE (FIB[4].[13:11]-1)|ETRLNG; 18524000
T~FPB[I+3].[43:5]; 18524100
IF T=10 OR T=12 OR T=13 OR T=26 THEN 18524200
BEGIN 18524300
IF FIB[5].[42:1] THEN GO TO CHANGENAME; 18524400
H~FIB[14]; 18524500
$ SET OMIT = DATACOM AND RJE 18524600
H[6]:=0; 18524700
$ POP OMIT 18524800
H[5]:=USERCODE[P1MIX]; 18524900
$ SET OMIT = NOT(DATACOM AND RJE ) 18525000
H[6]~(*P(DUP))&3[2:42:6]; 18525300
$ RESET OMIT 18525400
IF H[4] THEN 18525500
BEGIN FILECLOSE(N4.[33:15]); 18525600
CHANGENAME: IF (T~DIRECTORYSEARCH(FPB[I],FPB[I+1],4)) 18525700
LSS 64 18525750
THEN GO TO INITIATE; 18525800
H~[M[T]]&30[8:38:10]; 18525900
$ SET OMIT = NOT(SHAREDISK) 18526000
H[5]:=USERCODE[P1MIX]; 18526300
$ SET OMIT = NOT(PACKETS) 18526400
H[6]~(*P(DUP))&3[2:42:6]; 18526500
$ POP OMIT 18526600
ENTERCONTROLDECK(H); 18526700
P(DIRECTORYSEARCH(-FPB[I],FPB[I+1],8),DEL); 18526800
J~H[2]; % SAVED LASTCDNUM 18527000
FORGETSPACE(H); 18527100
END ELSE 18527200
BEGIN FILECLOSE((N4.[33:15])&6[18:33:15]); 18527300
ENTERCONTROLDECK(H); 18527400
J~H[2]; % SAVED LASTCDNUM 18527500
FOR T~10 STEP 1 UNTIL 29 DO H[T]~0; 18527600
FILECLOSE(N4.[33:15]); 18527700
END; 18527800
IF RUNUMBER LEQ 0 THEN 18527900
BEGIN 18528000
STREAM(A~[HAR[P1MIX,0]], B~H~USERCODE[P1MIX], 18528100
F~H!MCP AND H!0, P1MIX, J, T~T~SPACE(10)); 18528200
BEGIN SI~A; DS~LIT"#"; 18528300
2(SI~SI+1; DS~7 CHR; DS~LIT"/"); DI~DI-1; 18528400
F(SI~LOC B; SI~SI+1; DI~DI+1; DS~7 CHR); 18528500
SI~LOC P1MIX; DS~LIT"="; A~DI; 18528600
DS~2 DEC; DS~14 LIT" ZIPPED DECK #"; 18528700
SI~LOC J; DS~4 DEC; DS~LIT"~"; 18528800
DI~DI-5; DS~3 FILL; DI~A; DS~FILL; 18528900
END; 18529000
SPOUT(T); 18529100
END; 18529200
END; 18529300
END; 18529400
GO TO INITIATE; 18529500
% DISPLAY (COBOL) 18530000
C15: DISPLAY(A4 INX 1); GO TO INITIATE; 18530100
% COBOL ACCEPT 18540000
C16: DISPLAY(A4 INX 2); %747-18540100
IF AUTODS THEN TERMINATE(P1MIX&61[CTF]) ELSE %747-18540120
BEGIN REPLY[P1MIX]:=-VWY&VAX[36:42:6]; %747-18540140
COMPLEXSLEEP((TERMSET(P1MIX) OR REPLY[P1MIX] GTR 0)); 18540200
END; %747-18540220
IF TERMSET(P1MIX) THEN GO INITIATE; 18540300
IF NOT WHYSLEEP(VWY&VAX[36:42:6]) THEN GO TO C16; 18540400
T~REPLY[P1MIX].[18:15]; REPLY[P1MIX]~0; 18540500
STREAM(T,S~A4 INX 2); 18540600
BEGIN SI~T; 18540700
L: IF SC!"X" THEN BEGIN SI~SI+1; GO TO L END; 18540800
SI~SI+1; 2(DS~40 CHR); 18540900
END; 18541000
FORGETSPACE(T-1); GO TO INITIATE; 18541100
% DIRECTORYSEARCH AND UN-FILL FILE ID FOR NORMAL STATE PROGRAMS 18550000
C30: COMMENT SEARCHES DISK DIRECTORY AND RETURNS DATA IN ARRAY. 18550100
[0] IS USER-TYPE OR NOT-PRESENT FLAG 18550200
[1] IS MULTI-FILE ID 18550300
[2] IS FILE ID 18550400
IF NOT PRESENT, [3] => [5] ARE -1 18550500
IF INVALID USER, [3] => [5] ARE 0 18550600
IF PRIMARY, SECONDARY, OR TERTIARY USER: 18550700
[3] IS RECORD LENGTH 18550800
[4] IS BLOCK LENGTH 18550900
[5] IS END OF FILE POINTER 18551000
[6] IS OPEN COUNT 18551100
IF ARRAY SIZE IS GREATER THAN 9: 18551200
[7] = FILETYPE (FROM HEADER) 18551300
[8] = HEADER[3] (CREATION/ACCESS DATE,SAVE FACTOR) 18551400
[9] = HEADER[1] ( LOGGING DATES) 18551500
IF ARAY SIZE IS GREATER THAN 10: 18551600
[10]= SYSTEM NUMBER (SHAREDISK) 18551700
NOT-PRESENT FLAG IS -1 18551800
INVALID USER FLAG IS 0 18551900
PRIMARY USER FLAG IS 7 (LM,INPUT, AND OUTPUT BITS) 18552000
SECONDARY USER FLAG IS 3 (INPUT AND OUTPUT BITS) 18552100
TERTIARY USER FLAG IS 2 (INPUT BIT ONLY) 18552200
; 18552300
IF A4.[8:10]<7 THEN BEGIN TERMINATE(P1MIX);% 18552400
TERMINALMESSAGE(7); END;% 18552500
IF NOT A4.[2:1] THEN MAKEPRESENT(NFLAG(NOT 3 INX [RCW]));% 18552600
P([M[A4 INX NOT 1]],DUP,DUP,LOD,XCH,CCX,.J,STD,IOR);% 18552700
FIB ~ N5[NOT 2]; FPB ~ PRT[P1MIX,3]; 18552800
I ~ IF FIB[4].[12:1] THEN FIB[4].[13:11]% 18552900
ELSE (FIB[4].[13;11]-1)|ETRLNG; 18553000
A4[I] ~ FPB[I]; A4[2] ~ FPB[I+1]; 18553100
IF P(FPB[I+3].[43:5],DUP,DUP)=10 %RANDOM 18553200
OR (P(XCH) OR 1)=13 OR P(XCH)=26 THEN %SERIAL,UPDATE,PROTECT 18553300
IF ((T:=DIRECTORYSEARCH(A4[1],A4[2],5) ) NEQ 0 %207-18553400
AND M[T+4].[12:4] EQL 0 ) THEN %207-18553410
BEGIN IF (A4[0] ~ SECURITYCHECK(A4[1],A4[2],USERCODE[P1MIX],T))!0 18553500
AND M[T+4].[12:4]=0 18553600
THEN BEGIN A4[3] ~ M[T].[1:14];% 18553700
A4[4] ~ M[T].[15:15]; A4[5] ~ M[T+7];% 18553800
$ SET OMIT = SHAREDISK 18553900
A4[6]:=M[T+4].[16:5]+M[T+9].[9:5]; 18554000
$ POP OMIT 18554100
$ SET OMIT = NOT(SHAREDISK) 18554200
IF A4.[8:10] GTR 9 THEN 18554600
BEGIN A4[7]:=M[T+4].[36:6]; A4[8]:=M[T+3]; 18554700
A4[9]:=M[T+1]; 18554800
END; 18554900
IF A4.[8:10] GTR 10 THEN A4[10]:=SYSNO; 18555000
END ELSE A4[3]:=A4[4]:=A4[5]:=A4[6]:=0; 18555100
FORGETSPACE(T); 18555200
GO TO C30B 18555300
END ELSE GO C30A ELSE 18555400
BEGIN 18555500
T:=-1; 18555600
IF (T:=FINDINPUT(A4[1],A4[2],FPB[I+2].[1;17], 18555700
FPB[I+2].[18:30],FPB[I+3].[1:5],[A4[3]] INX 0, 18555800
T,0,0,0))=NABS(1) THEN GO TO C30A ELSE 18555900
IF T GEQ 0 THEN 18556000
BEGIN 18556100
A4[0]:=4; A4[3]:=(I:=RDCTABLE[T]).[14:10]; 18556200
A4[4]:=I.[24:17]; A4[5]:=I.[41:7]; 18556300
A4[6]:=TINU[T].[30:18]; IF T<16 THEN 18556400
A4[6]:=(*P(DUP))&PRNTABLE[T][12:30:18]; GO C30B; 18556500
END ELSE 18556600
BEGIN 18556700
A4[0]:=5; A4[3].[1:5]:=ABS(T); GO C30B 18556800
END; 18556900
END; 18557000
C30A: A4[0]:=A4[3]:=A4[4]:=A4[5]:=A4[6]:=-1; 18557100
C30B: 18557200
IF NOT J.[2:1] THEN P([M[J]],PRL);% 18557300
GO TO INITIATE;% 18557400
% ALGOL "DELAY" FUNCTION -- WAIT WITH TIMEOUT 18558990
C31: IF A6.[CF]<512 THEN % CAUGHT SOMEONE BEING SNEAKY 18559000
BEGIN TERMINATE(P1MIX); 18559100
TERMINALMESSAGE(17); 18559200
END; 18559300
I4:=60|I4+CLOCK+P(RTR); 18559400
IF NOT DELAYOK THEN COMPLEXSLEEP(DELAYOK); 18559500
I6:=I; 18559600
GO TO INITIATE; 18559700
C32:: 18560000
$ SET OMIT = NOT(DATACOM ) 18560100
GO TO INITIATE; 18565600
C33:: STREAM(R4,A~(R4!0),J~JARROW[P1MIX],P1MIX,% 18570000
T~T~SPACE(10));% 18570100
BEGIN DS~10 LIT " PAUSE # 0";% 18570200
A(DI~DI-1; DI~LOC R4; SI~SI+2; DS~6 CHR); 18570300
DS~5 LIT " FOR"; SI~J; SI~SI+1; DS~7 CHR;% 18570400
DS~LIT "/"; SI~SI+1; DS~7 CHR; DS~LIT "=";% 18570500
SI~LOC P1MIX; DS~2 DEC; DS~LIT "~"; DI~DI-3; DS~FILL;% 18570600
END;% 18570700
SPOUT(T);% 18570800
IF NOTERMSET(P1MIX) THEN PRTROW[P1MIX].[PSF]:=2; 18570900
GO TO INITIATE;% DON"T KEEP COMMUNICATE AROUND NEEDLESSLY 18571200
C45: IF R4 THEN % COBOL68 EXIT PROGRAM/ EXIT PROGRAM RETURN HERE 18580000
BEGIN IF A5.PBIT THEN % IF THERE IS A TASK ARRAY 18580100
IF A5[6]=1 THEN % TYPE = CALLED 18580200
BEGIN A5[7] ~ 1; 18580300
COMPLEXSLEEP(A5[7].[46:1] 18580400
OR (TERMSET(P1MIX))); 18580410
A5 ~ 1; 18580500
END ELSE A5 ~ 0 18580600
ELSE A5 ~ 0; 18580700
GO TO INITIATE; 18580800
END; 18580900
% DETACH TASK ARRAY: DS OR FS JOB RUNNING OR SCHEDULED 18581000
IF N5[6]=2 THEN GO TO INITIATE; 18581100
IF N5[3]=1 THEN SHEETDIDDLER(0,20,N5[4]); 18581200
IF N5[3]=2 THEN 18581300
BEGIN TERMINATE(N5[4]&61[CTF]); HALT; 18581400
NOPROCESSTOG ~ NOPROCESSTOG-1; 18581500
END; 18581600
GO TO INITIATE; 18581700
C49:: 18590000
$ SET OMIT = NOT SHAREDISK 18590100
GO INITIATE; 18593300
END OF COMMUNICATE1; 18599000
PROCEDURE COMMUNICATE0; 18700000
BEGIN REAL R4=-4,R5=-5,R6=-6,R7=-7,R8=-8; 18700100
INTEGER I4=-4,I5=-5,I6=-6; 18700200
ARRAY A4=-4[*],A5=-5[*],A6=-6[*]; 18700300
ARRAY A7=-7[*]; 18700400
NAME N4=-4,N5=-5,N6=-6; 18700500
LABEL C0,C1,C2,C3,C4,C5,C6,C7,C8,C9,C10,C11,C12,C13,C14,C15,C16, 18700600
C17,C18,C19,C20,C21,C22,C23,C24,C25,C26; 18700700
LABEL C27,C28,C29,C30,C31,C32; 18700800
LABEL C33,C34,C35,C36,C37,C38,C39,C45,C47,C48,C49, 18700900
C21A,C3A,INIT,US,D,TD,PR,IOT,TMR,IT,AD,WD; 18701000
LABEL PE,TE,PA; %145-18701010
DEFINE CN=DIFFCOM#; 18701100
SWITCH S:=PA,PE,TE,IT,US,D ,TD,PR,IOT,TMR,AD,WD; %145-18701200
SWITCH C:=INIT,C1,INIT,C3,INIT,INIT,C6,C7,C8,INIT,INIT, 18701300
INIT,C12,INIT,INIT,INIT,INIT,C17,INIT,INIT,C20, 18701400
C21,C22,INIT,INIT,C25,C26,INIT,INIT,C29,INIT, 18701500
INIT,INIT,INIT,INIT,INIT,INIT,INIT,C38,C39,INIT, 18701600
INIT,INIT,INIT,INIT,INIT,INIT,C47,C48,INIT; 18701700
REAL I,J,T; 18701800
ARRAY AIT[*]; REAL AITL=AIT; ARRAY A=AIT[*]; 18701900
NAME ADDR; 18702000
GO TO C[PRT[P1MIX,9]]; 18702200
INIT: GO TO INITIATE; 18702300
% TIME INTRINSIC 18710000
C1: IF (I4:=I4) GEQ (-5) AND I4 LEQ 6 THEN %145-18710100
BEGIN GO TO S[I4+5]; %145-18710200
PA: %145-18710240
$ SET OMIT = NOT(PACKETS) %145-18710242
IF (I:=PSEUDOMIX[P1MIX]) GEQ 32 THEN %145-18710244
I4:=PACKETACT[I-32]; %145-18710246
$ POP OMIT %145-18710248
GO TO INITIATE; %145-18710249
PE: %145-18710250
$ SET OMIT = NOT(PACKETS) %145-18710252
IF (I:=PSEUDOMIX[P1MIX]) GEQ 32 THEN %145-18710254
BEGIN %145-18710256
I4:=PACKETERR[I-32]; %145-18710258
PACKETERR[I-32]:=TRUE; %145-18710260
END; %145-18710262
$ POP OMIT %145-18710264
GO TO INITIATE; %145-18710266
TF: %145-18710268
$ SET OMIT = NOT PACKETS %145-18710270
IF (I:=PSEUDOMIX[P1MIX]) GEQ 32 THEN %145-18710272
T4:=PACKETERR[I-32]; %145-18710274
$ POP OMIT %145-18710276
GO TO INITIATE; %145-18710278
IT: I4~JAR[P1MIX,9].[5:1]; 18710300
JAR[P1MIX,9]~(*P(DUP)) & 2[4:46:2]; 18710400
GO INITIATE; 18710500
US: R4:=USERCODE[P1MIX]; GO TO INITIATE; 18710600
D: I4~DATE; GO TO INITIATE; 18710700
TD: I4~XCLOCK+P(RTR); GO TO INITIATE; 18710800
PR: I4~JAR[P1MIX,3]+PROCTIME[P1MIX]+CLOCK+P(RTR); 18710900
GO TO INITIATE; 18711000
IOT: I4~IOTIME[P1MIX]+JAR[P1MIX,4]; 18711100
WHILE I4<0 DO I4~I4+CLOCK+P(RTR); 18711200
GO TO INITIATE; 18711300
TMR: I4~P(RTR); GO TO INITIATE; 18711400
AD: I4~ACTDATE; GO TO INITIATE; 18711500
WD: I4~WEEKDAY; GO TO INITIATE; %753-18711600
END; 18711700
IF I4 = (-6) THEN I4~P1MIX; %753-18711790
GO TO INITIATE; 18711800
% RETURN SPECIFIC ARRAY 18720000
C3: ARTN(N4[0],1); % REMOVE 1 DIM ARRAY 18720100
C3A:: T~[AITL].[CF]; % REMOVE FROM AIT 18720200
IF NOT(AIT~PRT[P1MIX,6]).[2:1] THEN MAKEPRESENT(T); 18720300
J ~ AIT[0]; T ~ N4.[CF]; 18720400
FOR I~1 STEP 1 UNTIL J-1 DO 18720500
IF AIT[I].[18:15]=T THEN 18720600
BEGIN MOVE(J-I,[AIT[I+1]],[AIT[I]]); J~0 END; 18720700
IF J=0 OR AIT[J].[FF]=T THEN AIT[0] ~ *P(DUP)-1; 18720800
N4[0]~0; 18720900
GO TO INITIATE; 18721000
% WHEN 18730000
C6: I4~60|I4+P(RTR)+CLOCK; 18730100
WHILE NOTERMSET(P1MIX) AND CLOCK+P(RTR) LSS I4 DO 18730200
SLEEP([CLOCK],NOT CLOCK); 18730300
GO TO INITIATE; 18730400
% FILL 18740000
C7: IF NOT A5.[2:1] THEN MAKEPRESENT(NFLAG(NOT 0 INX [I4])); 18740100
I~M[A5 INX NOT 0]; J~M[A5 INX NOT 1]; 18740200
P([M[A5 INX NOT 1]],IOR); 18740300
IF (NT2~(NT1~*(I4 INX PRT[P1MIX,4])).[18:15])>NT3~A5.[8:10] THEN 18740400
NT2~NT3; 18740500
I4~(IF JAR[P1MIX,10]!0 THEN JAR[P1MIX,(NT1~NT1.[CF]) 18740600
DIV (NT3~JAR[P1MIX,8])+10]+NT1 MOD NT3 18740700
ELSE DALOC[P1MIX,NT1.[33:6]+P(DUP)-1]+NT1.[39:9]); 18740800
DISKWAIT(-A5.[CF],NT2,I4); 18740900
M[A5 INX NOT 0]~*P(.I); 18741000
IF NOT (*P(.J)).[2:1] THEN P([M[A5 INX NOT 1]],PRL); 18741100
GO TO INITIATE; 18741200
% PLAIN ZIP 18750000
C8: ZIPPER(R5,R4,0); 18750100
GO TO INITIATE; 18750200
% BREAKOUT 18760000
C12: 18760100
$ SET OMIT = NOT(BREAKOUT) 18760200
GO TO INITIATE; 18760500
% COBOL I/O ERROR 18770000
C17: A5~*A5; A~PRT[P1MIX,3]; I~"I/O ERR"; 18770100
IF A5[5].[1:1] THEN 18770200
BEGIN I:= "INVALID";J:=" USER"; R6:=1 END ELSE 18770300
STREAM(R4,N~[J]); BEGIN SI~LOC R4; DI~DI+1; DS~7 DEC; 18770400
DI~DI-7; DS~5 FILL; 18770500
END; 18770600
FILEMESS(I&R6[1:47:1],J,A[T~A5[4].[13:11]],A[T+1], 18770700
IF R4~(R4=16 OR R4=17 OR R4=82) THEN R8 ELSE 0, 18770800
IF R4 THEN R7 ELSE 0,0); 18770900
GO TO INITIATE; 18771000
% TAPE SWAP FOR TAPE SORT 18780000
C20: SLEEP([N4[3]],IOMASK); SLEEP([N4[4]],IOMASK); 18780100
FOR I~3 STEP 1 UNTIL 4 DO 18780200
BEGIN N5[I].[33:15]~N4[I]; 18780300
M[N4[I] INX NOT 1]~(*P(DUP))&N5[3][14:3:4]&[N5[3]][33:33:15]18780400
END; 18780500
A~N4[0]; A[5].[39:4]~2; A[16]~0; A[18]~NABS(*P(DUP)); 18780600
NT4~A[10].[3:15]; A[10].[3:15]~0; 18780700
A~N5[0]; A[5]~0; A[16]~NFLAG(N5[3]); A[18]~ABS(*P(DUP)); 18780800
A[10].[3:15]~NT4; 18780900
GO TO INITIATE; 18781000
% SORT STORAGE ASSIGNMENT 18790000
C21: A~[M[GETSPACE(R6+R5,2,1)+2]]&R5[8:38:10]; 18790100
A[0]~(R5 INX A)&R6[8:38:10]; 18790200
N4[0]~A; 18790300
IF NOT CONQUER(0,R5-1,R6,1 INX A,J) THEN 18790400
BEGIN FORGETSPACE(A); 18790500
C21A: STREAM(P1MIX,T~R5|R6,A~I~GETSPACE(7)); 18790600
BEGIN DS~LIT "#"; SI~LOC P1MIX; 18790700
DS~2 DEC; DS~ 13 LIT " NO SORT MEM:"; 18790800
DS~5 DEC; DS~9 LIT " WDS RQD~"; 18790900
END; 18791000
$ SET OMIT = PACKETS %713-18791099
$ SET OMIT = NOT PACKETS %713-18791609
SPOUTER(I,0,0); % JOB MESSAGE PAGE ONLY %713-18791610
STREAM(P1MIX, A~I~SPACE(6)); % SIMULATE OPERATORS REPLY %713-18791620
BEGIN DS~20 LIT "+OPERATOR KEYED IN: "; %713-18791630
SI~LOC P1MIX; DS~2 DEC; %713-18791640
DS~26 LIT " OU DK.... TRY DISK SORT~~"; %713-18791650
DI~DI-28; DS~2 FILL; %713-18791655
END; % OF STREAM %713-18791660
SPOUTER(I,0,0); % MESSAGE PAGE ONLY %713-18791670
J~1; % ASSUME "OU DK" IS OPERATORS RESPONSE %713-18791680
$ POP OMIT %713-18791681
GO TO C21; 18791700
END; 18791800
GO TO INITIATE; 18791900
% SORT STORAGE RETURN 18800000
C22:: I~N4[0] INX 1; 18800100
DO FORGETSPACE(M[I]) UNTIL (I~M[I].[18:15])=0; 18800200
FORGETSPACE(N4[0]); N4[0]~0; 18800300
GO TO INITIATE; 18800400
% RETURN OLD COPY OF OWN ARRAY 18810000
C25:: ARTN(A5,R4); 18810100
M[A5.[FF]]~A~PRT[P1MIX,17]&P(.A5,LOC)[18:18:15]; 18810200
IF A.[2:1] THEN M[A.[CF]-1].[CF]~A5.[FF]; 18810300
GO TO INITIATE; 18810400
% INVALID ARGUMENTS TO ALGOL INTRINSICS %WF 18820000
C26:: IF (I ~ R4)}0 THEN 18820100
STREAM(A ~R4, I~I~SPACE(10)); 18820200
BEGIN DS~LIT "-"; % %740-18820300
CI~CI+A; %WF 18820700
GO LOG; GO ROOT; GO LOG; GO EXP; GO SIN; %WF 18820800
DS~3 LIT "COS"; GO EXIT; %WF 18820900
LOG: DS~2 LIT "LN"; GO EXIT; %WF 18821000
ROOT: DS~4 LIT "SQRT"; GO EXIT; %WF 18821100
EXP: DS~3 LIT "EXP"; GO EXIT; %WF 18821200
SIN: DS~3 LIT "SIN"; %WF 18821300
EXIT: DS~8 LIT " ARGMNT "; SI~LOC A; SI~SI+7; % %740-18821400
IF SC}@3 THEN DS~5 LIT "> 158" ELSE %740-18821410
IF SC<@2 THEN DS~5 LIT "NEGTV" ELSE DS~4 LIT "ZERO"; %740-18821420
DS~2 LIT " ~"; % %740-18821430
END; 18821500
IF I = (-7) THEN % COBOL INVALID INDEX 18821600
BEGIN 18821700
R4 ~ R5; R5 ~ R6; 18821800
ERRORFIXER(4); % INVALID INDEX CHECK 18821900
END; 18822000
TERMINATE(P1MIX); TERMINALMESSAGE(-I); %WF 18822100
C29:: COMMENT THIS COMMUNICATE PROVIDES FOR DS-ING AN OBJECT PROGRAM 18830000
AND/OR SPOUTING A MESSAGE ABOUT A PROGRAM. 18830100
R4 IS USED TO SPECIFY THE MESSAGE REQUIRED. 18830200
R5 SET TO TRUE SPECIFIES P1MIX IS TO BE DS-ED. 18830300
T IS THE ADDRESS OF THE MESSAGE(WHICH ENDS WIH A "~"). 18830400
REMAINING VARIABLES MAY BE USED AS DESIRED; 18830500
T ~ SPACE(12); 18830600
IF R4 { 2 THEN 18830700
BEGIN; % 29-1 18830800
STREAM(J:T); 18830900
BEGIN % 29-2 18831000
DS ~ 9 LIT "-DEC ERR:"; 18831100
J ~ DI; 18831200
END; % 29-2 18831300
J ~ P; 18831400
IF R4=1 THEN 18831500
BEGIN; % 29-3 18831600
STREAM(T1~(R6<0),R6~ABS(R6),J); 18831700
BEGIN % 29-4 18831800
DS~17 LIT "ARRAY DIMINSION= ";T1(DS~1 LIT "-";); 18831900
SI ~ LOC R6; 18832000
DS ~ 8 DEC; J ~DI; 18832100
DI ~ DI-8; 18832200
DS ~ 7 FILL; DI ~ J; 18832300
DS ~ 2 LIT " ~"; 18832400
END; % 29-4 18832500
END % 29-3 18832600
ELSE 18832700
BEGIN; % 29-5 18832800
STREAM(R6,7); 18832900
BEGIN % 29-6 18833000
DS ~15 LIT "NO. DISK ROWS= "; 18833100
SI ~ LOC R6; 18833200
DS ~ 8 DEC; J ~ DI; 18833300
DI ~ DI-8; 18833400
DS ~ 7 FILL; DI ~ J; 18833500
DS ~ 2 LIT " ~"; 18833600
END; % 29-6 18833700
END; % 29-5 18833800
END; % 29-1 18833900
IF R4=3 THEN 18834000
BEGIN 18834100
;STREAM(T); 18834200
BEGIN 18834300
DS ~ 18 LIT "-EXP ARGMNT >158:~; % %740-18834400
END; 18834500
END; 18834600
IF R4 = 4 THEN STREAM(R); BEGIN 18834700
DS:=37 LIT"ILLEGAL PERFORM - RETURN OR RELEASE:~"; 18834800
END; 18834900
IF R5 THEN 18835000
BEGIN % 29-7 18835100
TERMINATE(P1MIX); 18835200
TERMINALMESSAGE(-T); 18835300
END % 29-7 18835400
ELSE 18835500
SPOUT(T); 18835600
GO TO INITIATE; 18835700
C38:: % RETURN STORAGE AND AUXILIARY MEMORY FOR CODE OR DATA SEGMENT 18840000
IF A4.[1:1] THEN % CODE SEGMENT 18840100
BEGIN A ~ PRT[P1MIX,*]; T ~ NFLAG(A4 & (I~0)[5:5:1]); 18840200
DO IF T.[5:1] THEN I ~ T.[FF] ELSE 18840300
IF T.[6:1] THEN I ~ T.[7:11] ELSE 18840400
T ~ NFLAG(A[T.[7:11]]) 18840500
UNTIL I!0; 18840600
ADDR ~ I INX A[4]; 18840700
IF ADDR[0].[3:1] THEN 18840800
COMPLEXSLEEP((NOT ADDR[0].[3:1])); 18840900
ADDR[0].[3:2] ~ 2; 18841000
COMMENT TURN OFF AUXILIARY MEMORY FLAG, AND TURN 18841100
ON THE "DO NOT TOUCH" FLAG FOR 18841200
RE-ENTRANT PRESENCE-BIT PROTECTION; 18841300
IF NOT STOREDY THEN SLEEP([TOGLE], STOREMASK); 18841400
LOCKTOG(STOREMASK); 18841500
IF (I ~ (T ~ ADDR[0]).[FF])>1023 THEN % PRESENT 18841600
BEGIN J ~ M[I-1]; P(OLAY(I-2), DEL) END 18841700
$ SET OMIT = NOT(AUXMEM) 18841800
$ SET OMIT = AUXMEM 18842200
; 18842300
$ POP OMIT 18842400
$ SET OMIT = NOT(AUXMEM) 18842500
ADDR[0].[3;1]~0; 18843400
COMMENT 3:1 =0, NOT BEING MASSAGED BY PRESENCE BIT 18843500
4:2 =2, ASSIGN AUXILIARY MEMORY NEXT OVELAY; 18843600
UNLOCKTOG(STOREMASK); 18843700
GO TO INITIATE 18843800
END; % OF CODE SEGMENTS 18843900
IF NOT STOREDY THEN SLEEP([TOGLE], STOREMASK); 18844000
LOCKTOG(STOREMASK); 18844100
IF (T ~ NFLAG(M[J ~ A4.[FF]])).[2:1] THEN 18844200
BEGIN M[J].[3:3]+7; %MARK AS "READ-ONLY", ALREADY WRITTEN 18844300
M[T INX NOT 0] ~ (*P(DUP)) & ((I~P(DUP).[FF]) OR 1)[CTF]; 18844400
AITL ~ M[T INX NOT 1].[2:1]; 18844500
P(OLAY(T.[CF]-2)); 18844600
$ SET OMIT = NOT(DEBUGGING) 18844700
P(DEL) 18845100
END ELSE AITL~((I~T.[CF])=1); 18845200
IF I>511 THEN DISKRTN(I, T.[8:10]); 18845300
M[J] ~ FLAG(T&0[2;42:6]&AITL[CTC]); 18845400
UNLOCKTOG(STOREMASK); 18845500
GO TO INITIATE; 18845600
C39:: % BASIC ARRAY RETURN 18850000
ARTN(N4[0],R5); % RETURN R5 DIM ARRAY 18850100
GO TO C3A; % TO REMOVE FROM AIT 18850200
C47:: PRT[P1MIX,8] ~ FLAG(R8);%DONE ONLY AT END OF INTERRUPTER INTRIN18860000
P(8 INX PRT[P1MIX,TSX],DUP,LOD,0,FFX,XCH,STD); 18860100
GO TO INITIATE; 18860200
% MEMORY DUMP OR TRACE FROM THE INTRINSICS 18870000
C48: % 18870100
$ SET OMIT = NOT(DUMP OR DEBUGGING) 18870200
IF I4 NEQ 0 THEN 18870300
$ SET OMIT = NOT(DEBUGGING) OR OMIT 18870400
ELSE DUMPNOW(R5); 18870700
$ POP OMIT 18870800
GO TO INITIATE;% 18870900
END OF COMMUNICATE0; 18872000
SAVE PROCEDURE COM2; %721-19300000
BEGIN % SLEEP FUNCTION (ALGOL WAIT) 19301000
REAL R4=-4; ARRAY A5=-5[*]; %721-19302000
SLEEP([M[A5]],R4); %721-19303000
GO TO RETURN; %721-19304000
END COM2; %721-19305000
PROCEDURE SHORTCOMMUNICATE; 19500000
BEGIN REAL R4=-4,R5=-5,R6=-6,R7=-7,R8=-8,R9=-9; % (SHM)19501000
INTEGER I4=-4,I5=-5,I6=-6; 19502000
ARRAY A4=-4[*],A5=-5[*],A6=-6[*]; 19503000
ARRAY A7=-7[*]; 19504000
NAME N4=-4,N5=-5,N6=-6; 19505000
LABEL C0,C1,C2,C3,C4,C5,C6,C7,C8,C9,C10,C11,C12,C13,C14,C15, 19506000
C16,C17,C18,C19,C20,C21,C22,C23,C24,C25,C26,C27,C28, 19507000
C29,C30,C31,C32,C33,C34,C35,C36,C37,C38,C39,C40,C41,C42,C43,C4419508000
,C46,SL,TW; 19508010
SWITCH C:=SL,TW,C2,TW,SL,C5,TW,TW,TW,C9,C10,C11,TW,C13,C14, 19511000
SL,SL,TW,C18,C19,TW,TW,TW,C23,C24,TW,TW,C27,C28, 19512000
TW,SL,SL,SL,SL,C34,C35,C36,C37,TW,TW,C40,C41, 19513000
C42,C43,C44,SL,C46,TW,TW,SL; 19513010
DEFINE CN=DIFFCOM#; 19515000
LABEL AC0,AC1,AC2,AC3,AC4,AC5; 19517000
SWITCH AC ~ AC0,AC1,AC2,AC3,AC4,AC5; 19518000
REAL I,J,T,RCW=+0; 19519000
ARRAY AIT[*]; REAL AITL=AIT; ARRAY A=AIT[*]; 19520000
ARRAY FIB=AIT[*],FPB[*],H[*];LABEL CHANGENAME; 19521000
NAME ADDR; 19522000
DEFINE BITS=(IF SB THEN DS~SET ELSE DS~RESET; SKIP SB)#; 19523000
CHECKSTACKSPACE;% %WF 19525000
IF P(PRT[P1MIX,9],DUP) < 0 THEN 19525100
BEGIN P(DEL); TERMINATE(P1MIX); TERMINALMESSAGE(81) END; 19525200
GO TO C[P]; 19526000
SL: P(.COMMUNCATE1); GO DIFFCOM; 19526100
TW: P(.COMMUNICATE0); GO DIFFCOM; 19526200
% SLEEP 19541100
C2: P(.COM2); GO TO CN; %721-19542000
% RETURN SPECIFIC ARRAY 19543000
% EOJ 19552000
C5: P(.COM5); GO TO CN; 19553000
% FILL WITH INQUIRY 19559000
C9: 19560000
$ SET OMIT = NOT(DATACOM) 19561000
% BLOCK EXIT 19565000
C10: P(.ASR); GO TO CN; 19566000
% ALGOL I/O FUNCTIONS 19567000
C11: % (SHM)19568000
IF R4=0 THEN FILEOPEN(0,A5,[CF]); % (SHM)19569000
IF R4=6 THEN % (SHM)19570000
BEGIN FILECLOSE(NFLAG(A5)); GO TO INITIATE END; % (SHM)19571000
IF R4=4 THEN % (SHM)19572000
BEGIN % (SHM)19573000
IF A5[4] THEN % FILE IS IN DIRECTORY % (SHM)19574000
FORGETSPACE(DIRECTORYSEARCH(R8,R7,-(A5,[CF])&R6[CTF]) ELSE 19575000
BEGIN % (SHM)19576000
IF (T:=R9.[18:5]) GTR 0 THEN % EU SPECIFIED % (SHM)19576100
T:=(IF T GTR 20 THEN 0 ELSE -T) ELSE % (SHM)19576200
IF (T:=R9.[16:2]) GTR 0 THEN % SPEED SPECIFIED % (SHM)19576300
T:=(IF T GTR 2 THEN 0 ELSE T) ELSE % (SHM)19576400
T:=0; % NO SPEED OR EU SPECIFIED % (SHM)19576500
A5[R6]:=PETUSERDISK(A5[8],T); % (SHM)19576600
END; % (SHM)19576700
GO TO INITIATE; % (SHM)19577000
END; % (SHM)19577100
P(.COM11); GO TO DIFFCOM; % (SHM)19578000
% COBOL I/O FUNCTIONS 19579000
C13: P(.COM13); GO TO CN; 19580000
% INVERT OVERLAYABLE STATUS 19581000
C14: IF NOT N4[0].[2:1] THEN MAKEPRESENT([N4[0]] INX 0); 19582000
M[N4[0] INX NOT 1]~P(DUP,LOD)&P(DUP,LNG)[2:2:1]; 19583000
GO TO INITIATE; 19584000
% ERROR - INQUIRY WRITE 19584200
C18: 19584300
$ SET OMIT = NOT(DATACOM) 19584400
GO TO INITIATE; 19584700
% PRINT BACK-UP 19585000
C19: P(.COM19); GO TO CN; 19586000
% LOAD CONTROL 19587000
C23:: P(.COM23); GO TO CN; 19588000
% RETURN ONE ROW OF A DISK FILE 19589000
C24:: T:=A4[R5]; A4[R5]:=0; 19590000
$ SET OMIT = SHAREDISK 19591000
FORGETUSERDISK(T,A4[8]); 19592000
$ POP OMIT 19592001
$ SET OMIT = NOT(SHAREDISK) 19593000
GO TO INITIATE; 19595000
% COBOL DATACOM I INTERROGATE 19601000
C27:: 19602000
$ SET OMIT = NOT(DATACOM ) 19603000
GO INITIATE; 19637000
% ALGOL DATACOM I INTERROGATE 19638000
C28:: 19639000
$ SET OMIT = NOT(DATACOM ) 19640000
GO INITIATE; 19668000
C34:: IF (T~R4) > 0 THEN STREAM(R4,T~T~SPACE(17)); 19680200
BEGIN SI~R4; DS~17 WDS END; 19680300
TERMINATE(P1MIX);% 19680400
TERMINALMESSAGE(-T);% 19680500
C35:: IF R4.[18:4]=1 THEN P(.LIBRARYZERO) 19681000
ELSE P(.LIBRARYCOPY); 19681100
GO TO CN; 19682000
C36:: % TYPE 19 DATACOM I/O INTERFACE 19683000
$ SET OMIT = DATACOM 19683499
GO TO INITIATE; 19683500
$ POP OMIT 19683501
$ SET OMIT = NOT(DATACOM ) 19684000
C37:: 19685010
AIT~JARROW[P1MIX]; 19685015
IF AIT[9].[FF]=0 THE NAIT[9].[FF]~GETESPDISK; 19685020
H~[M[SPACE(5)]]&5[8:38:10]; 19685025
H[1]~R5;H[2]~R4; 19685030
$ SET OMIT = NOT(DATACOM ) 19685035
$ SET OMIT = DATACOM 19685050
H[3]~0; 19685055
$ POP OMIT 19685060
DISKWAIT(H INX 0,5,AIT[9].[FF]); 19685065
FORGETSPACE(H); 19685070
GO TO INITIATE; 19685075
C40:: IF R5.[8:10]=1023 THEN 19685340
BEGIN M[R5.[CF]]:=PRNTABLE[R5.[FF]];GO INITIATE;END ELSE 19685350
IF R5.[CF]=0 THEN 19685360
BEGIN LINKUP(R6,R5:=R5.[FF]); 19685370
SLEEP([M[R5]],@1000000000000000); GO RETURN; 19685380
END ELSE 19685390
IF R5.[15:15]=0 THEN 19685400
BEGIN 19685410
$ SET OMIT = NOT(DATACOM ) 19685419
$ SET OMIT = DATACOM 19685429
M[R5]:=0; 19685430
$ POP OMIT 19685431
GO INITIATE; 19685440
END ELSE 19685450
IF R5.[FF]=@77777 THEN 19685452
BEGIN M[R5]:=MOD3IOS; GO INITIATE; END ELSE 19685456
BEGIN INDEPENDENTRUNNER(P(.DKBUSINESS),R5,128); SLEEP([M[R5]],1); 19685460
GO RETURN; 19685470
END; 19685480
C41:: IOREQUEST(R7,R6,FLAG(R5)); GO INITIATE; 19685550
C42:: P(..TISKTASK); GO TO CN; 19685560
C43:: H ~ PRT[P1MIX,TSX]; % SET TASK ATTRIBUTES 19685570
H[1] ~ JAR[P1MIX,0]; H[2] ~ JAR[P1MIX,1]; 19685580
H[3] ~ 2; H[4] ~ P1MIX; H[6] ~ 2; 19685585
GO TO INITIATE; 19685590
C44:: P(..PICKTHELOCK); GO TO CN; 19685595
C46:: P(..EVENTANDINTERRUPT); GO TO CN; % ATTACH, DETACH, CAUSE STMTS 19685596
END OF SHORT COMMUNICATE;% 19686000
PROCEDURE TISKTASK; 19687000
% A COBOL OR ALGOL PROGRAM WHICH EITHER CONTAINS OR IS INVOKED BY A 19687100
% PROCESS, CALL, OR RUN/EXECUTE STATEMENT, OR MANIPULATES LOCKS (COBOL)19687120
% OR EVENTS (ALGOL), WILL BE FLAGGED IN SEGMENT 0 (WORD 2 [3:1]=1) OF 19687140
% ITS CODE FILE AS HAVING A TASK ARRAY. 19687150
% THE FORMAT OF THE TASK ARRAY (MYSELF AT PRT[TSX]) IS AS FOLLOWS 19687200
% TSKA[0] = TASKVALUE: PROVIDED FOR USER 19687300
% TSKA[1] = 7 CHR MFID OF CODE FILE 19687400
% TSKA[2] = 7 CHR FID OF CODE FILE 19687500
% TSKA[3] = STATUS: 1=SCHEDULED 19687600
% 2=ACTIVE 19687610
% -1=TERMINATED (DS-ED OR EOJ) 19687650
% -2=INITIATION ATTEMPTED BUT FAILED 19687680
% TSKA[4] = STACKNO: MIX INDEX IF RUNNING 19687700
% SCHEDULE-ID IF SCHEDULED 19687750
% TSKA[5] =HEAD OF LIST OF LOCK-ITEMS IN CONTROL OR QUEUED19687780
% TSKA[6] = TYPE: 0=ASYNCHRONOUS DEPENDENT (PROCESS) 19687800
% 1=SYNCHRONOUS DEPENDENT (CALL) 19687840
% 2=INDEPENDENT (RUN/EXECUTE) 19687850
% TSKA[7] = CALL STATE: 0=INITIAL 19687860
% 1= EXIT PROGRAM/ 19687870
% EXIT PROGRAM RETURN HERE 19687872
% 2=CONTINUED OR RE-CALLED 19687874
% TSKA[8] : [1:1]=1 IFF JUST EXECUTED INTERRUPTER INTRINSC19687876
% AND SFINTQ IS NON-EMPTY 19687878
% [2:1]=1 IFF SFINTQ IS NON-EMPTY 19687880
% [3:1]=1 IFF INTERRUPTER INTRINSIC IS RUNNING 19687882
% [4:1] = SFINTQ INTERLOCK BIT (ON TO START) 19687883
% [FF] = ABSOLUTE ADDRESS OF OLD IRCW 19687884
% [CF] = HEAD OF LIST OF DECLARED INTERRUPTS 19687885
% SEGMENT 0 FOR IPC PROGRAM FILES: 19687886
% S[2].[2:1] =1 IF THERE ARE DECLARED INTERRUPTS 19687887
% S[2].[3:1] =1 FOR AN IPC PROGRAM FILE 19687888
% (EITHER INVOKING OR INVOKED) 19687889
% S[2].[4:1] =1 FOR AN INVOKED IPC PROGRAM FILE 19687890
% NOTE: S[2].[2:3] = JAR[2].[5:3]. JAR[2].[6:1]=1 INDICATES TO COM5 19687892
% THAT THIS JOB MAY HAVE DEPENDENT TASK DESCENDENTS TO BE DS-ED 19687894
% OR ES-ED AND LOCK QUEUES TO BE CLEANED UP WHEN IT TERMINATES. 19687896
% S[8] NUMBER OF TASK PARAMETERS TO BE RECEIVED 19687898
% ( = N BELOW). 19687900
% S[9] DISK ADDRESS OF PARAMETER DESCRIPTION SEG 19687910
% FORMAT OF ENTRY IN PARAMETER DESCRIPTION SEGMENT: 19687920
% (BEGINNING IN WORD 1) 19687925
% [18:15] : TYPE - 0 TASK ARRAY - NAME 19687930
% 1 EVENT/LOCK - NAME 19687935
% 2 PRT CELL - NAME 19687940
% 3 PRT CELL - VALUE 19687945
% 4 (SAVE) ARRAY - NAME 19687950
% 5 ARRAY - VALUE 19687955
% (ONLY 1-DIMENSIONAL ARRAYS CAN BE PASSED AS TASK PARAMETERS). 19687957
% [8:10] : SIZE - SIZE OF ARRAY FOR TYPES 4 AND 5, ELSE 0 19687960
% [33:15] : LOCATION-PRT LOCATION FOR TYPES 0-4, FOR TYPE 5: 19687965
% -RELATIVE DISK ADDRESS OF TYPE-2 SEGMENT 19687970
% TISTASK MAKES A TEST FOR AGREEMENT BETWEEN THE TASK PARAMETERS 19687975
% SPECIFIED IN THE PARAMETER DESCRIPTION SEGMENT AND THOSE SPECIFIED BY19687977
% THE F- CELLS (SEE BELOW). LACK OF AGREEMENT EITHER DS-ES THE PARENT 19687980
% OR CAUSES A 1 TO BE RETURNED (IN THE CASE OF A COBOL PROGRAM WHICH 19687982
% CONTAINS AN "ON EXCEPTION" CLAUSE). 19687984
% TISKTASK COPIES THE CODE FILE, FILLING NAME AND VALUE PARAMETERS INTO19687990
% THE NEW PRT AND WRITING OUT VALUE ARRAYS AS TYPE-2 SEGMENTS. THE JOB 19687995
% IS ENTERED IN THE SCHEDULE AND THE SCHEDULE-ID IS ENTERED IN THE 19687997
% TASK ARRAY. THE NEW SHEET ENTRY IS FLAGGED A GO JOB (AS FROM A 19687998
% COMPILE-AND-GO). 19687999
BEGIN 19688000
REAL MFID=-4,FID=-5, % FILE ID OF CODE FILE TO BE INVOKED 19688050
% MFID<0 IF ON EXCEPTION CLAUSE IS PRESENT19688060
% FID<0 IF CALL OR CONTINUE STATEMENT 19688070
N=-6; % NUMBER OF F- PARAMS BETWEEN F-7 AND MKSCW19689000
% THERE WILL BE A PAIR OF F- CELLS FOR 19689010
% EACH TASK PARAMETER. F(-I) CONTAINS 19689020
% THE NAME OR VALUE OF THE PARAMETER. 19689030
% F(-(I+1)) CONTAINS THE TYPE 19689040
% (AS IN SEGMENT 0). 19689050
% (TSKA IS THE FIRST TASK PARAMETER) 19689060
% N<0 IF CONTINUE STATEMENT 19689070
ARRAY NAME PARM; 19691000
ARRAY S[*],R[*],H[*],D[*],W[*], 19692000
TSKA=-7[*]; % TASK ARRAY DESCRIPTOR FOR PROCESS, CALL 19692100
% INTEGER = TASK ARRAY LENGTH FOR RUN 19692200
REAL T,T1,T2,T3,T4,ONEXCEPTION,CALLEDORCONT, 19693000
VARRAY,IOD,IOD1,NR,SR,HADDR,PRTRLOC,PRTSZ,ERR,SZ,S1,CR,PRTS; 19694000
LABEL L1,ERROR,NEXTROW,L2,XYT; 19695000
INTEGER PADDR,ADDR; 19696000
REAL COMMON,F,ESTPROC,ESTIO,STKSZ; %110-19696100
DEFINE CONTINUED = VARRAY#, SAVEBIT = IOD1#; 19696500
ONEXCEPTION ~ MFID<0; MFID ~ ABS(MFID); 19696600
CALLEDORCONT ~ FID<0; FID ~ ABS(FID); 19696700
CONTINUED ~ N<0; N ~ ABS(N); 19696800
PARM ~ [N]; 19697000
IF CALLEDORCONT THEN % CALL OR CONTINUE STATEMENT 19697200
BEGIN IF CONTINUED THEN IF TSKA[3]!2 OR TSKA[7]!1 THEN 19697300
BEGIN ERR ~ 1; TERMINATE(P1MIX&98[CTF]); GO XYT; 19697400
END; 19697500
IF TSKA[3]=2 THEN IF TSKA[7]=1 THEN 19697600
BEGIN TSKA[7] ~ 2; GO XYT; 19697700
END ELSE ELSE TSKA[7] ~ 0; 19697800
END; 19697900
IF (T:=DIRECTORYSEARCH(MFID,FID,3)) GEQ 64 THEN 19698000
BEGIN IF SECURITYCHECK(MFID,FID,USERCODE[P1MIX],T)=0 THEN 19699000
L1: BEGIN ERR ~ 1; 19700000
IF T GEQ 64 THEN FORGETSPACE(T); 19700500
GO ERROR; 19701000
END; 19702000
IF M[T INX 4].[9:2]!3 THEN GO L1; % NOT EXECUTABLE CODE 19703000
END ELSE GO L1; 19704000
IF TSKA.PBIT THEN IF TSKA[3]}1 THEN GO L1; 19704100
S ~ [M[GETSPACE(30,2,0)+2]]&30[8:38:10]; 19705000
% READ SEGMENT ZERO INTO S 19706000
DISKWAIT(-S.[CF],30,M[T INX 10]); 19707000
IF S[8]!N THEN 19708000
L2: BEGIN FORGETSPACE(S); 19709000
GO L1; 19710000
END; 19711000
W ~ [M[GETSPACE(T3~N DIV 2+1,2,0)+2]]&T3[8:38:10]; 19711100
% READ IPC PARAMETER DESCRIPTION SEGMENT INTO W 19711200
DISKWAIT(-W.[CF],T3,ADDR ~ M[T INX (10+((T2~S[9]) 19711300
DIV (SR~M[T INX 8])))] + (T2 MOD SR)); 19711400
FOR T1 ~ 2 STEP 2 UNTIL N DO 19713000
IF PARM[NOT(T1-1)]!W[T1 DIV 2].[FF] THEN 19714000
BEGIN FORGETSPACE(W); 19714100
GO L2; 19714200
END; 19714300
% READ PRT INTO R 19718000
R ~ [M[GETSPACE(S[3],2,0)+2]]&S[3][8:38:10]; 19719000
DISKWAIT(-R.[CF],S[3],PADDR ~ M[T INX (10+((PRTS~S[2].[CF]) 19720000
DIV SR))] + (PRTS MOD SR)); 19721000
FOR T1 ~ 2 STEP 2 UNTIL N DO 19722000
IF PARM[NOT(T1-1)]=5 THEN % PASS-BY-VALUE ARRAY 19723000
BEGIN PARM[NOT(T1-1)] ~ W[T1 DIV 2].[CF]; % RELATIVE DISK LOCA-19724000
VARRAY ~ VARRAY+1; % TION OF TYPE-2 SEG 19725000
END ELSE 19726000
BEGIN R[W[T1 DIV 2].[CF]] ~ *[PARM[NOT(T1-2)]];% PLACE NAME 19727000
PARM[NOT(T1-1)] ~ -@77777; % OR VALUE IN PRT19728000
END; 19729000
% BUILD HEADER FOR NEW CODE FILE IN H 19730000
H ~ [M[GETSPACE(30,2,0)+2]]&30[8:38:10]; 19731000
MOVE[30,T INX 0,[H]); 19732000
H[2] ~ H[5] ~ H[6] ~ 0; 19733000
T4 ~ M[T INX 9].[43:5]-1; 19733400
WHILE M[T INX (10+NR)]!0 AND NR{T4 DO NR ~ NR+1; % NR = # ROWS 19733600
T4 ~ NR+9; 19734000
H[4].[16:20] ~ 0; 19735000
H[9] ~ NR; 19735050
FOR T1 ~ 10 STEP 1 UNTIL T4 DO H[T1] ~ GETUSERDISK(SR); 19736000
HADDR ~ GETESPDISK; 19737000
DISKIO(IOD,H INX 0-1,30,HADDR); 19738000
F ~ S[15]; % SAVE LABEL EQUATION ENTRIES %110-19738100
ESTPROC:=S[16]; % SAVE ESTIMATED PROCESSOR TIME %110-19738110
ESTIO:= S[17]; % SAVE ESTIMATED I/O TIME %110-19738120
COMMON ~ S[19]; % SAVE COMMON VALUE %110-19738200
STKSZ:= S[21]; % SAVE STACK SIZE %110-19738210
CR ~ S[7],[FF]; % SAVE CORE REQ. 19739000
PRTRLOC ~ PRTS DIV SR; % ROW PRT IS LOCATED IN 19740000
PADDR !(PRTS MOD SR); % WHICH SEGMENT IN ROW 19741000
PRTSZ ~((S[3]+29) DIV 30); % NUMBER OF SEGMENTS IT OCCUPIES 19742000
SLEEP([IOD],IOMASK); 19743000
S1 ~ SR-1; % NO. OF SEGS/ROW - 1 19744000
FOR T1 := 10 STEP 1 UNTIL T4 DO % COPY CODE FILE CHANGEING%110-19746000
BEGIN % PRT & PASS-BY-VALUE SEGMENT19747000
FOR T3 := 0 STEP 1 UNTIL S1 DO % COPY ROW %171-19748000
BEGIN %110-19749000
DISKWAIT(-S.[CF],30,M[T INX T1]+T3); % READ SEGMENT %110-19750000
IF(T1=10) THEN IF(T3=0) THEN S[2].[3:2] ~ 3; % INVOKED 19750100
DISKWAIT( S.[CF],30,H[T1] +T3); % WRITE IT BACK%110-19751000
END; %110-19752000
IF(T1-10)=PRTRLOC THEN % PRT IS IN THIS ROW %110-19753000
DISKWAIT(R.[CF],PRTSZ|30,H[T1]+PADDR); % WRITE OUT PRT 19754000
IF VARRAY > 0 THEN % LOOK FOR TYPE-2 SEGMENTS IN THIS ROW 19755000
FOR T2:=2 STEP 2 UNTIL N DO %110-19756000
IF(T1-10)=(PARM[NOT(T2-1__DIV SR) THEN %110-19757000
% WE HAVE A TYPE-2 SEGMENT IN THIS ROW %110-19758000
BEGIN % MOVE SEGMENT TO CODE FILE ROW %110-19759000
SZ:=(W[T2 DIV 2].[8:10]+29) DIV 30; %110-19760000
D:=PARM[NOT(T2-2)]; %110-19761000
ADDR:=(PARM[NOT(T2-1)]MOD SR); %110-19762000
VARRAY:=VARRAY-1; %110-19763000
WHILE D.PBIT=0 DO %110-19764000
MAKEPRESENT([T] INX(NOT 1)); % ADDRESS OF D %110-19765000
SAVEBIT:=M[D INX (NOT 1)].[2:1]; %110-19766000
P(M[D INX (NOT 0)]); %110-19766100
M[D INX (NOT 1)].[2:1]:=1; %110-19766200
DISKWAIT(D.[CF],SZ|30,H[T1]+ADDR); %110-19766300
M[D INX (NOT 0)]:=P(XCH); %110-19766400
M[D INX (NOT 1)].[2:1]:=SAVEBIT; %110-19766500
END; %110-19766600
END; %110-19766700
FORGETSPACE(R); FORGETSPACE(T); FORGETSPACE(W); %110-19766800
% BUILD SHEET SKELETON IN S 19767700
STREAM(S);BEGIN 30(DS ~ 8 LIT "0"); END; 19767750
S[20] ~ CR; 19767760
S[25] ~ MADDR; 19767800
S[0] ~ MFID; 19767900
S[1] ~ FID; 19768000
S[2] ~ S[18] ~ PRYOR[P1MIX]; 19768050
% WRITE OUT DUMMY CONTROL CARD FOR LOGGING ROUTINE 19768100
STREAM(X~S[24]~USERCODE[P1MIX], MFID, FID, T~[H[2]] ); %722-19768200
BEGIN SI~LOC X; DS~9 LIT "CC USER ="; %722-19768300
SI!SI+1; DS~7 CHR; DS~9 LIT ";EXECUTE "; %722-19768400
2(SI~SI+1; DS~7 CHR; DS~LIT "/"); DI~DI-1; %722-19768450
DS~6 LIT ";END.~"; DS~16 LIT " "; %722-19768500
END STREAM; 19768550
H[0] ~ 0; 19768600
H[1] ~ 10; 19768650
S[6] ~ GETESPDISK & 10 [CTF]; 19768700
DISKWAIT(H.[CF],11,S[6] INX 0); 19768750
$ SET OMIT = NOT PACKETS %110-19768760
% PUT DUMMY CONTROL CARD IN PACKET PAGE ALSO %110-19768762
IF (T~PSEUDOMIX[P1MIX]) GEQ 32 THEN % ITS A PACKET JOB %110-19768764
BEGIN %110-19768766
STREAM(A~[JAR[P1MIX,0]],M~P1MIX,B~[H[2]],T1~T1~SPACE(10)); 19768768
BEGIN %110-19768770
DS~2 LIT">>>"; SI~B; DS~30 CHR; DS~14 CHR; %722-19768772
DS~13 LIT". INVOKED BY "; SI~A; SI~SI+1; DS~7 CHR;DS~LIT"/";19768774
SI~SI+1; DS~7 CHR; DS~LIT"="; SI~LOC M; DS~2 DEC; %110-19768776
DS~LIT LEFTARROW; DI~DI-3; DS~FILL; %110-19768778
END; %110-19768780
SPOUTER(T1,T,0); %110-19768782
END; %110-19768784
$ POP OMIT %110-19768786
SLEEP([TOGLE],SHEETMASK); LOCKTOG(SHEETMASK); 19768800
STREAM(A~0:B~P(.SCHEDULEIDS)); 19768900
BEGIN SI~B; 19768950
47(SKIP SB; SKIP DB; TALLY~TALLY+1; 19769000
IF SB THEN BEGIN END ELSE JUMP OUT); 19770000
DS~SET; A~TALLY; 19771000
END STREAM; 19772000
T1 ~ P; S[3] ~ D&T1[8:38:10]; 19773000
S[23]:=0&( %110-19774000
$ SET OMIT = NOT PACKETS %110-19774050
IF(T~PSEUDOMIX[P1MIX])!0 THEN T %110-19774100
ELSE %110-19774150
$ POP OMIT %110-19774200
$ SET OMIT = NOT DATACOM %110-19774250
26][2:42:6] %110-19774450
$ SET OMIT = NOT DATACOM %110-19774500
&((CLOCK+P(RTR)) DIV 60)[24:24:24]; %110-19774650
$ SET OMIT = NOT PACKETS %110-19774700
IF T GEQ 32 THEN PACKETACT[T-32]~PACKETACT[T-32]+1; %110-19774750
$ POP OMIT %110-19774800
S[24]:=USERCODE[P1MIX]; %110-19774850
S[12]:=512; %110-19775000
S[15] ~ F; % PUT LABEL EQUATION ENTRIES IN SHEET %110-19775100
S[16]:=ESTPROC; %110-19776000
S[17]:=ESTIO; %110-19776010
S[19] ~ COMMON; % AND COMMON %110-19776100
S[21]:=STKSZ; %110-19776110
HADDR ~ GETESPDISK; 19777000
IF SHEET[0].[CF]!0 THEN 19778000
BEGIN DISKWAIT(-H.[CF],30,T2 ~ SHEET[0].[FF]); 19779000
H[29] ~ HADDR; 19780000
DISKWAIT(H.[CF],30,T2); 19781000
END ELSE SHEET[0] ~ HADDR; 19782000
SHEET[0].[FF] ~ HADDR; 19783000
S[29] ~ 0; 19784000
DISKWAIT(S.[CF],30,HADDR); 19785000
UNLOCKTOG(SHEETMASK); FORGETSPACE(S); FORGETSPACE(H); 19786000
ERROR: 19787000
IF TSKA.PBIT THEN 19788000
BEGIN TSKA[3] ~ 1-3|ERR; % STATUS: SCHEDULED OR ERROR19791000
IF NOT ERR THEN TSKA[4] ~ T1; % SCHEDLE-ID 19792000
END; 19793000
IF ERR AND NOT ONEXCEPTION THEN TERMINATE(P1MIX&94[CTF]) ELSE 19796000
PARM[NOT(N+1)] ~ ERR; % PLACE BOOLEAN IN WORD BELOW MKSCW FOR 19797000
% ON EXCEPTION BRANCH IN COBOL 19798000
P(DIRECTORYSEARCH(NABS(MFID),FID,13),DEL);%CLOSE,FORGET HEADER 19799000
IF NOT ERR THEN SELECTION; 19799050
XYT:: IF CALLEDORCONT AND NOT ERR THEN COMPLEXSLEEP((TSKA[7] AND 1) 19799060
OR (TERMSET(P1MIX))); 19799070
END TISKTASK; 19800000
PROCEDURE PICKTHELOCK; 19900000
BEGIN COMMENT THIS PROCEDURE HANDLES LOCKING/UNLOCKING OF 19900010
LOCK-ITEMS FOR TASKING. IT ALSO HANDLES THE MAINTENANCE 19900020
OF A WAIT QUEUE AND PASSING CONTROL OF THE LOCK TO THE 19900030
FIRST PROCESS IN THE WAIT QUEUE. AFTER IT HAS BEEN 19900040
RELEASED BY ANOTHER PROCESS, THE HEAD OF THE QUEUE IS 19900050
THE LOCK-ITEM OF THE PROCESS CURRENTLY IN CONTROL AND 19900060
ENTRIES ARE MADE AT THE END OF THE QUEUE. LOCK-ITEMS 19900070
ARE IN THE PRT AND HAVE THE FOLLOWING FORMAT: 19900080
[1:1]=1, MEANS LOCKED(LOCK BIT,ORIGINAL ONLY) 19900090
[2:1]=1, IN CONTROL(CONTROL BIT) 19900100
[3:1]=1, ORIGINAL LOCK-ITEM(ORIGINAL BIT) 19900110
=0, A COPY 19900120
[4:1]= QUEUE INTERLOCK(ORIGINAL ONLY) 19900130
[8:10]=MIX INDEX OF PROGRAM IN CONTROL(ORIGINAL) 19900140
=RELATIVE PRT ADDRESS USED TO LINK ALL LOCK-ITEMS 19900150
IN CONTROL OR IN WAIT QUEUES(COPY) 19900160
[18:15]=POINTER TO NEXT PROCESS IN WAIT QUEUE, ELSE 0 19900170
[33:15]=POINTER TO HEAD OF QUEUE(ORIGINAL) 19900180
=POINTER TO ORIGINAL LOCK-ITEM(COPY) 19900190
"LOCKPTR" IS THE PARAMETER PASSED AND HAS THE FORMAT: 19900200
[1:1]=0, MEANS LOCK, ELSE UNLOCK 19900210
[2:1]=1, " TEST LOCK BIT, LOCK IF UNLOCKED AND 19900220
RETURN A 0, ELSE RETURN 1 19900230
[33:15]=RELATIVE PRT ADDRESS OF LOCK-ITEM; 19900240
REAL LOCKPTR=-4;%PARAMETER 19900250
REAL Q,R,S,T,U,V; 19900260
ARRAY A[*]; 19900270
DEFINE DSED=TERMSET(P1MIX)#, IMASK=@200000000000000#; 19900280
SUBROUTINE LINKIT; 19900290
BEGIN IF(V:=A[5])=0 THEN A[5]:=LOCKPTR INX 0 19900300
ELSE BEGIN WHILE PRT[P1MIX,V].[8:10] NEQ 0 DO 19900310
V:=PRT[P1MIX,V].[8:10]; 19900320
PRT[P1MIX,V].[8:10]:=LOCKPTR INX 0; 19900330
END; 19900340
END; 19900360
Q:=[PRT[P1MIX,LOCKPTR INX 0]] INX 0; 19900370
R~NFLAG(M[U+Q]); 19900380
S~IF R.[3:1] THEN Q ELSE (R INX 0); %ADDR OF ORIGINAL 19900390
A:=PRT[P1MIX,TSX];%TASK ARRAY 19900395
IF NOT M[S].[4:1] THEN SLEEP([M[S]],IMASK); 19900400
M[S].[4:1]:=0; 19900410
IF LOCKPTR.[2:1] THEN %TEST & LOCK 19900420
BEGIN IF NOT M[S].[1:1] THEN %UNLOCKED 19900430
BEGIN M[S]:=NABS(M[S])&U[CTC]&P1MIX[8:38:10]; 19900440
M[U]:=(M[U] OR M)&0[CTF]; 19900450
IF U!S THEN BEGIN M[U].[8:10]~0; 19900455
LINKIT; 19900460
END; 19900465
LOCKPTR:=0; 19900470
END ELSE LOCKPTR:=1; 19900480
M[S]:=(*P(DUP)) OR IMASK; 19900490
P(XIT); 19900500
END; 19900510
IF LOCKPTR GTR 0 THEN%LOCK 19900520
IF NOT M[U].[2:1] THEN%NOT IN CONTROL 19900530
BEGIN IF NOT M[S].[1:1] THEN 19900540
BEGIN M[S]:=NABS(M[S])&U[CTC]&P1MIX[8:38:10]; 19900550
M[U]:=((*P(DUP)) OR M)&0[CTF]; 19900560
IF U!S THEN BEGIN M[U].[8:10]~0; 19900565
LINKIT; 19900570
END; 19900575
END ELSE 19900580
BEGIN 19900590
T:=M[S] INX 0; 19900600
WHILE M[T].[FF] NEQ 0 DO T:=M[T].[FF]; 19900610
M[T].[FF]:=U; 19900620
M[U].[FF]:=0; 19900630
IF U!S THEN BEGIN M[U].[8:10]~0; LINKIT END; 19900650
M[S]:=(*P(DUP)) OR IMASK; 19900660
COMPLEXSLEEP(DSED OR M[U].[2:1]); 19900670
IF M[U].[2:1] THEN 19900675
M[S]~((*P(DUP))&P1MIX[8:38:10]) OR IMASK; 19900680
P(XIT); 19900690
END; 19900700
END ELSE ELSE %UNLOCK 19900710
BEGIN IF M[S].[1:1] THEN%LOCKED 19900720
BEGIN M[T:=M[S] INX 0].[2:1]:=0;%TURN OFF CONTROL 19900730
IF T!S THEN 19900735
BEGIN 19900740
A:=PRT[V:=M[S].[8:10],TSKX]; 19900745
R:=A[5]; 19900750
IF T NEQ ([PRT[V,R]] INX 0) THEN 19900755
BEGIN 19900758
WHILE M[S].[CF] NEQ ([PRT[V,R]] INX 0) DO 19900760
BEGIN U:=R; 19900770
R:=PRT[V,R].[8:10]; 19900780
END; 19900790
PRT[V,U].[8:10]:=PRT[V,R].[8:10];%DELINK 19900800
END ELSE A[5]:=M[T].[8:10; 19900805
END; 19900810
M[S].[CF]:=(T:=M[T].[FF]); 19900815
IF T NEQ 0 THEN 19900820
BEGIN M[T]~(*P(DUP)) OR M; P(XIT) END 19900830
ELSE M[S]:=ABS(M[S]); 19900840
END; 19900850
END; 19900855
M[S]:=(*P(DUP)) OR IMASK; 19900860
PROCEDURE EVENTANDINTERRUPT; 19900900
BEGIN 19901000
REAL TYPE=-4, % TYPE: 1=ATTACH INTERRUPT (AT REL.ADDR RELINT) 19901100
RELINT=-5, % TO EVENT (AT ABSOLUTE ADDR ABSEVT) 19901200
ABSEVT=-6; % 2=DETACH INTERRUPT (AT REL.ADDR RELINT) 19901300
% 3=CAUSE EVENT (AT ABSOLUTE ADDR ABSEVT) 19901400
REAL K,R,A,SIZE,MIX,J,I,ABSOLD=J; 19901500
LABEL ATTACHL,DETACHL,CAUSEL,ON,L1,L2,L3,L4,DONE; 19901600
SWITCH S ~ ATTACHL,DETACHL,CAUSEL; 19901700
ARRAY SFINTQ[*],TSKA[*]; 19901800
NAME BIGGERQ; 19901840
DEFINE TMASK = @200000000000000#,EMASK = @2000000000000000#; 19901850
SUBROUTINE DETACHINT; 19901900
BEGIN IF (ABSOLD~PRT[P1MIX,RELINT].[FF])!0 THEN 19902000
BEGIN WHILE NOT M[ABSOLD].[5:1] DO 19902100
ABSOLD ~ M[ABSOLD].[FF]; 19902120
IF M[ABSOLD]}0 THEN SLEEP([M[ABSOLD]],EMASK); 19902130
M[ABSOLD] ~ P(DUP,LOD,SSP); 19902140
K ~ T ~ PRT[P1MIX,RELINT].[FF]; 19902150
A ~[PRT[P1MIX,RELINT]] INX 0; 19902190
WHILE M[T].[FF]!A DO T ~ M[T].[FF]; 19902200
M[T].[FF] ~ IF T=K THEN 0 ELSE K; 19902300
PRT[P1MIX,RELINT].[FF] ~ 0; 19902350
M[ABSOLD] ~ P(DUP,LOD,SSN); 19902360
END; 19902400
END DETACHINT; 19902500
% FORMAT OF INTERRUPT (IN PRT): 19902501
% UPPER WORD (LINK WORD): 19902502
% [1:1]=1 IFF INTERRUPT IS DISALLOWED 19902503
% [FF]: ABSOLUTE ADDRESS OF NEXT INTERRUPT ON19902504
% EVENTS ATTACH LIST OR OF THE EVENT IF19902505
% THIS INTERRUPT IS THE LAST ON LIST 19902506
% [CF]: RELATIVE PRT ADDRESS OF NEXT DECLARED19902507
% INTERRUPT FOR THIS PROCESS 19902508
% LOWER WORD: PROCEDURE DESCRIPTOR FOR INTERRUPT 19902509
% FORMAT OF EVENT (IN PRT): 19902510
% "ORIGINAL" EVENT-ITEM (AT ABSOLUTE ADDR ABSEVT):19902511
% [1:1]: EVENT INTERLOCK BIT (ON TO START) 19902512
% [5:1]=1 DISTINGUISHES THE EVENT FROM 19902514
% ATTACHED INTERRUPTS 19902516
% [FF]: ABSOULTE ADDRESS OF FIRST INTERRUPT 19902520
% ON ATTACH LIST 19902522
% [47:1]: HAPPEN BIT 19902524
% "COPY" EVENT-ITEM (RECEIVED AS A PARAMETER): 19902526
% [CF]: ABSOLUTE ADDRESS OF ORIGINAL EVENT 19902527
% CONTENTS OF TSKA[8]: 19902528
% [1:1]=1 IFF INTERRUPTER HAS JUST RUN AND 19902529
% SFINTQ IS NON-EMPTY 19902530
% [2:1]=1 IFF SFINTQ IS NON-EMPTY 19902540
% [3:1]=1 IFF INTERRUPTER IS RUNNING 19902550
% [4:1]: SFINTQ INTERLOCK BIT (ON TO START) 19902560
% [FF] = ADDRESS OF OLD IRCW 19902570
% [CF] = RELATIVE PRT ADDRESS OF FIRST IN LINKED 19902580
% LIST OF DECLARED INTERRUPTS 19902593
% % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %19902600
GO TO S[TYPE-1]; 19902700
ATTACHL: DETACHINT; % AN ATTACH DOES AN IMPLICIT DETACH 19902800
IF M[ABSEVT]}0 THEN SLEEP([M[ABSEVT]],EMASK); 19902850
M[ABSEVT] ~ P(DUP,LOD,SSP); 19902860
IF (T~M[ABSEVT].[FF])=0 THEN T ~ ABSEVT; 19902900
PRT[P1MIX,RELINT] ~ PRT[P1MIX,RELINT]&T [CTF]&P1MIX [8:38:10]; 19903100
M[ABSEVT] ~ P(DUP,LOD,[PRT[P1MIX,RELINT]],CFX,SSN); 19903200
P(XIT); 19903300
DETACHL: DETACHINT; P(XIT); 19903400
CAUSEL: M[ABSEVT].[47:1] - 1; %SET HAPPEN BIT: AWAKEN ALL YE WHO WAIT19903500
IF M[ABSEVT].[FF]!0 THEN% IF THERE ARE INTERRUPTS ATTACHED 19903600
BEGIN IF M[ABSEVT]}0 THEN SLEEP([M[ABSEVT]],EMASK); 19903650
M[ABSEVT] ~ P(DUP,LOD,SSP); 19903660
A ~ M[ABSEVT].[FF]; 19903670
WHILE A!ABSEVT DO % INSERT ATTACHED INTERRTUPS IN THE 19903700
BEGIN % RELEVANT SFINTQS 19903800
MIX ~ (T~M[A]).[8:10]; 19903810
IF TERMSET(MIX) THEN 19903820
BEGIN IF T.[FF]!ABSEVT THEN 19903825
DO MIX ~ (T~M[A~T.[FF]]).[8:10] 19903830
UNTIL NOTERMSET(MIX) OR T.[FF]=ABSEVT; 19903850
IF TERMSET(MIX) THEN 19903860
BEGIN M[ABSEVT]~P(DUP,LOD,SSN); P(XIT);END;19903865
END; 19903870
TSKA ~ PRT[MIX,TSX]; 19903900
IF NOT TSKA[8].[4:1] THEN SLEEP([TSKA[8]],IMASK); 19903907
TSKA[8].[4:1] ~ 0; 19903908
SIZE ~ (SFINTQ~PRT[MIX,SFINTX]).[8:10]-1; 19903910
J ~ K ~ 0; 19903915
IF NOT TSKA[8].[3:1] THEN% IF INTERRUPTER INTRINSIC NOT RUNNING19903917
WHILE J{SIZE DO % COMPACT SFINTQ, PUSHING ALL NON-ZERO 19903920
BEGIN % ENTRIES TOWARD THE FRONT OF THE ARRAY 19903930
IF SFINTQ[J]=0 THEN % AND ZEROING OUT REMAINDER 19903940
BEGIN 19903950
I ~ IF K!0 THEN K+2 ELSE J+1; 19903960
L1: IF I>SIZE THEN GO DONE; 19903970
IF SFINTQ[I]=0 THEN BEGIN I ~ I+1; GO TO L1; END; 19903980
K ~ I; GO TO L3; 19903990
L2: IF K>SIZE THEN GO TO L4; 19904000
IF SFINTQ[K]!0 THEN 19904010
L3: BEGIN SFINTQ[J] ! SFINTQ[K]; 19904020
J ~ J+1; K ~ K+1; GO TO L2; 19904030
END; 19904040
L4: K ~ K-1; 19904050
FOR I ~ J STEP 1 UNTIL K DO SFINTQ[I] ~ 0; 19904060
END ELSE J ~ J+1; 19904070
END; 19904100
DONE: IF SFINTQ[SIZE]!0 THEN % QUEUE FULL--GET MORE SPACE19904300
IF SIZE+6>1023 THEN 19904340
BEGIN TERMINATE(MIX&103[CTF]); 19904350
TSKA[8] ~ *P(DUP) OR IMASK; A ~ T.[FF]; GO ON; 19904360
END ELSE 19904370
BEGIN PRT[MIX,SFINTX] ~ BIGGERQ ~FLAG(1&[PRT[MIX,SFINTX]]19904400
[CTF]&(SIZE+6) [TOSIZE]); 19904450
MAKEPRESENT([I] INX 3);%GETS SPACE AND ZEROS IT OUT19904600
M[BIGGERQ INX NOT 1].[9:6] ~ MIX; 19904650
MOVE(SIZE+1,SFINTQ,BIGGERQ); 19904700
FORGETSPACE(SFINTQ INX 0); 19904850
SFINTQ ~ BIGGERQ; 19904860
END; 19904900
K ~ 0; WHILE SFINTQ[K]!0 DO K ~ K+1; 19905000
SFINTQ[K] ~ A-1; % ABSOLUTE ADDRESS OF INTERRUPT PD 19905100
A ~ T.[FF]; 19905200
TSKA[8] ~ *P(DUP) OR @1200000000000000; 19905300
IF MIX=P2MIX THEN 19905310
BEGIN HALT; NOPROCESSTOG ~ NOPROCESSTOG-1; 19905320
END; 19905330
ON: 19905340
END; 19905350
M[ABSEVT] ~ P(DUP,LOD,SSN); 19905360
END; 19906100
END EVENTANDINTERRUPT; 19906300
% THE FORMAT OF SEGMENT ZERO OF PROGRAMS% 20000000
% S[0] = LOCATION OF SEGMENT DICTIONARY% 20001000
% S[1] = SIZE OF SEGMENT DICTIONARY% 20002000
% S[2] = LOCATION OF PRT% 20003000
% S[3] = SIZE OF PRT% 20004000
% S[4] = LOCATION OF FILE PARAMETER BLOCK% 20005000
% S[5] = SIZE OF FILE PARAMETER BLOCK% 20006000
% S[6].[1:1] = 1 FOR NEW FORMAT SEGMENT 0, ELSE 0 20006500
% S[6] = STARTING SEGMENT NUMBER% 20007000
% S[7].[2:1] = FORTRAN FAULT FLAG 20007100
% S[7].[33:15] = NUMBER OF FILES% 20008000
% S[7].[18:15] = CORE REQUIREMENT / 64% 20009000
% IF S[2] < 0 THEN THE JOB WAS COMPILED BY COBOL% 20010000
% S[15] = DISK ADDRESS OF LABEL EQUATION ENTRIES 20010100
% PRESENTED WHEN PROGRAM WAS COMPILED AND 20010200
% APPLICABLE TO ALL EXECUTIONS 20010300
% S[16] = ESTIMATED PROCESSOR TIME (FROM COMPILATN)20010400
% S[17] = ESTIMATED I/O TIME (FROM COMPILATN)20010500
% S[18] = PRIORITY (FROM COMPILATN)20010600
% S[19] = COMMON VALUE (FROM COMPILATN)20010700
% S[20] = ESTIMATED CORE REQUIREMENTS(FROM COMPILATN)20010800
% S[21] = STACK SIZE (FROM COMPILATN)20010900
20011000
20011100
PROCEDURE SELECTRUN1; 20011200
BEGIN 20011300
20011400
REAL MSCW = -2, 20011500
F = -1, 20011600
MYMSCW = -1, 20011700
RCW = +0, 20011800
I = +1, 20011900
T = +2, 20012000
L = +3, 20012100
DT = +4, 20012200
MIX = +5, 20012300
HDR = +6, 20012400
LEVEL = +7, 20012500
MCPJOB = +8, 20012600
OLAYDISK = +9, 20012700
THISLINK = +10, 20012800
NEXTLINK = +11, 20012900
PREVLINK = +12, 20013000
TYPE = +13, 20013100
STACKLOC = +14, 20013200
SHEETLOCKED = +15; 20013300
20013400
ARRAY S = +16[*], 20013500
SEG0 = +17[*], 20013600
TRP = +18[*], 20013700
LBL = +19[*], 20013800
SD = NT2[*], 20013900
TSKA = NT2[*]; 20014000
20014100
NAME ADDR = LBL +1; 20014300
REAL PASSLEVEL = ADDR + 1, 20014400
SVALUE = PASSLEVEL, 20014500
RETURNMSCW = PASSLEVEL + 1, 20014600
RETURNRCW = RETURNMSCW + 1; 20014700
20014800
DEFINE SHEETMAX = MIXMAX#; 20014900
20015000
20016100
%%%% ***NOTE**** 20016200
%%%% THE VARIABLES DECLARED ABOVE MUST CORRESPOND EXACTLY TO 20016300
%%%% THOSE DECLARED IN PROCEDURE SELECTRUN. 20016400
20016500
REAL EUVAL = RETURNRCW + 1, 20016600
FBADRS = EUVAL + 1, 20016700
FPBVERSION = FBADRS + 1, 20016800
FT = FPBVERSION+ 1, 20016900
LINDX = FT + 1, 20017000
LINK = LINDX + 1, 20017100
SENSEVAL = LINK + 1, 20017200
SPDVAL = SENSEVAL + 1, 20017300
S2 = SPDVAL + 1, 20017400
FB = S2 + 1, 20017500
FPB = FB + 1; 20017600
20017700
REAL FT1 = NT1, 20017800
TYPEDISK = NT3; 20017900
20018000
COMMENT THE VALUE OF "TYPE" DETERMINES WHICH PORTIONS OF 20018100
THIS PROCEDURE WILL BE EXECUTED. THIS PROCEDURE CAN ALSO 20018200
DETERMINE WHICH PORTIONS OF PROCEDURE "SELECTRUN" WILL BE 20018300
EXECUTED BY ASSIGNING A NEGATIVE VALUE TO "TYPE" BEFORE 20018400
RETURNING TO THAT PROCEDURE. 20018500
END OF COMMENT; 20018600
20018700
DEFINE STARTING = 1#, 20018800
CONTINUEING = 2#, 20018900
QUITTING = 3#, 20019000
RUNING = 4#, 20019100
PASSING = 5#, 20019200
EQUATING = 6#; 20019300
20019400
DEFINE XCLOCKTIME = 20019500
(((NT2:=(XCLOCK DIV 3600)) MOD 60 + (NT2 DIV 60)|100 + 20019600
0.5 ) DIV 1)#; 20019700
20019800
DEFINE ACTUALDISKADDRESS(ACTUALDISKADDRESS1) = 20019900
((JAR[MIX,((NT4:=ACTUALDISKADDRESS1) DIV (NT3:=JAR[MIX,8]))+10] 20020000
+ (NT4 MOD NT3) + 0.5) DIV 1)#; 20020100
20020110
$ SET OMIT = NOT(PACKETS) 20020119
DEFINE UNITNO = S[23].[2:6]#; % ORIGINATING UNIT 20020120
$ POP OMIT 20020121
20020200
LABEL CONTINUE, DLX, EXIT, LEM, RMSG, UNBLK, STOP; 20020300
20020400
SUBROUTINE DELINK; 20020500
% DELINKS THE SHEET ENTRY AND RETURNS SHEET DISK SPACE 20020600
BEGIN 20020700
STREAM(A:=S[3].[8:10],B:=P(.SCHEDULEIDS)); 20020800
BEGIN % MARK SCHEDULE SLOT "OPEN" 20020900
SKIP A DB; DS:=RESET; 20021000
END; 20021100
IF F = 0 THEN % SHEET ENTRY NOT PASSED AS PARAMETER 20021200
BEGIN 20021300
IF NEXTLINK=0 THEN SHEET[LEVEL].[FF]:=PREVLINK; 20021400
IF PREVLINK=0 THEN 20021500
BEGIN 20021600
SHEET[LEVEL].[CF]:=NEXTLINK; DO DLX; 20021700
END; 20021800
IF LBL=0 THEN 20021900
BEGIN 20021910
M[(LBL:=[M[SPACE(30)]]&30[8:38:10]) INX NOT 1].[9:6]:=0; 20021920
END; 20021930
DISKWAIT(-(LBL INX 0), 30, PREVLINK); 20022000
LBL[29]:=NEXTLINK; 20022100
DISKWAIT( (LBL INX 0), 30, PREVLINK); 20022200
DLX: FORGETESPDISK(THISLINK); 20022300
END; % IF SHEET ENTRY NOT A PARAMETER 20022400
END DELINK; 20022500
20022600
P(MYMSCW, STF); 20022700
20022800
P(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); % FOR VARIABLES LOCAL TO THIS 20022900
% PROCEDURE ONLY 20023000
20023100
IF TYPE=CONTINUEING THEN GO TO CONTINUE; 20023200
IF TYPE=STARTING THEN % SEARCH THE SHEET QUEUE TO FIND A CANDIDATE 20023300
% FOR SELECTION 20023400
BEGIN 20023500
PASSLEVEL:=RESTARTING; 20023800
COMMENT "PASSLEVEL" WILL BE NEGATIVE WHEN A JOB IS BEING RE-STARTED.20023900
UNDER THIS CONDITION, THE TEST FOR "LEVEL GEQ PASSLEVEL" WILL 20024000
FAIL AND NO OTHER JOBS WILL BE SELECTED UNTIL THE RE-START JOB 20024100
HAS BEEN INITIATED. 20024200
END OF COMMENT; 20024300
FOR LEVEL:=0 STEP 1 UNTIL SHEETMAX DO % FOR ALL "SHEET PRIORITIES" 20024600
BEGIN 20024700
PREVLINK:=NEXTLINK:=; % RESET FOR EACH "LEVEL" 20024800
% IF THERE IS AN ENTRY IN THE SHEET, SEE IF IT WILL FIT 20024900
IF(THISLINK:=SHEET[LEVEL].[CF]) NEQ 0 THEN GO TO LEM; 20025000
20025100
CONTINUE: 20025200
20025300
% "NEXTLINK" OBTAINED FROM "SHEET[29]" BELOW 20025400
% IF THERE IS ANOTHER ENTRY AT THIS LEVEL, PROCESS IT NOW 20025500
IF(THISLINK:=NEXTLINK) NEQ 0 THEN GO TO LEM; 20025600
END; 20025700
TYPE := -QUITTING; % END OF SHEET SEARCH 20025800
GO TO EXIT; 20025900
20026000
LEM: 20026100
20026200
% AT THIS POINT, THERE IS A CANDIDATE FOR SELECTION 20026300
IF S = 0 THEN % NO SHEET SPACE OBTAINED YET 20026400
BEGIN 20026500
S := [M[TYPEDSPACE(31,SHEETAREAV)]] & 30[SIZE];% %167-20026600
END; 20026700
20026800
% . . . . . . . . . . . . . . . . . . . . . . . 20026900
% READ SHEET ENTRY INTO CORE AT "S" 20027000
% . . . . . . . . . . . . . . . . . . . . . . . 20027100
20027200
DISKWAIT(-(S INX 0), 30, THISLINK); 20027300
NEXTLINK:=S[29]; % NEXT ENTRY IN SHEET QUEUE AT THIS LEVEL 20027400
20027500
% ***** *** * ***** * * **** ***** 20027600
% * * * * * * * * * * 20027700
% *** * * ***** ***** * * ***** 20027800
% * * * * * * * * * * 20027900
% * *** ***** ***** * * * * * * 0 20028000
20028100
HDR:=GETSPACE(30+(S[0]<0),DISKHEADERAREAV,1)+2; % S[0]<0 COMPILE 20028300
% THE EXTRA WORD IS FOR COMPILATIONS (JAR[30]=FID OF OBJECT FILE) 20028400
DISKWAIT(-HDR, 30, S[25]); % READ FILE HEADER INTO CORE AT "HDR" 20028900
GO TO EXIT; 20029000
END; % IF TYPE = STARTING OR CONTINUEING 20029100
20029200
IF TYPE=PASSING THEN % PASS THIS ENTRY WITHOUT DELINKING 20029300
BEGIN 20029400
20029500
% ***** ***** ***** ***** 20029600
% * * * * * * 20029700
% ***** ***** ***** ***** 20029800
% * * * * * 20029900
% * * * ***** ***** 20030000
20030100
IF (I:=S[2]<0) OR S[3]>0 THEN % XS/ES OR FIRST TIME THROUGH 20030200
BEGIN 20030300
S[2]:=ABS(S[2]); % MARK IT NOT XS-ED OR ES-ED. 20030350
S[3]:=NABS(S[3]); % MARK IT SCHEDULED 20030400
IF F=0 THEN % SHEET ENTRY NOT PASSED AS PARAMETER 20030500
% WRITE THE SHEET ENTR BACK OUT WITH S[3] "MARKED" 20030600
DISKWAIT((S INX 0), 30, THISLINK); 20030700
IF SCHEDMSG OR I OR (S[23].[9:4] NEQ 0) THEN %166-20030760
BEGIN 20030780
STREAM(I, L, C:=LEVEL, A:=S[*], ID:=S[3].[8:10], 20030800
$ SET OMIT = NOT(DCSPO AND DATACOM) 20031000
Q:=XCLOCKTIME, W:=S[20]|64, B:=HDR); 20031500
BEGIN 20031600
SI:=LOC C; DS:=6DEC; DI:=DI-6; DS:=5FILL; % PRIORITY20031700
DI:=B; DI:=DI+6; DS:=LIT":"; 20031800
SI:=A; SI:=SI+1; DS:=7CHR; % MFID 20031900
SI:=SI+1; DS:=LIT"/"; DS:=7CHR; % FID 20032000
DS:=LIT"="; SI:=LOC ID; DS:=2DEC; % SCH.NO. 20032100
CI:=CI+I; GO TO SCHD; 20032150
DS:=10 LIT" NOT XS-ED"; GO TO REASON; 20032200
SCHD: DS:=11 LIT" SCHEDULED "; SI:=LOC Q; DS:=4 DEC; % TIME 20032250
$ SET OMIT = NOT(DCSPO AND DATACOM) 20032400
REASON: DS:=2 LIT", "; 20032725
CI:=CI+L; GO TO L0; CO TO L1; 20032750
$ SET OMIT = NOT BREAKOUT 20032775
L2: DS:=14 LIT"TOO MANY JOBS~"; GO TO EXIT; 20032875
L1: DS:=13 LIT"NO OLAY DISK~"; GO TO EXIT; 20032900
L0: DS:= 5 LIT"NEEDS"; SI:=LOC W; DS:=6 DEC; DS:=LIT"~"; 20032925
DI:=DI-7; DS:=5 FILL; 20032930
EXIT: 20032950
END STREAM; 20033000
$ SET OMIT = NOT( DATACOM ) 20033200
SPOUTER(HDR,UNITNO,SCHEDMSG OR I); 20034000
END % IF SCHEDULE MESSAGE IS SPOUTED 20034050
ELSE FORGETSPACE(HDR); %166-20034060
END % IF XS/ES OR FIRST TIME 20034100
ELSE FORGETSPACE(HDR); 20034200
IF F NEQ 0 THEN % SHEET ENTRY PASSED AS A PARAMETER 20034300
BEGIN 20034400
DISKWAIT(F.[CF],30,T:=GETESPDISK); % WRITE SHEET ENTRY TO DISK 20034500
FORGETSPACE(S[7]); % CORE ADDRESS OF SEGMENT ZERO IN S[7] 20034600
IF SEG0=S[7] THEN SEG0:=0; % AVOID "DOUBLE "FORGETSPACE" 20034610
IF NOT SHEETLOCKED THEN 20034700
BEGIN 20034800
SLEEP([TOGLE],SHEETMASK); 20034900
LOCKTOG(SHEETMASK); 20035000
SHEETLOCKED := 1; 20035100
END; 20035200
IF (L:=S[2].[CF]) GTR SHEETMAX THEN L:=SHEETMAX; 20035300
% SHEET[2].[CF] = "SHEET" PRIORITY 20035400
IF SHEET[L].[CF] NEQ 0 THEN % SHEET QUEUE ALREADY EXISTS 20035500
BEGIN % LINK IN THIS ENTRY 20035600
DISKWAIT(-F.[CF],30,I:=SHEET[L].[FF]); %TAIL OF QUEUE 20035700
S[29]:=T; % LINK TO THIS ENTRY 20035800
DISKWAIT(F.[CF],30,I); % REPLACE ENTRY 20035900
END 20036000
ELSE SHEET[L]:=T; % ESTABLISH NEW SHEET QUEUE 20036100
SHEET[L].[FF]:=T; % LINK IN AT END OF QUEUE 20036200
TYPE := -QUITTING; 20036300
GO TO EXIT; % DONT PROCESS ANY MORE ENTRIES 20036400
END; 20036500
IF PASSLEVEL=1023 THEN PASSLEVEL:=LEVEL; 20036800
PREVLINK:=THISLINK; 20037100
IF MIX LEQ MIXMAX THEN 20037200
BEGIN 20037300
TYPE := -CONTINUEING; 20037400
GO TO CONTINUE; 20037500
END 20037600
ELSE 20037700
BEGIN 20037800
TYPE := -QUITTING; 20037900
GO TO EXIT; 20038000
END; 20038100
END; % IF TYPE = PASSING 20038200
20038300
IF TYPE=RUNING THEN % SPECIAL HANDLING FOR "RUN" JOBS 20038500
20038600
% ***** * * * * * ***** **** ***** 20038700
% * * * * ** * * * * * * * 20038800
% ***** * * * * * * * * * **** ***** 20038900
% * * * * * * * * * * * * * * 20039000
% * * ***** * ** **** ***** **** ***** 20039100
20039200
BEGIN 20039300
IF S[2].[2:1] NEQ 1 THEN % S[2].[2:1]=1 WHEN ES-ED 20039400
FOR I:=1 STEP 1 UNTIL MIXMAX DO 20039500
IF JAR[I,*] NEQ 0 THEN % JOB RUNNING AT THIS MIX INDEX 20039600
IF (S[0] EQV JAR[I,0])=(NOT 0) AND 20039700
(S[1] EQV JAR[I,1])=(NOT 0) AND 20039800
PRYOR[I] GEQ 0 THEN 20039900
BEGIN % JOB IS ALREADY RUNNING 20040000
$ SET OMIT = NOT(DCSPO AND DATACOM ) 20040100
IF BOJMESS THEN 20043000
BEGIN 20043100
$ SET OMIT = NOT (DCSPO AND DATACOM) 20043200
RMSG: BEGIN 20043600
STREAM(C:=S[18], A:=JARROW[1], I, % S[18]=PRIORITY 20043700
Q := XCLOCKTIME, B := HDR); 20043800
BEGIN 20043900
SI:=LOC C; DS:=6DEC; DI:=DI-6; DS:=5FILL; %PRIOR20044000
DI:=B; DI:=DI+6; DS:=LIT":"; 20044100
SI:=A; SI:=SI+1; DS:=7CHR; DS:=LIT"/"; % MFID20044200
SI:=SI+1; DS:=7CHR; % FID 20044300
SI:=LOC I; DS:=LIT"="; DS:=2DEC; % MIX 20044400
DS:=9LIT" RUNNING "; %161-20044500
DS:=4DEC; DS:=LIT"~"; DI:=DI-16; DS:=FILL;% TIME20044600
END STREAM; 20044700
SPOUT(HDR&S[23][9:9:9]); 20044800
END % IF BOJ MESSAGE SHOULD BE SENT 20044900
$ SET OMIT = NOT (DCSPO AND DATACOM) 20045000
END % IF BOJMESS 20045300
ELSE FORGETSPACE(HDR); 20045400
% BUMP OPEN COUNT BACK DOWN 20045500
FORGETSPACE(DIRECTORYSEARCH( ABS(S[0]), 20045600
IF S[0] LSS 0 THEN "DISK " ELSE S[1], 13)); 20045700
FORGETESPDISK(S[6] INX 0); % CARD IMAGE FOR LOG 20045800
T:=S[13]; % SAVE LINK TO LABEL EQUATION CARDS 20045900
WHILE T NEQ 0 DO % FORGET LABEL EQUATION SEGMENTS 20046000
BEGIN 20046100
DISKWAIT(-(S INX 0), 30, T); 20046200
FORGETESPDISK(T); 20046300
T:=S[29]; 20046400
END; 20046500
DELINK; % DELINK THE ENTRY FROM THE SHEET QUEUE 20046600
IF F=0 THEN % SHEET ENTRY NOT PASSED AS A PARAMETER 20046700
BEGIN 20046800
TYPE := -CONTINUEING; 20046900
GO TO CONTINUE; 20047000
END 20047100
ELSE 20047200
BEGIN % SHEET ENTRY PASSED AS A PARAMETER, DONT CONTINUE20047300
TYPE := -QUITTING; 20047400
GO TO EXIT; 20047500
END; 20047600
END; 20047700
END OF SPECIAL HANDLING OF RUN CARDS; 20047800
20048000
IF TYPE = EQUATING THEN 20048100
BEGIN 20048200
20048300
% ****** ***** ***** 20048400
% * * * * * 20048500
% **** ***** ***** 20048600
% * * * * 20048700
% * 0 * 0 ***** 0 20048800
20048900
FPB:=TYPEDSPACE(SEG0[5] INX 1,FPBAREAV); %167-20049000
% SEG0[5] = SIZE OF THE FILE PARAMETER BLOCK ON DISK 20049100
% SEG0[4] = RELATIVE DISK ADDRESS OF THE FILE PARAMETER BLOCK 20049200
% SEG0[7] = NUMBER OF FILES IN THE F.P.B. 20049300
% ETRLNG = NUMBER OF WORDS PER FILE USED IN THE F.P.B. 20049400
M[SEG0[5] INX FPB]:=0; % SET TO ZERO TO INSURE THAT STREAM STATEMENT20049500
% USED TO BUILD "IN-CORE" FPB WILL NOT SKAN 20049600
% PAST THE END OF THE COMPILER GENERATED FPB.20049700
FB:=GETSPACE(SEG0[7].[CF]|ETRLNG,FPBAREAV,1)+2; %167-20049800
% "FB" WILL BE "IN-CORE" FILE PARAMETER BLOCK LOCATION 20049900
DISKWAIT(-FPB, SEG0[5] INX 0, ACTUALDISKADDRESS(SEG0[4].[CF])); 20050000
20050100
COMMENT FORMAT OF COMPILER GENERATED FPB: 20050200
CHRS 1 AND 2 = FILE NUMBER (12 BIT BINARY) STARTING WITH 1 20050300
CHR. 3 = FILE TYPE 20050400
CHRS 4 THRU 10 = MFID 20050500
CHRS 11 THRU 17 = FID 20050600
CHR 18 = LENGTH OF INTERNAL FILE NAME (6 BIT BINARY) 20050700
CHRS 19 THRU N = INTERNAL NAME 20050800
FOR VERSION 1 ( VERSION NUMBER IN SEG0[5].[1:8] ) 20050900
NEXT TWO CHARACTERS FOLLOWING INTERNAL NAME CONTAIN: 20051000
[40:1] = SENSITIVE BIT 20051100
[41:2] = DISK SPEED (1=FAST, 2=SLOW, 0=UNSPECIFIED) 20051200
[43:5] = EU NUMBER + 1 20051300
20051400
COMMENT FORMAT OF "IN-CORE" FPB ( 5 WORDS FOR EACH FILE ENTRY ) 20051500
WORD[0].[ 6:42] = MFID 20051600
WORD[1].[ 6:42] = FID 20051700
WORD[2].[ 1:17] = REEL NUMBER (3 BCL DIGITS) 20051800
WORD[2].[18:30] = CREATION DATE (5 BCL DIGITS) 20051900
WORD[3].[ 1:5 ] = CYCLE NUMBER (BINARY) 20052000
WORD[3].[ 6:17] = PRN (PHYSICAL REEL NUMBER) FOR NON-DISK FILES 20052100
WORD[3].[15:1 ] = SENSITIVE BIT (DISK FILES ONLY) 20052200
WORD[3].[16:2 ] = DISK SPEED (DISK FILES ONLY) 20052300
WORD[3].[18:5 ] = EU. NUMBER+1 (DISK FILES ONLY) 20052400
WORD[3].[23:1 ] = IO CODE (INPUT=0,OUTPUT=1) 20052500
WORD[3].[24:12] = NUMBER OF ERRORS 20052600
WORD[3].[36:6 ] = LOGICAL UNIT NUMBER + 1 20052700
WORD[3].[43:5 ] = UNIT TYPE 20052800
END OF COMMENT; 20052900
20053000
FPBVERSION:=SEG0[5].1:8]; % NEWER VERSN.CONTAINS EU,SPD,ETC. 20053100
STREAM(TOG:=(FPBVERSION=1),T1:=0,T2:=0,C:=0,FPB,FB); 20053200
BEGIN 20053300
SI:=FPB; 20053400
LL: IF SC="0" THEN % FIRST DIGIT OF FILE NUMBER 20053500
BEGIN 20053600
SI:=SI+1; IF SC="0" THEN GO TO LP; % END OF FPB 20053700
END ELSE SI:=SI+1; 20053800
SI:=SI+1; T1:=SI; SI:=SI+1; % FILE TYPE LOCATION 20053900
2(DS:=LIT"0"; DS:=7CHR); % MFID,FID 20054000
T2:=DI; DI:=LOC C; DI:=DI+7; DS:=CHR; DI:=T2; %INT.NAME SIZE 20054100
DS:=15LIT"0"; % ZERO OUT REEL,DATE,CYCLE,ETC. 20054200
T2:=SI; SI:=T1; DS:=CHR; SI:=T2; % FILE TYPE 20054300
GO TO SK; L1: GO TO LL: L2: GO TO XXIT; SK: 20054400
SI:=SI+C; % SKIP OVER INTERNAL NAME 20054500
TOG(T2:=DI; DI:=DI-6; SKIP 3DB; SKIP 4SB; 20054600
IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB; % SENSITIVE 20054700
2(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP DB); % SPEED 20054800
5(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB); % EU 20054900
DI:=T2); 20055000
DS:=8LIT"0"; % ZERO OUT FIFTH WORD OF FB 20055100
GO TO L1; 20055200
XXIT: END STREAM STATEMENT; 20055300
20055400
IF MCPJOB THEN GO TO STOP; % NO LABEL EQUATION FOR "SYSTEM" JOBS 20055500
20055600
%%% LABEL EQUATION PROCESSING 20055700
20055800
COMMENT LABEL EQUATION RECORD FORMAT: 20055900
20056000
WORD[ 0] = MFID ( ZERO, IF NONE GIVEN ) 20056100
WORD[ 1] = FID 20056200
WORD[ 2 ].[1:17] = REEL NUMBER ( 3 BCL DIGITS ) 20056300
.[18:30] = CREATION DATE ( 5 BCL DIGITS ) 20056400
.[42:1 ] = MARKER FOR FILE OPEN ( 1 = CDATE GIVEN ) 20056500
WORD[ 3].[ 1:5 ] = CYCLE NUMBER 20056600
.[15:8 ] = NUMBER OF COPIES -1 20056700
.[23:1 ] = PACKETS 20056800
.[42:1 ] = "FORMS" REQUESTED 20056900
.[43:5 ] = UNIT TYPE 20057000
WORD[ 4].[ 0:6 ] = SIZE OF INTERNAL NAME 20057100
.[ 6:42] = FIRST SEVEN CHARACTERS OF INTERNAL NAME 20057200
WORD[ 5] THROUGH WORD[11] = REMAINDER OF INTERNAL NAME 20057300
WORD[12].[15:1 ] = SENSITIVE BIT 20057400
.[16:2 ] = DISK SPEED (1=FAST,2=SLOW,0=NOT SPECIFIED) 20057500
.[18:5 ] = EU NUMBER + 1 20057600
WORD[14] = START OF NEXT LBL.EQN.ENTRY (14 IF NO MORE ENTRIES) 20057700
WORD[29] = LINK TO NEXT ESP SEGMENT FOR LABEL EQUATION 20057800
END OF COMMENT; 20057900
20058000
FOR L := 1 STEP 1 UNTIL 2 DO 20058100
BEGIN 20058200
LINK:=IF L THEN S[15] ELSE S[13]; % EQN FROM COMPILE/EXEC, 20058300
% S[15] = RELATIVE DISK ADDRESS IN CODE FILE FOR LABEL 20058400
% EQUATION ENTERED AT COMPILE TIME 20058500
% S[13] = ACTUAL ESP DISK ADDRESS OF LABEL EQUATION ENTERED 20058600
% AT RUN TIME. 20058700
S2 := NOT L; % TRUE, IF LBL.EQN.ENTERED AT RUN TIME 20058800
WHILE LINK NEQ 0 DO % IF LBL.EQN.EXISTS 20058900
BEGIN 20059000
IF LBL=0 THEN 20059100
BEGIN 20059110
M[(LBL:=ARRAYDESC(30,LBLEQNAREAV)) INX NOT 1].AREAMIXF:=0; 20059120
END; 20059130
% IF LINK=S[15],READ FROM CODE FILE ELSE READ FROM ESP DISK 20059200
DISKWAIT(-(LBL INX 0), 30, 20059300
IF L THEN ACTUALDISKADDRESS(LINK) ELSE LINK); 20059400
I := 0; % START AT BEGINNING OF SEGMENT 20059500
IF NOT L THEN FORGETESPDISK(LINK); 20059600
LINK := LBL[29]; % NEXT LINK 20059700
IF S2 THEN % RUN TIME LABEL EQUATION 20059900
BEGIN 20060000
% IF A COMPILE JOB, SAVE FID OF OBJECT FILE NAME IN 20060100
% JAR[30] TO PRINT MIX MESSAGE OF THE FORM: 20060200
% "ALGOL"/<MFID>/<FID> 20060300
IF JAR[MIX,0] LSS 0 THEN JAR[MIX,30]:=LBL[1]; 20060400
S2:=0; % USE THE FIRST EQUATION ONLY 20060500
END; 20060600
IF LBL[0] = 14 THEN GO TO STOP; 20060800
UNBLK: LINDX:=I|14; % INDEX INTO LABEL EQUATION SEGMENT 20060900
STREAM(FN:=0 : FT:=[FT], ZERO:=0, T2:=0, 20061000
TOG:=(FPBVERSION=1), FPB, F:=[LBL[LINDX+4]], C:=0); 20061100
BEGIN 20061200
SI := F; DI:=LOC C; DI:=DI+7 ; DS:=CHR; % LBL.NAM.SIZE 20061300
SI := FPB; 20061400
L: DI:=LOC FN; DI:=DI+6; DS:=2 CHR; % FILE NUMBER 20061500
DI := LOC ZERO; SI:=SI-2; 20061600
IF 2 SC = DC THEN GO TO XXIT; % FILE NUMBER=0 20061700
DI:=FT; DS:=CHR; DI:=SI+14; % SAVE FILE TYPE FOR CHK BELOW 20061800
DI := F; % SI AT FPB INT.NAM,DI AT LBL.EQN. 20061900
IF SC = DC THEN % SAME STRING SIZE 20062000
BEGIN 20062100
IF C DC=DC THEN GO TO XXIT; % ALL CHARACTERS MATCH 20062200
END 20062300
ELSE 20062400
BEGIN % NOT THE SAME SIZE 20062500
SI:=SI-1; DI:=LOC T2; DI:=DI+7; DS:=CHR; 20062600
SI:=SI+72; % SKIP OVER FPB ENTRY 20062700
END; 20062800
TOG(SI:=SI+2); % SPEED AND EU CHARACTERS IN FPB(VERSION 1) 20062900
GO TO L; 20063000
XXIT: END; 20063100
20063200
IF (T:=P) NEQ 0 THEN % VALID LABEL EQUATION 20063300
BEGIN 20063400
FBADRS:=(T-1)|ETRLNT+FB; % ADRS OF FB FILE ENTRY 20063500
% FT IS FILE TYPE FROM FPB OBTAINED ABOVE 20063600
IF (FT1:=LBL[LINDX+3].[43:5]) NEQ @37 THEN FT:=FT1;%NEW TYP20063700
FT:=FT.[43:5]; % REMOVE "FORMS" BIT 20063800
TYPEDISK ~ (FT=10) OR (FT=12) OR (FT=13) OR (FT=26); 20063900
STREAM(X:=[LBL[LINDX]],TOG:=(TYPEDISK AND (FPBVERSION=1)), 20064000
FBADRS); 20064100
BEGIN 20064200
SI:=X; DS:=3WDS; DS:=CHR; % MFID,FID REEL,DATE,CYCLE 20064300
TOG(SI:=SI+2; SKIP 5SB; DI:=SI+2; SKIP 5DB; 20064400
IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB; 20064500
JUMP OUT TO L); % SAVE EU/SPEED SPECS FOR DISK 20064600
DS:=3CHR; 20064700
L: DS:=3CHR; 20064800
IF SC NEQ "~" THEN % NEW TYPE SPECIFIED 20064900
IF SC NEQ """ THEN DS:=CHR ELSE DS:=SET; 20065000
END STREAM STATEMENT; 20065100
SENSEVAL := (EUVAL := LBL[LINDX+12].[15:8]).[40:1]; 20065200
SPDVAL := EUVAL.[41:2]; 20065300
EUVAL := EUVAL AND @37; 20065400
IF SPDVAL GTR 0 THEN 20065500
M[FBADRS+3]:=(*P(DUP))&SPDVAL[16:46:2]; 20065600
IF SENSEVAL THEN % FILE SENSITIVE 20065700
M[FBADRS+3]:=(*P(DUP))&SENSEVAL[15:47:1]; 20065800
IF EUVAL GTR 0 THEN % NEW EU NUMBER REQUESTED IN LBL.EQN. 20065900
M[FBADRS+3]:=(*P(DUP))&EUVAL [18:43:5]; 20066000
END; % IF VALID LABEL EQUATION 20066100
IF (I:=I+1) = 1 THEN IF LBL[14] NEQ 14 THEN GO TO UNBLK; 20066200
END; % WHILE LINK NEQ 0 20066300
STOP: END; % FOR L 20066400
FORGETSPACE(FPB); 20066500
TRP[3] := [M[FB]] & (SEG0[7].[CF]|ETRLNG)[8:38:10]; 20066600
END; % IF TYPE = EQUATING 20066700
20066800
EXIT: 20080000
P([RETURNRCW], STS, 0, RDS, 0, XCH, P&P[CTF], STF); 20080100
END PROCEDURE SELECTRUN1; 20080200
20080300
20080400
PROCEDURE SELECTRUN2; 20080500
BEGIN 20080600
REAL MSCW = -2, 20080700
F = -1, 20080800
MYMSCW = -1, 20080900
RCW = +0, 20081000
I = +1, 20081100
T = +2, 20081200
L = +3, 20081300
DT = +4, 20081400
MIX = +5, 20081500
HDR = +6, 20081600
LEVEL = +7, 20081700
MCPJOB = +8, 20081800
OLAYDISK = +9, 20081900
THISLINK = +10, 20082000
NEXTLINK = +11, 20082100
PREVLINK = +12, 20082200
TYPE = +13, 20082300
STACKLOC = +14, 20082400
SHEETLOCKED = +15; 20082500
20082600
ARRAY S = +16[*], 20082700
SEG0 = +17[*], 20082800
TRP = +18[*], 20082900
LBL = +19[*], 20083000
SD = NT2[*], 20083100
TSKA = NT2[*]; 20083200
20083300
NAME ADDR = LBL +1; 20083500
REAL PASSLEVEL = ADDR + 1, 20083600
SVALUE = PASSLEVEL, 20083700
RETURNMSCW = PASSLEVEL + 1, 20083800
RETURNRCW = RETURNMSCW + 1; 20083900
20084000
DEFINE SHEETMAX = MIXMAX#; 20084100
20084200
20085300
%%%% ***NOTE**** 20085400
%%%% THE VARIABLES DECLARED ABOVE MUST CORRESPOND EXACTLY TO 20085500
%%%% THOSE DECLARED IN PROCEDURE SELECTRUN. 20085600
20085710
REAL MSGSPACE = RETURNRCW + 1; % LOCAL TO THIS PROCEDURE 20085800
LABEL DLX, BMSG, SKIP, EXIT; %127-20085900
DEFINE XCLOCKTIME = 20086000
(((NT2:=(XCLOCK DIV 3600)) MOD 60 + (NT2 DIV 60)|100 + 20086100
0.5 ) DIV 1)#; 20086200
20086300
DEFINE ACTUALDISKADDRESS(ACTUALDISKADDRESS1) = 20086400
((JAR[MIX,((NT4:=ACTUALDISKADDRESS1) DIV (NT3:=JAR[MIX,8]))+10] 20086500
+ (NT4 MOD NT3) + 0.5) DIV 1)#; 20086600
20086700
$ SET OMIT = NOT(PACKETS) 20086799
DEFINE UNITNO = S[23].[2:6]#; % ORIGINATING UNIT 20086800
$ POP OMIT 20086801
20086810
DEFINE DALOCSIZE = 9#; 20087200
20087400
% VALUES ASSOCIATED WITH "TYPE" ; 20087500
20087600
DEFINE STARTING = 1#, 20087700
CONTINUEING = 2#, 20087800
QUITTING = 3#, 20087900
RUNING = 4#, 20088000
PASSING = 5#, 20088100
EQUATING = 6#; 20088200
20088300
SUBROUTINE DELINK; 20088400
% DELINKS THE SHEET ENTRY AND RETURNS SHEET DISK SPACE 20088500
BEGIN 20088600
STREAM(A:=S[3].[8:10],B:=P(.SCHEDULEIDS)); 20088700
BEGIN % MARK SCHEDULE SLOT "OPEN" 20088800
SKIP A DB; DS:=RESET; 20088900
END; 20089000
IF F = 0 THEN % SHEET ENTRY NOT PASSED AS PARAMETER 20089100
BEGIN 20089200
IF NEXTLINK=0 THEN SHEET[LEVEL].[FF]:=PREVLINK; 20089300
IF PREVLINK=0 THEN 20089400
BEGIN 20089500
SHEET[LEVEL].[CF]:=NEXTLINK; GO DLX; 20089600
END; 20089700
IF LBL=0 THEN 20089800
BEGIN 20089810
M[(LBL:=ARRAYDESC(30,LBLEQNAREAV)) INX NOT 1].AREAMIXF:=0; 20089820
END; 20089830
DISKWAIT(-(LBL INX 0), 30, PREVLINK); 20089900
LBL[29]:=NEXTLINK; 20090000
DISKWAIT( (LBL INX 0), 30, PREVLINK); 20090100
DLX: FORGETESPDISK(THISLINK); 20090200
END; % IF SHEET ENTRY NOT A PARAMETER 20090300
END DELINK; 20090400
20090500
BOOLEAN SUBROUTINE REENTRY; 20090700
BEGIN 20090800
POLISH(FALSE); 20090900
IF JAR[MIX,2].[8:10] NEQ 0 THEN % NOT "GO" FROM COMPILE AND GO 20091000
IF NOT (S[2].[2:1]) THEN % NOT ES-ED 20091100
FOR I:=1 STEP 1 UNTIL MIXMAX DO 20091200
IF JAR[I,*] NEQ 0 THEN 20091300
IF ((JAR[MIX,0] EQV JAR[I,0])) = (NOT 0) THEN % SAME MFID 20091400
IF ((JAR[MIX,0] LSS 0) OR % COMPILER 20091500
(((JAR[MIX,1] EQV JAR[I,1])) = (NOT 0))) THEN % SAME FID 20091600
IF JAR[I,10] NEQ 0 THEN % COMPILER OR SAME MFID 20091700
IF JAR[I,2].[8:10] NEQ 0 THEN % NOT "GO" PART OF COMP.& GO 20091800
IF PRYOR[I] GEQ 0 OR 20091900
NFO[(I-1)|NDX+1].[FF] NEQ 0 THEN % RUNNING 20092000
BEGIN 20092100
COMMENT MAKE THE ENTRY IN LINKED-LIST STYLE; 20092200
IF PRT[I,4].[FF] NEQ 0 THEN % ALREADY PRESENT 20092300
BEGIN 20092400
COMMENT ENTER AT TAIL OF PREVIOUS LIST; 20092500
DO NT1:= I UNTIL (I:=PRT[I,4].[24:6])=@77; 20092600
NFO[(MIX-1)|NDX+1]:=TRP[4]:=PRT[NT1,4]; 20092700
NFO[(NT1-1)|NDX+1]:=PRT[NT1,4]:= 20092800
(*P(DUP))&MIX[24:42:6]; 20092900
END 20093000
ELSE 20093100
BEGIN 20093200
COMMENT CONSTRUCT NEW LIST; 20093300
NFO[(I-1)|NDX+1]:=PRT[I,4]:= 20093400
(*P(DUP))&I[18:42:6]&MIX[24:42:6]; 20093500
NFO[(MIX-1)|NDX+1]:=TRP[4]:= 20093600
PRT[I,4]&@77[24:42:6]; 20093700
END; 20093800
POLISH(DEL,TRUE); 20093900
I:=MIXMAX; 20094000
END; 20094100
REENTRY:=POLISH; 20094200
END REENTRANT CODE LINKAGE ESTABLISHMENT SUBROUTINE; 20094300
20094500
P(MYMSCW, STF); 20094600
P(0); % MESAGE SPACE, LOCAL TO THIS PROCEDURE 20094610
20094700
% **** ***** *** ***** ***** ***** ***** 20094800
% * * * * * * * * * * * 20094900
% **** * * * * * * ***** ***** * ** 20095000
% * * * * * * * * * * * * * 20095100
% **** ***** **** * * * ***** ***** ***** 0 20095200
20095300
$ SET OMIT = NOT( DCSPO AND DATACOM ) 20098900
IF BOJMESS THEN 20100700
IF MCPJOB.[1:1] THEN % "SYSTEM" TYPE JOB 20100800
IF NOT (AUTOMESS) THEN % SUPPRESS BOJ/EOJ MESSAGE 20100900
IF NOT (S[2].[2:1]) THEN % NOT ES-ED 20101000
IF S[2].[4:1] THEN % SUPRESS BOJ/EOJ MESSAGE 20101100
BEGIN 20101200
STREAM(N:=S[0], MIX, T:=T:=SPACE(4)); 20101300
BEGIN 20101400
DS:=6LIT" AUTO-"; 20101500
SI:=LOC N; SI:=SI+1; DS:=7CHR; 20101600
DS:=2LIT" ="; SI:=LOC MIX; DS:=2DEC; 20101700
DS:=LIT"~"; DI:=DI-3; DS:=FILL; 20101800
END; 20101900
SPOUT(T); 20102000
GO TO SKIP; 20102100
END; 20102200
$ SET OMIT = PACKETS 20104600
$ SET OMIT = NOT(PACKETS) 20104900
IF (NOT MCPJOB OR BOJMESS) 20105000
$ POP OMIT % PACKETS 20105100
AND NOT S[2].[2:1] THEN % S[2].[2:1]=1 WHEN ES-ED 20105200
BEGIN 20105300
GIMEDATE([DT].[CF],-DT); % CONVERT DATE TO "MMDDYY" FORMAT 20105350
STREAM(DAAT:=DT, DTOG:=NOT(MCPJOB) AND TRUE, SV :=0, 20105400
$ SET OMIT = NOT(DCSPO AND DATACOM) 20105500
C:=S[18], A:=JARROW[MIX], MIX, % S[18]=PRIORITY 20105900
Q:=XCLOCKTIME, B:=MESAGESPACE:=GETSPACE(12,0,0)+2); 20106000
BEGIN 20106100
SI:=LOC C; DS:=6DEC; DI:=DI-6; DS:=5FILL; % PRIORITY 20106200
DI:=B; DI:=DI+6; DS:=LIT":"; 20106300
SI:=A; SI:=SI+1; DS:=7CHR; % MFID 20106400
DS:=LIT"/"; SI:=SI+1; DS:=7CHR; % FID 20106500
SI:=LOC MIX; DS:=LIT"="; DS:=2DEC; % MIX 20106600
SV:=DI; DI:=DI-2; DS:=FILL; DI:=SV; 20106700
DS:=5LIT" BOJ "; DS:=4DEC; DS:=LIT" "; % TIME 20106800
DTOG(SI:=LOC DAAT; SI:=SI+2; 20106900
3(DS:=2CHR; DS:=LIT"/"); DI:=DI-1; % CDATE 20107000
$ SET OMIT = NOT(DCSPO AND DATACOM) 20107100
DS:=LIT"~"; 20107500
END STREAM STATEMENT; 20107600
$ SET OMIT = NOT(DCSPO AND DATACOM) 20107700
20108400
END; 20108500
20108700
SKIP: 20108800
20108900
20109000
% ***** ***** ***** ***** ***** ***** ***** 20109100
% * * * * * * * * * 20109200
% ***** ***** * ** * ***** ***** * * 20109300
% * * * * * * * * * * 20109400
% ***** ***** ***** ***** ***** * * ***** 20109500
20109600
JAR[MIX,2] := (*P(DUP)) & SEG0[2][1:1:2] & 20110700
SEG0[2][5:2:3] & 20110900
SEG0[7][3:2:1]; 20111100
% SEG0[2].[1:1] = JOB COMPILED BY COBOL ( NO "OAT" ENTRY ) 20111200
% SEG0[2].[2:3], SEG0[7].[2:1] = USED FOR INTER-PROG.COMMUNICATION 20111300
IF SEG0[2].[2:1] THEN SOFTI:=SOFTI+1; 20111500
IF SEG0[2].[4:1] AND (MESAGESPACE!0) THEN % INVOKED I.P.C. TASK%110-20111600
BEGIN % CHANGE BOJ TO BOT %110-20111610
STREAM(MESAGESPACE); BEGIN DI~DI+28; DS~LIT"T"; END; %110-20111620
END; %110-20111630
$ SET OMIT = NOT(BREAKOUT) 20111800
20115200
% ***** ***** ***** ***** * * ***** ***** ***** 20115300
% * * * * * * * * * * * * * 20115400
% ***** * ***** * * * ***** ***** ***** * 20115500
% * * * * * * * * * * * * 20115600
% ***** * * * ***** * * * * * * 20115700
20115800
IF MESAGESPACE NEQ 0 THEN % BOJ MESSAGE BUILD 20118350
BEGIN 20118360
SPOUTER(MESAGESPACE,UNITNO,(BOJMESS AND NOT S[2].[2:1])); 20118370
% S[2].[2:1] = 1 WHEN ES-ED 20118380
MESAGESPACE:=0; 20118390
END; 20118400
M[STACKLOC].[9:6] := MIX; % PLACE MIX INDEX IN MEMORY LINK 20118600
% COMPUTE THE ADDRESS FOR THE PRT SUCH THAT PRTADRS.[42:6]=0 20118800
T:=(((STACKLOC:=STACKLOC+2)+S[21]) OR 63) + 1; % S[21]=STACKSIZE 20118900
IF ((I:=M[STACKLOC-2].[CF])-(L:=SEG0[3] INX T)) GTR 10 THEN 20119000
BEGIN % RETURN REMAINDER OF PRT SPACE 20119100
IF NOT STORDY THEN SLEEP([TOGLE],STOREMASK); 20119600
LOCKTOG(STOREMASK); 20119700
M[L] := I & (STACKLOC-2)[CTF] & MIX[9:42:6]; % NEW LINK 20119900
M[I].[FF] := L; % BACK LINK 20120000
M[STACKLOC-2].[CF] := L; % FORWARD LINK 20120100
UNLOCKTOG(STOREMASK); 20120600
FORGETSPACE(L+2); 20120800
END; % IF PRT SPACE WAS TOO LARGE 20120900
% ZERO OUT STACK TO EASE PROBLEMS OF CONGENITAL DUMP-READERS 20121000
M[STACKLOC] := @3333333333333333; 20121100
MOVE(T-STACKLOC-1,STACKLOC,STACKLOC+1); 20121200
20121300
% . . . . . . . . . . . . . . . . . . . . . . . 20121400
% READ IN PRT FROM DISK 20121500
% . . . . . . . . . . . . . . . . . . . . . . . 20121600
20121700
DISKWAIT(-T, SEG0[3].[CF], ACTUALDISKADDRESS(SEG0[2].[CF])); 20121800
% SEG0[2] = RELATIVE DISK ADDRESS OF THE PRT IN THE CODE FILE 20121900
% SEG0[3] = SIZE OF THE PRT 20122000
TRP:=PRTROW[MIX]:=[M[T]]&1023[8:38:10]; % DESCRIPTOR TO THE PRT 20122100
20122200
% ***** ***** ***** **** *** ***** ***** 20122300
% * * * * * * * * 20122400
% ***** ***** * ** * * * * * 20122500
% * * * * * * * * * 20122600
% ***** ***** ***** **** *** ***** * 0 20122700
20122800
IF REENTRY THEN 20123000
BEGIN 20123100
% RE-ENTRANT JOB, PRT[4] POINTS TO EXISTING SEGMENT DICTIONARY 20123200
COMMENT BUILD PHONY ICW, IRCW, & INCW; 20123300
M[STACKLOC] := @2222222222222222; 20123400
M[STACKLOC+1] := -FLAG(0&(TRP)[6:33:9]); 20123500
M[STACKLOC+2] := -FLAG(0); 20123600
TRP[8] := -FLAG(STACKLOC+2); 20123700
TRP[10] := TRP&(STACKLOC+1)[18:33:15]; 20123800
END % REENTRY 20123900
ELSE 20124000
BEGIN 20124100
NFO[(MIX-1)|NDX+1] := 20124700
TRP[4]:=[M[T:=GETSPACE(SEG0[1].[CF],SEGDICTAREAV,1)+2]]; %167-20124900
DISKWAIT(-T, SEG0[1].[CF], ACTUALDISKADDRESS(SEG0[0].[CF])); 20125000
% SEG0[0]= RELATIVE DISK ADDRESS OF SEGMENT DICTIONARY 20125100
% SEG0[1]= SIZE OF THE SEGMENT DICTIONARY 20125200
M[TRP[4]] := SEG0[1].[CF] -1; % SEGDICT[0]=SIZE OF DICTIONARY 20125300
$ SET OMIT = NOT(AUXMEM) 20125400
END; % NOT REENTRY 20126400
20126600
% **** ***** * ***** ***** 20126700
% * * * * * * * * 20126800
% * * ***** * * * * 20126900
% * * * * * * * * 20127000
% **** * * ***** ***** ***** 20127100
20127200
STREAM(D:=DALOCROW[MIX]:=SAVEARRAYDESC(DALOCSIZE,DALOCROWAREAV)); 20127300
BEGIN 20127500
SI:=D; SI:=SI-8; DS:=DALOCSIZE WDS; 20127600
END; 20127700
IF OLAYDISK NEQ 0 THEN % OLAY DISK OBTAINED ABOVE 20127800
BEGIN 20127900
DALOC[MIX.0] := @200002; 20128000
DALOC[MIX,1] := OLAYDISK; 20128100
OLAYDISK := 0; 20128200
END; 20128300
OLAYMASK := TWO(MIX) OR OLAYMASK; % OLAYS NOW ALLOWABLE 20128400
20128500
% ***** ***** ***** ***** ***** * * 20128600
% * * * * * * * * * * * ** * 20128700
% * * * * * * * * * * * * * * 20128800
% * * * * * * * * * * * * * * 20128900
% ***** ***** * * * * * * ***** * ** 20129000
20129100
% PLACE "COMMON" VALUE IN FIRST SIMPLE VARIABLE IN THE PRT 20129200
NT1 := S[19]; % COMMON VALUE IN SHEET[19] 20129300
FOR I:= @25 STEP 1 WHILE NT1 NEQ 0 AND I LSS SEG0[3] DO 20129400
IF TRP[I]=0 THEN % SIMPLE VARIABLE (NOT A DESCRIPTOR) 20129500
BEGIN 20129600
TRP[I]:=NT1; 20129700
NT1:=0; 20129800
END; 20129900
DELINK; % DELINK SHEET ENTRY FROM SHEET QUEUE 20130000
20130100
EXIT: 20140000
20140100
P([RETURNRCW], STS, 0, RDS, 0, XCH, P&P[CTF], STF); 20140200
END PROCEDURE SELECTRUN2; 20140300
20140400
% FOR ADDITIONAL INFORMATION CONCERNING THE SHEET, SEE THE 20140500
% DOCUMENT AT SEQUENCE NUMBER 20512000 20140600
20140700
PROCEDURE SELECTRUN(F); VALUE F; REAL F; 20140800
BEGIN 20140900
20141000
REAL MSCW = -2, 20141100
F = -1, 20141200
MYMSCW = -1, 20141300
RCW = +0, 20141400
I = +1, 20141500
T = +2, 20141600
L = +3, 20141700
DT = +4, 20141800
MIX = +5, 20141900
HDR = +6, 20142000
LEVEL = +7, 20142100
MCPJOB = +8, 20142200
OLAYDISK = +9, 20142300
THISLINK = +10, 20142400
NEXTLINK = +11, 20142500
PREVLINK = +12, 20142600
TYPE = +13, 20142700
STACKLOC = +14, 20142800
SHEETLOCKED = +15; 20142900
20142940
INTEGER EST = I; % USED FROM 20163700 TO 20165300 20142950
20143000
ARRAY S = +16[*], 20143100
SEG0 = +17[*], 20143200
TRP = +18[*], 20143300
LBL = +19[*], 20143400
SD = NT2[*], 20143500
TSKA = NT2[*]; 20143600
20143700
NAME ADDR = LBL +1; 20143900
REAL PASSLEVEL = ADDR + 1, 20144000
SVALUE = PASSLEVEL, 20144100
RETURNMSCW = PASSLEVEL + 1, 20144200
RETURNRCW = RETURNMSCW + 1; 20144300
20144400
DEFINE SHEETMAX = MIXMAX#; 20144500
20144600
20145700
%%%% ***NOTE**** 20145800
%%%% THE VARIABLES DECLARED ABOVE MUST CORRESPOND EXACTLY TO 20145900
%%%% THOSE DECLARED IN PROCEDURE SELECTRUN. 20146000
20146100
DEFINE XCLOCKTIME = 20146200
(((NT2:=(XCLOCK DIV 3600)) MOD 60 + (NT2 DIV 60)|100 + 20146300
0.5 ) DIV 1)#; 20146400
20146410
$ SET OMIT = NOT(PACKETS) 20146419
DEFINE UNITNO = S[23].[2:6]#; % ORIGINATING UNIT 20146420
$ POP OMIT 20146421
20146500
LABEL START, CONTINUE, LOAD, PASS, WINDUP, QUIT; 20146600
LABEL JARSPACE, TRYAGAIN, NG; %127-20146700
20146800
SWITCH SW := QUIT, START, CONTINUE, QUIT, QUIT, PASS; 20146900
20147000
COMMENT THE VALUE OF "TYPE" MAY DETERMINE WHICH PORTIONS OF 20147100
PROCEDURES "SELECTRUN1" AND/OR "SELECTRUN2" WILL BE EXECUTED. 20147200
PROCEDURE "SELECTRUN1" AND "SELECTRUN2" MAY, IN TURN, SPECIFY 20147300
THE BRANCH POINT IN THIS PROCEDURE. 20147400
THE FOLLOWING DEFINES ARE USED TO SPECIFY THE BRANCH POINT 20147500
IN SWITCH "SW". 20147600
END OF COMMENT; 20147700
20147800
DEFINE STARTING = 1#, 20147900
CONTINUEING = 2#, 20148000
QUITTING = 3#, 20148100
RUNING = 4#, 20148200
PASSING = 5#, 20148300
EQUATING = 6#; 20148400
20148500
P(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); 20148700
RCW := RCW & P(..SELECTRUN,LOD)[CTC]; 20149200
20149300
TYPE := STARTING; 20149400
20149500
START: 20149600
20149700
P1MIX := 0; 20149800
IF F NEQ 0 THEN % SHEET ENTRY PASSED AS A PARAMETER 20149900
BEGIN 20150000
S := IOQUE & F[CTC]; % SHEET ENTRY 20150100
HDR := F.[FF]; % CORE ADDRESS OF OBJECT FILE HEADER 20150200
END 20150300
ELSE 20150400
BEGIN 20150500
IF TYPE=STARTING AND NOT SHEETLOCKED THEN 20150600
BEGIN 20150700
SLEEP([TOGLE].SHEETMASK); 20150800
LOCKTOG(SHEETMASK); 20150900
SHEETLOCKED := 1; 20151000
END; 20151100
P([SVALUE], STS); 20151200
SELECTRUN1; 20151300
IF TYPE LSS 0 THEN 20151400
GO TO SW[TYPE:=ABS(TYPE)]; 20151500
END; 20151600
20151700
CONTINUE: 20151800
20151900
P1MIX := 0; 20152000
IF (MCPJOB := S[2].SSYSJOBF) THEN 20152100
IF (MCPJOB = PRNPBTCODE AND AUTOPRINT) OR 20152200
(MCPJOB = LDCNTRLCODE AND CDONLY) THEN 20152300
MCPJOB.[1:1] := 1; 20152800
20152900
% NOTE: A NEGATIVE SIGN FOR MCPJOB IMPLIES THAT THIS JOB 20153000
% SHOULD BE STARTED REGARDLESS OF THE AVAILABILITY OF 20153100
% SYSTEM CORE. 20153200
20153300
IF INTSIZE=0 THEN % NO INTRINSICS FILE 20153400
IF NOT(MCPJOB) THEN % NOT "SYSTEM" PROGRAM 20153500
BEGIN 20153600
STREAM(NT3:=NT3:=SPACE(4)); 20153700
DS:=24 LIT"##NO INTRINSICS FILE...~"; 20153800
SPOUT(NT3); 20153900
SLEEP([INTSIZE],@1777); 20154000
END; 20154100
20154200
WHILE(NT2:=XCLOCK+P(RTR)) GEQ WITCHINGHOUR DO MIDNIGHT; 20157700
20157800
% ***** * ***** * * **** *** ***** * * 20157900
% * * * * * * * * * * * * * 20158000
% * * * ***** * * * * ***** *** 20158100
% * * * * * * * * * * * * 20158200
% ***** ***** * * * **** *** ***** * * 20158300
20158400
IF NOT MCPJOB THEN % NOT "LIBMAIN","LDCNTRL","PRNPBT" 20158500
IF OLAYDISK=0 THEN % NO OLAY DISK OBTAINED YET 20158600
IF(OLAYDISK:=PETUERDISK(500 OR M,1))=0 THEN % NO OLAY DISK 20159100
BEGIN 20159200
L:=1; 20159500
GO TO PASS; 20159900
END; % IF NOT OLAY DISK 20160000
20160200
COMMENT JOB WILL BE RUN ONLY IF: 20160300
1) AN XS OR ES MESSAGE HAS BEEN ENERED FOR THIS JOB, (IN WHICH 20160400
CASE SHEETDIDDLER TURNED ON S[2].[1:1] AND CALLED SELECTION),20160500
OR 2) THE SUM OF THIS JOBS CORE REQUIREMENTS (S[20]) PLUS THE SUM 20160600
OF THE CORE REQUIREMENTS OF ALL OTHER JOBS ACTUALLY RUNNING 20160700
(CORE.[FF]) IS LESS THAN THE TOTAL AMOUNT OF CORE AVAILABLE 20160800
FOR USER PROGRAMS (THE INITIAL SPACE AVAILABLE (CORE.[CF]) 20160900
TIMES THE MULTIPROCESSING FACTOR (CORE.[4:14]), 20161000
OR 3) "LDCNTRL/DISK" IS BEING TESTED AND THE "CDONLY" OPTION IS SET 20161100
OR 20161200
"PRNPBT/DISK" IS BEING TESTED AND THE "AUTOPRNT" OPTION IS SET20161300
20161400
IF THE JOB BEING TESTED IS A "SYSTEM" JOB (LIBMAIN,LDCNTRL, 20161500
PRNPBT) AND THE ABOVE CONDITIONS ARE NOT SATISFIED, THE 20161600
THE APPARENT AMOUNT OF AVAILABLE CORE (AS SHOWN IN THE "CORE" 20161700
WORD) IS TESTED USING A FACTOR OF 1.1 TIMES THE ACTUAL FACTOR 20161800
IN ORDER TO ATTEMPT TO FORCE THESE JOBS IN. 20161900
END OF COMMENT; 20162000
20162100
IF S[2].[8:10]=5 THEN % "RUN" JOB GETS SPECIAL HANDLING 20162300
$ SET OMIT = NOT(DATACOM AND RJE ) 20162400
BEGIN 20162700
TYPE := RUNING; 20162800
P([SVALUE],STS); 20162900
SELECTRUN1; 20163000
IF TYPE LSS 0 THEN 20163100
GO TO SW[TYPE:=ABS(TYPE)]; 20163200
END; % IF A "RUN" REQUEST 20163300
T:=S[20]; % USED UNTIL 20178900 20163600
IF (EST:=CORE.[CF]|CORE.[4:14]/100)<T THEN % ESTIMATE > TOTAL. 20163700
IF EST>0 THEN T:=EST; % SET IT TO TOTAL. 20163800
L:=0; %125-20163900
IF NOMEM NEQ 0 THEN GO TO PASS; 20164000
IF (S[2] LSS 0) OR (MCPJOB.[1:1]) THEN GO TO JARSPACE; 20164200
% MCPJOB.[1:1]=1 MEANS RUN IT REGARDLESS OF CORE AVAILABILITY 20164300
% S[2].[1:2] ::: [0=NORMAL, 1=NOT USED, 2=XS-ED, 3=ES-ED] 20164400
IF (LEVEL GTR PASSLEVEL) THEN GO TO PASS; %140-20164700
$ SET OMIT = NOT(BREAKOUT) %140-20164750
$ SET OMIT = NOT(WORKSET) 20165110
IF (WKSETSTOPJOBS NEQ 0) OR WKSETNOSELECT THEN GO TO PASS; 20165120
$ POP OMIT % WORKSET 20165130
IF CORE.[FF]+T > (IF MCPJOB THEN EST|1.1 ELSE EST) THEN GO PASS;20165300
% AN ATTEMPT IS MADE TO RUN MCPJOBS EVEN WHEN CORE IS FULL BY 20165400
% TESTING THEM AGAINST A VALUE 10% HIGHER. 20165500
20166800
% *** ***** ***** ***** ***** ***** ***** ***** 20166900
% * * * * * * * * * * * * 20167000
% * ***** ***** ***** ***** ***** * ***** 20167100
% * * * * * * * * * * * * 20167200
% ***** * * * * ***** * * * ***** ***** 20167300
20167400
JARSPACE: 20167500
20167600
IDLETIME; 20167650
% FIND A MIX SLOT FOR THIS JOB 20167700
FOR MIX:=1 STEP 1 UNTIL MIXMAX DO 20167800
IF JAR[MIX,*]=0 THEN GO LOAD; 20167900
20168000
% NO FREE SPACE IN JAR: PASS ENTRY WITHOUT DELINKING AND CONTINUE 20168100
L:=2; 20168150
GO TO PASS; 20168200
20168700
% * ***** ***** **** *** ***** ***** 20168800
% * * * * * * * * * * * * 20168900
% * * * ***** * * * ***** ***** 20169000
% * * * * * * * * * * * * * 20169100
% ***** ***** * * **** **** * * * * 20169200
20169300
LOAD: 20169400
20169500
JARROW[MIX] := IOQUE & HDR[CTC]; % FILE HEADER BECOMES JAR ROW 20169600
M[HDR-2].[9:6] := MIX; % PLACE MIX INDEX IN MEMORY LINK 20169800
M[HDR-2].[3:6] := JARROWAREAV; %167-20169900
CORE.[FF] := CORE.[FF] + T; % ADD IN CORE ESTIMATE 20170600
$ SET OMIT = NOT(PACKETS) 20170700
IF(I:=S[23].[2:6]) GEQ 32 THEN PSEUDOMIX]MIX]:=I; % PSUEDO-RDR JOB 20170800
$ POP OMIT % PACKETS 20170900
JAR[MIX,0] := S[0]; 20171000
JAR[MIX,1] := S[1]; 20171100
JAR[MIX,2]:=S[2]&(IF (NT1:=S[2].[8:10])=5 THEN 2 ELSE NT1)[8:38:10];20171200
% IF THIS IS A "RUN" JOB, CHANGE IT TO SAY "EXECUTE" 20171300
% JAR[MIX,2].[8:10] = SHEET[2].[8:10] = 20171400
% 0 = "GO" PART OF COMPILE AND GO 20171500
% 1 = COMPILE AND GO 20171600
% 2 = EXECUTE 20171700
% 3 = COMPILE FOR SYNTAX 20171800
% 4 = COMPILE TO LIBRARY 20171900
5 5 = RUN JOB 20172000
STREAM(A:=JAR[MIX,3].[30:18], D:=[DT]); % CREATION DATE FROM HDR 20172100
BEGIN 20172200
SI:=LOC A; DS:=8DEC; 20172300
END; 20172400
$ SET OMIT = NOT(NEWLOGGING) 20172499
PROCTIME[MIX] := -(JAR[MIX,3]:=S[16]); % PROCESS LIMIT %127-20172600
IOTIME [MIX] := -(JAR[MIX,4]:=S[17]); % I/O LIMIT %127-20172700
STREAM(DATE, A:=[I]); % CONVERT DATE TO OCTAL FOR LOGGING 20172800
BEGIN 20172900
SI:=LOC DATE; DS:=8OCT; 20173000
END; 20173100
JAR[MIX,5]:=(XCLOCK+P(RTR)) & I[1:25:23]; % DATE AND TIME 20173200
JAR[MIX,6] := S[6]&S[23][2:2:6]; % CARD/PSEUDO RDR. UNITNO IN [2:6] 20173300
JAR[MIX,7] := 0; % IDLETIME ENTRY 20173800
JAR[MIX,9].[FF] := 0; % ZERO OUT "CHAIN" DISK ADDRESS FIELD 20173900
% JAR[MIX,8] THROUGH JAR[MIX,29] STILL CONTAIN CONTENTS OF 20174100
% OBJECT FILE HEADER AS OBTAINED ABOVE 20174200
JAR[MIX,9] := M[HDR INX 9].[CF] & MCPJOB[6:45:3] & 20174300
(S[2].[4:1] AND NOT(S[2].[2:1] OR AUTOMESS))[2:47:1]; 20174400
% S[2].[4:1]=1 MEANS SUPPRESS BOJ/EOJ MESSAGES 20174500
% MARK JAR[9] WITH JOB CODE (1,3 OR 5 FOR SYS JOB) 20174600
% INSURE THAT THIS JOB HAS A UNIQUE STARTING TIME (FOR LOG) 20174900
TRYAGAIN: 20175000
FOR I:=1 STEP 1 UNTIL MIXMAX DO 20175100
BEGIN 20175200
IF JARROW[1] NEQ 0 THEN % JOB RUNNING HERE 20175300
IF I NEQ MIX THEN % NOT OUR JOB 20175400
IF JAR[MIX,5].[24:24]=JAR[I,5].[24:24] THEN % SAME START TIME 20175500
BEGIN 20175600
JAR[MIX,5].[24:24]:=JAR[MIX,5].[24:24]+1; % BUMP THE TIME 20175700
GO TRYAGAIN; 20175800
END; 20175900
END; 20176000
% %127-20176003
% ***** ***** ***** ***** ***** ***** ***** %127-20176006
% * * * * * * * * * %127-20176009
% ***** ***** * ** * ***** ***** * * %127-20176012
% * * * * * * * * * * %127-20176015
% ***** ***** ***** ***** ***** * * ***** %127-20176018
% %127-20176021
IF F NEQ 0 THE % SHEET ENTRY PASSED AS A PARAMETER %127-20176024
BEGIN %127-20176027
IF SEG0 NEQ 0 THEN FORGETSPACE(SEG0); %127-20176030
SEG0 := S & S[7][CTC]; % CEG. ZERO PRESENT AT CORE ADDR. "S[7]" 20176033
END %127-20176036
ELSE %127-20176039
BEGIN %127-20176042
IF SEG0 = 0 THEN % %127-20176045
M[(SEG0:=ARRAYDESC(30,SEGZEROAREAV)) INX NOT 1].AREAMIXF:=0;20176048
DISKWAIT(-(SEG0 INX 0),30,M[HDR INX 10]); % READ SEGMENT ZERO 20176054
END; % IF SEGMENT ZERO WAS NOT PRESENT %127-20176057
% %127-20176060
% ***** ***** ***** ***** * * ***** ***** ***** 20176063
% * * * * * * * * * * * * * 20176066
% ***** * ***** * *** ***** ***** ***** * 20176069
% * * * * * * * * * * * * 20176072
% ***** * * * ***** * * * * * * 20176075
% %127-20176078
% S[21] CONTAINS STACK SIZE, SEG0[3] CONTAINS PRT SIZE %127-20176081
IF SEG0[3] GTR 0 THEN % NOT A RESTART JOB %127-20176084
BEGIN %127-20176087
NFO[(MIX-1)|NDX+2] := (STACKLOC:=GETSPACE % %167-20176090
(SEG0[3] INX S[21] INX 64,STACKPRTAREAV,3))+2; % %167-20176093
IF STACKLOC = 0 THEN % NO MEMORY %127-20176096
BEGIN %127-20176099
NG: JARROW[MIX] := L := 0; % %127-20176102
CORE.[FF] := CORE.[FF] - T; % %127-20176105
$ SET OMIT = NOT(PACKETS) %127-20176117
PSEUDOMIX[MIX] := 0; % %127-20176120
$ POP OMIT %127-20176123
GO TO PASS; %127-20176126
END; % IF NO MEMORY %127-20176129
IF NOT MCPJOB.[1:1] THEN % DON-T UATO-START SYSJOB %127-20176132
IF STACKLOC GEQ @50000 THEN %127-20176135
BEGIN % SAVE SPACE TO HIGH... %127-20176138
FORGETSPACE(STACKLOC+2); % %127-20176141
STACKLOC := 0; % %127-20176144
GO TO NG; % %127-20176147
END; %127-20176150
END; % NOT RESTART %127-20176153
%%% SEE ALSO "SEGMENT ZERO" SECTION IN PROCEDURE "SELECTRUN2" FOR 20176200
%%% FURTHER ALTERATION TO THE JAR. 20176300
20176400
% ***** ***** **** * ***** ***** 20176500
% * * * * * * * * 20176600
% * ***** **** * ***** ***** 20176700
% * * * * * * * * 20176800
% * * * **** ***** ***** ***** 20176900
20177000
$ SET OMIT = NOT(STATISTICS) 20177200
IF S[2].[2:1] OR (S[21] LSS 128) THEN S[21]:=128; 20178100
% S[2].[2:1]=1 WHEN ES-ED, S[21] CONTAINS STACK SIZE 20178200
NFO[(MIX-1)|NDX+2] := P(DUP,LOC) & T [CTF] & ((CLOCK+P(RTR)) %127-20178900
DIV 60) [1:31:17]; % %127-20178910
PRYOR[MIX] := -1; 20179100
$ SET OMIT = NOT(WORKSET) 20179210
OLAYTIME[MIX] := 0; 20179220
$ POP OMIT % WORKSET 20179230
$ SET OMIT = NOT(DATACOM) %141-20179610
20179700
%%%%% % %%%%% %%% % % 20179800
% % %% % % % % % % 20179900
P1MIX:=MIX; %%%%% % % % % % % 20180000
% % % % % % % % 20180100
% %%% % % % %%% % % 20180200
20180300
STARTLOG(P1MIX); % BEGIN LOGGING FOR THIS MIX %127-20180350
USERCODE[MIX]:=ABS(S[24]); % USERCODE IN S[24] 20180400
CHANGEABORT(S[6]); 20180600
IF S[2].[8:10]=0 THEN FORGETESPDISK(S[25]); % FORGET OBJ.SKELETON 20180800
% S[2].[8:10]=0 FOR "GO" PART OF "COMPILE AND GO" 20180900
STREAM(Q:=FSROW[MIX]:=SAVEARRAYDESC(4,FSAREAV)); %167-20181000
DS:=32LIT"0"; 20181100
$ SET OMIT = NOT(AUXMEM) 20185300
20185700
TYPE := CONTINUEING; 20185800
20185900
% SELECTRUN2 IS CONCERNED WITH: 20186000
% BOJ MESSAGE 20186100
% SEGMENT ZERO 20186200
% STACK AND PRT 20186300
% SEGMENT DICTIONARY 20186400
% DALOC 20186500
% COMMON 20186600
20186700
P([SVALUE],STS); 20186800
SELECTRUN2; 20186900
IF TYPE LSS 0 THEN 20187000
GO TO SW[TYPE:=ABS(TYPE)]; 20187100
20187200
IF (SEG0[7].[CF]=0) THEN % BUILD A DUMMY FILE PARAMETER BLOCK 20187300
TRP[3]:=[M[GETSPACE(1,FPBAREAV,1)+2]] ELSE% %167-20187400
BEGIN 20187500
TYPE := EQUATING; % BUILD FPB AND PROCESS LABEL EQUATION 20187600
P([SVALUE],STS); 20187700
SELECTRUN1; 20187800
IF TYPE.[1:1] THEN GO TO SW[TYPE:=ABS(TYPE)]; 20187900
END; 20188000
20188100
NFO[(MIX-1)|NDX] := TRP[3]; 20188600
% TRP[3] VALUE SET BY SELECTRUN1 FOR NON-MCP TYPE JOB 20188800
GO TO WINDUP; 20188900
20189000
PASS: 20189100
20189200
TYPE := PASSING; 20189300
P([SVALUE],STS); 20189400
SELECTRUN1; 20189500
IF TYPE LSS 0 THEN 20189600
GO TO SW[TYPE:=ABS(TYPE)]; % SELECTRUN1 DETERMINES BRANCH POINT 20189700
20189800
WINDUP: 20189900
20190000
% *** ** * *** ***** *** ***** **** 20190100
% * ** * * * * * * * * 20190200
% * * * * * * * * * **** 20190300
% * * ** * * * * * * * * 20190400
% *** * ** *** * 0 **** ***** **** 20190500
20190600
$ SET OMIT = NOT(WORKSET) 20190610
WKSETSWITCHTIME := CLOCK + P(RTR); % TIME OF LAST SELECTION 20190620
$ POP OMIT % WORKSET 20190630
% INITIALIZE OTHER PRT CELLS 20190700
TRP[0] := WORDOFEASE; 20190800
TRP[2] := MEMORY; 20190900
TRP[10] := TRP&(STACKLOC+1)[18:33:15]; 20191000
IF JAR[MIX,0] LSS 0 THEN % COMPILE JOB 20191100
BEGIN 20191200
IF(NT1:=JAR[MIX,2].[8:10])=4 THEN % COMPILE TO LIBRARY 20191300
TRP[@26]:=S[22] % SAVE FACTOR FOR OBJECT FILE IN SHEET[22] 20191400
ELSE IF NT1=3 THEN % COMPILE FOR SYNTAX ONLY 20191500
BEGIN 20191600
TRP[@26]:=-1; % SAVE FACTOR = (-1) % DONT SAVE OBJECT 20191700
JAR[MIX,2].[8:10]:=2; % MARK IT AN "EXECUTE" JOB 20191800
END; 20191900
END; % COMPILE JOBS 20192000
TRP[6]:=FLAG(0&[TRP[6]][18:33:15]&[8:38:10]); 20192100
IF JAR[MIX,2] GEQ 0 THEN % NOT COBOL 20192200
TRP[11]:=FLAG(0&[TRP[11]][18:33:15]&8[8:38:10]); % "OAT" ENTRY 20192300
% BRING IN STARTING SEGMENT&BUILD CONTROL WORDS FOR INITIATE% 20192400
MAKEPRESENT(TRP INX POLISH(SEG0[6],TRP[4],INX,LOD).[8:10]); 20192500
% SEG0[6] = STARTING SEGMENT NUMBER 20192600
% SEGDICT[SEG0[6]].[8:10] = PRT LOCN. OF DESC. FOR STARTING SEGMENT 20192700
M[STACKLOC+2]:= -FLAG(POLISH(SEG0[6],TRP[4],INX,LOD).[18:15]); 20192800
M[STACKLOC+1]:= -FLAG(0&(TRP)[6:33:9]); 20192900
M[STACKLOC] := @2222222222222222; 20193000
TRP[8] := -FLAG(STACKLOC+2); % INITIATE CONTROL WORD 20193100
IF(NT1:=TRP[4].[18:6]) NEQ 0 THEN 20193200
INTABLEROW[MIX]:=INTABLEROW[NT1] 20193300
ELSE IF NOT(JAR[MIX,9].SYSJOBF) THEN % NOT "SYSTEM" JOB 20193400
BEGIN 20193500
I:=INTSIZE; 20194100
INTABLEROW[MIX]:=[M[GETSPACE(I,1,1)+2]]&1[8:38:10]; 20194300
STREAM(A:=I,T:=INTABLEROW[MIX]); 20194400
BEGIN 20194500
SI:=T; SI:=SI-8; DS:=A WDS; 20194600
END; 20194700
END; 20194800
20194900
20195000
IF S[2].[2:1] THEN % S[2].[2:1]=1 WHEN ES-ED, CALL TERMINATE 20195100
BEGIN 20195200
JAR[MIX,2].[2:1]:=1; % MARK IT TERMINATED 20195400
TERMINATE(MIX & 20195500
(IF JAR[MIX,2].[7:1] AND (*P(TSX INX TRP)).PBIT THEN 20195600
90 ELSE 35)[CTF]); 20195700
END 20196300
ELSE 20196400
IF JAR[MIX,2].[7:1] THEN % TASK WHOSE PARENT HAS 20196500
IF (TSKA~*P(TSX INX TRP)).PBIT THEN % DECLARED TASK ARRAY %110-20196600
BEGIN 20196700
TSKA[1] := JAR[MIX,0]; 20196800
TSKA[2] := JAR[MIX,1]; 20196900
TSKA[3] := 2; % STATUS: ACTIVE 20197000
TSKA[4] := MIX; 20197100
END; 20197200
$ SET OMIT = NOT(NEWLOGGING) 20197300
SAVEMIX(MIX); 20197600
PRYOR[MIX] := S[18]; % PRIORITY IN SHEET[18]; 20198500
IF F=0 THEN % SHEET ENTRY NOT PASSED AS A PARAMETER 20199200
BEGIN 20199300
TYPE := (IF S[2].[1:1] THEN STARTING ELSE CONTINUEING); 20199400
% IF ES-ED THEN RE-START SHEET SEARCH; OTHERWISE,CONTINUE ON 20199500
GO TO START; 20199600
END; 20199700
20199800
QUIT: 20210000
20210100
P1MIX := 0; 20210200
IF SHEETLOCKED THEN UNLOCKTOG(SHEETMASK); 20210300
IF S NEQ 0 THEN FORGETSPACE(S); % SPACE FOR SHEET ENTRY 20210400
IF SEG0 NEQ 0 THEN FORGETSPACE(SEG0); % SPACE FOR SEGMENT ZERO 20210500
IF OLAYDISK NEQ 0 THEN FORGETUSERDISK(OLAYDISK,-500); 20210600
IF LBL NEQ 0 THEN FORGETSPACE(LBL); % SPACE FOR LABEL EQN.ENTRIES 20210700
KILL([MSCW]); 20211400
END SELECTION ROUTINE; 20211600
DEFINE% 20212000
COMMA = 10#,% 20213000
EQUAL = 11#,% 20214000
PERIO = 12#,% 20215000
SLASH = 13#,% 20216000
QUEST = 14#,% 20217000
POUND = 15#,% %LP 1 20217500
RB = 16#,% RIGHT BRACKET FOR EXCEPT LIST 20217600
LB = 17#,% LEFT " " " " 20217700
SPECI = 19#,% 20218000
IDENT = 20#,% 20219000
UNLOCKV = 21#,% SWITCH LABEL (FUNC) IN 20219050
USEV = 22#,% SECURITYMAINT USES THE ORDER OF 20219060
LOCKV = 23#,% VALUES OF "UNLOCKV" THROUGH "OPEN". 20219100
FREE = 24#, 20219200
OPEN = 25#, 20219300
PACKET = 26#, 20219310
USER = 27#, 20219400
RUNV = 28#, 20219500
COMPI = 29#, 20220000
EXECU = 30#, 20221000
COPYN = 31#, 20221500
DUMP = 32#, 20222000
UNLOAD = 33#, 20223000
ADDV = 34#, 20224000
LOAD = 35#, 20224500
REMOV = 36#, 20225000
CHANG = 37#, 20225500
ENDFI = 39#,% 20226000
$ SET OMIT = NOT(PACKETS) 20226099
WAITV = 40#,% 20226100
$ POP OMIT 20226101
DATAV = 41#,% 20226500
LABEV = 42#,% 20227000
SETV = 43#,% 20228000
RESETV = 44#,% 20228100
FILEV = 47#,% -20228200
EXPIRED = 48#,% -20228300
ACCESSD = 49#,% -20228400
PROCE = 50#,% A STORE NEARE THE END OF PCC 20229000
IO = 51#,% MAKES USE OF THE ORDER AND VALUES 20230000
PRIOR = 52#,% OF "PROCE" THRU "SAVEV". 20231000
COMMONV = 53#,% 20232000
COREV = 54#,% 20232500
STACK = 55#,% 20233000
SAVEV = 56#,% (SAVE #DAYS ON COMPILE TO LIBRARY) 20233500
ALGOL = 60#,% 20234000
FORTRAN = 62#,% -20235000
TSPOL = 63#,% -20235050
BASIC = 64#,% 20235075
COBOL68 = 65#,% -20235080
WITH = 66#,% -20235099
COBOL = 67#,% -20235100
LIBRA = 68#,% 20236000
SYNTA = 69#,% 20237000
FROM = 70#,% 20238000
TOV = 71#,% 20239000
ONV = 72#,% %148-20239100
FORM = 75#,% SWITCH D(PCC)"FORM"-"SPECIAL- %846-20240000
LINES66 = 77#, % 66 LINES PER PAGE %724-20240020
NO = 79#,% 20241000
DISK = 80#,% 20242000
TAPE = 81#,% 20243000
PUNCH = 82#,% 20244000
PRINT = 82#,% 20245000
BACK = 83#,% 20246000
SPECIAL = 90#, 20247000
REMOTE = 89#, 20247500
EU = 91#,% -20247600
SLOW = 92#,% -20247700
B6500 = 93#,% -20247800
FAST = 94#, 20247900
MAXV = 96#, 20247920
FREEF = 97#,% 20247930
FIXED = 98#, 20247940
SENSE = 100#, 20247950
LATESTV = 101#, 20247960
EXCEPT = 102#, 20247970
AS = 103#, 20247980
NOHASH = 104#, 20247990
PAPER = 84#;% 20248000
COMMENT RESWDS CONTAINS RESERVED WORDS FOR CONTROL CARDS;% 20249000
DEFINE DECLARECCVARIABLES = 20288000
REAL MSCW = -2, 20288100
CARD = MSCW+1, MYMSCW = CARD, 20288105
RCW = +0, 20288110
PROCVAL = RCW+1, %IN CASE OF TYPED PROCEDURES 20288115
A = PROCVAL+1, T = A, 20288120
CADDR = A+1, SFID = CADDR, 20288125
CARDLOC = CADDR+1, 20288130
CDEX = CARDLOC+1, SDEX = CDEX, 20288135
CMPLR = CDEX+1, 20288140
ON = CMPLR+1, 20288150
KOUNT = CN+1, 20288155
LASTSCAN = KOUNT+1, 20288165
LIBNO = LASTSCAN+1, 20288170
N1 = LIBNO+1, 20288175
N2 = N1+1, 20288185
N3 = N2+1, 20288190
N4 = N3+1, U = N4, 20288195
OPTN = N4+1, 20288200
OPTNN = OPTN+1, 20288205
PADDR = OPTNN+1, SFH = PADDR, 20288210
PDEX = PADDR+1, SMID = PDEX, 20288215
PPCPROCESS = PDEX+1, 20288220
SOURCE = PPCPROCESS+1, 20288225
SPOUTUNIT = SOURCE+1, 20288240
ST = SPOUTUNIT+1, 20288245
T1 = ST+1, 20288250
UNITNO = T1+1, 20288255
USERID = UNITNO+1, 20288260
ARRAY ACCUM = USERID+1[*], 20288265
CEQN = ACCUM+1[*], 20288270
CMM = CEQN+1[*], 20288275
DIRECT = CMM+1[*], 20288280
PEQN = DIRECT+1[*], 20288285
PROG = PEQN+1[*]; 20288295
NAME ADDR = PROG+1; 20288300
BOOLEAN ABORT = ADDR+1, 20288305
TOG = ABORT+1; 20288310
REAL RETURNMSCW = TOG+1, % THESE LOCALS MUST BE THE LAST 20288315
RETURNRCW = RETURNMSCW+1, % THREE LOCALS OF CONTROLCARD 20288320
RETURNVAL = RETURNRCW+1 20288325
#; 20288900
20289000
$ SET OMIT = NOT(PACKETS) 20289009
PROCEDURE PRINTTHECOVER(CARD,UNITNO,PS); 20289010
VALUE CARD,UNITNO,PS; REAL CARD,UNITNO,PS; 20289020
% TO ALTER SIZE OF ONE-AREA PACKET PAGE CHANGE DEFINE AT 02113091 20289025
BEGIN LABEL TRYAGAIN; 20289030
REAL BUF,T,TP,X; 20289035
INTEGER I,PAGEADDR; ARRAY HEADER[*]; 20289040
SUBROUTINE BUILDHEADER; 20289045
BEGIN 20289050
HEADER:=IOQUE & BUF[CTC]; 20289055
M[BUF]:=0; 20289060
MOVE(29,BUF,BUF+1); 20289065
STREAM(DATE,H3:=HEADER INX 3); 20289080
BEGIN SI:=LOC DATE; DS:=8OCT; % CREATION 20289085
DI:=H3; DS:=2LIT"+#"; % SAVE 10 20289090
SI:=H3; SI:=SI+5; DS:=3CHR; % ACCESSED 20289095
END; 20289100
HEADER[0]:=@0013200132000103; % 90,90,1,3 20289105
HEADER[1]:=(XCLOCK+P(RTR)) & HEADER[3][6:30:18]; 20289110
HEADER[2]:=HEADER[5]:=MCP.[6:42]; %131-20289113
HEADER[4]:=0&(@1001)[2:38:10]&SYSNO[4:46:2]; %112-20289115
$ SET OMIT = NOT(DATACOM AND RJE) OR OMIT 20289117
HEADER[7]:=(PAGESIZE DIV 3)-1; 20289120
HEADER[8]:=PAGESIZE; 20289125
HEADER[9]:=1; 20289130
HEADER[10]:=PAGEADDR; 20289135
END BUILDHEADER; 20289140
TRYAGAIN: 20289142
CIDTABLE[UNITNO-32,6]:=TP:= 001 & NEXTCDNUM(1)[6:24:24]; 20289144
IF DIRECTORYSEARCH(="PBD ",TP,5)!0 THEN GO TRYAGAIN; 20289146
BUF:=SPACE(90); 20289148
PAGEADDR:=GETUSERDISK(PAGESIZE); 20289150
PS:=IF CARD.[9:9]=0 THEN 20289152
IF PS=0 THEN "CRA" ELSE IF PS=1 THEN "CRB" ELSE 20289153
IF PS=2 THEN TINU[UNITNO].[30:18] ELSE 20289154
IF PS=3 THEN "ZIP" ELSE " " ELSE 20289155
$ SET OMIT = NOT(DATACOM AND RJE) OR OMIT 20289156
" "; 20289159
STREAM(CARD,TP:=CIDTABLE[UNITNO-32,2],PS 20289160
, N:=CIDTABLE[UNITNO-32,7]+1,BUF); 20289163
BEGIN DS:=8LIT" "; SI:=BUF; 2(DS:=44 WDS); 20289165
SI:=LOC N; DI:=LOC N; DS:=8DEC; DI:=LOC N; DS:=8FILL; 20289170
SI:=LOC N; SI:=SI+3; DI:=BUF; DI:=DI+12; 20289175
DS:=7LIT"INPUT "; DS:=5CHR; DS:=12LIT" CARDS FROM "; 20289180
SI:=LOC PS; SI:=SI+5; DS:=3CHR; 20289185
DI:=BUF; 4(DI:=DI+34); DS:=8LIT":|}14000"; BUF:=DI; 20289190
SI:=LOC TP; SI:=SI+2; DI:=DI+12; 20289195
DS:=8LIT"PACKET "; DS:=4CHR; DI:=DI-4; DS:=3FILL; 20289200
DI:=BUF; 4(DI:=DI+34); DS:=8LIT":|}14000"; BUF:=DI; 20289205
SI:=CARD; DS:=9WDS; 20289210
DI:=BUF; 4(DI:=DI+34); DS:=8LIT":|}12000"; BUF:=DI; 20289215
54(DS:=LIT"#"); DS:=11LIT" ABORTED "; 55(DS:=LIT"#"); 20289220
DI:=BUF; 4(DI:=DI+34); DS:=8LIT":|}12000"; BUF:=DI; 20289225
DS:=16LIT"+ABORTED0PAGE "; DS:=9LIT"0PACKET 0"; 20289230
SI:=LOC TP; SI:=SI+2; DS:=4CHR; DI:=DI+3; 20289235
SI:=CARD; DS:=9 WDS; %131-20289240
40(DS:=LIT"0"); 20289245
END; 20289250
M[BUF+87]:=MCP; %131-20289252
DISKWAIT(BUF,90,PAGEADDR); 20289255
STREAM(A:=I:=((NT1:=((XCLOCK+P(RTR)) DIV 3600)) MOD 60 20289260
+(NT1 DIV 60)|100),DATE,WEEKDAY,ACTDATE,BUF); 20289265
BEGIN 20289270
3(4(DI:=DI+34); DS:=8LIT":|0|2000"); BUF:=DI; 20289275
DS:=8LIT" "; SI:=BUF; DS:=34 WDS; DI:=BUF; 20289280
SI:=LOC DATE; DI:=DI+12; DS:=4LIT"DATE"; DI:=DI+3; 20289285
SI:=SI+3; DS:=5CHR; DI:=DI+1; 20289287
SI:=SI+2; 6(IF SC=" " THEN SI:=SI+1 ELSE DS:=CHR); 20289290
SI:=LOC ACTDATE; DS:=5LIT"DAY, "; 20289295
SI:=SI+2; 2(DS:=2CHR; DS:=LIT"/"); DS:=2 CHR; 20289300
DI:=BUF; 4(DI:=DI+34); DS:=8LIT":|}14000"; BUF:=DI; 20289305
SI:=LOC A; DI:=DI+12; DS:=4LIT"TIME"; DI:=DI+4; DS:=4DEC; 20289310
DI:=BUF; 4(DI:=DI+34); DS:=8LIT":|}14000"; 20289315
END; 20289320
DISKWAIT(BUF,90,PAGEADDR+3); 20289325
X:=6; M[BUF+17]:=0; %178-20289335
IF (T:=DIRECTORYSEARCH("MESSAGE","0THEDAY",5))!0 THEN 20289340
BEGIN 20289345
FOR I:=0 STEP 1 WHILE (I<6) AND NOT M[BUF+17] DO 20289350
BEGIN 20289355
DISKWAIT(-BUF,90,M[T+10]+3|I); 20289360
DISKWAIT(BUF,90,PAGEADDR+6+3|I); 20289365
X:=X+3; 20289370
END; 20289375
FORGETSPACE(T); 20289380
END; 20289385
STREAM(ML:=MARKLEVEL,PL:=PATCHLEVEL,LL:=LOCALLEVEL 20289390
,IL:=M[3],BUF:=BUF+54); 20289395
BEGIN DS:=8LIT" "; SI:=BUF; DS:=34 WDS; DI:=BUF; 20289400
DI:=DI-8; DS:=8LIT":|0Q0803"; 20289405
DI:=DI+12; DS:=18LIT"#NO MESSAGES TODAY"; 20289410
DI:=BUF; 4(DI:=DI+34); DS:=8LIT":|}12002"; BUF:=DI; 20289415
DI:=DI+8; DS:=3LIT"*** BURROUGHS B5700 DCMCP MARK "; 20289420
SI:=LOC ML; IF SC GEQ " " THEN; 20289425
8(IF TOGGLE THEN IF SC="0" THEN SI:=SI+1 ELSE DS:=CHR 20289430
ELSE DS:=CHR); DS:=LIT"."; 20289435
SI:=LOC PL; IF SC GEQ " " THEN; 20289440
6(IF TOGGLE THEN IF SC="0" THEN SI:=SI+1 ELSE DS:=CHR 20289445
ELSE DS:=CHR); DS:=2CHR; 20289450
SI:=LOC LL; IF SC GEQ " " THEN; 20289455
8(IF TOGGLE THEN IF SC="0" THEN SI:=SI+1 ELSE DS:=CHR 20289460
ELSE DS:=CHR); DS:=21LIT" AND INTRINSICS MARK "; 20289465
SI:=LOC ML; IF SC GEQ " " THEN; 20289470
8(IF TOGGLE THEN IF SC="0" THEN SI:=SI+1 ELSE DS:=CHR 20289475
ELSE DS:=CHR); DS:=LIT"."; 20289480
SI:=LOC IL; SI:=SI+1; IF SC>"0" THEN DS:=CHR ELSE 20289485
SI:=SI+1; DS:=2CHR; DS:=4LIT" ***"; 20289490
DI:=BUF; 4(DI:=DI+34); DS:=8LIT":|}12001"; 20289495
END; 20289500
DISKWAIT(BUF,90,PAGEADDR+X); 20289510
BUILDHEADER; 20289520
ENTERUSERFILE("PBD ",TP,BUF-1); 20289530
PSEUDO[UNITNO-32]:=(*P(DUP))& 20289540
11[8:38:10]& % PACKETPDB 20289550
(IF T!0 THEN 3 ELSE 2)[18:45:3]& % PACKETREC 20289560
1[21:47:1]& % PACKETFREE 20289570
(PAGEADDR+X)[22:22:26]; % PACKETPAGE 20289580
FORGETSPACE(BUF); 20289590
END PRINTTHECOVER; 20289600
$ POP OMIT 20289601
COMMENT FETCH READS THE NEXT CONTROL CARD , SETS SOURCE TO BEGINNING 20290000
OF CARD , SETS LAST WORD OF CARD TO PERIOD. ;% 20291000
PROCEDURE FETCH(UNITNO,CARDLOC,SOURCE); 20292000
VALUE UNITNO,CARDLOC; 20292100
REAL UNITNO,CARADLOC,SOURCE ; 20292200
BEGIN% 20293000
REAL T,E; 20294000
E:=@14&UNITNO[45:1:1]; UNITNO:=ABS(UNITNO); 20294800
IF (UNITNO OR 1)=31 THEN % DCOM OR ZIP 20295000
M[SOURCE:=CARDLOC]:=@1425452432373737 20295100
ELSE 20295200
BEGIN % NOT DCOM 20295300
$ SET OMIT = PACKETS 20295999
$ SET OMIT = NOT(PACKETS) 20296099
IF UNITNO GEQ 32 THEN 20296100
DO UNTIL NOT E.[45:1] OR T:= 20296200
$ POP OMIT 20296201
READEMFROMDISK(CIDROW[UNITNO-32],% 20297000
[M[CARDLOC]]&10[8:38:10]) ELSE% 20298000
DO BEGIN T~ 20298100
20298111
WAITIO(CARDLOC INX @40000000,E,UNITNO); 20299000
IF UNITNO=30 OR T.[45:1] THEN 20299020
STREAM(Q~12,CARDLOC); 20299030
BEGIN SI~LOC Q;SI~SI+7;DS~CHR;DS~4 LIT "END." END; 20299040
IF UNITNO=25 THEN 20299110
BEGIN 20299111
STREAM(T~0:CARDLOC);% 20300000
BEGIN SI~CARDLOC;SI~LOC T;DI~DI+6;SI~SI-1;DS~2CHR;SI~SI-1;20301000
DI~CARDLOC;DI~DI-1;DS~LIT"<";8(60(IF SC="~" THEN 20301100
BEGIN DS~CHR;JUMP OUT 2 TO L END;IF SC="<" THEN 20301200
BEGIN DI~DI-1;IF SC!DC THEN DI~DI-1 END ELSE 20301300
DS~CHR)); 20301400
L: DI~CARDLOC;DI~DI-1;SI~LOC T;SI~SI+6;DS~CHR; 20301500
END; 20301600
END ELSE P(0); 20301700
END UNTIL P.[42:6]!31; 20302000
M[(SOURCE ~ CARDLOC)+9]~0&"."[1:43:5];% 20303000
END; % NOT DCOM 20303900
END ;% 20304000
COMMENT THE SCAN ROUTINE IS USED FOR CONTROL CARD SCANNING.% 20305000
SCAN RETURNS THE FOLLOWING RESULTS :% 20306000
4 FOR IDENTIFIERS WHICH ARE NOT RESERVED% 20307000
0 FOR PERIOD% 20308000
1 FOR SLASH% 20309000
2 FOR QUESTION MARK% 20310000
5... FOR IDENTIFIERS IN DIRECT.% 20311000
3 FOR OTHER SPECIAL CHARACTERS.% 20312000
13 FOR "PRIORITY" ;% 20313000
REAL PROCEDURE SCN(UNITNO,CARDLOC,SOURCE,ACCUM,KOUNT,LASTSCAN. 20314000
DIRECT); 20314050
VALUE UNITNO,CARDLOC ; 20314100
REAL UNITNO,CARDLOC,SOURCE, KOUNT,LASTSCAN ; 20314200
ARRAY ACCUM[*],DIRECT[*]; 20314300
BEGIN 20315000
LABEL GOGO, TYPE0,TYPE1,TYPE2;% 20316000
SWITCH TYPE ~ TYPE0,TYPE1,TYPE2 ;% 20317000
DEFINE DSIZE = 56#;% 20318000
REAL I;% 20319000
LABEL PERPER;% 20320000
GOTO:% 20321000
IF LASTSCAN THEN% 20322000
BEGIN IF LASTSCAN < 0 OR UNITNO = 31 THEN% 20323000
BEGIN I ~ QUEST; LASTSCAN ~ 0; GO TO TYPE1 END; 20324000
FETCH(UNITNO,CARDLOC,SOURCE); 20325000
LASTSCAN:=0 20325100
$ SET OMIT = NOT(PACKETS) 20325109
&1[2:47:1]; 20325110
$ POP OMIT 20325111
END;% 20326000
I ~ IDENT;% 20327000
STREAM (J~0,K~0,SOURCE : ACCUM);% 20328000
BEGIN% 20329000
SI ~ SOURCE ; DI ~ ACCUM ; DI~DI+1;% 20330000
L: IF SC = " " THEN BEGIN SI~SI+1; GO L END;% 20331000
IF SC = ALPHA THEN% 20332000
BEGIN% 20333000
IF SC =@14 THEN GO TO L3;% 20334000
DS ~ CHR ; TALLY ~ 1;% 20335000
L1: 63(IF SC=ALPHA THEN BEGIN DS~CHR;% 20336000
TALLY~TALLY+1 END ELSE JUMP OUT);% 20337000
K~TALLY; TALLY~0; J~TALLY; DS~8 LIT" ";% 20338000
END% 20339000
ELSE IF SC = """ THEN% 20340000
BEGIN SI ~ SI+1;% 20341000
30(IF SC=""" THEN JUMP OUT; 20342000
DS:=CHR; TALLY:=TALLY+1); 20342250
IF TOGGLE THEN % FOUND CLOSING QUOTE 20342500
BEGIN DS:=8 LIT" "; SI:=SI+1; 20342750
K:=TALLY; TALLY:=1; J:=TALLY; 20343000
END 20343250
ELSE % INVALID STRING 20343500
BEGIN 20343750
SI~SI-31; GO L3; 20344000
END; 20344250
END% 20345000
ELSE BEGIN% 20346000
L3:% 20347000
TALLY ~ 2; J~TALLY; DI~LOC K; DI~DI+7; DS~CHR ;% 20348000
END;% 20349000
SOURCE ~ SI;% 20350000
END;% 20351000
COMMENT STACK NOW CONTAINS : 0 FOR IDENTIFIER & NO. OF CHRS% 20352000
1 FOR "ID" & NO. OF CHRS% 20353000
2 FOR SPECIAL CHR & ACTUAL CHR ;% 20354000
P([SOURCE],~); 20355000
P([KOUNT],~); 20356000
GO TO TYPE[POLISH];% 20357000
TYPE0:% 20358000
BEGIN 20361000
I~-2; WHILE DIRECT[I~I+2]!0 DO% 20362000
IF (DIRECT[I] EQV ACCUM[0])= NOT 0 THEN% 20363000
BEGIN IF DIRECT[I+1] !QUEST OR UNITNO=25 OR UNITNO}30 THEN20364000
BEGIN I~DIRECT[I+1];GO TO TYPE1 END END;% 20365000
I ~ IDENT ; END;% 20366000
GO TO TYPE1 ;% 20367000
TYPE2:% 20368000
IF KOUNT!"~" THEN ACCUM[0]~ " 0" OR KOUNT; 20368100
IF KOUNT="~" OR% 20369000
KOUNT ="." THEN% 20370000
BEGIN LASTSCAN ~ 1;% 20371000
PERPER: I ~ PERIO; GO TO TYPE1;% 20372000
END;% 20373000
IF KOUNT="-" THEN BEGIN IF UNITNO}32 THEN 20374000
IF CIDTABLE[UNITNO-32,3]} 20374100
CIDTABLE[UNITNO-32,7] THEN 20374200
BEGIN I~ENDFI; GO TO TYPE1 END; 20374300
IF UNITNO = 31 THEN 20374310
BEGIN I~PERIO; GO TO TYPE1 END; 20374320
FETCH(UNITNO,CARDLOC,SOURCE); 20374400
STREAM(CARDLOC); %890-20374401
BEGIN %890-20374402
2(36(IF SC=">" THEN %890-20374403
BEGIN CARDLOC~SI;DI~CARDLOC;DS~ LIT "=" END; %890-20374404
IF SC="}" THEN %890-20374405
BEGIN CARDLOC~SI;DI~CARDLOC;DS~ LIT """ END; %890-20374406
SI~SI+1;)) %890-20374407
END; %890-20374408
$ SET OMIT = NOT(PACKETS) 20374409
IF UNITNO GEQ 32 AND NOT LASTSCAN.[2:1] THEN 20374410
BEGIN STREAM(CARDLOC, I~I~SPACE(10)); 20374415
BEGIN DS~5LIT">"; 20374420
SI~CARDLOC; 2(DS~36 CHR); DS~LIT"~"; 20374425
END; SPOUTER(I,UNITNO,64); 20374430
END; 20374435
$ POP OMIT 20374436
GO TO GOGO; 20374500
END; 20374600
IF KOUNT = "1" THEN% 20375000
BEGIN LASTSCAN ~ -1; GO TO PERPER END;% 20376000
I ~ IF KOUNT ="/" THEN SLASH ELSE% 20377000
(IF KOUNT = @14 THEN QUEST ELSE% 20378000
(IF KOUNT ="," THEN COMMA ELSE% 20379000
(IF KOUNT = "=" THEN EQUAL ELSE % THIS IS AS IN SYMBOL 20380000
(IF KOUNT = "]" THEN RB ELSE 20380100
(IF KOUNT = "[" THEN RB ELSE 20380200
(IF KOUNT = "#" THEN POUND ELSE SPECI)))))); 20380500
TYPE1: SCN~I; 20381000
END SCAN ;% 20382000
PROCEDURE SEEKNAM(A,B,C,D,E,N,XLST); VALUE A,B; 20382010
REAL A,B,C,D,E,N; ARRAY XLST[*]; 20382015
BEGIN 20382020
LABEL FIND,L; 20382030
ARRAY NB[*]; 20382040
REAL I,K,T,X; INTEGER J; BOOLEAN INXLST; 20382050
INTEGER J1,J2,J3,K1,K2; 20382052
LABEL RESTART; 20382054
IF C=0 THEN 20382056
BEGIN N:=SPACE(60);-1; 20382058
J1:=J3:=0; K1:=K2:=MODULUS-1; 20382060
IF A GEQ 0 THEN J1:=K1:=(A.[6:18]+A.[24:24]) MOD MODULUS; 20382062
IF B GEQ 0 THEN J3:=K2:=(B.[6:18]+B.[24:24]) MOD MODULUS; 20382064
END ELSE 20382066
BEGIN I:=(T:=M[N]).[42:6]; 20382068
J1:=T.[36:6]; J2:=T.[30:6]; J3:=T.[12:6]; 20382070
K1:=T.[24:6]; K2:=T.[18:6]; 20382072
END; 20382074
NB:=[M[N+1]]&60[8:38:10]; 20382076
IF C NEQ 0 THEN GO TO RESTART; 20382095
FOR J1:=J1 STEP 1 UNTIL K1 DO 20382100
FOR J2:=J3 STEP 1 UNTIL K2 DO 20382110
BEGIN J:=SCRAMBLE(J1,J2); 20382120
DO BEGIN 20382130
DISKWAIT(-N-1,60,J); 20382140
FOR I:=0 STEP 3 UNTIL 57 DO 20382150
BEGIN 20382160
IF (T:=NB[I]) NEQ @14 THEN 20382165
IF (T EQV A)=NOT 0 OR A<0 THEN 20382170
IF (NB[I+1] EQV B)=NOT 0 OR B LSS 0 THEN 20382200
IF (X:=XLST.[8:10]-2) GEQ 0 THEN % EXCEPT LIST EXISTS20382220
BEGIN INXLST:=FALSE; 20382240
FOR K:=0 STEP 2 UNTIL X DO 20382260
IF (XLST[K] EQV T)=NOT 0 OR XLST[K] LSS 0 THEN 20382280
IF (XLST[K+1] EQV NB[I+1])=NOT 0 OR XLST[K+1] LSS 0 20382300
THEN BEGIN INXLST:=TRUE; 20382320
IF NOT (XLST[K].[1:1] OR XLST[K+1].[1;1]) 20382340
THEN BEGIN XLST[K]:=XLST[X]; 20382360
XLST[K+1]:=XLST[X+1]; 20382380
XLST.[8:10]:=XLST.[8:10]-2; 20382400
END; 20382420
K:=X; 20382440
END; 20382460
IF INXLST THEN ELSE GO FIND; 20382480
END ELSE GO FIND; 20382500
RESTART: END; 20382520
END UNTIL (J:=NB[2].[FF])=0; 20382540
END; 20382560
FORGETSPACE(NB); 20382580
IF C=0 THEN N:=0 ELSE C:=0; 20382600
GO L; 20382620
FIND: 20382640
D:=NB[I]; E:=NB[I+1]; 20382660
C:=NB[I+2].[CF]; 20382680
M[N]:=I&J1[36:42:6]&J2[30:42:6]&K1[24:42:6]&K2[18:42:6]& 20382700
J3[12:42:6]; 20382720
L: 20382740
END; % SEEKNAME 20382760
REAL PROCEDURE PPC 20383000
(ADDR,EQN,X,DEX,TYPE,UNITNO,CARDLOC,SOURCE,ACCUM,LASTSCAN, 20384000
DIRECT); 20384100
VALUE TYPE,UNITNO,CARDLOC ; 20385000
REAL ADDR, DEX,TYPE,UNITNO,CARDLOC,SOURCE, LASTSCAN ; 20386000
ARRAY EQN[*],X[*],ACCUM[*],DIRECT[*]; 20386100
BEGIN% 20387000
REAL IOD,KOUNT; 20388000
LABEL EXIT,ERROR,NEXT,LFORM,LND,LDISK,LTAPE,LPUNCH,LPAPER,% 20389000
ROUND,PROTECT, 20390000
SERIAL,UPDATE,SPO,DSKCHECK, % (SHM)20391000
DOWN,LREMOTE, 20392000
LDUMMY, %846-20392870
LLINES66, % %724-20392880
LRANDOM, %603-20392890
LSPECIAL,LPRINT,LBACK,LCOPY,LFREE; 20393000
SWITCH D~LFORM, %603-20394000
LDUMMY, %846-20394070
LLINES66, %724-20394080
LRANDOM, %603-20394090
LNO,LDISK,LTAPE,LPUNCH,LPRINT,LPAPER, %603-20394900
LBACK,SERIAL,UPDATE,SPO,% 20395000
LREMOTE,LSPECIAL,ERROR,ERROR,ERROR,ERROR,LCOPY,ERROR, 20396000
LFREF,ERROR,PROTECT; 20396010
REAL NOLBL,TPNO ;% 20397000
BOOLEAN FAROUT; 20397050
REAL SUBROUTINE SCAN; 20397100
BEGIN SCAN~SCN(UNITNO,CARDLOC,SOURCE,ACCUM,KOUNT,LASTSCAN,20397200
DIRECT) 20397300
END; 20397400
IF TYPE = FILEV THEN% 20398000
BEGIN% 20399000
IF ADDR =0 THEN ADDR~X[13]~GETESPDISK ;% 20400000
IF DEX = 2 THEN% 20401000
BEGIN% 20402000
EQN [29] ~ GETESPDISK;% 20403000
DISKIO( IOD , EQN INX 0-1 ,30, ADDR);% 20404000
ADDR ~ EQN[29];% 20405000
DEX ~ 0;% 20406000
SLEEP([IOD], IOMASK);% 20407000
END;% 20408000
IF (TYPE:=SCAN) < IDENT THEN GO TO ERROR; 20409000
EQN ~ (14 | DEX) INX EQN ;% 20410000
EQN[12]:=0; % ZERO OUT EU/SPEED CELL % (SHM)20410100
STREAM( KOUNT, ACCUM, Z ~ [EQN[4]]);% 20411000
BEGIN% 20412000
SI ~ LOC KOUNT ; SI~SI+7; DI~Z; DS~CHR;% 20413000
SI ~ ACCUM ; SI~SI+1; DS~ KOUNT CHR ;% 20414000
END ;% 20415000
IF X[0]<0 THEN IF KOUNT=4 AND ACCUM[0].[6:24]="CARD" 20415100
THEN FAROUT ~ TRUE; 20415200
IF SCAN ! EQUAL THEN GO TO ERROR; 20416000
IF SCAN < IDENT THEN GO TO ERROR; 20416500
EQN[2] ~ EQN[3]~% 20417000
EQN[0]~0; EQN[1] ~ ACCUM[0];% 20418000
IF (TYPE~SCAN)= SLASH THEN% 20419000
BEGIN IF SCAN}IDENT THEN% 20420000
BEGIN EQN[0]~EQN[1]; EQN[1]~ACCUM[0] ;% 20421000
; END ELSE GO TO ERROR;% 20422000
TYPE ~ SCAN END;% 20423000
IF TYPE = COMMA THEN% 20424000
BEGIN% 20425000
IF(TYPE~SCAN)~ IDENT OR KOUNT >3 THEN GO TO ERROR;% 20426000
STREAM ( S ~ 3-KOUNT,KOUNT,ACCUM, T~[EQN[2]]);% 20427000
BEGIN SI~ACCUM; SI~SI+1; DI~DI+S; DS~KOUNT NUM;% 20428000
END;% 20429000
IF(TYPE~SCAN)= COMMA THEN% 20430000
BEGIN% 20431000
IF(TYPE~SCAN)! IDENT OR KOUNT>5 THEN GO TO ERROR;% 20432000
STREAM( S~8-KOUNT,KOUNT,ACCUM, T~[EQN[2]]);% 20433000
BEGIN SI~ACCUM; SI~SI+1; DI~DI+S;DS~KOUNT NUM% 20434000
END;% 20435000
EQN[2].[42:1] ~ 1;% SO FILE OPEN KNOWS ITS LABELEQUAT20435500
IF(TYPE~SCAN)= COMMA THEN% 20436000
BEGIN% 20437000
IF(TYPE~SCAN)!IDENT OR KOUNT>1 THEN GO TO ERROR; 20438000
STREAM(S~1-KOUNT,KOUNT,ACCUM,T~[EQN[3]]); 20439000
BEGIN SI~ACCUM; SI~SI+1; DI~DI+S;DS~KOUNT NUM;% 20440000
END; TYPE ~ SCAN;% 20441000
END% CYCLE ;% 20442000
END% CREATION DATE ;% 20443000
END;%REEL NUMBER;% 20444000
TPNO~@37;% 20445000
NOLBL ~ 0;% 20446000
ROUND:% 20447000
WHILE TYPE NEQ PERIO AND 20448000
((TYPE LSS FORM AND TYPE NEQ COPYN) OR TYPE GTR FREEF) DO 20448050
TYPE:=SCAN; 20448100
IF TYPE = PERIO THEN GO TO EXIT;% 20449000
IF TYPE = COPYN THEN GO LCOPY; 20449100
GO TO D[TYPE-FORM];% 20450000
NEXT: TYPE~SCAN; GO TO ROUND;% 20451000
LDUMMY: TPNO~11; % " FORM SPO" - DUMMY FILE %846-20451900
LFORM:% 20452000
EQN[3].[42:1]~1; GO TO NEXT;% 20453000
LNO:% 20454000
NOLBL ~ 1; GO TO NEXT;% 20455000
LDISK:% 20456000
TPNO~12; GO TO DSKCHECK; % "DISK" MEANS DISK SERIAL %603-20457000
LTAPE:% 20458000
TPNO ~ 2; GO TO NEXT;% 20459000
LPUNCH:% 20460000
TPNO:=0; 20460100
IF (TYPE:=SCAN)=PERIO THEN GO TO EXIT; 20461000
IF TYPE=FREEF THEN GO TO LFREE ELSE 20461050
IF TYPE=BACK THEN 20461100
TPNO~20 ELSE 20461200
BEGIN TPNO~21; IF TYPE=COPYN THEN BEGIN %603-20461300
TPNO~22; GO LCOPY END ELSE %603-20461310
IF SCAN!BACK THEN GO ERROR; %603-20461320
END; %603-20461330
IF SCAN=PERIO THEN GO ERROR; 20461400
IF (TYPE~SCAN)=PERIO THEN 20461500
TPNO~TPNO+4 ELSE 20461600
IF TYPE=FREEF THEN GO TO LFREE ELSE 20461650
IF TYPE=DISK THEN 20461700
TPNO~TPNO+2 ELSE 20461800
IF TYPE=COPYN THEN BEGIN TPNO~22; GO LCOPY END ELSE %603-20461810
IF TYPE!TAPE THEN GO ERROR; 20461900
IF TYPE!PERIO THEN GO NEXT ELSE GO EXIT; 20461950
LPAPER:% 20462000
TYPE ~ SCAN; TPNO ~ 7; GO TO NEXT;% 20463000
LSPECIAL:% 20464000
TPNO ~ 3; GO TO NEXT;% 20465000
LLINES66: % %724-20465050
EQN[0] ~ "FULLPGE" ; %SET UP MFID FOR FULL PAGE %724-20465100
LPRINT:% 20466000
TPNO:=1; 20466100
IF (TYPE:=SCAN)=PERIO THEN GO TO EXIT; 20467000
IF TYPE=FREEF THEN GO TO LFREE ELSE 20467100
IF TYPE=BACK THEN %P 20468000
LBACK: TPNO~6 ELSE %P 20469000
BEGIN TPNO~4; IF TYPE=COPYN THEN BEGIN %603-20470000
TPNO~15; GO TO LCOPY END ELSE %603-20470100
IF SCAN!BACK THEN GO ERROR; %603-20470110
END; %603-20470120
IF SCAN=PERIO THEN GO ERROR; %P 20471000
IF (TYPE~SCAN)=PERIO THEN %P 20472000
TPNO~22-TPNO ELSE %P 20473000
IF TYPE=FREEF THEN GO TO LFREE ELSE 20473100
IF TYPE=DISK THEN %P 20474000
TPNO~21-TPNO ELSE %P 20475000
IF TYPE=COPYN THEN BEGIN TPNO~16; GO LCOPY END ELSE %603-20475100
IF TYPE~TAPE THEN GO ERROR; %P 20476000
IF TYPE !PERIO THEN GO NEXT ELSE GO EXIT; 20477000
LFREE: 20478500
$ SET OMIT = NOT(PACKETS) 20478504
EQN[3].[23:1]~1; 20478505
$ POP OMIT 20478506
GO TO NEXT; 20478508
LCOPY: IF (TYPE:=SCAN) NEQ IDENT OR KOUNT GTR 3 THEN GO TO ERROR;20478510
STREAM(A:=0:KOUNT,ACCUM); 20478520
BEGIN SI:=ACCUM;SI:=SI+1;DI:=LOC A;DS:=KOUNT OCT END; 20478530
IF(TYPE:=P(DUP)) GTR 256 OR P(XCH)LSS 1 THEN GO ERROR; 20478540
EQN[3].[15:8]:=TYPE-1;GO TO NEXT; 20478550
ERROR:% 20479000
PPC~TRUE;GO DOWN;% 20480000
SPO: TPNO~11;GO TO NEXT;% 20481000
LREMOTE: TPNO~ 19; GO NEXT; 20481100
LRANDOM: TPNO~10; GO TO DSKCHECK; %603-20481900
SERIAL: TPNO:=12; GO TO DSKCHECK; % (SHM)20482000
UPDATE: TPNO~13; GO TO DSKCHECK; 20483000
PROTECT: TPNO~26; 20483100
DSKCHECK: % (SHM)20484000
IF (TYPE:=SCAN)=COMMA THEN GO TO DSKCHECK; % (SHM)20484050
IF TYPE=EU THEN % (SHM)20484100
BEGIN % (SHM)20484150
IF SCAN NEQ EQUAL THEN GO TO ERROR ELSE % (SHM)20484200
IF (TYPE:=SCAN) NEQ IDENT OR KOUNT GTR 2 THEN GO ERROR;20484250
STREAM(KOUNT,ACCUM,T:=[TYPE]); % (SHM)20484300
BEGIN % (SHM)20484350
SI:=ACCUM; SI:=SI+1; DI:=T; DS:=KOUNT OCT; % (SHM)20484400
END; % (SHM)20484450
EQN[12].[18:5]:=TYPE+1; % (SHM)20484500
GO TO DSKCHECK; % (SHM)20484550
END % IF EU % (SHM)20484600
ELSE IF TYPE=FAST OR TYPE=SLOW THEN % (SHM)20484650
BEGIN % (SHM)20484700
EQN[12].[16:2]:=1+(TYPE=SLOW); % (SHM)20484750
GO TO DSKCHECK; % (SHM)20484800
END 20484850
ELSE IF TYPE = SENSE THEN 20484855
BEGIN 20484860
EQN[12].[15:1]:=1; 20484865
GO TO DSKCHECK; 20484870
END; 20484875
GO TO ROUND; 20484900
EXIT:% 20485000
IF NOLBL THEN TPNO ~ IF TPNO=2 THEN 9 ELSE% 20486000
(IF TPNO =3 THEN 5 ELSE% 20487000
(IF TPNO=7 THEN 8 ELSE% 20488000
(IF TPNO=@37 THEN 9 ELSE TPNO)));% 20489000
IF FAROUT THEN IF UNITNO}32 THEN CIDROW[UNITNO-32].[3:5] ~ 0 20489100
ELSE IF UNITNO=23 THEN READERA.[FF] ~ 0 20489200
ELSE IF UNITNO=24 THEN READERB.[FF] ~ 0; 20489300
EQN[3].[43:5]~TPNO;% 20490000
DEX ~ DEX+1;% 20491000
END% 20492000
ELSE% 20493000
BEGIN% 20494000
DO UNTIL (IOD ~ SCAN) = EQUAL OR IOD = PERIO;% 20495000
IF IOD = PERIO THEN GO TO ERROR;% 20496000
IOD ~ SCAN;% 20497000
STREAM (K~0; A ~ [ACCUM[0]],KOUNT);% 20498000
BEGIN% 20499000
SI ~ A ; SI~SI+1; DI~LOC K;% 20500000
KOUNT(IF SC<"0" THEN BEGIN DS~LIT"+"; 20500100
JUMP OUT TO ERR; END; SI~SI+1); 20500200
SI~SI-KOUNT; 20500300
DS ~ KOUNT OCT ;% 20501000
ERR: 20501100
END;% 20502000
IF (TPNO~P).[1:1] THEN GO TO ERROR; 20503000
IF TYPE=PROCE OR TYPE=IO THEN X[16+TYPE-PROCE]~TPNO|3600 20504000
ELSE IF TYPE=COREV THEN %512-20504500
BEGIN X[20] ~ TPNO DIV 64; %512-20505000
DO UNTIL (IOD ~ SCAN)=MAXV OR IOD=PERIO; %512-20507000
IF IOD=MAXV THEN P([X[20]],IOR) ELSE GO TO DOWN; %512-20507100
END %512-20507200
ELSE IF TYPE}PRIOR AND TYPE{SAVEV THEN %512-20507300
X[18+TYPE-PRIOR]~TPNO ELSE GO TO ERROR; %512-20507400
DO UNTIL SCAN = PERIO;% 20508000
END;% 20509000
DOWN:% 20510000
END;% 20511000
PROCEDURE SECURITYMAINT( TYPE,SMID,SFID,CMM,SFH,CARD); 20511100
VALUE TYPE,SMID,SFID,SFH,CARD; 20511110
REAL TYPE,SMID,SFID,SFH,CARD; 20511120
ARRAY CMM[*]; 20511130
BEGIN 20511140
DEFINE SPOUTUNIT = CARD #; % TO ALLOW "LIBERR" TO WORK %589-20511148
REAL N4,OPTN,T1; 20511150
REAL ER1,ER2,ER3; LABEL ERSYS; %169-20511152
REAL T=TYPE; 20511155
LABEL SEC3,FUNC0,FUNC1,FUNC2,FUNC3,SEC4,EXYT; 20511160
LABEL ERR,ERROR,FUNCJ;% 20511165
SWITCH FUNC,FUNCJ,FUNC0,FUNC1,FUNC2,FUNC3;% 20511170
LABEL EXIT; % 20511171
ER1:=")~ ";% %169-20511175
N4:= ABS(CMM[5]); 20511181
IF ((CMM[0]EQV "DECK ")=NOT 0) AND 20511182
(((CMM[1]AND @77000000007777)EQV @12000000003714)=NOT 0) 20511184
OR SYSTEMFILE(CMM[0],CMM[1]) THEN% %169-20511188
BEGIN ERSYS: ER1:="SYSTEM ";ER2:="FILE)~ "; GO ERROR END; %169-20511190
IF TYPE = USEV AND 20511295
((CMM[0]EQV SMID)=NOT 0 AND (CMM[1]EQV SFID)=NOT 0) THEN 20511300
BEGIN ER1:="SAME FI";ER2:="LE)~ "; GO ERROR END %169-20511303
ELSE 20511305
IF (OPTN:=DIRECTORYSEARCH(CMM[0],CMM[1],3)) GEQ 64 THEN 20511306
BEGIN 20511311
IF TYPE=USEV AND M[OPTN+2]<0 THEN% %169-20511312
BEGIN ER1:="SECURIT";ER2:="Y FILE)";ER3:="~ "; GO ERR END;20511313
IF (T1~((N4 EQV MCP)=NOT 0) OR (CMM[5]=NOT(-0))) OR 20511315
(M[OPTN+2]>0 AND(N4 EQV ABS(M[OPTN+2]))=NOT 0)THEN 20511320
GO TO SEC3 ELSE 20511330
BEGIN ER1:="INVALID";ER2:=" USER)~";% %169-20511335
ERR: FORGETSPACE(OPTN);% %169-20511340
FORGETSPACE(DIRECTORYSEARCH(CMM[0],CMM[1],14)); 20511350
END; 20511360
END ELSE IF OPTN=2 THEN GO ERSYS% @ LINE 20511190 %169-20511363
ELSE IF OPTN=1 THEN BEGIN ER1:="IN USE)";ER2:="~ " END 20511364
ELSE IF OPTN=0 THEN BEGIN ER1:="NOT ON ";ER2:="DISK)~ " END;20511365
ERROR: %169-20511366
STREAM(A:=[CMM[0]],ER:=[ER1],B:=(OPTN:=SPACE(10))); %169-20511370
BEGIN SI:=A; SI:=SI+1; DS:=LIT" "; DS:=7 CHR; 20511380
SI:=SI+1; DS:=LIT"/"; DS:=7 CHR; 20511390
DS:=25 LIT " SECURITY MAINT IGNORED ("; SI:=ER;% %169-20511400
3(SI:=SI+1; DS:=7 CHR);% %169-20511405
END STREAM; 20511410
SPOUTER(OPTN&CARD[9:9:9],CARD,LIBERR); %149-20511420
GO TO EXYT; 20511430
SEC3: 20511440
GO TO FUNC[TYPE-UNLOCKV]; 20511450
FUNCJ:M[OPTN INX 5]~M[OPTN INX 6]~@14;% 20511455
CMM[2] := " UNLOCK"; CMM[3] := "ED~~ ";% 20511457
GO TO SEC4;% 20511459
FUNC0: 20511460
M[OPTN INX 5]:=-SMID; M[OPTN INX 6]:= SFID; 20511470
CMM[2]:= " SECURE"; CMM[3]:= "D WITH "; 20511480
M[SFH+2] := P(DUP,LOD,SSB); 20511490
GO TO SEC4; 20511500
FUNC1: 20511510
IF (T1~T1 AND (M[OPTN+2]=0)) THEN M[OPTN+2]~CMM[6]; 20511515
SMID:=M[OPTN+5]; SFID:=M[OPTN+6]; 20511520
M[OPTN INX 5]:= M[OPTN INX 6]:=0; 20511525
CMM[2]~" LOCKED";CMM[3]~" FROM ";CMM[4]~" WITH :";GO TO SEC4; 20511530
FUNC2: 20511540
M[OPTN INX 5]~M[OPTN INX 2].[6:42]; M[OPTN INX 2]~M[OPTN INX 6]~0; 20511550
CMM[2]:= " FREE F"; CMM[3]:= "ILE~~ "; GO TO SEC4; 20511560
FUNC3: 20511570
M[OPTN INX 5]:= @14; M[OPTN INX 6]:= 0; 20511580
CMM[2]:= " PUBLIC";CMM[3]:= " FILE~~"; 20511590
SEC4: 20511600
DISKWAIT(OPTN,[CF],30,OPTN.[FF]); 20511610
P(DIRECTORYSEARCH(-CMM[0],CMM[1],14),DEL); 20511620
$ SET OMIT = PACKETS 20511639
STREAM(A:=ABS(SMID),B:=SFID,C:=CMM,Q:=(T LSS FREE)% 20511660
AND (T!UNLOCKV) AND (ABS(SMID)!12),% 20511662
X:=(SFID=0 OR ABS(SFID)=12) % 20511663
AND T LSS FREE AND T~UNLCOKV,% 20511664
Y~T=LOCKV AND(((N4 EQV MCP)=NOT 0)AND((CMM[6] EQV MCP)! 20511665
NOT 0)) AND T1,D~OPTN~OPTN INX 0); 20511666
BEGIN SI:=C; SI:=SI+1; DS:=LIT" "; DS:=7 CHR; DS:=LIT"/"; 20511670
3(SI:=SI+1; DS:=7 CHR); 20511680
X(DI:=DI-7; DS:=2 LIT"~~"); 20511685
Q(DS:=LIT" ";SI:=LOC A;SI:=SI+1;DS:=7 CHR; DS:=LIT"/"; 20511690
SI~SI+1; DS~7 CHR); 20511700
Y(X(DI~DI-18); SI~C;4(SI~SI+8);SI~SI+1;DS~7 CHR; 20511702
SI~SI+9; DS~7 CHR); DS~ LIT "~"; 20511704
END STREAM; 20511710
SPOUTER(OPTN&CARD[9:9:9],CARD,SECMSG); 20511720
$ SET OMIT = PACKETS 20511729
EXYT: 20511800
END SECURITYMAINT; 20511810
COMMENT THE PRT CELL "SHEET" GIVES DISK ADDRESS OF 1ST SHEET ENTRY 20512000
*** ENTRIES IN THE SHEET ARE AS FOLLOWS: 20512400
S[ 0] = 1ST NAME (7 CHRS) 20512800
.[ 2:1 ] = "CANDE" JOB (TSS ONLY) 20513200
S[ 1] = 2ND NAME (7 CHRS) 20513600
S[ 2].[ 1: 2] = 0 NORMAL 20514000
2 JOB HAS BEEN XS-ED (FORCED RUN) 20514400
3 JOB HAS BEEN ES-ED (FORCED RUN AND DS) 20514800
S[ 3].[ 4:1 ] = SUPPRESS BOJ/EOJ MESSAGES FOR SYSTEM JOBS 20515200
S[ 2].[ 5:3 ] = 0 NORMAL, 1 LIBMAIN, 3 LDCNTRL, 5 PRNPBT 20515400
S[ 2].[ 8:10] = 0 GO JOB (FROM COMPILE & GO) 20515600
= 1 COMPILER (FOR COMPILE & GO) 20516000
= 2 EXECUTE JOB 20516400
= 3 COMPILER (FOR SYNTAX CHECK)(SET TO 2 LATER) 20516800
= 4 COMPILER (FOR COMPILE TO LIBRARY) 20517200
= 5 RUN JOB 20517600
S[ 2].[18:15] = SKELETONS DISK ADDRESS (IF S[2].[8:10] = 1,2,4 20518000
S[ 2].[33:15] = PRIORITY, SAME AS S[18] 20518400
S[ 3].[ 1:1 ] = SET BY SELECTRUN WHEN "SCHEDULED" MESSAGE 20518800
IS SENT (IF SCHEDULED) 20519200
S[ 3].[ 2: 1] = 1 RESTART JOB 20519600
S[ 3].[ 8:10] = SCHEDULE-ID FOR THIS JOB 20520000
S[ 5] = STARTING TIME FOR LOG 20520400
S[ 6] = LOCATION OF LAST PART OF LOG 20520800
S[ 7] = CORE ADDRESS OF SEGMENT ZERO (WHEN THE 20521200
SHEET IS PASSED TO SELECTRUN AS A PARAMETER) 20521600
S[13] = DISK ADDRESS OF LABEL EQUATION ENTRIES 20522000
APPLICABLE TO THIS EXECUTION ONLY (SEE BELOW) 20522400
S[14] = ACTUAL MFID OF JOB (TSS ONLY). THIS MAY BE 20522800
BE DIFFERENT FROM S[0] FOR SOME JOBS 20523200
WHICH ARE STARTED BY CANDE. 20523600
S[15] = DISK ADDRESS OF LABEL EQUATION ENTRIES 20524000
PRESENTED WHEN PROGRAM WAS COMPILED AND 20524400
APPLICABLE TO ALL EXECUTIONS 20524800
S[16] = ESTIMATED PROCESSOR TIME 20525200
S[17] = ESTIMATED I/O TIME 20525600
S[18] = PRIORITY 20526000
S[19] = COMMON VALUE 20526400
S[20] = ESTIMATED CORE REQUIREMENTS 20526800
S[20].[ 2:1 ] = "CAN-T EXPAND" BIT (TSS) 20527200
.[33:15] = ESTIMATED CORE REQUIREMENT 20527600
S[21] = STACK SIZE 20528000
S[22] = SAVE FACTOR FOR OBJECT FILE (COMPILATIONS) 20528400
S[23].[2:6] = UNITNO OF CARD/PSEUDO READER IN CONTROLCARD. 20528800
S[23].[9:9] = REMOTE STATION ADDRESS, ELSE 0 20529200
S[23].[24:24] = TIME JOB PUT IN SHEET(FOR TS MSG) 20529600
S[24] = USER CODE 20530000
S[25] = DISK ADDRESS OF FILE HEADER FOR THE JOB 20530400
S[26] = LOGLINE (TSS) 20530800
S[27] = FID FOR COMPILES,TAPE NAME FOR LIBMAIN. 20531200
S[29] = DISK ADDRESS OF NEXT SHEET ENTRY (=0 IF LAST) 20531600
*** ENTRIES FOR LABEL EQAT. ARE AS FOLLOWS: 20532000
F[0] = MULTI-FILE ID (7 CHRS) 20532400
F[1] = FILE ID (7 CHRS) 20532800
F[2].[0:18] = REEL NO (3 CHRS) 20533200
F[2].[18:30] = CREATION DATE (5 CHRS) 20533600
F[3].[0:6] = CYCLE (1 CHR) 20534000
F[3].[15:8] = NUM COPIES OF PBD OR PUD FILE 20534400
F[3].[23:1] = 1, IF "FREEF" PDB PACKET FILE 20534800
F[3].[42:1] = 1 FOR FORMS REQUIRED 20535200
F[3].[43:5] = 0 FOR CP (FILE TYPES ) 20535600
1 FOR LP 20536000
2 FOR MT 20536400
3 FOR SPECIFIC UNIT 20536800
4 FOR LP (MAY BACKUP) 20537200
5 FOR SPECIFIC (UNLABELED) 20537600
6 FOR LP (MUST BACKUP) 20538000
7 FOR PT 20538400
8 FOR PT (UNLABELED) 20538800
9 FOR MT (UNLABELED) 20539200
10 FOR DISK 20539600
F[4].[0:6] = NO OF CHARS IN INTERNAL NAME 20540000
F[4].[6:42] = INTERNAL NAME (MAY CONTINUE TO F[11]) 20540400
F[12].[15:1] = "SENSITIVE" BIT 20540800
F[12].[16:2] = DISK SPEED 20541200
F[12].[18:5] = EU NUMBER + 1 20541600
F[14]- F[25] SAME AS ABOVE FOR NEXT FILE (F[14]=14 IF NO NEXT)20542000
F[29] = DISK ADRS.OF NXT.LBL.EQUAT.ENTRY(=0 IF NONE) 20542400
**** ALSO SEE PROCEDURE "SELECTRUN1" (SEQ.NO.20055600) FOR 20542800
**** FURTHER INFORMATION ON LABEL EQUATION AND THE FILE 20543200
**** PARAMETER BLOCK. 20543600
20544000
**** CONTENTS OF THE JAR: 20544400
JAR[0].[ 1:1 ] = COMPILE JOB 20544800
.[ 2:1 ] = "CANDE" JOB (TSS ONLY) 20545200
.[ 6:42] = MFID OF THE JOB 20545600
JAR[1].[ 1:1 ] = JOB IS BEING DS-ED 20546000
.[ 2:1 ] = JOB IS BEING ES-ED 20546400
.[ 6:42] = FID OF THE JOB 20546800
JAR[2].[ 1:1 ] = COBOL JOB 20547200
.[ 2:1 ] = DECLARED SOFTWARD INTERRUPTS 20547600
.[ 3:1 ] = JOB HAS MAINTENANCE LOG ENTRY 20548000
.[ 4:1 ] = NOT USED 20548400
.[ 5:1 ] = DECLARED SOFTWARE INTERRUPTS 20548800
.[ 6:1 ] = INVOKED OR INVOKING IPC PROG.FILE 20549200
.[ 7:1 ] = INVOKED IPC PROGRAM FILE 20549600
.[ 6:10] = SAME AS S[2].[8:10] ABOVE 20550000
.[18:15] = DISK ADDRESS FOR THE SKELETON SHEET (COMPILATIONS20550400
.[33:15] = PRIORITY 20550800
JAR[3] = PROCESS TIME LIMIT 20551200
JAR[4] = IO TIME LIMIT 20551600
JAR[5].[ 1:23] = STARTING DATE (OCTAL) 20552000
.[24:24] = STARTING TIME (OCTAL) 20552400
JAR[6].[ 1:1 ] = JOB IS SD-ED 20552800
.[ 2:4 ] = PSEUDO-READER NUMBER 20553200
.[18:15] = SIZE OF LOG INFORMATION (BATCH) 20553600
.[33:15] = DISK ADDRESS OF FIRST RECORD FOR THE LOG 20554000
JAR[7] = IDLETIME ENTRY (BATCH) 20554400
JAR[7] = MFID OF JOB (TSS ONLY). THIS MAY BE DIFFERENT 20554800
FROM JAR[0] FOR SOME JOBS STARTED BY CANDE. 20555200
JAR[8] = LENGTH OF CODE FILE ROW 20555600
JAR[9].[ 1:1 ] = REEL CHANGE IN PROGRESS DUE TO "RC" MESSAGE 20556000
.[ 2:1 ] = SUPPRESS PRINTING OF BOJ/EOJ MESSAGES 20556400
.[ 3:1 ] = JOB HAS BEEN "STOPPED" (WORKSET ON BATCH) 20556410
.[ 4:1 ] = KEYBOARD INTERRUPTS ARE ALLOWED 20556420
.[ 5:1 ] = A KEYBOARD INTERRUPT HAS OCCURRED 20556430
.[ 6:3 ] = 0 NORMAL JOB 20556700
= 1 LIBMAIN 20556710
= 3 LDCNTRL 20556720
= 5 PRNPBT -- ODD VALUES FOR BOOLEAN TESTING 20556730
.[18:15] = DISK ADDRESS FOR "CHAIN" IF NON-ZERO 20556800
.[33:15] = NUMBER FOR DISK ROWS IN CODE FILE 20557200
JAR[10] THROUGH JAR[29] = DISK ADDRESS OF CODE FILE ROWS 20557600
JAR[30] = FID OF OBJECT FILE (BATCH COMPILES ONLY) 20558000
END OF COMMENT; 20558400
REAL PROCEDURE CCLIB; 20566000
BEGIN LABEL NEXT,LOOP; 20566011
DECLARECCVARIABLES; 20566100
REAL CNT = RETURNVAL+1, % BEGIN LOCALS TO CCLIB 20566245
HOLD1 = CNT+1, 20566247
HOLD2 = HOLD1+1, XI = HOLD2, 20566250
HOLD3 = HOLD2+1, 20566255
REPEAT = HOLD3+1, XLSTSZ = REPEAT, 20566260
TYM = REPEAT+1, HME = TYM; 20566265
BOOLEAN FIRSTIME = TYM+1; 20566270
ARRAY XLST = FIRSTIME+1[*]; 20566280
REAL FROMHLD = XLST+1, 20566290
TOHLD = FROMHLD+1, 20566300
REMEMBER = TOHLD+1, 20566310
NAMECNT = REMEMBER+1; 20566320
BOOLEAN DIDGETESPDISK= NAMECNT + 1; 20566330
INTEGER I = DIDGETESPDISK + 1; %148-20566340
%********************************************************************** 20566350
% 20566352
% 20566354
% CCLIB HAS BEEN EXPANDED TO HANDLE NEW FACILITIES AVAILABLE 20566356
% THROUGH USE OF THE "COPY" CONTROL CARD AND THE EXTENSION OF 20566358
% "EXCEPT" LISTS TO "REMOVE" CONTROL CARDS. 20566360
% 20566362
% 20566364
% 1: COPY CONTROL CARDS 20566366
% 20566368
% PERFORMS SYNTAX ANALYSIS (SEE DOCUMENTATION) 20566370
% 20566372
% SETS UP LINKED LIST OF ESPDISK SEGMENTS PROVIDING DATA AND 20566374
% NAMES NECESSARY FOR LIBRARY MAINTENANCE PROCESSING 20566376
% (INCLUDING "EXCEPT" AND "AS" LISTS). 20566378
% 20566380
% 20566382
% 2: REMOVE CONTROL CARDS 20566384
% 20566386
% SCANS "EXCEPT" LIST ASSOCIATED WITH ANY PARTICULAR NAME 20566388
% PAIR PASSING SAID LISTS TO PROCEDURE "SEEKNAM", WHICH IN 20566390
% TURN USES THE "EXCEPT" LIST WHEN DETERMINING WHETHER OR 20566392
% NOT TO RETURN SPECIFIC NAMES FOR REMOVAL. 20566394
% 20566396
% 20566398
% CMM[19].[2:1] INDICATES ORIGINATON 20566400
% .[3:6] UNITNO FOR PACKETS 20566402
% .[9:9] USER SPECIFIED MAXIMUM NUMBER OF FILES PER 20566404
% OUTPUT UNIT 20566406
% 20566408
% XLST DESCRIPTOR TO "EXCEPT" LIST ASSOCIATED WITH 20566410
% A PARTICULAR NAME PAIR 20566412
% 20566414
% REMEMBER USED FOR CORRECT PLACEMENT OF "FROMHLD", 20566426
% "TOHLD", OPTIONS AND NAME COUNTS WITHIN THE 20566428
% LINKED LIST OF ESPDISK SEGMENTS... 20566430
% .[3:15] FIRST ESPDISK ADDRESS 20566432
% .[FF] OFFSET INTO .[CF] 20566434
% .[CF] ESPDISK ADDRESS OF OPTIONS AND NAME COUNT WORD 20566436
% 20566438
% NAMECNT.[FF] COUNT OF "EXCEPT" LIST PAIRS AND "AS" CLAUSE 20566440
% PAIRS FOR A PARTICULAR SOURCE 20566442
% .[CF] COUNT OF NAME PAIRS 20566444
% 20566446
% FROMHLD.[1:5] INPUT UNIT NUMBER + 1 %148-20566448
% IF .[1:5] = 0 THEN INPUT FROM ANY TAPE %148-20566449
% THAT WAS THE CORRECT NAME %148-20566450
% .[6:42] IF DISK THEN 0 %148-20566451
% IF TAPE THEN TAPE NAME 20566452
% 20566454
% TOHLD.[1:5] OUTPUT UNIT NUMBER + 1 %148-20566455
% IF .[1:5] = 0 THEN OUTPUT TO ANY SCRATCH %148-20566456
% TAPE. %148-20566457
% IF DISK THEN .[40:1] SPECIFIES TYPE FAST 20566458
% .[41:1] " " SLOW 20566460
% .[42:6] " EU # 20566462
% IF TAPE THEN .[6:42] HAS TAPE NAME %148-20566464
% 20566466
% 20566468
%***********************************************************************20566470
LABEL CCA,QUIT,POWIE,CHAN,REMO,INCSC,GETEM,ENTE,LCOPY,SEEK,INIT; 20566600
LABEL DOWNR,OUTR,SCNX,NEXTL,MIRID; 20566610
SWITCH SW:=LCOPY,LCOPY,LCOPY,ENTE,ENTE,REMO,CHAN; 20566620
DEFINE ZIPMIX=CARD.[18:6]#; 20566630
DEFINE UNITNUM = [1:5]#; %148-20566640
% 20566650
%************************************************** 20566655
% 20566660
SUBROUTINE CHECK; 20566665
BEGIN 20566670
IF (CNT:=CNT+2) GTR 26 THEN 20566675
BEGIN 20566680
PROG[29]:=GETESPDISK; 20566685
DIDGETESPDISK:=TRUE; 20566687
DISKWAIT(PROG INX 0,30,LIBNO); 20566690
LIBNO:=PROG[29]; 20566695
CNT:=0; 20566700
END; 20566705
END; % CHECK 20566710
% 20566744
%************************************************** 20566745
% 20566746
% - FINAL PREPARATIONS BEFORE EXITING 20566747
% - PLACEMENT OF FINAL INPUT SOURCE AND DESTINATION 20566748
% 20566749
%************************************************** 20566750
% 20566751
SUBROUTINE BOTH; 20566752
BEGIN CMM[0]:="LIBMAIN"; CMM[1]:="DISK "; 20566755
CMM[2] := 0 & LIBMAINCODE[5:45:3] & 2[8:38:10]; CMM[13]:=0; 20566760
$ SET OMIT = PACKETS 20566765
$ SET OMIT = NOT(PACKETS) 20566780
CMM[23]:=0&CARD[9:9:9]&(IF ZIPMIX NEQ 0 THEN PSEUDOMIX[ZIPMIX]20566785
ELSE UNITNO[2:42:6]; 20566790
$ POP OMIT 20566795
CHECK; PROG[CNT]:=@14; 20566805
IF T GEQ COPYN AND T LEQ LOAD THEN %543-20566807
BEGIN PROG[CNT+1]:=FROMHLD; CHECK; PROG[CNT]:=@114; 20566810
IF LIBNO=REMEMBER.[3:15] THEN PROG[1]:=TOHLD; 20566812
END; 20566815
OPTN:=CN; PROG[29]:=0; %123-20566817
DISKWAIT(PROG INX 0,30,LIBNO); 20566820
IF T GEQ COPYN AND T LEQ LOAD THEN %543-20566822
IF LIBNO NEQ REMEMBER.[3:15] THEN 20566825
BEGIN DISKWAIT(-PROG.[CF],30,REMEMBER.[3:15]); 20566830
PROG[1]:=TOHLD; 20566835
DISKWAIT(PROG INX 0,30,REMEMBER.[3:15]); 20566840
END; 20566845
LIBNO:=ABS(CMM[19]); 20566850
END OF BOTH; 20566855
% 20566864
%************************************************** 20566865
% 20566866
REAL SUBROUTINE SCAN; 20566875
SCAN~SCN(UNITNO,CARDLOC,SOURCE,ACCUM,KOUNT,LASTSCAN, 20566900
DIRECT); 20566902
REAL SUBROUTINE SKAN; 20566905
BEGIN 20566910
STREAM(X:=0:CN:=0,ACCUM); 20566915
BEGIN 20566920
SI:=ACCUM;SI:=SI+1; 20566925
8(IF SC GEQ "0" THEN BEGIN SI:=SI+1;TALLY:=TALLY+1; END ELSE 20566930
IF SC=" " THEN JUMP OUT ELSE BEGIN TALLY:=0;JUMP OUT END); 20566935
CN:=TALLY;SI:=SI-CN;DI:=LOC X;DS:=CN OCT; 20566940
END; 20566945
SKAN:=P; 20566950
END OF SKAN; 20566955
% 20566984
%************************************************** 20566985
% 20566986
% - CREATES AN EXCEPTION LIST OF FILE NAMES WHICH ARE 20566987
% ASSOCIATED WITH A PARTICULAR PRECEDING FILE NAME 20566988
% 20566989
%************************************************** 20566990
% 20566991
SUBROUTINE SCANEXCEPT; 20567000
BEGIN IF XLST=0 THEN XLST:=[M[SPACE(XLSTSZ:=30)]]&30[8:38:10]; %177-20567005
SCNX: IF (XX:=XI+2) GEQ XLSTSZ 20567010
THEN BEGIN % EXPAND EXCEPTION LIST SIZE 20567015
ST:=SPACE(XLSTSZ:=XLSTSZ+30); 20567020
MOVE(XLSTSZ-30,XLST,ST); 20567025
FORGETSPACE(XLST); 20567030
XLST:=[M[ST]]&XLSTSZ[8:38:10]; 20567035
END; 20567040
IF (CN:=SCAN)=EQUAL 20567045
THEN BEGIN XLST[X]:=-1; 20567050
IF HME ! 2 %792-20567055
THEN BEGIN IF T1.[46:1] THEN GO POWIE; %792-20567056
XLST[XI] ~ IF T1.[45:1] THEN CMM[0] %792-20567057
ELSE PROG[CNT]; %792-20567058
END END %792-20567060
ELSE IF CN GEQ IDENT THEN XLST[XI]:=ACCUM[0] 20567065
ELSE GO POWIE; 20567070
IF SCAN NEQ SLASH THEN GO POWIE; 20567075
IF (CN:=SCAN)=EQUAL 20567080
THEN BEGIN IF XLST[XI].[1:1] THEN GO POWIE; 20567085
XLST[XI+1]:=-1; 20567090
IF HME ! 2 %792-20567095
THEN BEGIN IF T1 THEN GO POWIE; %792-20567096
XLST[SI+1] ~ IF T1.[45:1] THEN CMM[1] %792-20567097
ELSE PROG[CNT+1]; %792-20567098
END END %792-20567100
ELSE IF CN GEQ IDENT THEN XLST[X]:=ACCUM[0] 20567105
ELSE GO POWIE; 20567110
IF (CN:=SCAN)=COMMA THEN GO SCNX 20567115
ELSE IF CN NEQ RB THEN GO POWIE; 20567120
END; % SCANEXCEPT 20567125
% %148-20567140
%************************************************** %148-20567142
% %148-20567144
% - LOOK FOR TAPE UNIT ASSOCIATED WITH AN INPUT OR %148-20567145
% OUTPUT FILE NAME %148-20567146
% %148-20567148
%************************************************** %148-20567150
% %148-20567152
REAL SUBROUTINE SCANON; %148-20567154
BEGIN IF(CN:=SCAN) ! IDENT THEN GO POWIE; %148-20567158
CN:=ACCUM[0].[6:18]; %148-20567160
FOR I:=0 STEP 1 UNTIL 15 DO %148-20567162
IF TINU[1].[30:18]=CN THEN %148-20567166
BEGIN %148-20567168
P(I+1); %148-20567170
I:=16; %148-20567172
END; %148-20567174
IF I!17 THEN GO TO POWIE; %148-20567176
CN:=SCAN; %148-20567178
SCANON:=P; %148-20567180
END SCANON; 20567182
% 20567200
%************************************************** 20567201
% 20567202
SUBROUTINE SCANDSKTYP; 20567205
BEGIN 20567210
IF (CN:=SCAN)=EU 20567215
THEN BEGIN 20567220
IF (CN:=SCAN) NEQ IDENT THEN GO POWIE; 20567225
IF P(SKAN,DUP) GTR 19 THEN BEGIN P(DEL); GO POWIE; END; 20567230
CN:=P+1; TOHLD.[42:6]:=CN; 20567235
IF CN GTR NEUP.NEUF THEN GO POWIE; 20567240
END 20567245
ELSE IF CN=SLOW THEN TOHLD.[41:1]:=1 ELSE 20567250
IF CN=FAST THEN TOHLD.[40:1]:=1 ELSE 20567255
IF T NEQ COPYN THEN GO POWIE ELSE 20567260
IF CN=DISK THEN ELSE 20567265
IF CN NEQ IDENT THEN GO POWIE ELSE TOHLD:=ACCUM[0]; 20567270
IF (CN:=SCAN)=ONV THEN %148-20567271
IF TOHLD.UNITNUM!0 THEN GO POWIE %148-20567274
ELSE %148-20567276
BEGIN %148-20567278
TOHLD.UNITNUM:=SCANON; %148-20567280
END; %148-20567282
END OF SCANDSKTYP; 20567285
% 20567300
%************************************************ 20567305
% 20567310
% - PLACEMENT OF OPTIONS AND NAME COUNTS INTO CORRECT 20567311
% WORD OF CORRECT ESPDISK SEGMENT 20567312
% 20567313
%************************************************** 20567314
% 20567315
SUBROUTINE SETUP; 20567316
BEGIN 20567320
IF LIBNO NEQ REMEMBER.[CF] THEN 20567325
BEGIN DISKWAIT(PROG INX 0,30,LIBNO); 20567330
DISKWAIT(-PROG.[CF],30,REMEMBER.[CF]); 20567335
PROG[REMEMBER.[FF]]:=(*P(DUP))&NAMECNT[18:18:15]&NAMECNT[CTC]; 20567340
DISKWAIT(PROG INX 0,30,REMEMBER.[CF]); 20567345
DISKWAIT(-PROG.[CF],30,LIBNO); 20567350
END ELSE 20567355
PROG[REMEMBER.[FF]]:=(*P(DUP))&NAMECNT[18:18:15]&NAMECNT[CTC]; 20567360
END OF SETUP; 20567365
% 20567510
%****************** START HERE ****************** 20567511
% 20567512
P(RCW,MYMSCW,STF); 20567520
RCW:=RCW & P(XCH)[CTC]; 20567530
P(0,0,0,0,0,0,0,0,0,0,0,0,0); % ZERO LOCALS OF CCLIB 20567540
P(0); %148-20567550
GO SW [T-COPYN]; 20567600
LCOPY: 20569200
ENTE: 20569230
PROG[0]:=PROG[2]:=0; CNT:=2; 20569240
IF (CN:=SCAN)=IDENT THEN 20569260
BEGIN 20569290
IF (ST:=SKAN)=0 THEN ST:=511 ELSE CN:=SCAN; 20569320
IF ST GTR 511 THEN ST:=511; 20569350
END ELSE ST:=511; 20569380
REMEMBER.[3:15]:=LIBNO:=GETESPDISK; 20569400
DIDGETESPDISK:=TRUE; 20569410
CMM[19]:=0&(IF UNITNO=23 OR UNITNO=24 OR UNITNO GEQ 32 THEN 20569420
UNITNO ELSE 0)[3:42:6]&ST[9:39:9]& 20569440
LIBNO[CTC]&1[2:47:1]; 20569460
NEXTL: 20569520
FROMHLD.UNITNUM:=19; TOHLD.UNITNUM:=19; % 19=DISK UNINTO+1%148-20569522
PROG[CNT+1]:=0; 20569525
NAMECNT:=0; 20569527
IF T=ADDV THEN PROG[CNT+1].[6:1]:=1; 20569528
IF T=UNLOAD THEN PROG[CNT+1].[8:1]:=1; 20569529
$ SET OMIT = NOT B6500LOAD 20569530
IF T NEQ COPYN THEN 20569590
IF CN=TOV AND T GTR UNLOAD THEN 20569610
SCANDSKTYP; 20569630
IF CN=LATESTV THEN 20569650
BEGIN PROG[CNT+1].[5:1]:=1; CN:=SCAN; END; 20569670
IF CN=EXPIRED THEN 20569690
BEGIN PROG[CNT+1].[4:1]:=1; CN:=SCAN; END; 20569710
IF CN=ACCESSD THEN 20569730
BEGIN PROG[CNT+1].[3:1]:=1; CN:=SCAN; END; 20569750
IF CN=ADDV THEN 20569770
BEGIN PROG[CNT+1].[6:1]:=1; CN:=SCAN; END; 20569780
IF CN=NOHASH THEN 20569790
BEGIN PROG[CNT+1].[7:1]:=1; CN:=SCAN; NAMECNT.[17:1]:=1; END; 20569800
IF CN=UNLOAD THEN 20569802
BEGIN PROG[CNT+1].[8:1]:=1; CN:=SCAN; NAMECNT.[17:1]:=1; END; 20569804
IF T NEQ COPYN THEN 20569810
IF SCAN NEQ IDENT 20569830
THEN GO POWIE 20569835
ELSE IF T LEQ UNLOAD 20569840
THEN BEGIN TOHLD:=ACCUM[0]; %148-20569845
IF (CN:=SCAN)=ONV THEN TOHLD.UNITNUM:=SCANON;%148-20569846
END %148-20569847
ELSE BEGIN FROMHLD:=ACCUM[0]; %148-20569850
IF (CN:=SCAN)=ONV THEN FROMHLD.UNITNUM:=SCANON; 20569860
END; %148-20569870
REMEMBER:=REMEMBER&LIBNO[CTC]&(CNT+1)[CTF]; 20569890
GETEM: 20569920
CHECK; 20569925
T1.[46:1]~HOLD3~(CN=EQUAL); %543-20569930
IF HOLD3 THEN PROG[CNT]:=-1 ELSE %543-20569935
IF CN GEQ IDENT THEN PROG[CNT]:=ACCUM[0] ELSE GO POWIE; %543-20569940
IF SCAN NEQ SLASH THEN GO POWIE; 20569950
T1.[47:1]~HOLD3~((CN~SCAN)=EQUAL); %543-20569960
IF HOLD3 THEN PROG[CNT+1]:=-1 ELSE %543-20569965
IF CN GEQ IDENT THEN PROG[CNT+1]:=ACCUM[0] ELSE GO POWIE; 20569970
NAMECNT.[CF]:=NAMECNT.[CF]+2; 20569975
HME:=PROG[CNT].[1:1]+PROG[CNT+1].[1:1]; 20569980
HOLD3:=1; 20569985
IF (CN:=SCAN)=EXCEPT THEN BEGIN CN:=SCAN; HOLD3:=0; END; 20569990
IF CN=LB THEN IF HME NEQ 0 THEN 20570000
BEGIN XI:=-2; 20570010
SCANEXCEPT; 20570015
FOR ST:=0 STEP 2 UNTIL XI DO 20570020
BEGIN CHECK; 20570030
PROG[CNT]:=XLST[ST]&1[5:47:1]; 20570040
PROG[CNT+1]:=XLST[ST+1]&1[5:47:1]; 20570050
NAMECNT.[FF]:=NAMECNT.[FF]+2; 20570055
END; 20570060
CN:=SCAN; 20570065
FORGETSPACE(XLST); XLST:=0; %543-20570070
END ELSE GO POWIE 20570080
ELSE IF HOLD3=0 THEN GO POWIE; 20570090
IF CN=AS THEN 20570100
BEGIN 20570110
IF HME=2 OR T=UNLOAD OR NAMECNT.[17:1] THEN GO POWIE; 20570120
IF (CN~SCAN)=EQUAL THEN IF T1.[46:1] THEN %543-20570130
BEGIN CHECK; PROG[CNT]:=-1&1[4:47:1]; END ELSE GO POWIE 20570140
ELSE IF CN GEQ IDENT THEN IF T1.[46:1] THEN GO POWIE %543-20570150
ELSE BEGIN CHECK; PROG[CNT]:=ACCUM[0]&1[4:47:1]; END 20570160
ELSE GO POWIE; 20570170
IF SCAN NEQ SLASH THEN GO POWIE; 20570180
IF (CN~SCAN)=EQUAL THEN IF T1 THEN %543-20570190
PROG[CNT+1]:=-1&1[4:47:1] ELSE GO POWIE 20570200
ELSE IF CN GEQ IDENT THEN IF T1 THEN GO POWIE %543-20570210
ELSE PROG[CNT+1]:=ACCUM[0]&1[4:47:1] 20570220
ELSE GO POWIE; 20570230
NAMECNT.[FF]:=NAMECNT.[FF]+2; 20570232
CN:=SCAN; 20570235
END; 20570240
IF CN=COMMA THEN BEGIN CN:=SCAN; GO GETEM; END; 20570250
IF CN=PERIO OR CN=POUND 20570270
THEN IF T=COPYN THEN GO POWIE ELSE GO QUIT 20570280
ELSE IF T NEQ COPYN 20570290
THEN GO POWIE 20570300
ELSE IF CN=TOV 20570310
THEN BEGIN 20570320
FIRSTIME:=TRUE; 20570330
MIRID: SCANDSKTYP; 20570340
IF FIRSTIME AND (TOHLD.UNITNUM=19) %148-20570350
THEN GO POWIE 20570360
ELSE IF CN=PERIO OR CN=POUND 20570370
THEN GO QUIT ELSE GO POWIE 20570380
END 20570390
ELSE IF CN NEQ FROM 20570400
THEN GO POWIE 20570410
ELSE BEGIN 20570420
IF (CN:=SCAN)=DISK 20570430
THEN FIRSTIME:=TRUE 20570440
ELSE IF CNNEQ IDENT 20570450
THEN GO POWIE ELSE FROMHLD:=ACCUM[0]; 20570460
IF (CN:=SCAN) = ONV THEN %148-20570462
FROMHLD.UNITNUM:=SCANON; %148-20570464
IF CN=POUND OR CN=PERIO %148-20570470
THEN IF FIRSTIME THEN GO POWIE 20570480
ELSE GO QUIT 20570490
ELSE IF CN=TOV 20570500
THEN GO MIRID 20570510
ELSE IF CN NEQ COMMA 20570520
THEN GO POWIE 20570530
ELSE BEGIN 20570540
SETUP; 20570550
CHECK; PROG[CNT]:=@14; 20570560
PROG[CNT+1]:=FROMHLD; 20570570
CN:=SCAN; 20570575
CHECK; PROG[CNT]:=0; 20570577
GO NEXTL; 20570580
END; 20570590
END; 20570600
QUIT: 20571500
SETUP; BOTH; 20571600
STREAM(A:=TOHLD,B:=TOHLD.[42:6]-1,C:=TOHLD.[42:6]!0, %122-20571700
D:=[CMM[27]]); %122-20571702
BEGIN %122-20571710
SI:=LOC A; SKIP SB; %122-20571720
IF SB THEN %122-20571730
BEGIN %122-20571740
SKIP 39 SB; %122-20571750
IF SB THEN DS:=8 LIT"0FAST " %122-20571760
ELSE %122-20571770
BEGIN %122-20571780
SKIP SB; %122-20571782
IF SB THEN DS:=8 LIT"0SLOW " %122-20571790
ELSE %122-20571800
BEGIN %122-20571810
C(SI:=LOC B; %122-20571820
DS:=6 LIT"0EU # "; DS:=2 DEC; %122-20571830
JUMP OUT TO L); %122-20571840
DS:=8 LIT"0DISK "; %122-20571842
L: END %122-20571850
END %122-20571860
END %122-20571870
ELSE %122-20571880
BEGIN %122-20571890
SKIP 5 SB; %122-20571900
DS:=LIT"0"; DS:=7 CHR; %122-20571910
END; %122-20571920
END; %122-20571930
GO INIT; 20572100
POWIE: 20572200
IF DIDGETESPDISK THEN 20572210
BEGIN 20572220
IF CMM[19].[CF]!LIBNO THEN % MORE THAN ONE SEGMENT USED 20572300
BEGIN 20572400
DISKWAIT(-PROG.[CF],30,CMM[19].[CF]); 20572500
FORGETESPDISK(CMM[19].[CF]); 20572700
CMM[19]~PROG[29]; 20572800
GO POWIE; 20572900
END; 20573000
FORGETESPDISK(LIBNO); 20573100
END; 20573110
GO INCSC; 20573200
REMO: 20573300
IF XLST NEQ 0 THEN BEGIN FORGETSPACE(XLST); XLST:=0; END; %543-20573350
T1.[46:1] ~ ((CN ~ SCAN) = EQUAL); %552-20573400
IF T1.[46:1] THEN CMM[0]~-1 ELSE %552-20573402
IF CN GEQ IDENT THEN CMM[0]:=ACCUM[0] ELSE GO POWIE; 20573410
IF SCAN NEQ SLASH THEN GO POWIE; 20573420
T1.[47:1] ~ ((CN ~ SCAN) = EQUAL); %552-20573430
IF T1 THEN CMM[1]~-1 ELSE %552-20573432
IF CN GEQ IDENT THEN CMM[1]:=ACCUM[0] ELSE GO POWIE; 20573440
HME:=CMM[0].[1:1]~CMM[1].[1:1]; 20573450
XI:=-2; 20573460
IF (CN:=SCAN)=PERIO OR CN=COMMA 20573470
THEN HOLD1:=CN 20573480
ELSE BEGIN 20573490
IF CN=EXCEPT THEN CN:=SCAN; 20573500
IF CN=LB THEN IF HME NEQ 0 THEN ELSE GO POWIE 20573510
ELSE GO POWIE; 20573520
T1.[45:1] ~ 1; % FLAG FOR SCANEXCEPT. ON REMOVE = %552=20573525
SCANEXCEPT; 20573530
XLST.[8:10]:=X1+2; 20573540
HOLD1:=SCAN; 20573760
END; 20573770
CN:=T:=0; 20573850
IF (CMM[0] OR CMM[1]) LSS 0 THEN 20573900
SEEK: 20574000
SEEKNAM(CMM[0],CMM[1],CN,CMM[2],CMM[3],OPTN,XLST) ELSE 20574100
BEGIN 20574200
CMM[2]:=CMM[0]; 20574300
CMM[3]:=CMM[1]; 20574400
CN:=1; 20574500
END; 20574600
IF CN NEQ 0 20574700
THEN T:=IF SYSTEMFILE(CMM[2],CMM[3]) 20574750
THEN 2 20574800
ELSE DIRECTORYSEARCH(CMM[2],CMM[3],5) 20574850
ELSE IF OPTN NEQ 0 THEN GO OUTR; 20574875
IF T GEQ 64 THEN 20574900
BEGIN IF HOLD3:=NOT(M[T+4].[44:1]) THEN BEGIN FORGETSPACE(T); 20574905
T:=DIRECTORYSEARCH(CMM[2],CMM[3]&(UNITNO=25 OR UNITNO=30)20574910
[1:47:1],4); END; 20574915
IF T GEQ 64 THEN %508-20574917
IF M[T+4].[43:2]=3 THEN BEGIN FORGETSPACE(T); T:=1; END; 20574920
END; 20574922
IF CARD.[8:1] THEN GO DOWNR; 20574925
IF T LSS 2 20574950
THEN IF T=1 20575000
THEN LBMESS(ABS(CMM[2]),CMM[3],-7,45,0,SPOUTUNIT,LIBERR) 20575050
ELSE LBMESS(CMM[0],CMM[1],-7,15,0,SPOUTUNIT,LIBERR) %149-20575100
ELSE IF T=2 20575150
THEN LBMESS(CMM[2],CMM[3],-7,25,0,SPOUTUNIT,LIBERR) %149-20575200
ELSE IF T GEQ 64 20575250
THEN BEGIN 20575300
IF M[T+2] NEQ 0 AND (USERID EQV MCP) NEQ 20575350
NOT 0 AND (USERID EQV ABS(M[T+2])) NEQ 20575400
NOT 0 20575450
THEN BEGIN 20575500
LBMESS(CMM[2],CMM[3],-7,41, 20575550
0, SPOUTUNIT, LIBERR);%149-20575600
FORGETSPACE(DIRECTORYSEARCH(CMM[2],20575650
CMM[3],14)); 20575700
END 20575750
ELSE IF M[T+4].[43:2] NEQ 0 20575800
THEN BEGIN 20575850
DOWNR: IF NOT FIRSTIME THEN 20575900
BEGIN FIRSTIME:=1; 20576000
CMM[19]:=(LIBNO:= 20576050
GETESPDISK)&1[18:44:4]; 20576100
DIDGETESPDISK:=TRUE; 20576125
END; 20576150
M[T+4].[43:2]:=1; 20576200
DISKWAIT(T.[CF],30,T.[FF]); 20576210
IF HOLD3 THEN FORGETSPACE( 20576215
DIRECTORYSEARCH(CMM[2], 20576216
CMM[3],14)); 20576217
CHECK; 20576220
PROG[CNT]:=CMM[2]; 20576230
PROG[CNT+1]:=CMM[3]; 20576240
END 20576250
ELSE FORGETSPACE(DIRECTORYSEARCH(20576300
CMM[2],CMM[3],6 20576350
$ SET OMIT = NOT (PACKETS) 20576395
&SPOUTUNIT[9:9:9] 20576400
&SPOUTUNIT[24:42:6] 20576405
$ POP OMIT 20576410
)); 20576415
FORGETSPACE(T); 20576450
END; 20576475
IF CN NEQ 0 AND (CMM[0] OR CMM[1] LSS 0 THEN GO SEEK; 20576500
OUTR: IF (CN:=HOLD1)=COMMA THEN GO REMO; 20576600
IF CN=PERIO THEN 20576700
IF FIRSTIME THEN 20576710
BEGIN BOTH; 20576720
M[CARDLOC-2]:=0; 20576754
M[CARDLOC-1]:=10; 20576756
CMM[6]:=GETESPDISK & 10[18:33:15]; 20576758
$ SET OMIT = NOT(DATACOM AND RJE) 20576760
DISKWAIT(CARDLOC-2,11,CMM[6] INX 0); 20576768
GO INIT; 20576770
END 20576780
ELSE GO CCA 20576790
ELSE GO POWIE; 20576800
CHAN: 20576850
T:=0; % T USED AS BIT MASK FOR SYNTAX CHECK 20576900
FOR CN:=0 STEP 1 UNTIL 3 DO % SCAN INPUT REQUEST 20576925
BEGIN 20576950
OPTN := SCAN; 20576975
T := (OPTN=EQUAL) & T[43:44:4]; % SHIFT PREVIOUS VALUE LEFT 20577000
IF T THEN CMM[CN] := (-1) ELSE 20577025
IF OPTN GEQ IDENT THEN CMM[CN] := ACCUM[0] ELSE 20577050
GO TO INCSC; % INCORECT REQUEST 20577075
OPTN := SCAN; % SKIP "/","," OR ";" 20577100
END; % SCANNING INPUT REQUEST 20577125
IF (T NEQ 0) AND (T NEQ 5) AND (T NEQ 10) THEN GO INCSC; 20577150
% T=5 FOR =/<NAME1> TO =/<NAME2> 20577175
% T=10 FOR <NAME1>/= TO <NAME2>/= 20577200
% T=0 FOR <NAME1>/<NAME2> TO <NAME3>/<NAME4> 20577225
IF (REPEAT:=(T GTR 0)) THEN 20577250
BEGIN 20577275
HOLD1 := CMM[0]; HOLD2 := CMM[1]; TYM:=1; CN:=0; 20577300
LOOP: SEEKNAM(HOLD1,HOLD2,CN,CMM[1],CMM[1],HOLD3,P(0)); 20577325
IF CN = 0 THEN % NOT FOUND IN DIRECTORY 20577350
BEGIN 20577375
IF TYM = 1 THEN % FIRST PASS, NULL SEARCH 20577400
BEGIN 20577425
LBMESS(HOLD1, HOLD2, -5, 15, %NOT CHANGED, NOT ON DISK20577450
0, SPOUTUNIT, LIBERR); %149-20577475
END; 20577500
GO TO NEXT; 20577525
END; 20577550
TYM := 2; 20577575
IF HOLD1 LSS 0 THEN CMM[2] := CMM[0] ELSE 20577600
IF HOLD2 LSS 0 THEN CMM[3] := CMM[1]; % USE NAME "FOUND" 20577625
END; 20577650
IF (T:=DIRECTORYSEARCH(CMM[2],CMM[3],5)) NEQ 0 THEN 20577675
BEGIN 20577700
FORGETSPACE(T); 20577725
LBMESS(CMM[0], CMM[1], -5, 29, % NOT CHANGED, DUP FILE 20577750
0, SPOUTUNIT, LIBERR); %149-20577775
END ELSE 20577800
BEGIN 20577805
T:=IF SYSTEMFILE(CMM[0].CMM[1]) THEN 3 ELSE 20577810
DIRECTORYSEARCH(CMM[0],CMM[1],5); 20577815
IF T GEQ 64 THEN 20577820
BEGIN IF NOT(M[T+4].[44:1]) THEN BEGIN FORGETSPACE(T); 20577823
T~DIRECTORYSEARCH(CMM[0],CMM[1]&(P(UNITNO,DUP)=25 OR 20577826
P(XCH)=30)[1:47:1],4); END; %508-20577827
IF T GEQ 64 THEN %508-20577828
IF M[T+4].[43:2]=3 THEN BEGIN FORGETSPACE(T); T:=1; 20577829
END; 20577832
END; 20577833
IF T LXX 2 THEN 20577835
LBMESS(CMM[0],CMM[1],-5,15+((T=1)|30), % NOT CHANGED 20577875
% 45 = IN USE, 15 = NOT ON DISK 20577900
0, SPOUTUNIT, LIBERR) %149-20577925
ELSE IF T=2 THEN 20577950
LBMESS(CMM[0], CMM[1], -5, 25, % NOT CHANGED, SYSTEM FILE 20577975
0, SPOUTUNIT, 1 ) % 20578000
ELSE IF M[T+2] NEQ 0 AND % NOT FREE FILE 20578025
(USERID EQV MCP) NEQ NOT 0 AND % NOT MCP 20578050
(USERID EQV ABS(M[T+2])) NEQ NOT 0 THEN % NOT CREATOR 20578075
BEGIN 20578100
LBMESS(CMM[0], CMM[1], -5, 41, % NOT CHANGED, INVALID USER 20578125
0, SPOUTUNIT, 1 ); % 20578150
IF M[T+4].[43:2] NEQ 1 THEN 20578175
FORGETSPACE( DIRECTORYSEARCH(CMM[0], CMM[1], 14 ) ); 20578200
FORGETSPACE(T); 20578210
END 20578225
ELSE 20578250
BEGIN % CHANGE OK 20578275
M[T+4]:=(*P(DUP))&3[1:46:2]; 20578300
T:=T&EUF(-CMM[2],CMM[3],T INX 0-1)[18:33:15]; 20578375
FORGETSPACE(DIRECTORYSEARCH(CMM[0],CMM[1],8)); 20578400
HEADERUNLOCK(CMM[2],CMM[3],T); 20578425
$ SET OMIT = PACKETS 20578450
LBMESS(CMM[0], CMM[1], 52, % CHANGED TO 20578525
CMM[2], CMM[3], SPOUTUNIT, LIBMSG); 20578550
PBCOUNT:=PBCOUNT-((((CMM[0] EQV "PBD ")=NOT 0) OR 20578575
((CMM[0] EQV "PUD ")=NOT 0)) AND (CMM[1].[CF]=1)) 20578600
+((((CMM[2] EQV "PBD ")=NOT 0) OR 20578625
((CMM[2] EQV "PUD ")=NOT 0)) AND (CMM[3],[CF]=1)); 20578650
END; 20578675
END; 20578685
IF REPEAT THEN GO TO LOOP; % FIND REMAINING FILES 20578700
NEXT: 20578725
IF OPTN=COMMA THEN GO CHAN; 20578900
IF OPTN=PERIO THEN GO TO CCA ELSE GO INCSC; 20579000
INIT: CCLIB:=LIBNO; GO CCA; 20579100
INCSC: CCLIB:=1; 20579200
CCA: CADDR:=CDEX:=0; 20579300
IF XLST NEQ 0 THEN FORGETSPACE(XLST); 20579302
IF (LIBNO:=PROCVAL).[CF] GTR 1 THEN PROCVAL:=2 ELSE 20579305
IF LIBNO THEN PROCVAL:=6 ELSE PROCVAL:=0; 20579310
RETURNVAL:=PROCVAL; 20579330
P([RETURNRCW],STS,0,RDS,0,XCH,P&P[CTF],STF); 20579340
END; % CCLIB PROCEDURE 20579350
REAL PROCEDURE CCSET; FORWARD; 20579400
PROCEDURE CCFINISH; 20579800
BEGIN 20579852
DECLARECCVARIABLES; 20581000
REAL TEMP = RETURNRCW+1; % BEGIN LOCALS OF CCFINISH 20581080
P(RCW,MYMSCW,STF); 20581125
RCW:=RCW & P(XCH)[CTC]; 20581130
P(0); % ZERO LOCAL OF CCFINISH 20581140
PPCPROCESS:=0; 20581150
CN:=T; 20581200
IF OPTN = PERIO OR OPTN = LIBRA THEN 20581250
BEGIN 20581300
CMM[22]:= PROG[22]; 20581350
PROG[2].[CF]:= IF PROG[18] > 32767 THEN 32767 20581400
ELSE PROG[18]; 20581450
IF PROG[20] > 512 THEN PROG[20]:= 512; 20581500
IF PADDR NEQ 0 THEN 20581550
BEGIN 20581600
PEQN[29]:= 0; 20581650
IF PDEX=0 THEN PEQN[0]:=14; 20581700
IF PDEX=1 THEN PEQN[14]:= 14; 20581750
DISKWAIT(PEQN.[CF],30,PADDR); 20581800
END; 20581850
PROG[29]:= 0; 20581900
CMM[2].[FF]:=NT1:=GETESPDISK; 20581950
DISKWAIT(PROG.[CF],30,NT1); 20582000
END; 20582050
IF CADDR NEQ 0 THEN 20582100
BEGIN 20582150
CEQN[29]:= 0; 20582200
IF CDEX=0 THEN CEQN[0]:= 14; 20582250
IF CDEX=1 THEN CEQN[14]:= 14; 20582300
DISKWAIT(CEQN.[CF],30,CADDR); 20582350
END; 20582400
COMPLEXSLEEP((SCHEDULEIDS!NOT 0) AND SHEETFREE); 20582440
LOCKTOG(SHEETMASK); 20582450
CDEX:= GETESPDISK; 20582500
CMM[2].[CF]:= IF CMM[18] > 32767 THEN 32767 ELSE CMM[18]; 20582550
PDEX:= IF CMM[18] > MIXMAX THEN MIXMAX ELSE CMM[18]; 20582600
IF LIBNO NEQ 0 THEN CMM[19]:= LIBNO; 20582650
STREAM(A:=0:S:=P(.SCHEDULEIDS)); 20582750
BEGIN SI:=S; 20582800
47(SKIP SB; SKIB DB; TALLY:=TALLY+1; 20582850
IF SB THEN BEGIN END ELSE JUMP OUT); 20582900
DS:= SET; A:= TALLY; 20582950
END STREAM; 20583000
TEMP:= P; CMM[3]:= 0&TEMP[8:38:10]; 20583050
CMM[23].[24:24]~(CLOCK+P(RTR))DIV 60; 20583100
IF SHEET[PDEX].[CF] NEQ 0 THEN 20583150
BEGIN 20583200
DISKWAIT(-PROG.[CF],30,PADDR:=SHEET[PDEX].[FF]); 20583250
PROG[29]:= CDEX; 20583300
DISKWAIT(PROG.[CF],30,PADDR); 20583350
END; 20583400
ELSE SHEET[PDEX]:= CDEX; 20583450
SHEET[PDEX].[18:15]:= CDEX; 20583500
CMM[29]:= 0; 20583550
DISKWAIT(CMM.[CF],30,CDEX); 20583600
UNLOCKTOG(SHEETMASK); 20583650
T:= CN; 20583700
P([RETURNRCW],STS,0,RDS,0,XCH,P&P[CTF],STF); 20583710
END CCFINISH; 20583750
REAL PROCEDURE CCCOMPILE; 20583800
BEGIN COMMENT SETUP OF COMPILER LABEL EQUATION CODE: PN1/PN2; 20583860
DECLARECCVARIABLES; 20584000
REAL SUBROUTINE SCAN; 20584150
SCAN~SCN[UNITNO,CARDLOC,SOURCE,ACCUM,KOUNT,LASTSCAN,DIRECT); 20584200
LABEL SKN,EXIT; 20584250
DEFINE ZIPMIX=CARD.[18:6]#; 20584275
DEFINE DISKTYPE = 10#;% 20584300
P(RCW,MYMSCW,STF); 20584325
RCW:=RCW & P(XCH)[CTC]; 20584330
CCCOMPILE~0; %510-20584340
T:=SCAN;% 20584350
CEQN[0]:=ACCUM[0]; 20584400
T:=SCAN;% 20584450
T:=SCAN;% 20584500
CEQN[1]:=ACCUM[0];% 20584550
CEQN[2]:=0;% 20584600
CEQN[3]:=DISKTYPE;% 20584650
CEQN[4]:=@423462425606060;% 20584700
CEQN[12]:=0; % EU/SPEED CELL % (SHM)20584710
CDEX :=1;% 20584750
IF ((UNITNO+1)AND 24)=24 OR UNITNO GEQ 32 THEN% 20584800
BEGIN CEQN[14]:=CEQN[16]:=CEQN[17]:=0;% 20584850
CEQN[15]:= "CARD 00" OR ((IF UNITNO GEQ 32 THEN% 20584900
"C/" ELSE @5772) + UNITNO);% 20584950
CEQN[18]:=@423215124000000; CDEX:=2;% 20585000
IF UNITNO GEQ 32 THEN CIDROW[UNITNO-32].[3:5]:=1 ELSE% 20585050
IF UNITNO=23 THEN READERA.[FF] ~ 1 ELSE 20585100
IF UNITNO=24 THEN READERB.[FF] ~ 1; 20585125
END; 20585150
WHILE (CN:=SCAN) LSS ALGOL OR CN GTR COBOL DO 20585200
IF CN=PERIO THEN BEGIN CCCOMPILE:=1; GO EXIT END; 20585250
IF CN=WITH THEN 20585300
IF (CN~SCAN)=PERIO THEN BEGIN CCCOMPILE~1; GO EXIT END; 20585350
IF CN<ALGOL OR CN>COBOL THEN 20585355
IF(T:=DIRECTORYSEARCH(ACCUM[0],"DISK ",5))!0 THEN 20585360
BEGIN IF NOT M[T+4].[8:1] THEN 20585365
BEGIN LBMESS(ACCUM[0],"DISK ",-22,0, 20585370
0, SPOUTUNIT, LIBERR); %149-20585375
FORGETSPACE(T); CCCOMPILE~1; GO EXIT; 20585380
END; FORGETSPACE(T); 20585385
END; 20585390
COMMENT SET UP NOMICAL VALUES FOR PROGRAM PARAMETERS;% 20585400
CMM[0]:=-(CMPLR:=ACCUM[0]); CMM[1]:=CEQN[0]; 20585450
CMM[2]:=0; 20585500
CMM[13]:= CADDR:= GETESPDISK; 20585550
$ SET OMIT = PACKETS 20585599
$ SET OMIT = NOT(PACKETS) 20585609
CMM[23]:=0&CARD[9:9:9]&(IF ZIPMIX NEQ 0 THEN PSEUDOMIX[ZIPMIX]20585610
ELSE UNITNO)[2:42:6]; 20585620
$ POP OMIT 20585621
CMM[27]:=CEQN[1]; %FID FOR SCHED MESS. 20585630
% GET OPTION (GO,SYNTAX CHECK, OR LIBRARY) 20585650
SKN: DO OPTN:=SCAN UNTIL OPTN=PERIO OR OPTN=SYNTA OR OPTN=LIBRA 20585700
OR OPTN=QUEST; % IN CASE OF HYPHEN IN COMMENT PORTION 20585705
IF OPTN=QUEST THEN 20585710
IF SOURCE=(CARDLOC&1[30:45:3]) THEN 20585715
BEGIN 20585720
OPTN:=PERIO; SOURCE:=CARDLOC; 20585725
END ELSE GO TO SKN; 20585730
CMM[2].[8:10] := IF OPTN=PERIO THEN 1 ELSE 20585750
IF OPTN=SYNTA THEN 3 ELSE 4;%(OPTN=LIBRA) 20585800
IF OPTN NEQ SYNTA THEN 20585850
% SET UP PROG ARRAY FOR COMPILE AND GO OR COMPILE TO LIBRARY JOBS 20585900
BEGIN 20585950
PROG[0]:= CEQN[0]; 20586000
PROG[1]:= CEQN[1]; 20586050
PROG[2]:=PROG[15]:= 0; 20586100
PROG[16]:=PROG[17]:= @377777777777; 20586150
PROG[18]:= (MIXMAX+1) DIV 2; 20586200
PROG[19]:= 0; 20586250
PROG[20]:= -1; 20586300
PROG[21]:= 512; 20586350
PROG[22]:= 10; 20586400
PROG[23]:= CMM[23]; 20586450
PROG[24]:= USERID; 20586500
END; 20586550
EXIT: RETURNVAL:=PROCVAL; % ADJUST RESULT OF TYPED PROC 20586600
P([RETURNRCW],STS,0,RDS,0,XCH,P&P[CTF],STF); 20586625
END CCCOMPILE; 20586650
REAL PROCEDURE INITIALIZEIT; 20586700
BEGIN LABEL TRYAGAIN,LS,SPLAT,SPOT,EXIT; 20586715
DECLARECCVARIABLES; 20586800
REAL CMM1 = RETURNVAL+1; % BEGIN LOCAL TO INITIALIZEIT 20586950
REAL SUBROUTINE SCAN; 20587050
SCAN~SCN(UNITNO,CARDLOC,SOURCE,ACCUM,DOUNT,LASTSCAN,DIRECT); 20587100
P(RCW,MYMSCW,STF); 20587110
RCW:=RCW & P(XCH)[CTC]; 20587120
P(0); % ZERO LOCAL TO INITIALIZEIT 20587130
PROG[13]:=PADDR:=PDEX:=0; % IN CASE PROGRAM NOT IN DIRECTORY 20587150
TRYAGAIN: 20587170
IF (T:=DIRECTORYSEARCH(ABS(CMM[0]),CMM1:=IF CMM[0] LSS 0 THEN 20587200
"DISK " ELSE CMM[1],3))=0 THEN 20587250
BEGIN 20587300
IF CMM[2].SSYSJOBF = LIBMAINCODE THEN 20587310
BEGIN 20587330
INTERSYSFILE(1); 20587340
GOTRYAGAIN; 20587350
END; 20587360
IF CARD.[9:9]=0 THEN GO TO LS; 20587370
$ SET OMIT = NOT(DATACOM) 20587399
BEGIN 20587500
LS: LBMESS(ABS(CMM[0]),CMM1,-15,0,0,SPOUTUNIT,LIBERR); %149-20587550
SPLAT: 20587650
IF UNITNO GEQ 32 THEN BEGIN INITIALIZEIT:=5;GO EXIT END; 20587700
END; 20587750
DO T~SCAN UNTIL T>IDENT AND T{RESETV; 20587800
IF UNITNO=31 THEN BEGIN INITIALIZEIT:=7; GO EXIT; END; 20587850
INITIALIZEIT:=1; GO EXIT; 20587950
END; 20587975
IF M[T INX 4].[9:2]=2 THEN 20588000
BEGIN FORGETSPACE(T); 20588010
GO TO SPOT; 20588020
END; 20588030
IF SECURITYCHECK(ABS(CMM[0]), 20588050
CMM1.USERID,T)=0 THEN 20588100
BEGIN 20588150
OPTN:=0; CMM[2]:=T; 20588200
P(DIRECTORYSEARCH(NABS(CMM[0]),CMM[1]:=CMM1,13),DEL); 20588250
INITIALIZEIT:=4; 20588350
GO TO EXIT; 20588360
END; 20588370
DISKIO(N1,-(PEQN INX 0-1),30,M[T+10]); 20588400
P(M[T INX 4].[9:2]=3); FORGETSPACE(T);%NOTE FOR BELOW 20588450
CMM[24]:= USERID; 20588500
CMM[25]:= T.[FF]; 20588550
SLEEP([N1],IOMASK); 20588600
FOR T:=1 STEP 1 UNTIL 4 DO 20588650
IF (NOT ABS(PEQN[T]&0[CTC])) NEQ NOT 0 THEN T:= 7; 20588700
IF PEQN[3] GEQ 0 THEN % SKIP IF RESTART FILE %106-20588701
IF ABS(PEQN[3])>1023 THEN P(DEL,T~0); % PRT>1023 NO WAY%202-20588702
$ SET OMIT = NOT(BREAKOUT) 20588710
$ SET OMIT = BREAKOUT 20588730
IF PEQN[3].[1:1] THE NP(DEL,T:=0);% CAN-T RESTART; 20588740
$ POP OMIT 20588745
IF PEQN[2].[3:1] THEN % I.P.C. %110-20588746
IF(PEQN[8]>2) THEN P(DEL,T~0); % I.P.C. - NEEDS PARAMETERS 20588747
IF NOT (P OR T) THEN %NOT CODE 20588750
BEGIN 20588800
SPOT: LBMESS(ABS(CMM[0]),CMM1,-19,0,0,SPOUTUNIT,LIBERR); %149-20588900
P(DIRECTORYSEARCH(NABS(CMM[0]),CMM1,13),DEL); 20589000
GO TO SPLAT; 20589150
END; 20589200
IF PEQN[6] LSS 0 THEN FOR T:=15 STEP 1 UNTIL 22 DO 20589250
CMM[T]:=PEQN[T] ELSE 20589300
BEGIN 20589350
CMM[15]:= 0; 20589400
CMM[16]:= CMM[17]:= @377777777777; 20589450
CMM[18]:=(MIXMAX-1) DIV 2; 20589460
CMM[19]:= 0; 20589470
CMM[20]:= PEQN[7].[FF]; 20589480
CMM[21]:= 512; 20589490
END; 20589500
INITIALIZEIT:=3; 20589550
EXIT: RETURNVAL:=PROCVAL; % ADJUST RESULT OF TYPED PROC 20589600
P([RETURNRCW],STS,0,RDS,0,XCH,P&P[CTF],STF); 20589610
END INITIALIZEIT; 20589650
REAL PROCEDURE CCUNIT; 20589700
BEGIN LBEL U1,ERROR,EXIT; 20589720
DECLARECCVARIABLES; 20589800
REAL SUBROUTINE SCAN; 20589950
SCAN~SCN(UNITNO,CARDLOC,SOURCE,ACCUM,KOUNT,LASTSCAN,DIRECT); 20590000
P(RCW,MYMSCW,STF); 20590010
RCW:=RCW & P(XCH)[CTC]; 20590020
T:= SCAN; CN:= ACCUM[0]; 20590050
T~SCAN; IF T!EQUAL THEN GO ERROR; 20590100
FOR T:= 0 STEP 1 UNTIL 31 DO 20590150
IF CN.[6:18]=TINU[T].[30:18] THEN GO TO U1; 20590200
GO ERROR; 20590250
U1: IF LABELTABLE[T] NEQ @314 THEN BEGIN CCUNIT:=6; GO EXIT END; 20590300
CN:= SCAN; 20590350
MULTITABLE[T]:=RDCTABLE[T]:=0; 20590400
LABELTABLE[T]:= ACCUM[0]; 20590450
IF (CN:= SCAN) = SLASH THEN 20590500
BEGIN MULTITABLE[T]:= LABELTABLE[T]; 20590550
CN~SCAN; LABELTABLE[T]~ACCUM[0]; CN~SCAN; 20590600
END; 20590610
IF CN=COMMA THEN 20590650
BEGIN IF(CN~SCAN)!IDENT OR KOUNT>3 THEN GO ERROR; 20590655
STREAM(R~0:KOUNT,ACCUM); 20590660
BEGIN SI~ACCUM;SI~SI+1;DI~LOC R;DS~KOUNT OCT END; 20590665
RDCTABLE[T]~P(XCH,RDCTABLE[T])&P(XCH)[14:38:10]; 20590668
IF(CN~SCAN)=COMMA THEN 20590670
BEGIN IF(CN~SCAN)!IDENT OR KOUNT>5 THEN GO ERROR; 20590675
STREAM(R~0:KOUNT,ACCUM); 20590680
BEGIN SI~ACCUM;SI~SI+1;DI~LOC R;DS~KOUNT OCT END; 20590685
RDCTABLE[T]~P(XCH,RDCTABLE[T])&P(XCH)[24:31:17]; 20590688
IF(CN~SCAN)=COMMA THEN 20590690
BEGIN IF(CN~SCAN)!IDENT OR KOUNT>2 THEN GO ERROR; 20590695
STREAM(R~0:KOUNT,ACCUM); 20590700
BEGIN SI~ACCUM;SI~SI+1;DI~LOC R;DS~KOUNT OCT END; 20590705
RDCTABLE[T]~P(XCH,RDCTABLE[T])&P(XCH)41:41:17]; 20590710
END %CYCLE 20590715
END %CREATION DATE 20590720
END; %REEL NUMBER 20590725
IF CN! PERIO THEN DO CN~SCAN UNTIL CN=PERIO;CCUNIT~0;GO EXIT; 20590730
ERROR: CCUNIT~6; 20590740
EXIT: RETURNVAL:=PROCVAL; % ADJUST RESULT OF TYPED PROC 20590750
P([RETURNRCW],STS,0,RDS,0,XCH,P&P[CTF],STF); 20590751
END CCUNIT; 20590800
REAL PROCEDURE CCSECMAINT; 20590850
BEGIN LABEL EXIT,CCC; 20590910
DECLARECCVARIABLES; 20591000
REAL SUBROUTINE SCAN; 20591350
SCAN~SCN(UNITNO,CARDLOC,SOURCE,ACCUM,KOUNT,LASTSCAN,DIRECT); 20591400
LABEL OPTNO,OPTN,OPTN2,SEC1,SEC2,SEC5,ST1, 20591500
ST2,LS; 20591550
SWITCH SW:=OPTNO,OPTN1,OPTN2; 20591600
P(RCW,MYMSCW,STF); 20591610
RCW:=RCW & P(XCH)[CTC]; 20591620
GO TO SW[OPTNN]; 20591650
OPTNO: USERID:= ABS(USERID); 20591700
IF SCAN LSS IDENT THEN BEGIN CCSECMAINT:=6;GO EXIT END; 20591750
SMID:= CMM[0]:= ACCUM[0]; CN:=SCAN; 20591800
IF SCAN LSS IDENT THEN BEGIN CCSECMAINT:=6; GO EXIT END; 20591850
SFID:= CMM[1]:= ACCUM[0]; CDEX:= 0; 20591900
IF (SFH:=DIRECTORYSEARCH(SMID,SFID,4))=0 THEN GO TO LS; 20591950
IF NOT(SYSTEMFILE(CMM[CDEX] ,CMM[CDEX+1]) OR 20592000
(SMID EQV "PBD ")=NOT 0) AND (M[SFH+5]=0 20592050
AND M[SFH+2] NEQ 0) THEN 20592100
% INHIBIT USE ON PUBLIC, SECURE FILES 20592150
BEGIN CN:=SCAN; GO TO OPTN2 END; 20592200
OPTN:=0; CMM[2]:= SFH; 20592250
P(DIRECTORYSEARCH(NABS(CMM[0]),CMM[1],14),DEL); 20592300
OPTN1: STREAM(USERID,Q:=USERID>0,B:=[CMM],D:=CN:=SPACE(10)); 20592400
BEGIN Q(SI:=LOC USERID; SI:=SI+1;DS:=LIT " "; DS:= 7CHR;); 20592450
DS:= 17LIB " INVALID USER OF "; SI:=B; 20592500
SI:=SI+1; DS:= 7CHR; DS:=LIT "/"; SI:=SI+1; DS:= 7CHR; 20592550
DS:=LIT"~"; 20592600
END STREAM; 20592650
SPOUTER( CN&CARD[9:9:9], SPOUTUNIT, 1 ); % 20592700
FORGETSPACE(CMM[2]); 20592725
IF OPTN NEQ 0 THEN GO TO SEC5; 20592750
IF UNITNO GEQ 32 THEN BEGIN CCSECMAINT:=5;GO EXIT END; 20592800
GO TO CCC; 20592850
OPTN2: CMM[5]:=USERID; 20592900
ST:= CDEX:= 0; 20592950
SEC1: FOR OPTN:=0 STEP 1 UNTIL 1 DO 20593000
BEGIN CN:=SCAN; 20593050
IF T=OPEN AND CN=UNLOCKV AND OPTN=0 THEN 20593060
BEGIN T:=UNLOCKV; GO TO SEC1 END 20593100
ELSE IF CN LSS IDENT AND CN NEQ EQUAL THEN GO TO ST1; 20593150
CMM[OPTN]:= IF CN=EQUAL THEN -1 ELSE ACCUM[0]; 20593200
CN:=SCAN; 20593250
END; 20593300
IF CN=WITH THEN BEGIN CN~SCAN;CMM[6]~IF CN}IDENT THEN ACCUM[0] 20593310
ELSE USERID; CN~SCAN END ELSE CMM[6]~USERID; 20593320
IF CMM[0] GEQ 0 AND CMM[1] GEQ 0 THEN GO TO SEC2; 20593350
N1:= CMM[0]; N2:= CMM[1]; N3:= 0; ST:= 1; 20593400
ST2: SEEKNAM(N1,N2,N3,CMM[0],CMM[1],T1,P(0)); 20593450
IF N3 NEQ 0 THEN GO TO SEC2; 20593500
ST:= 0; GO TO SEC5; 20593550
SEC2: IF (ABS(USERID)EQV MCP) NEQ NOT 0 THEN 20593600
IF SYSTEMFILE(CMM[CDEX],CMM[CDEX+1]) OR 20593650
(CMM[0] EQV "PBD ")= NOT 0 THEN GO SEC5; 20593700
SECURITYMAINT(T,SMID,SFID,CMM,SFH,SPOUTUNIT); 20593750
SEC5: IF ST THEN GO TO ST2; 20593800
IF CN=COMMA THEN GO SEC1; 20593850
IF T=USEV THEN 20593900
HEADERUNLOCK(SMID,SFID,SFH); 20593950
GO TO CCC; 20594000
LS: LBMESS(CMM[0],CMM[1],-15,0,0,SPOUTUNIT,LIBERR); %149-20594350
IF UNITNO GEQ 32 THEN BEGIN CCSECMAINT:=5; GO EXIT END; 20594400
CCC: DO T~SCAN UNTIL T>IDENT AND T{RESETV; 20594450
IF UNITNO=31 THEN BEGIN CCSECMAINT:=7; GO EXIT; END; 20594500
CCSECMAINT:=1; GO EXIT; 20594550
ST1: IF T=USEV THEN 20594600
HEADERUNLOCK(SMID,SFID,SFH); 20594650
CCSECMAINT:=6; 20594700
EXIT: RETURNVAL:=PROCVAL; % ADJUST RESULT OF TYPED PROC 20594750
P([RETURNRCW],STS,0,RDS,0,XCH,P&P[CTF],STF); 20594751
END CCSECMAINT; 20594800
REAL PROCEDURE CCLABEL; 20594850
BEGIN LABEL EXIT; 20594870
DECLARECCVARIABLES; 20595000
P(RCW,MYMSCW,STF); 20595080
RCW:=RCW & P(XCH)[CTC]; 20595090
CN:=0; 20595150
UNITCODE[UNITNO-23]:= USERID; 20595200
MULTITABLE[UNITNO]:= 0; 20595250
RDCTABLE[UNITNO]:= 1&1[14:38:10]; 20595300
IF UNITNO=23 THEN BEGIN CN:=READERA.[FF];READERA:=CARDLOC END 20595350
ELSE IF UNITNO=24 THEN BEGIN CN:=READERB.[FF];READERB:=CARDLOC END 20595400
ELSE IF UNITNO GEQ 32 THEN BEGIN CN:= CIDROW[UNITNO-32].[3:5]; 20595450
CIDROW[UNITNO-32].[3:5]:= 0; 20595500
CIDROW[UNITNO-32].[18:15]:= CARDLOC; 20595550
M[CARDLOC-4].[3:6]:=20;M[CARDLOC-3]:=UNITNO-32; 20595560
END; 20595600
IF CN THEN BEGIN LABELTABLE[UNITNO]:= "CARD 00" OR 20595650
((IF UNITNO GEQ 32 THEN "C/" ELSE @5772 + UNITNO); 20595700
CCLABEL:=8; GO EXIT; 20595750
END; 20595800
IF T = LABEV THEN BEGIN 20595850
MULTITABLE[UNINTO]:=M[CARDLOC+1].[6:42]; 20595900
STREAM(A:=0,B:=0,C:=0:D:=CARDLOC+3); 20595950
BEGIN DI:=LOC A; SI:=D;DS:=3OCT; 20596000
DS:=5OCT; DS:=2OCT; END; 20596050
P(P(XCH)&P[24:31:17]&P(XCH)[14:38:10], 20596100
[RDCTABLE[UNITNO]],~);% 20596150
LABELTABLE[UNITNO]:=M[CARDLOC+2].[6:42]; 20596200
END 20596250
ELSE IF SCN(UNITNO,CARDLOC,SOURCE,ACCUM,KOUNT,LASTSCAN,DIRECT) 20596300
GEQ IDENT THEN LABELTABLE[UNITNO]:=ACCUM[0] 20596350
ELSE BEGIN IF UNITNO GEQ 32 THEN 20596400
CIDROW[UNITNO-32].[18:15]:=0; 20596450
CCLABEL:=6; GO EXIT; 20596500
END; 20596550
CCLABEL:=6; 20596600
EXIT: RETURNVAL:=PROCVAL; % ADJUST RESULT OF TYPED PROC 20596650
P([RETURNRCW],STS,0,RDS,0,XCH,P&P[CTF],STF); 20596651
END CCLABEL; 20596700
BOOLEAN PROCEDURE CCFIND; 20596750
BEGIN LABEL FINDX; 20596760
DECLARECCVARIABLES; 20596800
P(RCW,MYMSCW,STF); 20596945
RCW:=RCW & P(XCH)[CTC]; 20596947
IF T=ENDFI THEN BEGIN P(0); GO TO FINDX END; 20596950
IF T=DATAV THEN BEGIN P(1); GO TO FINDX; END; 20597000
IF T=LABEV THEN BEGIN P(1); GO TO FINDX; END; 20597050
$ SET OMIT = NOT(DCSPO AND DATACOM ) 20597100
FINDX: CCFIND:=P; 20597450
RETURNVAL:=PROCVAL; % ADJUST RESULT OF TYPED PROC; 20597459
P([RETURNRCW],STS,P&RCW[CTC],0,RDS,0,XCH,P&P[CTF],STF); 20597460
END CCFIND; 20597500
PROCEDURE CONTROLCARD(CARD); VALUE CARD; REAL CARD; 20597550
BEGIN 20597600
LABEL CC,CCTYPE,COMPILE,INITIALIZATION,BEFORETRYNEXT,TRYNEXT, 20597650
CONTROLER,CONTROLA,COMPILEJOB,COMJOB,EXEC,EXRUN,RUN, 20597700
USERS,USES,SECBOMB,UNLOX,LOX,FREES,OPENS,ENTE, 20597750
LCOPY,CHANGE,REMOVE,UNITI,INCSC,ENDF,ENDECK,SAVENO, 20597800
LABE,FINIS,ZIPEXIT,EXIT,SET,RSET,DOWN; 20597850
LABEL CCC,PACK,PACK2,WAIT,ZIPLIST; 20597880
SWITCH TYPE~ UNLOX,USES,LOX,FREES,OPENS,PACK,USERS, 20597900
RUN,COMPILE,EXEC,LCOPY,LCOPY,LCOPY,ENTE,ENTE,REMOVE, 20597950
CHANGE,UNITI,ENDF,WAIT,LABE,LABE,SET,RSET; 20598000
SWITCH SW~ CC,CCTYPE,INITIALIZATION,BEFORETRYNEXT,SECBOMB,ENDECK, 20599000
INCSC,ZIPEXIT,EXIT,PACK2; 20599100
DEFINE ZIPMIX=CARD.[18:6]#, PSOURCE=CARD.[24:6]#; 20600000
DECLARECCVARIABLES; 20600010
REAL SUBROUTINE SCAN; 20600020
SCAN:=SCN(UNITNO,CARDLOC,SOURCE,ACCUM,KOUNT,LASTSCAN,DIRECT); 20600040
$ SET OMIT = NOT(PACKETS) 20600099
SUBROUTINE LISTHECARD; 20600100
IF LASTSCAN.[2:1] THEN 20600110
IF SPOUTUNIT.[CF] GEQ 32 THEN 20600120
IF T!PACKET THEN 20600130
BEGIN 20600140
LASTSCAN.[2:1]:=0; ABORT:=CARDLOC; 20600150
IF UNITNO=31 THEN 20600160
STREAM(E:="END....", CARDLOC); 20600170
BEGIN SI:=CARDLOC; DI:=LOC E; DI:=DI+1; 20600180
L1: IF SC=" " THEN BEGIN SI:=SI+1; GO L1; END; 20600190
IF SC="~" THEN GO FINI; 20600200
IF SC=ALPHA THEN 20600210
IF SC="E" THEN 20600220
BEGIN 20600230
IF 3 SC=DC THEN IF SC=ALPHA THEN ELSE 20600240
BEGIN 20600250
CARDLOC:=SI; DI:=CARDLOC; DS:=LIT"~"; 20600260
GO FINI; 20600270
END; 20600280
SI:=SI-3; DI:=DI-3; GO L2; 20600290
END ELSE % ALPHANUMERIC 20600300
BEGIN 20600310
L2: SI:=SI+1; IF SC=ALPHA THEN GO L2; 20600320
END ELSE % SPECIAL CHR 20600330
SI:=SI+1; 20600340
GO L; 20600350
FINI: 20600360
END; 20600370
ZIPLIST: 20600380
STREAM(EOS:=0; CARDLOC:=[ABORT], PC:=PPCPROCESS, 20600390
ZZP:=UNITNO=31, D:=NT1:=SPACE(10)); 20600400
BEGIN SI:=CARDLOC; SI:=SI+5; SI:=SC; 20600410
DS:=LIT">"; PPC(DS:=4LIT">"); ZZP(DS:=2LIT">"); 20600420
2(36(IF SC="~" THEN JUMP OUT 2 TO DUN; 20600425
ZZP(IF SC="1" THEN BEGIN DS:=CHR; 20600430
LUP: IF SC=" " THEN BEGIN SI:=SI+1; GO LUP; END; 20600435
JUMP OUT 3 TO AGN; END); 20600440
DS:=CHR)); 20600445
AGN: TALLY:=1; EOS:=TALLY; 20600450
DUN: DS:=LIT"~"; 20600455
ZZP(D:=SI; SI:=LOC D; DI:=CARDLOC; DS:=WDS); 20600460
END; 20600465
SPOUTER(NT1,SPOUTUNIT,64); 20600470
IF P AND (UNITNO=31) THEN 20600480
GO Z;PLIST; 20600490
ABORT:=0; 20600500
END LISTHECARD; 20600510
$ POP OMIT 20600511
P(0,0,0,0,0,0,0,0,0,0);% 20600600
P(0,0,0,0,0,0,0,0,0,0);% 20600650
P(0,0,0,0,0,0,0,0,0,0);% 20600700
P(0,0,0,0); 20600750
% DO NOT ZERO THE LAST THREE LOCALS (RETURN-MSCW, RCW, & VAL) 20600755
RCW:=RCW & P1(..CONTROLCARD,LOD)[CTC]; 20600760
UNITNO := CARD.[2:6]; 20600850
IF CARD.[33:15] = 0 THEN 20600900
BEGIN CARD.[33:15] := GETSPACE(13,0,0)+4; 20600950
IF WAITIO(CARD INX @40000000,@15,UNITNO).[45:3] NEQ 0% 20601000
THEN 20601050
BEGIN LABELTABLE[UNITNO] := @114;% 20601100
RRRMECH := NOT TWO (UNITNO) AND RRRMECH;% 20601150
FORGETSPACE(CARD INX NOT 1);% 20601200
KILL([MSCW]); 20601250
END; 20601300
END; 20601350
COMMENT GET OWN STACK AND GET RID OF INDEPENDENT STACK;% 20601400
COMMENT SET UP ACCUM ARRAY FOR SCAN;% 20601450
ACCUM:=[M[SPACE(10)]]&10[8:38:10];% 20601500
ACCUM[0] := 0;% 20601550
IF (CCTBLWORD:=P(CCTBLWORD,DUP)&(P.[FF]+1)[CTF]).[FF]>1 THEN 20601600
BEGIN 20601620
IF CCTBLADDR=0 THEN SLEEP([CCTBLWORD],@77777); 20601640
DIRECT:=[C[CCTBLWORD]]&CCTABLSZ[8:38:10]; 20601660
END ELSE 20601680
BEGIN 20601700
DIRECT:=[M[T:=SPACE(CCTABLSZ)]]&CCTABLSZ[8:38:10]; 20601720
DISKWAIT(-T,CCTABLSZ,MESSAGETABLE[3].[22:26]); 20601740
CCTABLDDR:=T; 20601760
END; 20601780
CMM:=[M[GETSPACE(130,2,0)+2]]&30[8:38:10];% 20601850
PEQN:=(31 INX (CEQN:=(31 INX(PROG:=(31 INX CMM)))));% 20601900
% PLACE "." IN COL 73 ;% 20601950
CARDLOC := CARD INX 0;% 20602000
IF UNITNO=25 OR UNITNO=26 OR UNITNO=30 OR UNITNO=31 THEN 20602050
SOURCE:=CARDLOC ELSE 20602100
M[(SOURCE:=CARDLOC)+9] := @3277320000000000; % .". 2B XTRA SAFE20602150
IF UNITNO GEQ 32 AND UNITCODE[UNITNO-23].[1:1] THEN 20602200
UNITCODE[UNITNO-23]:=M[CARDLOC + 10]; 20602250
IF UNITNO=25 OR UNITNO=31 THEN USERID:=MCP ELSE% 20602300
BEGIN IF UNITNO=26 THEN UNITNO:=31;% 20602350
USERID:=UNITCODE[UNITNO-23];% 20602400
$ SET OMIT = NOT(DATACOM AND RJE ) 20602409
END;% 20602450
SPOUTUNIT:=( 20602460
$ SET OMIT = NOT(PACKETS) 20602469
IF ZIPMIX!0 AND PSEUDOMIX[ZIPMIX] GEQ 32 THEN 20602470
PSEUDOMIX[ZIPMIX] ELSE 20602480
IF UNITNO GEQ 32 THEN UNITNO ELSE 20602490
$ POP OMIT 20602491
0)&CARD[9:9:9]; 20602500
$ SET OMIT = NOT(PACKETS) 20602509
IF UNITNO GEQ 32 THEN 20602510
IF PKTONLY THEN %124-20602515
IF PSEUDO[UNITNO-32]=0 THEN 20602520
PRINTTHECOVER(CARDLOC&CARD[9:9:9],UNITNO,PSOURCE); 20602530
LASTSCAN:=0&1[2:47:1]; 20602540
$ POP OMIT 20602541
COMMENT SCAN FOR CARD WITH QUESTION MARK IN COL. 1;% 20602550
CC: IF SCAN NEQ QUEST THEN GO TO INCSC;% 20602650
T:=SCAN; 20602700
CCTYPE: IF (T LSS UNLOCKV) OR (T GTR RESETV) THEN 20602800
GO TO INCSC;% 20602850
PPCPROCESS:=0;% %173-20602855
PROCVAL:=0; %128-20602860
IF CARD.[9:9] NEQ 0 THEN% 20602900
$ SET OMIT = NOT(DATACOM AND RJE ) 20602909
IF CCFIND THEN GO TO INCSC; 20602950
IF (T LEQ LOAD AND (T GEQ RUNV) THEN 20603000
BEGIN % 20603050
M[CARDLOC - 2] := 0;% 20603100
M[CARDLOC -1] :=10;% 20603150
CMM[6]:= GETESPDISK & 10[18:33:15];% 20603200
$ SET OMIT = NOT(DATACOM AND RJE ) 20603209
DISKWAIT(CARDLOC-2,11,CMM[6] INX 0); 20603250
END;% 20603350
$ SET OMIT = NOT(PACKETS) 20603359
LISTHECARD; 20603360
$ POP OMIT 20603361
% WRITE OUT CONTROL CARD FOR LOGGING ROUTINE% 20603400
% BRANCH ON 1ST WORD ON CONTROL CARD% 20603450
LIBNO:=0; 20603500
TOG:= FALSE; 20603550
IF UNITNO GEQ 32 THEN %780-20603560
IF T=PACKET OR T=USER THEN ELSE %780-20603565
IF (USERID.[1:1] AND USERID ! MCP) THEN %780-20603570
BEGIN USERID ~ "U000000"; %780-20603575
UNITCODE[UNIT-23] ~ USERID %780-20603580
END; %780-20603590
GO TO TYPE[T-UNLOCKV]; 20603600
% COMPILER CALL OUT CARD% 20603700
COMPILE: IF CCCOMPILE THEN GO INCSC; 20603750
INITIALIZATION: OPTNN:=INITIALIZEIT; GO DOWN; 20603900
BEFORETRYNEXT: IF OPTN=PERIO THEN GO TO CONTROLLER; 20604050
TRYNEXT: IF KOUNT=@14 THEN 20604100
IF SOURCE=(CARDLOC&1[30:45:3]) THEN 20604105
BEGIN 20604110
PPCPROCESS:=1; T:=SCAN; GO CONTROLA; 20604115
END; 20604120
IF SCAN NEQ PERIO THEN GO TRYNEXT; 20604125
CONTROLER: PPCPROCESS:= 1; 20604150
IF SCAN NEQ QUEST THEN GO TO INCSC; 20604200
T:= SCAN; 20604250
CONTROLA: IF (T < FILEV OR T > COBOL) AND ACCUM[0] ! CMPLR THEN %527-20604300
IF T GEQ UNLOCKV AND T LEQ RESETV THEN %527-20604350
GO TO FINIS ELSE GO TO INCSC; 20604360
IF CARD.[9:9] NEQ 0 THEN 20604400
$ SET OMIT = NOT(DATACOM AND RJE ) 20604409
IF CCFIND THEN GO TO INCSC; 20604450
$ SET OMIT = NOT(PACKETS) 20604479
LISTHECARD; 20604480
$ POP OMIT 20604481
IF T GEQ ALGOL OR ACCUM[0]=CMPLR THEN 20604500
IF OPTN=EXECU OR OPTN=RUNV THEN 20604550
GO TO TRYNEXT 20604600
ELSE GO TO COMPILEJOB; 20604650
IF OPTN=SYNTA THEN GO TO TRYNEXT; 20604700
IF OPTN=EXECU OR OPTN=RUNV THEN GO TO COMJOB; 20604750
% CALL RPC FOR COMPILE AND GO JOB% 20604800
IF PPC(PADDR,PEQN,PROG,PDEX,T,UNITNO,CARDLOC,SOURCE,ACCUM, 20604850
LASTSCAN,DIRECT) THEN GO TO INCSC; 20604900
GO TO CONTROLER; 20604950
COMPILEJOB: T:=SCAN; 20605000
COMJOB: IF PPC(CADDR,CEQN,CMM,CDEX,T,UNITNO,CARDLOC,SOURCE,ACCUM, 20605050
LASTSCAN,DIRECT) THEN GO TO INCSC; 20605100
GO TO CONTOLER; 20605150
COMMENT EXECUTE CARD;% 20605250
EXEC: P(EXECU); 20605300
EXRUN: OPTN:=P; 20605320
CMM[13]:=CADDR:=CDEX:=0; 20605340
T:=SCAN; CMM[0]:=ACCUM[0]; 20605360
T:=SCAN; T:=SCAN; 20605380
IF ((CMM[1]:=ACCUM[0]) EQV "DISK ") ! NOT 0 THEN T := 0 20605400
ELSE IF ((T := CMM[0]) EQV "LIBMAIN") = NOT 0 THEN 20605405
IF UNITNO ! 31 20605410
$ SET OMIT = NOT(DATACOM AND RJE) 20605415
THEN GO TO INCSC ELSE T := LIBMAINCODE 20605430
ELSE IF (T EQV "PRNPBT ") = NOT 0 THEN 20605435
IF UNITNO ! 31 20605440
$ SET OMIT = NOT(DATACOM AND RJE) 20605445
THEN GO TO INCSC ELSE T := PRNPBTCODE 20605460
ELSE IF (T EQV "LDCNTRL") = NOT 0 THEN T := LDCNTRLCODE 20605465
ELSE T := 0; 20605470
CMM[2] := 0 & (IF OPTN=RUNV THEN 5 ELSE 2)[8:38:10] & T[5:45:3]; 20605480
CMM[23]:=0&CARD[9:9:9]&( 20605500
$ SET OMIT = NOT(PACKETS) 20605509
IF ZIPMIX!0 THEN PSEUDOMIX[ZIPMIX] ELSE 20605510
$ POP OMIT 20605511
UNITNO)[2:42:6]; 20605520
GO TO INITIALIZATION; 20605550
RUN: P(RUNV); 20605600
GO TO EXRUN; 20605650
USERS: IF(T:=SCAN)!EQUAL THEN GO INCSC; %133-20605700
IF(T:=SCAN)=PERIO THEN GO INCSC; %133-20605702
IF (USERID.[1:1] AND USERID!MCP) 20605750
$ SET OMIT = NOT(DATACOM AND RJE ) 20605759
THEN BEGIN 20605800
USERID:=ACCUM[0]; 20605810
$ SET OMIT = NOT(PACKETS) 20605819
IF UNITNO GEQ 32 THEN UNITCODE[UNITNO-23]:=USERID; 20605820
$ POP OMIT 20605821
END; 20605830
CCC: %COME HERE TO FLUSH TO NEXT INITIAL WORD 20605870
$ SET OMIT = NOT(PACKETS) 20605879
DO T:=SCAN UNTIL T=QUEST;T:=SCAN; 20605880
$ POP OMIT 20605881
$ SET OMIT = PACKETS 20605899
GO TO CCTYPE; 20606000
USES: OPTNN:=0; OPTNN:=CCSECMAINT; GO DOWN; 20606050
SECBOMB: OPTNN:=1; OPTNN:=CCSECMAINT; GO DOWN; 20606100
UNLOX: 20606150
LOX: 20606200
FREES: 20606250
OPENS: 20606300
OPTNN:=2; OPTNN:=CCSECMAINT; GO DOWN; 20606350
ENTE:: 20606400
LCOPY: 20606450
CHANGE: 20606500
REMOVE: 20606550
OPTNN:=CCLIB; 20606600
DOWN: GO TO SW[OPTNN]; 20606610
SET: TOG:= TRUE; 20606650
RSET: IF CCSET THEN GO CC ELSE GO INCSC; 20606700
UNIT: OPTNN:=CCUNIT; GO DOWN; 20606800
INCSC: 20606850
IF PCPROCESS THEN 20606860
P(DIRECTORYSEARCH(-CMM[0],IF CMM[0] LSS 0 THEN "DISK " ELSE 20606865
CMM[1], 13),DEL); 20606870
$ SET OMIT = NOT(PACKETS) 20606874
LISTHECARD; 20606875
$ POP OMIT 20606876
IF UNITNO}32 THEN CIDROW[UNITNO-32].[3:5]:=0 ELSE% %173-20606900
IF UNITNO=23 THEN READERA.[FF]:=0 ELSE% %173-20606910
IF UNITNO=24 THEN READERB.[FF]:=0;% %173-20606920
LASTSCAN := 0; 20607000
STREAM(CARDLOC, U:=TINU[UNITNO], ACCUM, MIX:=ZIPMIX, 20607020
ZZP:=UNITNO=31, CRD:=SPOUTUNIT.[CF]=0, 20607040
D:=T:=SPACE(15)); 20607060
BEGIN 20607080
DS:=20LIT"#CONTROL CARD ERROR "; 20607100
SI:=LOC U; SI:=SI+5; DS:=3 CHR; 20607120
ZZP(DI:=DI-22; DS:=24LIT"ZIP ERROR, IGNORED, MIX="; 20607140
SI:=LOC MIX; DS:=2 DEC; DS:=LIT":"; 20607160
D:=DI; DI:=DI-3; DS:=FILL; DI:=D); 20607180
DS:=4LIT" AT "; 20607200
SI:=ACCUM; SI:=SI+1; 20607220
7(IF SC=" " THEN SI:=SI+1 ELSE DS:=CHR); 20607240
CRD(DS:=LIT":"; SI:=CARDLOC; 2(DS:=36 CHR)); 20607260
DS:=LIT"~"; 20607280
END; 20607300
IF UNITNO!25 THEN 20607500
BEGIN 20607550
SPOUTER(T&CARD[9:9:9],SPOUTUNIT,1); 20607600
IF UNITNO=30 OR UNITNO=31 THEN GO ZIPEXIT; 20607700
IF UNITNO GEQ 32 THEN GO ENDECK; 20607750
END ELSE 20607800
BEGIN P(WAITIO(T,0,25),DEL); 20608000
FORGETSPACE(T); 20608050
$ SET OMIT = PACKETS 20608059
$ SET OMIT = NOT(PACKETS) 20608069
FETCH(UNITNO,CARDLOC,SOURCE); 20608070
IF SCAN NEQ QUEST THEN GO TO INCSC; 20608072
T:=SCAN; 20608074
IF PPCPROCESS THEN GO TO CONTROLA; 20608076
IF (T}PACKET) AND (T{RESETV) AND (T!RUNV) THEN %527-20608078
GO TO CCTYPE; GO TO INCSC; 20608080
$ POP OMIT 20608081
END; 20608100
$ SET OMIT = NOT(PACKETS) 20608109
ENDECK: 20608110
IF ZIPMIX NEQ 0 THEN %147-20608112
IF (T:=PSEUDOMIX[ZIPMIX]) GEQ 32 THEN %147-20608114
PACKETERR[T-32]:=TRUE; %147-20608116
IF UNITNO GEQ 32 THEN 20608120
BEGIN ABORT:=TRUE; 20608130
PACKETERR[UNITNO-32]:=TRUE; 20608140
GO TO PACK2; 20608142
END; 20608144
$ POP OMIT 20608146
DO DO 20608150
FETCH(-UNITNO,CRDLOC,SOURCE) 20608200
UNTIL SCAN=QUEST 20608250
UNTIL SCAN=ENDFI; 20608300
ENDF:: 20608450
$ SET OMIT = NOT(PACKETS) 20608459
IF UNITNO LSS 32 THEN 20608460
$ POP OMIT 20608461
IF UNITNO NEQ 30 THEN UNITCODE[UNITNO-23]:=0; 20608500
IF UNITNO=23 THEN READERA:=0 ELSE 20608510
IF UNITNO=24 THEN READERB:=0 ELSE 20608520
IF UNITNO GEQ 25 THEN 20608550
IF UNITNO GEQ 32 THEN 20608600
PACK2:: %PACKET CARDS END HERE FROM PSEUDO-READERS 20608610
IF CIDTABLE[UNITNO-32,3] LSS CIDTABLE[UNITNO-32,7]THEN 20608650
BEGIN FETCH(-UNITNO,CARDLOC,SOURCE); 20608700
$ SET OMIT = NOT(PACKETS) 20608709
IF ABORT THEN 20608710
BEGIN 20608720
IF (T:=SCAN)=QUEST THEN 20608730
IF (T:=SCAN) = ENDFI THEN %129-20608740
ABORT:=FALSE; 20608750
GO TO PACK2; %129-20608760
END ELSE T:=0; 20608770
LASTSCAN:=0&1[2:47:1]; 20608780
PACKETERR(UNITNO-32]:=FALSE; 20608790
$ POP OMIT 20608801
GO CC; 20608810
END ELSE 20608820
BEGIN 20608830
$ SET OMIT = NOT(PACKETS) 20608839
LABELTABLE[UNITNO]:=@114; 20608840
IF PACKETACT[UNITNO-32]=D THEN 20608850
$ POP OMIT 20608851
$ SET OMIT = PACKETS 20608859
ENDOFDECK((UNITNO-32),SPOUTUNIT&CARD[1:1:1]); 20608870
GO ZIPEXIT; 20608880
END ELSE 20608890
GO ZIPEXIT; 20608900
IF(TWO(UNITNO) AND SAVEWORD) NEQ 0 THEN GO TO SAVENO; 20608950
IF WAITIO(CARDLOC&400[18:33:15],@15,UNITNO).[45:3] NEQ 0 THEN20609000
BEGIN 20609050
SAVEND: LABELTABLE[UNITNO]:= @114; 20609100
RRRMECH:= NOT (NT1:= TWO(UNITNO)) AND RRRMECH OR 20609150
NT1 AND SAVEWORD; 20609200
GO TO ZIPEXIT; 20609250
END; 20609300
M[(SOURCE:= CARDLOC)+9]:= 0&"."[1:43:5]; 20609350
USERID:= UNITCODE[UNITNO-23]; 20609400
GO TO CC; 20609410
PACK: IF UNITNO<32 THEN GO INCSC; 20609420
$ SET OMIT = NOT(PACKETS) %124-20609425
IF PSEUDO[UNITNO-32] = 0 THEN %124-20609430
PRINTTHECOVER(CARDLOC,UNITNO,PSOURCE); %124-20609435
IF PSOURCE = 3 THEN USERID ~USERID &1[1:47:1]; %782-20609436
$ POP OMIT %124-20609440
GO PACK2; 20609450
LABE: OPTNN:=CCLABEL; GO DOWN; 20609500
WAIT: 20609555
$ SET OMIT = NOT(PACKETS) 20609559
IF UNITNO<32 THEN GO TO CCC; 20609560
IF PACKETACT[UNITNO-32]=0 THEN GO TO CCC; 20609570
LABELTABLE[UNITNO]:=@214; GO TO ZIPEXIT; 20609580
$ POP OMIT 20609581
FINIS:: CCFINISH; 20609600
$ SET OMIT = NOT(PACKETS) 20609659
IF (NT1~IF ZIPMIX!0 THEN PSEUDOMIX[ZIPMIX] ELSE UNITNO) 20609660
GEQ 32 THEN PACKETACT[NT1-32]:=PACKETACT[NT1-32]+1; 20609670
$ POP OMIT 20609671
SELECTION; 20609700
IF UNITNO NEQ 31 THEN 20609750
BEGIN 20609760
$ SET OMIT = PACKETS 20609799
GO CCTYPE; 20610100
END; 20610150
ZIPEXIT: FORGETSPACE(CARDLOC-2); 20610200
EXIT:: 20610250
$ SET OMIT = NOT(PACKETS) 20610259
IF ZIPMIX NEQ 0 THEN NYLONZIPPER[ZIPMIX].[2:1]:=1; 20610260
$ POP OMIT 20610261
FORGETSPACE(ACCUM INX 0);% 20610300
FORGETSPACE(CMM INX 0);% 20610350
IF (CCTBLWORD:=P(CCTBLWORD,DUP)&(P.[FF]-1)[CTF]).[FF]=0 THEN 20610400
BEGIN 20610410
FORGETSPACE(CCTBLADDR); 20610420
CCTBLADDR:=0; 20610430
END; 20610440
IF UNITNO GEQ 32 AND UNITNO LEQ 63 THEN 20610500
PSEUDOCOPY:= PSEUDOCOPY - 1; 20610550
KILL([MSCW]); 20610600
END CONTROLCARD; 20610650
REAL PROCEDURE CCSET; 20700000
BEGIN LABEL MORE,SEEK,SKIP,CCERR,L1,L2; 20701000
DECLARECCVARIABLES; 20701500
REAL FXTOG = RETURNVAL+1, % BEGIN LOCALS OF CCSET 20702000
LOK = FXTOG+1, 20702100
N = LOK+1, 20703000
SENSETOG = N+1; 20704000
BOOLEAN FT=N; DEFINE FH(FH1)=M[T+FH1]#; % RESET FILE A/B %815-20704100
SUBROUTINE CLEARTHEFILE; % CLEAR AN IN-USE FILE %815-20704200
BEGIN %815-20704210
FH[4].[01:06]~0; % EXCLUSIVE %815-20704220
FH[4].[16:20]~0; % OPEN COUNT 2 %815-20704230
FH[9].[01:28]~0; % TOGS & OPEN COUNT 1 %815-20704240
DISKWAIT(T.[CF],30,T.[FF]); % FIX IT %815-20704250
FILEHOLD(CMM[2],CMM[3],0,T,0); % MAKE UP WAITING PROCESSES %815-20704260
LBMESS(CMM[2],CMM[3],11,26,0,SPOUTUNIT,1); %815-20704270
END CLEARTHEFILE; %815-20704280
REAL SUBROUTINE SCAN; 20705000
SCAN~SCN(UNITNO,CARDLOC,SOURCE,ACCUM,KOUNT,LASTSCAN,DIRECT); 20706000
P(RCW,MYMSCW,STF); 20707000
RCW:=RCW & P(XCH)[CTC]; 20708000
P(0,0,0,0); % ZERO LOCALS OF CCSET 20709000
CCSET~0; %510-20711100
IF NOT (FXTOG:=(CN:=SCAN)=FIXED) THEN 20712000
IF NOT (SENSETOG:=(CN=SENSE)) THEN 20713000
IF CN!ACCESS0 THEN %815-20714000
IF NOT (FT~FXTOG~(CN=FILEV)) THEN GO TO CCERR; %815-20714500
MORE: 20715000
IF (CN:=SCAN)=EQUAL THEN CMM[0]:=-1 ELSE 20716000
IF CN GEQ IDENT THEN CMM[0]:=ACCUM[0] ELSE GO CCERR; 20717000
IF SCAN NEQ SLASH THEN GO TO CCERR; 20718000
IF (CN:=SCAN)=EQUAL THEN CMM[1]:=-1 ELSE 20719000
IF CN GEQ IDENT THEN CMM[1]:=ACCUM[0] ELSE 20720000
GO TO CCERR; 20721000
CN:=T:=0; 20722000
SEEK: 20723000
IF (CMM[0] OR CMM[1]) LSS 0 THEN 20724000
SEEKNAM(CMM[0],CMM[1],CN,CMM[2],CMM[3],N,P(0)) ELSE 20725000
BEGIN CN:=1; CMM[2]:=CMM[0]; CMM[3]:=CMM[1] END; 20726000
IF CN NEQ 0 THEN 20727000
BEGIN 20728000
IF NOT FXTOG THEN IF SYSTEMFILE(CMM[2],CMM[3]) THEN 20729000
BEGIN T~2; GO TO L1; END; %521-20730000
T:=DIRECTORYSEARCH(CMM[2],CMM[3],19); 20731000
END ELSE IF N=0 THEN BEGIN CMM[2]:=CMM[0]; CMM[3]:=CMM[1]; GO L1; 20732000
END 20733000
ELSE GO L2; 20734000
SKIP: 20735000
IF T GEQ 64 THEN 20736000
BEGIN 20737000
IF M[T+4].[43:2]=3 THEN 20738000
BEGIN FORGETSPACE(T); T~1; GO SKIP; END; %521-20739000
IF (USERID EQV MCP)= NOT 0 OR 20740000
(USERID EQV ABS(M[T+2]))= NOT 0 OR 20741000
(NOT SENSETOG AND (M[T+2]=0)) THEN 20742000
BEGIN 20743000
LOK:=0; 20744000
IF FXTOG 20745000
THEN M[T+4].[42:1]:=TOG 20746000
ELSE IF SENSETOG 20747000
THEN IF LOK:=((M[T+4].[43:2]=1) AND NOT TOG) 20748000
THEN M[T+4].[43:2]:=0 20749000
ELSE IF M[T+4].[43:2]=1 20750000
THEN ELSE M[T+4].[43:2]:=TOG|2 20751000
ELSE BEGIN 20752000
M[T+4].[11:1]:=TOG; 20753000
IF TOG THEN % %503-20753800
BEGIN % %503-20753900
STREAM(DATE,J:=5); 20754000
BEGIN SI:=LOC DATE; DS:=8OCT; END; 20755000
M[T+3].[12:18]:=JUNK; 20756000
END; % %503-20756100
END; 20757000
DISKWAIT(T.[CF],-30,T.[FF]); 20758000
$ SET OMIT = SHAREDISK 20759000
UNLOCKDIRECTORY; 20760000
$ POP OMIT 20761000
$ SET OMIT = PACKETS 20762000
IF LOK THEN P(DIRECTORYSEARCH(-CMM[2],CMM[3],6),DEL) 20765000
ELSE LBMESS(CMM[2],CMM[3],IF TOG THEN 12 ELSE 11, 20766000
13+(SENSETOG|47)-(FXTOG|3),0,SPOUTUNIT,RSTOG) 20767000
END ELSE IF FT THEN CLEARTHEFILE ELSE BEGIN %815-20769000
$ SET OMIT = SHAREDISK %521-20769100
UNLOCKDIRECTORY; %521-20769200
$ POP OMIT %521-20769300
LBMESS(CMM[2],CMM[3],-(11+TOG),41,0,SPOUTUNIT,1); %521-20769400
END; %521-20769500
FORGETSPACE(T); %521-20769600
END 20770000
ELSE BEGIN %521-20771000
$ SET OMIT = SHAREDISK %521-20771010
UNLOCKDIRECTORY; %521-20771020
$ POP OMIT %521-20771030
L1: LBMESS(CMM[2],CMM[3],-(11+TOG),15+((T=1)|30)+((T=2)|10),20771100
0, SPOUTUNIT, 1 ); % 20772000
END; %521-20772050
IF CN NEQ 0 AND (CMM[0] OR CMM[1]) LSS 0 THEN GO SEEK; 20779000
L2: IF (CN:=SCAN)=COMMA THEN GO MORE; 20780000
IF CN=PERIO THEN CCSET:=1; 20781000
CCERR: RETURNVAL:=PROCVAL; % ADJUST RESULT OF TYPED PROC 20782000
P([RETURNRCW],STS,0,RDS,0,XCH,P&P[CTF],STF); 20783000
END CCSET; 20784000
$ SET OMIT = NOT(DATACOM ) 20999999
REAL SECONDCTR; 22000000
$ SET OMIT = NOT(SHAREDISK) 22000499
PROCEDURE NSECOND;% 22001000
BEGIN REAL RCW=+0, I=RCW+1, X=I+1, J=X+1; 22002000
REAL MSCW=-2; 22002500
ARRAY A=J+1[*]; 22003000
$ SET OMIT = NOT SHAREDISK 22003990
P(0,0,0,0); 22006000
$ SET OMIT = NOT SHAREDISK 22006090
IF (J:=TOGLE.MEMNO)!0 THEN 22007000
TOGLE.MEMNO:=IF J THEN 6 ELSE J-2; 22007100
A ~ [M[SPACE(3|MIXMAX+3)]]&90[8:38:10]; 22008000
$ SET OMIT = NOT(DCLOG AND DATACOM ) 22008049
SLEEP([TOGLE],ABORTMASK); 22009000
LOCKTOG(ABORTMASK); 22010000
HALT; IDLETIME;% 22011000
J:=NEUP.NEUF ; 22011100
$ SET OMIT = NOT(SHAREDISK ) 22011190
FOR I:=J-1 STEP -1 UNTIL 0 DO 22011300
BEGIN 22011400
EUIO[I+EUIOFFSET]:=*P(DUP)|EUTAPER+PEUIO[I]; 22011500
PEUIO[I]:=0; 22011600
END; 22011700
$ SET OMIT = NOT(SHAREDISK ) 22011790
WHILE (J:=XCLOCK+P(RTR)) GEQ WITCHINGHOUR DO MIDNIGHT; 22012000
CHANGEDATE(0); 22012500
A[0]~J; A[2]~"ABORT";J~0; 22013000
A[1] ~ DATE;% 22014000
IF (CLOCK AND @17777)=0 THEN 22014100
BEGIN FOR I:=1 STEP 1 UNTIL MIXMAX DO 22014400
IF *[JARROW[I]] NEQ 0 THEN 22014500
IF REPLY[I] LSS 0 THEN % WAITING FOR SOMETHING 22014600
$ SET OMIT = NOT(WORKSET) 22014610
IF (WKSETSTOPJOBS AND TWO(I))=0 THEN % NOT AUTO-ST22014620
$ POP OMIT % WORKSET 22014630
REPLY[I]:=VWY; 22014640
END; 22014900
FOR I ~ 1 STEP 1 UNTIL MIXMAX DO% 22015000
BEGIN J ~ J+3;% 22016000
IF JARROW[I] ! 0 THEN% 22017000
BEGIN A[J] ~ JAR[I,3]+PROCTIME[I]; 22018000
NT1 ~ IOTIME[I]+JAR[I,4];% 22019000
WHILE NT1 < 0 DO NT1~NT1+CLOCK+P(RTR);22020000
A[J+1] ~ NT1;% 22021000
A[J+2] ~ JAR[I,7];% 22022000
IF PROCTIME[I]>0 THEN 22023500
TERMINATE(I&15[18:33:15]) ELSE 22024000
IF A[J+1]> JAR[I,4] THEN 22024500
TERMINATE(I&83[18:33:15]); 22025000
END% 22026000
ELSE A[J] ~ A[J+1] ~ A[J+2] ~ 0;% 22027000
END;% 22028000
DISKIO(J,A INX 0-1,3|MIXMAX+3,ESPDISKTOP+1); 22029000
UNLOCKTOG(ABORTMASK); 22030000
$ SET OMIT = NOT(DCLOG AND DATACOM ) 22030099
NOPROCESSTOG ~ NOPROCESSTOG-1;% 22031000
FOR I ~ 20 STEP 1 UNTIL 21 DO% 22032000
BEGIN IF NOT UNIT[I].[16:1] THEN% 22033000
UNIT[I].[17:1] ~ 0;% 22034000
STARTIO(I);% 22035000
END;% 22036000
$ SET OMIT = NOT(DFX) 22036999
IF TERMINALCLOCK ! 0 THEN% 22039000
IF CLOCK-TERMINALCLOCK > 512 THEN % 22040000
BEGIN 22040500
FOR I ~ 0 STEP 2 UNTIL JOBNUM DO% 22041000
IF PRTROW[X:=BED[I].[3:5]].[PSF]=1 THEN 22042000
IF JAR[X,9].SYSJOBF ! LIBMAINCODE THEN 22042100
BEGIN BED[I] ~ BED[JOBNUM];% 22043000
BED[I+1] ~ BED[JOBNUM+1];% 22044000
INDEPENDENTRUNNER(P(.RUN),X,0); 22045000
I ~ JOBNUM ~ JOBNUM-2;% 22046000
END;% 22048000
TERMINALCLOCK:=0; 22048200
END; 22048400
SLEEP([J],IOMASK);% 22049000
FORGETSPACE(A);% 22050000
$ SET OMIT = NOT(STATISTICS) 22050909
$ SET OMIT = NOT(SHAREDISK) 22050999
NSECONDREADY:=TRUE; 22053700
SECONDCTR:=0; 22053800
KILL([MSCW]); 22053900
END;% 22054000
PROCEDURE STATUS;% 22055000
BEGIN REAL U=+1,% 22056000
MSCW=-2, 22056500
T=U+1,% 22057000
T1=T+1;% 22058000
INTEGER 22059000
I=T1+1;% 22060000
ARRAY AREA=I+1[*];% 22061000
REAL HDR = AREA+1, 22061100
SEG0= HDR + 1, 22061110
F = SEG0+1; 22061120
ARRAY SEAT = F+1[*]; 22061130
LABEL TRYAGAIN,LDCNTRL,DISK; 22061200
LABEL L,EL,NOTREADY,DIE,ACCEPT,SCRATCH,INPUT,TESTBACKUP, 22062000
COMMON; 22063000
LABEL CARD,PRINTER,TAPE,DRUM,DISC,SPO,PUNCH,UNLD, 22064000
PAPERPUNCH,PAPER,DATACOM; 22064500
SWITCH S := CARD,PRINTER,TAPE,DRUM,DISC,SPO,PUNCH,UNLD, 22065000
PAPERPUNCH,PAPER,DATACOM;% 22066000
REAL RCW=+0;% 22067000
SUBROUTINE SPACEA;% 22068000
BEGIN AREA ~ (SPACE(12) INX MEMORY)&10[8:38:10] END;% 22069000
SUBROUTINE AUTOLOADER; 22069010
BEGIN 22069020
TRYAGAIN: 22069025
IF (HDR:=DIRECTORYSEARCH(P(LDCNTRL),P(DISK),3)) ! 0 THEN 22069030
BEGIN 22069040
SHEAT := [M[F:=TYPEDSPACE(31,SHEETAREAV))] & 30[8:38:10];%%167-22069050
STREAM(S:=F-1, D:=F); % ZERO OUT THE SHEAT ENTRY 22069060
BEGIN 22069070
SI:=S; DS:=30 WDS; 22069080
END; 22069090
SEG0 := TYPEDSPACE(30,SEGZEROAREAV);% %167-22069100
DISKWAIT(-SEG0, 30, M[HDR INX 10]); 22069110
F.[FF] := HDR; % CORE ADDRESS OF HEADER IN [FF] OF PARAM. 22069120
SHEAT[7] := SEG0; % CORE ADRS.OF SEGMENT ZERO IN SHETA[7] 22069130
SHEAT[0] := P(LDCNTRL); 22069140
SHEAT[1] := P(DISK); 22069150
SHEAT[2] := 0 & 1[4:47:1] & LDCNTRLCODE[5:45:3] & 2[8:38:10]; 22069160
% [4:1] IN SHEET[2] MEANS SUPRESS BOJ/EOJ MESSAGES 22069170
SHEAT[16] := SHEAT[17] := @377777777777; % TIME LIMITS 22069180
SHEAT[19] := U; % COMMON VALUE 22069190
SHEAT[20] := 4; % CORE ESTIMATE 22069200
SHEAT[21] := 150; % STACK SIZE 22069210
SHEAT[24] := MCP; %131-22069212
22069220
STREAM(A:=0 : S := P(.SCHEDULEIDS)); 22069230
BEGIN 22069240
SI:=S; 22069250
47(SKIP SB; SKIP DB; TALLY:=TALLY+1; 22069260
IF SB THEN ELSE JUMP OUT); 22069270
DS:=SET; A:=TALLY; 22069280
END STREAM STATEMENT; 22069290
22069300
I := P; 22069310
SHEAT[3].[8:10] := 1; % SCHEDULE NUMBER 22069320
SHEAT[23] := (CLOCK + P(RTR)) DIV 60; 22069330
SHEAT[25] := HDR.[FF]; % DISK ADDRESS OF FILE HEADER 22069340
STREAM(U, I:=I:=SPACE(11)); 22069350
BEGIN 22069360
DI:=DI+16; 22069370
DS:=31LIT"CC EXECUTE LDCNTRL/DISK;COMMON="; 22069380
SI:=LOC U; DS:=8DEC; 22069390
DS:=6LIT";END.~"; 22069400
END STREAM STATEMENT; 22069410
M[I] := 0; M[I+1]:=10; 22069420
SHEAT[6] := GETESPDISK & 10[18:33:15]; 22069430
DISKWAIT(I, 11, SHEAT[6].[CF]); 22069440
FORGETSPACE(I); 22069450
MULTITABLE[U] := "CONTROL"; 22069460
LABELTABLE[U] := (-"DECK "); 22069470
RDCTABLE[U] := 1 & 1[14:38:10]; 22069480
IF U THEN READERA:=0 ELSE READERB:=0; 22069490
INDEPENDENTRUNNER(P(.SELECTRUN),F,160); 22069500
END ELSE % IF IN DIRECTORY 22069510
BEGIN 22069520
ENTERSYSFILE(2); 22069530
GO TRYAGAIN; 22069540
LDCNTRL::: "LDCNTRL"; 22069550
DISK::: "DISK "; 22069560
END; 22069570
END SUBROUTINE AUTOLOADER; 22069600
P(0,0,0,0,0,0,0,0,0);% 22071000
SPACEA;% 22073000
WHILE (T ~ P(RRR) OR RRRMECH) ! READY DO% 22074000
BEGIN I ~ 0&TINU[U ~ (P(T EQV NOT READY,DUP,DUP,|,|)% 22075000
|@1000000000000).% 22076000
[3:6]][5:11:7]/@1000000000000;% 22077000
IF T < READY THEN% 22078000
BEGIN COMMENT SOMETHING WENT NOT READY;% 22079000
READY ~ READY AND NOT I;% 22080000
IF LABELTABLE[U] } 0 THEN% 22081000
BEGIN% 22082000
L: LABELTABLE[U] ~ @114;% 22083000
IF (U AND @774) NEQ 16 THEN 22084000
MULTITABLE[U]:=0; 22084500
END;% 22085000
EL: RRRMECH ~ RRRMECH AND NOT I;% 22086000
END OF NOT READY% 22087000
ELSE BEGIN COMMENT SOMETHING WENT READY;% 22088000
READY ~ READY OR I;% 22089000
UNIT[U].[13;1] ~ 0;% 22090000
IF LABELTABLE[U] ! @114 THEN% 22091000
BEGIN RRRMECH ~ RRRMECH OR I;% 22092000
IF LABELTABLE[U] = @214 THEN% 22093000
BEGIN I ~ I AND NOT SAVEWORD;% 22094000
GO TO L;% 22095000
END;% 22096000
STARTIO(U);% 22097000
GO TO COMMON;% 22098000
END;% 22099000
IF (U AND @774) NEQ 16 THEN 22100000
MULTITABLE[U]:=RDCTABLE[U]:=0; 22100500
IF (I AND SAVEWORD) ! 0 THEN% 22101000
BEGIN RRRMECH ~ I AND SAVEWORD OR RRRMECH; 22102000
GO TO COMMON;% 22103000
END;% 22104000
GO S[UNIT[U].[1:4]];% 22105000
TAPE: P(WAITIO(@4200000000,5,U),DEL);% 22106000
IF (T ~ WAITIO(AREA INX @120540000000,@7500045,U),% 22107000
[45:3] ! 0 THEN% 22108000
NOTREADY: BEGIN READY ~ READY AND NOT I;% 22109000
GO TO L;% 22110000
END;% 22111000
IF MOD3IOS AND NOT T.[42:1] THEN BEGIN %AI22111500
DO UNTIL (T1~WAITIO(AREA INX @340000012,@75,U))!0; 22112000
IF T1.[43:2]!0 THEN T1~WAITIO(@4200000000,5,U); %697-22112100
END ELSE T1~WAITIO(@4200000000,5,U); %AI22112500
IF T1.[45:3]!0 THEN GO TO NOTREADY; %AI22113000
DO UNTIL NOT (T1~WAITIO(@500000000,@165,U)) OR 22114000
(TRANSACTION[U]~0);% 22115000
IF T1.[42:1] THEN 22115020
BEGIN; STREAM(T~TINU[U],A~AREA); 22115030
BEGIN SI~LOC T; SI~SI+5; DS~LIT"#"; 22115040
DS~3 CHR; DS~10 LIT "-BAD LOAD~"; 22115050
END; 22115060
SPOUT(AREA INX 0); SPACEA; GO TO L; 22115070
END; 22115075
IF T1.[45:1] THEN GO TO NOTREADY;% 22116000
PRNTABLE[U]~0&(NOT T1)[1:43:1];% 22117000
IF T.[43:1] THEN% 22118000
BEGIN;STREAM(T~TINU[U],AREA);% 22119000
BEGIN SI ~ LOC T; SI ~ SI+5;% 22120000
DS ~ LIT "#"; DS ~ 3 CHR;% 22121000
DS ~ 14 LIT " PARITY, RW/L~"% 22122000
END;% 22123000
DIE: SPOUT(AREA INX 0); SPACEA; 22124000
LABELTABLE[U] ~ @314;% 22125000
GO TO FL;% 22126000
END;% 22127000
IF T.[42:1] THEN% 22128000
BEGIN;STREAM(T~TINU[U],AREA);% 22129000
BEGIN SI ~ LOC T; SI ~ SI+5;% 22130000
DS ~ LIT "#"; DS ~ 3 CHR;% 22131000
DS ~ 15 LIT " TAPE MK, RW/L~";% 22132000
END;# 22133000
GO TO DIE;% 22134000
END;% 22135000
STREAM(Y~0:AREA,X~[T]);% 22136000
BEGIN DS ~ 8 LIT " LABEL ";% 22137000
SI ~ AREA; DI ~ DI-8;% 22138000
IF 8 SC = DC THEN TALLY ~ 1;% 22139000
AREA ~ TALLY;% 22140000
SI ~ SI+45; DI ~ LOC Y; DS ~ 5 OCT;% 22141000
SI ~ LOC AREA; DI ~ X; DS ~ WDS;% 22142000
END;% 22143000
NT1 ~ P;% 22144000
IF T THEN PRNTABLE[U].[30:18]:=NT1 ELSE 22145000
BEGIN STREAM(Y:=0:AREA,X:=[T]); 22145050
BEGIN DS:=4 LIT "VOL1"; 22145100
SI:=AREA; DI:=DI-4; 22145150
IF 4 SC=DC THEN TALLY:=1; 22145200
AREA:=TALLY; SI:=SI+1; 22145250
DI:=LOC Y; DS:=5 OCT; 22145300
SI:=LOC AREA; DI:=X; DS:=WDS; 22145350
END; 22145400
NT1:=P; 22145450
IF T THEN BEGIN 22145500
PRNTABLE[U]:=(*P(DUP))&NT1[30:30:18] OR M;22145525
USASITAPE([AREA].[CF],T,1,U,1); 22145550
END; 22145600
END; 22145650
IF NOT T1.[43:1] THEN% 22146000
BEGIN IF T THEN% 22147000
BEGIN 22148000
IF P(AREA[1],DUP)="PBTMCP " OR 22156000
P(XCH)="PUTMCP " THEN GO INPUT; 22156100
IF AREA[4].[12:30] > DATE THEN% 22157000
BEGIN IF RETMSG THEN 22158000
STREAM(T~TINU[U],A~[AREA[6]]); 22159000
BEGIN SI~LOC T;SI~SI+5;DS~3 CHR;22160000
DS~5 LIT " RET "; 22161000
END ELSE GO TO INPUT; 22162000
ACCEPT: T1 ~ SPACE(4);% 22163000
STREAM(A~[AREA[1]],T1);% 22164000
BEGIN SI ~ A; SI ~ SI+40;% 22165000
DS ~ LIT "#";% 22166000
DS ~ 8 CHR; SI ~ A;% 22167000
2(DS ~ LIT " ";% 22168000
SI ~ SI+1; DS ~ 7 CHR);22169000
DS ~ LIT "~";% 22170000
END;% 22171000
SPOUT(T1);% 22172000
GO TO INPUT;% 22173000
END ELSE% 22174000
SCRATCH: LABELTABLE[U] ~ 0;% 22175000
END ELSE GO TO UNLD; 22176000
END% 22177000
ELSE IF T THEN BEGIN% 22178000
INPUT: LABELTABLE[U] ~ AREA[2];% 22179000
MULTITABLE[U] ~ AREA[1];% 22180000
STREAM(A~[AREA[3]],B~[T]);% 22181000
BEGIN SI ~ A; DS ~ 3 OCT;% 22182000
DS ~ 5 OCT; DS ~ 2 OCT% 22183000
END;% 22184000
RDCTABLE[U] ~ I&T1[24:31:17]&T[14:38:10];% 22185000
IF (MULTITABLE[U]="PBTMCP " OR 22188000
MULTITABLE[U]="PUTMCP ") AND 22188100
LABELTABLE[U] = "BACK-UP" THEN% 22189000
BEGIN LABELTABLE[U] ~ @322212342546447;% 22190000
STREAM(A~TINU[U],PN~MULTITABLE[U]="PUTMCP ", 22191000
AREA); 22191100
BEGIN SI ~ LOC A; SI ~ SI+5;% 22192000
PN(DS~3 LIT"#CP"; JUMP OUT TO L);22192100
DS~3 LIT"#LP"; L: 22192200
DS~12 LIT" BACK-UP ON "; 22193000
DS ~ 3 CHR; DS ~ LIT "~";% 22194000
END;% 22195000
SPOUT(AREA INX 0); SPACEA; 22196000
END;% 22197000
END ELSE% 22198000
PAPER:% 22199000
UNLD: LABELTABLE[U] ~ @314;% 22200000
GO TO COMMON;% 22201000
PRINTER:% 22202000
T ~ WAITIO(@6000000000,4,U).[45:1];% 22203000
UNIT[U].[16:2] ~ 0;% 22204000
IF T THEN GO TO NOTREADY;% 22205000
TESTBACKUP: 22205500
IF AUTOPRINT THEN 22206000
IF PRINTORPUNCHWAIT(-U,0) THEN GO TO COMMON; 22207000
GO TO SCRATCH; 22208000
CARD:% 22209000
RRRMECH:=RRRMECH OR I; 22209200
IF CDONLY THEN 22209400
BEGIN 22209500
AUTOLOADER; 22209600
GO TO COMMON; 22209700
END; 22209800
LABELTABLE[U]:=-@14; 22212200
INDEPENDENTRUNNER(P(.CONTROLCARD),0&U[3:43:5],192); 22212400
IF U}32 AND U{63 THEN PSEUDOCOPY~PSEUDOCOPY+1;% %541-22212450
GO TO COMMON;% 22213000
PUNCH: 22213500
STARTIO(U); 22213600
IF UNIT[U].[15:3]=0 THEN GO TESTBACKUP ELSE GO TO SCRATCH;22213700
DRUM:% 22214000
DISC: 22215000
SPO:% 22216000
PAPERPUNCH:% 22218000
DATACOM:% 22219000
STARTIO(U);% 22220000
GO TO SCRATCH;% 22221000
COMMON: END OF READY;% 22222000
END;% 22223000
STATUSBIT ~ TRUE;% 22224000
FORGETSPACE(AREA.[33:15]);% 22225000
KILL([MSCW]); 22226000
END STATUS;% 22227000
BOOLEAN PROCEDURE OLAY(LOC); % MADE SAVE IN INITIALIZE 22228000
VALUE LOC; REAL LOC;% 22229000
BEGIN REAL LINK, MOM, FRONT, BACK, CHAR, BS, STACK, S, SB,% 22230000
T, X, SESC, DISK, IOD, MIX, JOBKILLED, MIXUP, SEGNO;% 22231000
ARRAY NAME SEGDICT;% 22232000
REAL RESULT=+1;% 22233000
ARRAY SPRT[*]; 22234000
REAL CORE, CUED; REAL INITCW=MIXUP; 22235000
REAL TYPE13, RSLT, NOAUX; 22235500
$ SET OMIT = NOT(NEWLOGGING) 22235599
$ SET OMIT = NOT(WORKSET) 22235610
REAL MCPTEMP; 22235620
$ POP OMIT % WORKSET 22235621
LABEL EXIT; % ALL AVENUES MUST LEAD TO HERE 22235700
LABEL AROUND, CODE, BACKAGAIN, MCP, INTRINSIC;% 22236000
LABEL RETRY, AGAIN, FOG; 22236100
DEFINE TSKA = SPRT#; 22236150
BOOLEAN SUBROUTINE AWAKEN;% 22237000
BEGIN COMMENT AWAKEN CHECKS TO SEE IF WE HAVE HALTED 22238000
THE JOB ON PROCESSOR 2. IF SO, IT RESTARTS THE 22239000
TIMING FOR HIM, AND CALLS "HALT" TO CHECK INTERRUPTS;% 22240000
IF JOBKILLED THEN% 22241000
BEGIN 22242000
$ SET OMIT = NEWLOGGING 22242099
STARTLOG(P2MIX;); 22242100
$ POP OMIT 22242101
JOBKILLED ~ FALSE; OLAY ~ RESULT OR 2;% 22243000
HALT; NOPROCESSTOG ~ NOPROCESSTOG-1;% 22244000
END;% 22245000
AWAKEN ~ RESULT END;% 22246000
SUBROUTINE STOP;% 22247000
BEGIN COMMENT STOP HALTS THE JOB ON PROCESSOR 2, AND 22248000
CLOCKS HIM OFF. IT SETS JOBKILLED SO THAT AWAKEN 22249000
CAN DO ITS DIRTY WORK BEFORE RETURNING;% 22250000
JOBKILLED ~ TRUE; P(HP2);% 22251000
STOPLOG(P2MIX,0); 22252000
END STOPPER;% 22253000
SUBROUTINE CODEOVERLAY;% 22254000
BEGIN COMMENT CODEOVERLAY HANDLES ALL CASES OF MARKING 22255000
A NORMAL-STATE SEGMENT AS NOT-PRESENT. IT DOES THIS 22256000
A SINGEL PRT AND STACK AT A TIME, AND IS ONLY CALLED 22257000
REPREATEDLY FOR RE-ENTRANT CODE OR INTRINSICS;% 22258000
IF CHAR THEN S ~ M[SB ~ M[S].[FF]].[FF] ELSE S ~ S-1;% 22259000
SPRT ~ PRT[MIX,10];% 22260000
IF SPRT[X].[2:1] THEN BEGIN% 22261000
% NEED TO DO PRT AND STACK SEARCH ONLY IF PRESENT IN THIS PRT 22262000
DO UNTIL (X ~ (SPRT[X] ~ (*P(DUP))&0[22:1]% 22263000
&(SPRT[X].[CF]-FRONT)[CTC]).[6:12])}2048;% 22264000
AROUND:% 22265000
WHILE (STACK := HUNT(BS).[CF]) LSS S DO 22266000
BEGIN CORE ~ (DESC ~ NFLAG(M[STACK])).[CF];% 22267000
IF CORE } FRONT AND CORE < BACK THEN 22268000
IF DESC LSS 0 THEN%PROG. DESC OR RCW. 22269000
IF DESC.[3:1] THEN%DESC 22270000
IF DESC.[2:1] THEN%PRESENT 22270050
IF DESC.[6:2]=1 THEN %TYPE 13 INTRINSIC DESC 22270100
M[STACK]:=FLAG(DESC & 0[2:2:1] 22270200
& (MOM.[8:10])[CTC]) ELSE 22270300
% DESCRIPTOR -- INSERT OFFSET AND RESET P-BIT 22271000
M[STACK] ~ FLAG(DESC&0[2:2:1]% 22272000
&(CORE-FRONT)[CTC])% 22273000
ELSE 22273100
ELSE BEGIN% 22274000
% CONTROL WORD (RCW) -- UNFLAG IN STACK, PUT OFFSET INTO 22275000
% CORRESPONDING MSCW, AND MOM INTO RCW.[CF] 22276000
M[X ~ DESC.[FF]] ~% 22277000
(*P(DUP))&(CORE-FRONT)[CTC];% 22278000
M[STACK] ~ DESC&SEGNO[CTC];% 22279000
END;% 22280000
BS ~ STACK+1;% 22281000
END;% 22282000
IF CHAR AND (STACK<SB) THEN% 22283000
BEGIN BS ~ SB; S ~ HUNT(BS+1).[CF]; GO AROUND END; 22284000
IF P(SPRT[19],TOP) THEN P(DEL) ELSE %DS22284100
BEGIN CORE:=POLISH.[CF]; %DS22284200
IF CORE < FRONT OR CORE } BACK THEN 22284300
ELSE SPRT[19]:=(*P(DUP))&0[2:2:1] %DS22284400
&(CORE-FRONT)[CTC]; %DS22284500
END; %DS22284600
$ SET OMIT = NOT(STATISTICS) 22284699
END OF PRESENT IN PRT CASE;% 22285000
END OF CODEOVERLAY;% 22286000
SUBROUTINE INT13; %STACK SEARCH FOR TYPE 13 INTRINSIC CALLS 22286010
BEGIN CHAR:=P(PRT[MIX,8],DUP).[32:1]; 22286020
S:1P INX 0; BS:=PRT[MIX,10].[FF]; 22286030
IF CHAR THEN S:=M[SB:=M[S].[FF]].[FF] ELSE S:=S-1; 22286040
AGAIN: WHILE (STACK := HUNT(BS).[CF]) LSS S DO 22286050
BEGIN CORE:=(DESC:=NFLAG(M[STACK])).[CF];% 22286060
IF CORE GEQ FRONT AND CORE LSS BACK THEN% 22286070
IF DESC.[1:2] NEQ 0 THEN 22286075
IF DESC.[1:3]=7 THEN% 22286080
M[STACK]:=FLAG(DESC&0[2:2:1]&(MOM.[8:10])[CTC])22286090
ELSE 22286100
BEGIN M[DESC.[FF]]:=(*P(DUP))&(CORE-FRONT)[CTC];22286110
M[STACK]:=DESC&(MOM.[8:10])[CTC]& 22286120
1[33:47:1]; 22286130
END; 22286140
BS:=STACK+1; 22286150
END; 22286160
IF CHAR AND (STACK LSS SB) THEN% 22286170
BEGIN BS:=SB; S:=HUNT(BS+1).[CF]; GO AGAIN; END; 22286180
END OF TYPE 13 INTRINSIC STACK SEARCH; 22286190
COMMENT OLAY HANDLES OVERLAYS, THERE ARE 3 CLASSES 22287000
OF THINGS WHICH MAY BE OVERLAID; 22288000
1) OBJECT PROGRAM DATA SEGMENTS 22289000
2) OBJECT PROGRAM CODE SEGMENTS 22290000
AND 3) MCP (NON-SAVE) PROCEDURES. 22291000
4) MCP TABLES - OVERLAYABLE 22291500
EACH OF THESE CLASSES GETS SPECIAL HANDLING, 22292000
WHICH WILL BE DESCRIBED AS WE COME TO IT; 22293000
% THIS CODE IS COMMON TO ALL CLASSES AND ALL CASES 22294000
$ SET OMIT = NOT(NEWLOGGING) 22294099
$ SET OMIT = NOT(WORKSET) 22294110
MCPTEMP := CLOCK + P(RTR); 22294120
$ POP OMIT % WORKSET 22294121
LINK ~ M[LOC]; MOM ~ M[LOC+1];% 22295000
FRONT := LOC + 2; BACK := LINK.[CF]; 22296000
IF (MIX ~ LINK.[AREAMIXF])=0 THEN GO TO MCP;% %167-22297000
% <MIX>=0 AND NON-SAVE MEANS MCP PROCEDURE OR INTRINSIC 22298000
IF MIX=P2MIX THEN STOP;% 22299000
CHAR ~ (INITCW ~ PRT[MIX,8]).[32:1];% 22300000
S ~ INITCW.[CF]; BS ~ PRT[MIX,10].[FF];% 22301000
% CHAR IS CWMF, S IS TOP-OF-STACK, BS IS BASE OF STACK 22302000
IF LINK.[AREATYPEF]=CODEAREAV THEN GO TO CODE;% %167-22303000
IF TERMGOING(MIX) THEN GO TO FOG; %507-22303200
% TYPE=1 MEANS PROGRAM -- ONLY ALTERNATIVE IS DATA 22304000
IF CHAR THEN% 22305000
% SPECIAL CHECKS FOR ADDRESS SAVED IN CHARACTER MODE 22306000
BEGIN CHAR:=(((T:=M[S-1].[CF]) } FRONT AND T < BACK) OR 22307000
% M-REGISTER FROM ICW (SOURCE ADDRESS) 22308000
((T:=M[S-2].[FF])} FRONT AND T < BACK)); 22309000
% S-REGISTER FROM ILCW (DESTINATION ADDRESS) 22310000
IF NOT CHAR THEN% 22311000
BEGIN X ~ M[S ~ M[S].[FF]].[FF]+1;% 22312000
% M[S].[FF] IS ADDRESS OF RCW, M[RCW].[FF] IS ADDRESS OF MSCW 22313000
DO CHAR ~ ((T ~ M[S ~ S-1].[CF])}FRONT 22314000
AND T < BACK) UNTIL (S { X) OR CHAR; 22315000
% SEARCH THROUGH STREAM LOCALS AND PARAMETERS FOR ADDRESSES 22316000
S ~ X;% 22317000
END;% 22318000
END;% 22319000
IF CHAR THEN %TELL BREAKOUT ABOUT IT 22320000
BEGIN P(AWAKEN,SSN); GO EXIT; 22320100
END; 22320200
% CANNOT OVERLAY IF MAY BE ADDRESSES IN CHAR MODE STACK 22321000
IOD~M[MOM].[8:10]; 22322000
IF (DISK:=MOM.[FF]) NEQ 0 THEN % OLAY ADDRESS PRESENT 22323000
BEGIN 22323200
$ SET OMIT = NOT(AUXMEM) 22323400
MOM.[FF]:=0; 22324800
END; 22325000
IF DISK=0 THEN DISK:=DISKSPACE(IOD,MIX,NOAUX); 22325200
IF DISK LSS 0 THEN % NO OLAY DISK 22325400
BEGIN P(AWAKEN); GO EXIT; 22325410
END; 22325430
$ SET OMIT = NOT(STATISTICS) 22325600
IF (S:=S-1) GTR MOM THEN IF MOM GTR BS THEN BS:=MOM-1; 22326400
% IF MOTHER IS IN STACK, ONLY SEARCH ABOVE IT 22326600
WHILE (STACK:=HUNT(BS).[CF]) LSS S DO 22326800
BEGIN 22327000
IF (DESC:=NFLAG(M[STACK])).[1:2]=1 THEN 22327200
% ONLY WORRY ABOUT DATA DESCRIPTORS WHICH ARE PRESENT 22327400
IF DESC.[FF]=MOM THEN 22327600
% THIS ONE DEMANDS ACTION -- IT POINTS INTO OUR ARRAY 22327800
IF DESC.[8:10]=0 THEN 22328000
% NAME DESCRIPTOR -- PUT IN OFFSET AND RESET P-BIT 22328200
M[STACK]:=FLAG((DESC.[CF]-FRONT)&MOM[CTF]) 22328400
ELSE 22328600
% NORMAL ROW DESCRIPTOR -- ZERO CORE FIELD AND RESET P-BIT 22328800
M[STACK]:=FLAG(0&DESC[8:8:25]); 22329000
BS:=STACK+1; 22329200
END; 22329400
IF M[MOM].[3:3] NEQ 7 % NOT READ ONLY ALREADY WRITTEN 22329600
$ SET OMIT = NOT(BREAKOUT) 22329800
THEN 22330400
BEGIN 22330600
$ SET OMIT = NOT(AUXMEM) 22330800
RETRY: DISKIO(RSLT,FRONT-1,IOD&1[3:47:1],DATADDRESS(MIX,DISK)); 22331400
% [3:1] IN SIZE MARKS I/O AS ORIGINATING FROM OLAY 22331600
M[MOM]:=(*P(DUP))&0[2:47:1]&5[CTC]; 22331800
P(AWAKEN,DEL); 22332000
% CF=5 IN MOTHER IS INTERLOCK FOR MAKEPRESENT 22332200
SNOOZE(0,[RSLT],IOMASK); 22332400
IF RLST.[26:7] NEQ 0 THEN % I/O ERROR 22332600
BEGIN 22332800
$ SET OMIT = NOT(AUXMEM) 22333000
IF (DISK:=DISKSPACE(IOD,MIX,-0)) LSS 0 THEN 22333800
BEGIN % NO OLAY DISK 22334000
M[MOM]:=(*P(DUP))&6[CTC]; % TERMINATE MARKER 22334200
GO TO FOG; 22334400
END; 22334600
GO TO RETRY; % TRY AGAIN WITH ANOTHER ADDRESS 22334800
END; % IF I/O ERROR 22335000
M[MOM]:=(*P(DUP))&DISK[CTC]; % PUT DISK ADDRESS IN MOTHER 22335200
END % IF READ ONLY, NOT YET WRITTEN 22335400
ELSE 22335600
BEGIN 22335800
M[MOM]:=(*P(DUP))&0[2:47:1]&DISK[CTC]; 22336000
P(AWAKEN,DEL); 22336200
END; 22336400
IF M[MOM].[3:3]=6 THEN M[MOM].[5:1]~1; 22339100
FOG: FORGETSPACE(FRONT); 22350000
P(TRUE); GO EXIT; 22351000
CODE:% 22352000
% OBJECT PROGRAM CODE TO BE OVERLAID 22353000
IF (T ~ M[S].[CF])}FRONT AND T{BACK THEN% 22354000
% CANNOT OVERLAY NORMAL STATE SEGMENT HE WILL RETURN TO 22355000
BEGIN P(AWAKEN); GO EXIT; 22356000
END; 22356020
IF SOFTI>0 THEN 22356100
IF JAR[MIX,2].[5:1] THEN % SOFTWARE INTERRUPTS 22356140
IF (TSKA ~ PRT[MIX,TSX]).PBIT THEN 22356150
IF (T ~ TSKA[8].[FF])!0 THEN 22356200
IF (M~M[T].[CF])}FRONT AND T{BACK THEN 22356300
BEGIN P(AWAKEN); GO EXIT; 22356400
END; 22356420
IF (MIXUP ~ (SEGDICT ~ PRT[MIX,4]).[FF])!0 THEN% 22357000
% RE-ENTRANT CODE TO BE OVERLAID -- CHECK OTHER USERS, TOO 22358000
BEGIN MIXUP ~ MIXUP.[39:6];% 22359000
DO BEGIN% 22360000
IF MIXUP=P2MIX THEN STOP;% 22361000
% STOP OTHER USER OF THIS CODE IF RUNNING ON PROCESSOR 2 22362000
IF (T ~ M[PRT[MIXUP,8]].[CF])}FRONT AND T{BACK% 22363000
THEN BEGIN P(AWAKEN); GO EXIT; 22364000
END; 22364100
% SAME CRITERIA APPLY TO ALL USERS OF THIS CODE 22365000
IF SOFTI>0 THEN 22365100
IF JAR[MIXUP,2].[5:1] THEN % SOFTWARE INTERRUPTS 22365140
IF (TSKA ~ PRT[MIXUP,@26]).PBIT THEN 22365150
IF (T ~ TSKA[8].[FF])!0 THEN 22365200
IF (T~M[T].[CF])}FRONT AND T{BACK THEN 22365300
BEGIN P(AWAKEN); GO EXIT; 22365400
END; 22365420
END UNTIL (MIXUP ~ PRT[MIXUP,4].[24:6])=@77;% 22366000
% CHECK ALL USERS ON MIX-INDEX LINKED LIST 22367000
END;% 22368000
% IF WE REACH THIS POINT, WE CAN AND WILL OVERLAY THE AREA 22369000
$ SET OMIT = NOT(AUXMEM) 22369999
BACKAGAIN:: 22371200
$ SET OMIT = AUXMEM 22371210
X~SEGDICT[SEGNO~MOM].[8:10];CODEOVERLAY; 22371220
$ POP OMIT 22371221
$ SET OMIT = NOT(AUXMEM) 22371299
IF MIXUP THEN% 22372000
% RE-ENTRANT CODE BEING OVERLAID -- MUST FIX ALL STACKS AND PRTS 22373000
IF (MIX ~ PRT[MIX,4].[24:6])!@77 THEN% 22374000
% SET UP CHAR, S, AND BS FOR NEXT USERS STACK 22375000
BEGIN CHAR ~ (S ~ PRT[MIX,8]).[32:1];% 22376000
S ~ S INX 0; BS ~ PRT[MX,10].[FF];% 22377000
% GO DO STACK SEARCH AND PRT FIX-UP FOR ANOTHER USER 22378000
GO TO BACKAGAIN;% 22379000
END;% 22380000
$ SET OMIT = NOT(AUXMEM) 22380049
$ SET OMIT = AUXMEM 22383049
SEGDICT[MOM]~(*P(DUP))&MOM[FTF];% 22383050
FORGETSPACE(FRONT); P(AWAKEN,DEL,TRUE); GO EXIT; 22383100
$ POP OMIT 22383101
% NOW WAS THAT NOT TRIVIALITY PERSONIFIED... 22384000
MCP:% 22385000
IF P(LINK.[AREATYPEF],DUP)=TYPE7INTAREAV OR% %167-22386000
P(XCH)=TYPE13INTAREAV THEN GO TO INTRINSIC;% %167-22386010
IF LINK.[AREATYPEF]=DATAAREAV THEN % OVERLAYABLE MCP DATA %167-22386100
BEGIN 22386150
COMMENT MCP TABLES CAN BE MARKED AS OVERLAYABLE SO THAT THEY CAN22386200
REMAIN IN CORE WHEN IN USE AND BETWEEN USES BUT CAN BE REMOVED 22386204
WHEN THE SPACE IS NEEDED, PREVIOUSLY THEY HAD TO BE LEFT IN 22386208
CORE PERMANENTLY OR READ FROM DISK WITH EACH USE. EACH TABLE 22386212
NEEDS A "DESCRIPTOR" TELLING ITS PRESENCE [2:1], ITS ADDRESS 22386216
[33:15], AND THE NUMBER OF PROCESSES ACCESSING IT[18:15]. 22386220
MEMORY LINKS MUST BE HANDLED AS IN LBMESS. WHEN AN AREA IS 22386224
IN USE, THE PAIR (MIX=0,TYPE=2(DSTA)) IN WORD 1 OF THE MEMORY 22386228
LINK INDICATES SUCH AN AREA; 22386232
IF M[MOM].[FF] = 0 THEN 22386250
BEGIN %CAN OVERLAY: NO ONE IS WAITING 22386300
M[MOM] := 0; % MARK ABSENT 22386350
FORGETSPACE(FRONT); 22386400
P(TRUE); %SIGNAL SUCCESS 22386450
GO EXIT; 22386500
END 22386550
ELSE BEGIN P(FALSE); GO EXIT END 22386600
END; 22386650
X ~ -2; BS ~ (P(0,RDF)).[FF];% 22387000
% SET BS TO POINT AT RCW FOR CALL ON OLAY 22388000
DO BEGIN% 22389000
OLAY ~ NOT(S ~ ((CORE ~ (T ~ M[BS]).[CF]){BACK 22390000
AND CORE}FRONT));% 22391000
% S IS TRUE IF THE RCW POINTS TO THE ROUTINE TO BE OVERLAID 22392000
BS ~ T.[FF];% 22393000
% POINT T TO CORRESPONDING MSCW 22394000
WHILE (T ~ M[BS]).[16:1] DO BS ~ T.[FF];% 22395000
% RUN DOWN STACK OF MSCWS UNTIL NOT MSFF 22396000
IF (BS ~ T.[FF]){64 THEN 22397000
% END OF STACK -- THIS IS RATIONALE FOR OBSCURE USE OF "P(0,STF)" 22398000
BS ~ BED[X ~ X+2].[FF];% 22399000
END UNTIL (X>JOBNUM) OR S;% 22400000
IF RESULT THEN% 22401000
BEGIN M[MOM] ~ (*P(DUP))&(*P(.ESPBIT))[CTC];% 22402000
FORGETSPACE(FRONT);% 22403000
END;% 22404000
P(RESULT AND 1); GO EXIT; 22405000
INTRINSIC:% 22406000
FOR MIX~1 STEP 1 UNTIL MIXMAX DO% 22407000
IF INTABLEROW[MIX]!0 THEN% 22408000
BEGIN IF MIX=P2MIX THEN STOP;% 22409000
IF (T ~ M[PRT[MIX,8]].[CF])}FRONT AND T{BACK% 22410000
THEN BEGIN P(AWAKEN); GO EXIT; 22411000
END; 22411020
END;% 22412000
FOR MIX~1 STEP 1 UNTIL MIXMAX DO% 22413000
IF INTABLEROW[MIX]!0 THEN 22413010
BEGIN SEGNO ~ MOM.[8:10]-1;% 22415000
STREAM(A ~ SEGNO AND 3; T ~ [INTABLE[MIX,SEGNO DIV 4]]); 22416000
BEGIN SI ~ T; SI ~ SI+A; SI ~ SI+A; DI ~ LOC A;% 22417000
DI ~ DI+6; DS ~ 2 CHR; END STREAMING;% 22418000
IF (SEGNO ~ POLISH)!0 THEN% 22419000
IF SEGNO = @2000 THEN INT13 ELSE 22419500
BEGIN CHAR ~ P(PRT[MIX,8], DUP).[32:1];% 22420000
TYPE13:=SEGNO.[37:1]; 22420200
SEGNO:=SEGNO AND @1777; %IGNORE TYPE 13 BIT 22420500
S ~ POLISH INX 0; BS ~ PRT[MIX,10].[FF];% 22421000
SEGDICT ~ PRT[MIX,4];% 22422000
X:=SEGDICT[SEGNO].[8:10]; 22423000
IF TYPE13 AND NOT PRT[MIX,X].[2:1] THEN 22423100
% TYPE 13 REFERENCE ALSO EXISTS AND TYPE 7 REFERENCE IS NOT PRESENT 22423200
INT13 ELSE 22423300
BEGIN 22423400
CODEOVERLAY; 22423500
SEGDICT[SEGNO] ~ (*P(DUP))&MOM[FTF];% 22424000
END; 22424500
END;% 22425000
END;% 22426000
INTRNSC[MOM.[8:10]] ~ (*P(DUP))&MOM[FTC];% 22427000
FORGETSPACE(FRONT);% 22428000
P(AWAKEN,DEL,TRUE); 22429000
EXIT: 22429100
$ SET OMIT = NOT(NEWLOGGING) 22429199
$ SET OMIT = NOT(WORKSET) 22429210
IF P1MIX NEQ 0 THEN 22429220
IKATTUNEPO1NUX]:=(*P(DUP))+(CLOCK+P(RTR)-MCPTEMP); 22429230
$ POP OMIT % WORKSET 22429231
P(RTN); 22429300
END OF OVERLAY;% REVISION OF MAY 31, 1967... 22430000
PROCEDURE CHANGEABORT(X); VALUE X; REAL X;% 22900000
BEGIN ARRAY A[*];, B[*];% 22901000
REAL J, T;% 22902000
22903000
A~[M[SPACE(210)]]&210[8:38:10]; 22904000
SLEEP([TOGLE], ABORTMASK);% 22905000
LOCKTOG(ABORTMASK); 22906000
DISKWAIT(-A.[CF],210,ESPDISKTOP+1); 22907000
WHILE (A[0]:=XCLOCK+P(RTR)) GEQ WITCHINGHOUR DO MIDNIGHT; 22909000
A[1] ~ DATE;% 22910000
J ~ 3|P1MIX;% 22911000
A[J] ~ A[J+1] ~ A[J+2] ~ 0;% 22912000
B~JARROW[P1MIX]; %CANT WATCH JAR AND LOSE CONTROL, TOO. 22913000
A[J+90] ~ B[0]; 22914000
A[J+91] ~ B[1]; 22915000
A[J+92] ~ X&B[5][1:25:23]; 22916000
A[180+P1MIX]~USERCODE[P1MIX]; 22917000
DISKWAIT(A.[CF],210,ESPDISKTOP+1); 22918000
UNLOCKTOG(ABORTMASK); 22919000
FORGETSPACE(A);% 22920000
END;% 22921000
$ SET OMIT = NOT(DATACOM) 22999999
REAL SPACESTACK; 23500000
SAVE PROCEDURE FORGETSPACE(LOC);% 24000000
VALUE LOC;% 24001000
REAL LOC;% 24002000
BEGIN% 24003000
REAL B,BACK,F,FRONT,LINK,X,T,SIZE;% 24004000
LOC ~ *P(.LOC) INX 0 -2;% 24005000
IF (B~ M[BACK~ (LINK~ M[LOC]).[FF]]).[CF]!LOC OR 24006000
(F~M[FRONT~LINK.[CF]]).[FF]!LOC OR LINK<0 THEN 24007000
PUNT(3); % INVALID LINK 24007100
IF F<0 THEN 24007200
BEGIN% 24008000
M[LOC]~LINK &F[CTC];% 24009000
M[F]~M[F] & LOC[CTF];% 24010000
M[T~M[FRONT+2]]~M[T] &(X~M[FRONT+1])[CTC];% 24011000
M[X+1]~T;% 24012000
END;% 24013000
IF B<0% 24014000
THEN% 24015000
BEGIN 24016000
M[BACK]~B&(T~M[LOC].[CF])[CTC];% 24017000
M[T]~M[T]& BACK[CTF];% 24018000
M[BACK+1]~M[BACK+1]&(SIZE~T-BACK-2)[CTF];% 24019000
END% 24020000
ELSE %BACK IN USE 24021000
BEGIN% 24022000
M[LOC+2]~AVAIL;% 24023000
M[LOC+1]~(T~M[AVAIL]) &(SIZE~M[LOC].[CF ]-LOC-2)[CTF24024000
];% 24025000
M[T+1]~LOC+1;% 24026000
M[AVAIL]~T &(LOC+1)[CTC]% 24027000
; M[LOC]~-M[LOC]% 24028000
END;% 24029000
IF LOC{LEFTOFF THEN IF M[LOC].[CF]>LEFTOFF THEN LEFTOFF~M[LOC].[FF];24030000
$ SET OMIT = NOT(DEBUGGING OR CHECKLINK) 24030100
END FORGETSPACE;% 24031000
SAVE INTEGER PROCEDURE ACTSPACE(SIZE,SAVEF); 24032050
VALUE SIZE,SAVEF; REAL SIZE; BOOLEAN SAVEF; 24032100
BEGIN REAL LINK,LOC,X,Y,T; 24032200
$ SET OMIT = NOT(SATISTICS 24032300
REAL SIZEF,LOS; 24032700
LABEL SVSTART,SVSEARCH,START,OVSEARCH,XX,ROCKABYE; 24032800
IF SAVEF THEN% ATTEMPT TO ALLOCATE AT START OF MEMORY 24032900
BEGIN 24033000
SVSTART: LINK:=M[0]; 24033100
SVSEARCH: IF (LOC:=LINK.[CF])=0 THEN GO TO ROCKABYE; 24033200
IF (LINK ~ M[LOC])}0 THEN% 24033300
BEGIN IF NOT LINK.[2:1] THEN% 24033400
BEGIN % OVRLAY ONLY IF POTENTIAL SPACE ADEQUATE 24033500
SIZEF ~ -2; X ~ T ~ LOC; 24033600
IF (Y~LINK.[FF]) ~ 0 THEN 24033700
IF M[Y] < 0 THEN SIZEF~M[(T~Y)+1].[FF]; 24033800
WHILE SIZE>SIZEF AND (Y~M[X]).[1:2]!1 DO 24033900
SIZEF ~ SIZEF - X + (X ~ Y.[CF]); 24034000
IF SIZE > SIZEF THEN 24034100
BEGIN LINK ~ Y; GO SVSEARCH; END; 24034200
IF OLAY(LOC) THEN % RE-SET "LINK" 24034300
IF (Y~M[LINK~T])>0 OR Y.[CF]=LOC 24034400
OR M[Y].[FF]!LINK THEN 24034500
% MEM LINK AT "T" NO LONGER VALID 24034600
GO TO SVSTART ELSE GO TO SVSEARCH 24034700
ELSE GO TO SVSEARCH; 24034750
END ELSE 24034800
GO TO SVSEARCH;% 24034900
END;% 24035000
IF (SIZEF ~ M[T~LOC+1].[FF])<SIZE THEN GO SVSEARCH;% 24035100
M[ACTSPACE:=LOC]:=ABS(LINK&1[2:47:1]); 24035200
LINK ~ M[T]; M[LINK+1] ~ Y ~ M[T+1];% 24035300
M[Y] ~ (*P(DUP))&LINK[CTC];% 24035400
IF SIZEF>SIZE+DELTA THEN% 24035500
BEGIN M[LOC] ~ (X ~ *P(DUP))&(Y ~ LOC+SIZE+2)[CTC];% 24035600
M[X] ~ (*P(DUP))&Y[CTF];% 24035700
M[Y] ~ X.[CF]&LOC[CTF];% 24035800
FORGETSPACE(Y+2);% 24035900
END;% 24036000
END ELSE 24036100
IF SAVEF}63 OR TOGLE.MEMNO=0 THEN 24036125
BEGIN% ALLOCATE ON "SPACE AVAILABLE" BASIS 24036150
START:% 24036200
IF (LINK ~ POLISH(M[AVAIL], 0, SIZE, CFX, LLL,% 24036300
0, INX, .T, STD)).[FF]=@77777 THEN% 24036400
BEGIN% 24036500
OVSEARCH:% 24036600
IF (LINK:=M[LEFTOFF]).[1:2] = 0 THEN 24036700
BEGIN% OVERLAY ONLY IF POTENTIAL SPACE ADEQUATE 24036800
SIZEF:=-2; X:=LEFTOFF; 24036900
IF (Y:=LINK.[CF]) ! 0 THEN 24037000
IF M[Y] < 0 THEN SIZEF ~ M[Y+1].[FF]; 24037100
WHILE SIZE > SIZEF AND (Y~M[X]).[1:2]!1 DO 24037200
BEGIN SIZEF~SIZEF+Y.[CF]-X; X~Y.[FF] END; 24037300
IF SIZE > SIZEF THEN 24037400
BEGIN LEFTOFF ~ Y.[FF]; 24037500
IF LEFTOFF=0 OR X=0 THEN GO TO XX 24037600
ELSE GO TO OVSEARCH END; 24037700
IF (IF P1MIX=0 THEN 1 ELSE 24037900
IF (X:=LINK.[9:6])!P1MIX THEN 1 ELSE 24038000
((TWO(X) AND OLAYMASK)!0)) THEN 24038100
IF OLAY(LEFTOFF) THEN GO TO START; 24038200
END;% 24038300
IF (LEFTOFF~LINK.[FF])=0 THEN 24038400
XX: IF LOS THEN GO TO ROCKABYE ELSE LOS~1; 24038500
GO TO OVSEARCH; 24038600
END;% 24038700
IF (SIZEF ~ LINK.[FF])>SIZE+DELTA THEN% 24038800
BEGIN M[T] ~ LINK&(X ~ SIZEF-SIZE-2)[CTF];% 24038900
LOC ~ T+X+1;% 24039000
X ~ (Y ~ M[T-1])&(T-1)[CTF];% 24039100
M[Y] ~ (*P(DUP))&LOC[CTF];% 24039200
M[T-1] ~ Y&LOC[CTC];% 24039300
END ELSE 24039400
BEGIN 24039450
M[LINK+1] ~ Y ~ M[T+1];% 24039500
M[Y] ~ (*P(DUP))&LINK[CTC];% 24039600
X ~ M[LOC ~ T-1];% 24039700
END;% 24039800
M[ACTSPACE:=LOC]:=ABS(X&1[2:47:1]); 24039900
END ELSE GO TO SVSTART; % MEMNO!0 24040000
$ SET OMIT = NOT(STATISTICS) 24040100
M[LOC+1]:=0; 24041900
ROCKABYE: 24042000
END ACTSPACE; 24042100
SAVE INTEGER PROCEDURE GETSPACE(SIZE,TYPE,SAVEF); 24042200
VALUE SIZE,TYPE,SAVEF; 24042300
REAL SIZE,TYPE; BOOLEAN SAVEF; 24042400
BEGIN 24042500
REAL COUNT,T,MESS; 24042550
% %156-24042555
% FIELDS OF SAVEF PARAMETER %156-24042560
% %156-24042565
FIELD %156-24042570
% NEEDOLAY = 09:39 % THIS FIELD IS NON ZERO IF 24042575
% REQUESTOR WANTS OLAY SPACE24042580
TYPENOMEMANDRETURN = 45:01 % IF SAVEF.[45:02] = 3 THEN24042585
,JUSTRETURN = 46:01 % GETSPACE WILL TYPE OK MEM24042590
,GETFROMFRONT = 47:01 % IF SUCCESSFUL. %156-24042595
; %156-24042596
LABEL NEWSTART; 24042600
SUBROUTINE TELLSPO; 24042625
BEGIN P(MESS!0 OR SAVEF.[45:2]=3); %156-24042650
IF (MESS:=GETSPACE(3,0,2)+2)=2 THEN PUNT(3); 24042675
M[MESS-2].[9:6]:=0; %549-24042680
STREAM(X:=P: P1MIX, SIZE, MESS); 24042700
BEGIN SI:=LOC P1MIX; DS:=2 DEC; 24042725
DS:=8 LIT" NO MEM "; 24042750
DS:=5 DEC; DS:=5 LIT" WDS~"; 24042775
X(DI:=DI-17; DS:=2 LIT"OK"); 24042800
END; 24042825
P(DEL); 24042850
IOREQUEST(MESS&@274[1:40:8], P(DUP), 24042875
[17]&@231[10:40:8]); 24042900
END OF TELLING SPO ABOUT NO MEMS; 24042925
NEWSTART: 24042950
IF NOT STOREDY THEN SLEEP([TOGLE],STOREMASK); 24043000
LOCKTOG(STOREMASK); 24043100
$ SET OMIT = NOT(DEBUGGING OR CHECKLINK) 24043200
P(SPACESTACK,STS); 24043500
T:=ACTSPACE(SIZE,SAVEF); 24043600
P([MESS],STS); 24043700
UNLOCKTOG(STOREMASK); 24043800
IF T=0 THEN 24043900
BEGIN NOMEMTOG:=1; 24044000
IF SAVEF.JUSTRETURN THEN P(0,RTN); %156-24044100
IF SAVEF.TYPENOMEMANDRETURN THEN %156-24044110
BEGIN %156-24044120
TELLSPO; %156-24044130
P(0,TRN); %156-24044140
END; %156-24044150
NOMEM~NOMEM+1; 24044200
TAR[P1MIX].[20:1]:=1; 24044250
IF (COUNT~COUNT+1)>5 THEN 24044300
IF MESS=0 THEN TELLSPO; 24044400
SLEEP([CLOCK], NOT CLOCK);% 24045100
NOMEN~NOMEN-1; 24045200
TAR[P1MIX].[20:1]:=0; 24045250
GO TO NEWSTART;% 24045300
END;% 24045400
M[GETSPACE:=T]:=(*P(DUP))&TYPE[3:42:6]&P1MIX[9:42:6]; 24045500
IF MESS!0 OR SAVEF.[45:2]=3 THEN TELLSPO; %156-24045600
END GETSPACE; 24046200
SAVE INTEGER PROCEDURE DISKSPACE(WORDS,MIX,AUX); 24101000
VALUE WORDS,MIX,AUX; 24102000
INTEGER WORDS,MIX; REAL AUX; 24103000
BEGIN ARRAY LOC=+2[*]; 24104000
INTEGER INDEX=NT1, 24105000
SEG =NT2, 24106000
CNTRS=NT3, 24107000
SIZE =NT4, 24108000
LIMIT=NT5; 24109000
REAL T =NT6; 24110000
LABEL L1, 24111000
FINAL, 24112000
BADEXIT, 24112500
EXIT; 24113000
DEFINE HEURISTIC = 2#; 24114000
REAL SUBROUTINE FINDSEG; 24115000
BEGIN; STREAM(A~0:T); 24116000
BEGIN S1~LOC T; SI~SI+3; 24117000
5(IF SC="0" THEN JUMP OUT TO L; 24118000
SI~SI+1; TALLY~TALLY+1); 24119000
L: A~TALLY; 24120000
END STREAM; 24121000
FINDSEG ~ POLISH 24122000
END FINDSEG; 24123000
SUBROUTINE FIND; 24124000
BEGIN POLISH(0); 24125000
T ~ LOC[INDEX]; 24126000
SEG ~ T.[9:3]; 24127000
CNTRS ~ T.[2:7]; 24128000
IF SEG>4 THEN 24129000
L1: IF (SEG ~ FINDSEG(=5 THEN GO TO FINAL 24130000
ELSE CNTRS ~0; 24131000
IF SIZE+CNTRS>100 THEN GO TO L1; 24132000
P(DEL,(INDEX|256)+SEG|100+CNTRS); 24133000
STREAM(A~0:SEG,T~[T]); 24134000
BEGIN SI~T; SI~SI+3; SI~SI+SEG; 24135000
DI~LOC A; DI~DI+7; SEG~DI; 24136000
T~SI; DS~CHR; TALLY~A; 24137000
TALLY~TALLY+1; A~TALLY; 24138000
SI~SEG; DI~T; DS~CHR; 24139000
L5:: 24139500
END STREAM; 24140000
IF (POLISH=63) OR (CNTRS ~ CNTRS+SIZE)=100 THEN 24141000
BEGIN CNTRS ~ 0; SEG ~ FINDSEG END; 24142000
LOC[INDEX] ~ T&SEG[9:45:3]&CNTRS[2:41:7]; 24143000
FINAL: IF (DISKSPACE ~ POLISH)!0 THEN 24144000
BEGIN IF SEG=5 THEN INDEX ~ 0; 24145000
LOC[0] ~ LIMIT&INDEX[CTF]; 24146000
GO TO EXIT; 24147000
END END FIND; 24148000
$ SET OMIT = NOT(AUXMEM) 24148999
P(DALOCROW[MIX]); 24150000
SIZE ~ (WORDS+29) DIV 30; 24151000
IF (LIMIT := LOC[0].[CF])=0 THEN GO TO BADEXIT; 24152000
IF (INDEX ~ LOC[0].[FF])!0 THEN FIND; 24153000
INDEX ~ 2; 24154000
DO FIND UNTIL (INDEX := INDEX+2)>LIMIT; 24155000
BADEXIT: 24155500
DISKSPACE ~ -1; 24156000
EXIT: 24157000
$ SET OMIT = NOT(STATISTICS) 24157199
STREAM(A~0:L~LIMIT.[41:6],T~[LOC[1]]); 24158000
BEGIN SI~T; DI~A; 24159000
L(SI~SI+11; 24160000
5(IF SC="0" THEN DI~DI+8; SI~SI+1)); 24161000
A~DI; 24162000
END STREAM; 24163000
IF (POLISH<HEURISTIC) THEN 24164000
IF ((SEG ~ TWO(MIX)) AND OLAYMASK)!0 THEN 24165000
BEGIN OLAYMASK ~ NOT SEG AND OLAYMASK; 24166000
INDEPENDENTRUNNER(P(.GETMOREOLAYDISK),MIX,100); % 24167000
END; 24168000
END DISKSPACE; 24169000
SAVE PROCEDURE DISKRTN(SEGNO, SIZE); 24200000
VALUE SEGNO, SIZE; 24201000
INTEGER SEGNO, SIZE; 24202000
BEGIN INTEGER INDEX=NT1, 24203000
WORD =NT2, 24204000
COUNT=NT3, 24205000
DRUM =NT4, 24206000
X =NT5, 24207000
ARRAY LOC =+1[*]; 24208000
LABEL L; 24209000
$ SET OMIT = NOT(AUXMEM) 24209099
P(DALOC[P1MIX,*]); 24210000
COUNT ~ TWO(24-6|(SEGNO.[39:9] DIV 100)); 24211000
X ~ (INDEX ~ 0&SEGNO[41:33:6])-1; 24212000
IF (WORD ~ LOC[INDEX].[18:30]-COUNT)=0 THEN 24213000
BEGIN LOC[INDEX] ~ 0; 24214000
L: IF P(LOC[0].[FF],DUP)!0 THEN 24221000
IF LOC[POLISH-1]<0 THEN P(XIT); 24222000
LOC[0] ~ (*P(DUP))&INDEX[CTF]; 24223000
END ELSE BEGIN LOC[INDEX]~ (*P(DUP))&WORD[18:18:30]; 24224000
IF LOC[X]<0 THEN 24225000
IF (WORD DIV COUNT).[42:6]=0 THEN GO TO L; 24226000
END END DISKRTN; 24227000
$ SET OMIT = NOT(DATACOM ) 24499999
$ SET OMIT = NOT(SHAREDISK) 24599999
$ SET OMIT = NOT(DATACOM AND DCSPO ) 24999999
$ SET OMIT = NOT(DATACOM) 25004999
$ SET OMIT = NOT(B6500LOAD) 27990099
PROCEDURE LIBRARYHELP(Z); VALUE Z; REAL Z; 28000000
% 28000002
%********************************************************************** 28000004
% 28000006
% 28000008
% LIBRARYHELP PERFORMS INFREQUENTLY NEEDED TASKS FOR THE OTHER 28000010
% LIBRARY MAINTENANCE PROCEDURES. IT SHARES LOCALS BY USING THE 28000012
% SAME STACK AS ITS CALLING PROCEDURE. LIBRARYCOPY OR 28000014
% LIBRARYTRANSFER. 28000016
% 28000018
% 28000020
% 0: A) SETS UP FPB ENTRY FOR INPUT SOURCE TAPE 28000022
% B) RETURNS DIRECTORY LEAVING TAPE POSITIONED AFTER 28000024
% ENDING LABEL OF DIRECTORY 28000026
% 28000028
% 1: RETURNS AFTER SECURING A NEW INPUT SOURCE TAPE 28000030
% 28000032
% 2: ABORT FROM LIBRARYTRANSFER 28000034
% 28000036
% 3: SETS UP FPB ENTRY FOR INPUT SOURCE DISK 28000038
% 28000040
% 4: ABORT FROM LIBRARYCOPY 28000042
% 28000044
% 5: INITIALIZATION OF LIBRARYTRANSFER INCLUDING LOCATION 28000046
% OF SPECIFIED OUTPUT UNIT 28000048
% 28000050
% 6: ERROR HANDLING OR REEL SWITCHING 28000052
% 28000054
% 7: WRITING DIRECTORY IF NOT REEL 1 28000056
% 28000058
% 8: EXTRA RECORDS DETECTED IN CURRENT FILE 28000060
% 28000062
% 9: BAD HEADER DETECTED ON SOURCE 28000064
% 28000066
% 10: INVALID RECORD SIZE ON LAST READ OR WRITE 28000068
% 28000070
% 11: KEYIN REEL SWITCH 28000072
% 28000074
% 28000076
%********************************************************************** 28000078
% 28000080
BEGIN 28000200
REAL COMMON=-4, 28000400
MSCW=-2, RCW=+0, 28000500
MFID=+1, FID=MFID+1, 28000600
ASMFID=FID+1, ASFID=ASMFID+1, 28000800
TMP=ASFID+1, TEMP=TMP+1, 28001000
FA=TEMP+1, FAINFO=FA+1, 28001200
FASZ=FAINFO+1, FAIN-FASZ+1, 28001400
TU=FAIN+1, T=IU+1, 28001600
FPBPTR=T+1, IREEL=FPBPTR+1, 28001800
NM1=IREEL+1, NM2=NM1+1, 28002000
DESTIN=NM2+1, TOGS=DESTIN+1, 28002200
DA=TOGS+1, CCAIN=DA+1, OU=CCAIN, 28002400
FAIN=CCAIN+1, OREEL=FAIN, NAIN=EAIN+1, N=NAIN, 28002600
NA=NAIN+1, CNT=NA, NASZ=NA+1, INC=NASZ, 28002800
LSX=NASZ+1, OUC=LSX, BUMPFA=LSX+1, Y=BUMPFA, 28003000
POOL=BUMPFA+1, W=POOL, INDX=POOL+1, SIZE=INDX, 28003200
UN=INDX+1, Q=UN, SEG=UN+1, J=SEG, 28003400
MAX=SEG+1, TM=MAX, K=MAX+1, 28003600
L=K+1, MIDPTR=L+1, SV=MIDPTR, 28003800
UNITNO=MIDPTR+1; 28004000
ARRAY 28004200
CCA=NITNO+1[*], H=CCA[*], X=CCA+1[*], AROW=X[*], 28004400
PAP=X+1[*], IOD=PAP[*], LAB=PAP+1[*], 28004600
LBL=LAB+1[*], WRDSZ=LBL+1[*]; 28004800
$ SET OMIT = NOT(B6600LOAD) 28005000
LABEL TRYNEXT,TRYAGN,FINDIT,BAC,BACK,P1,P2,P3,EXIT,ST,TAPEPAR; 28005800
LABEL CASE0,CASE1,CASE2,CASE3,CASE4,CASE5,CASE6,CASE7,CASE9; 28006000
DEFINE 28006200
BACKSPACER = 5&@3400[CTF]#, 28006400
SPACER = 5&@1400[CTF]#, 28006600
MM = @37700040#, 28006800
SM = @37700000#, 28007000
DSED = (TERMSET(P1MIX))#, 28007200
UNITNUM = [1:5]#, %148-28007300
SPOUTUNIT = 0#, 28007400
FORKED = TOGS.[23:1]#, 28007600
B6500 = TOGS.[24:1]#, 28007800
OE = TOGS.[26:1]#, 28008000
FROMCOPY = TOGS.[27:1]#, 28008200
REELSW = TOGS.[33:1]#, 28008400
REEL1START = TOGS.[34:1]#, 28008600
SKIPDIR = TOGS.[35:1]#, 28008800
SPACITSW = TOGS.[36:1]#, 28009000
CHKLBL = TOGS.[37:1]#, 28009200
COPYING = TOGS.[38:1]#, 28009300
OUTAPEPARITY= TOGS.[39:1]#, 28009400
SKIPFILE = TOGS.[40:1]#, 28009600
DUMPDIR = TOGS.[42:1]#; 28009800
SWITCH SWIT:=CASE0,CASE1,CASE2,CASE3,CASE4,CASE5,CASE6,CASE7, 28010000
P2,CASE9,P1,TAPEPAR; 28010200
%*********************************************************** 28010400
DEFINE NOTCOPIED(NOTCOPIED1)= 28010600
BEGIN NT3:=NOTCOPIED1; NOCOPYMESS; END#; 28010800
SUBROUTINE NCOPYMESS; 28011000
LBMESS( ABS(MFID, FID, -67, NT3, TINU[IU], SPOUTUNIT, 1 ); 28011200
%*********************************************************** 28011400
SUBROUTINE ABORT; 28011600
BEGIN 28011800
IF COPYING 28011810
THEN IF OU=18 28011820
THEN BEGIN P(DIRECTORYSEARCH(MFID,FID,6),DEL); 28011830
OE:=0; % NOT OPENED EXCLUSIVE 28011832
END 28011834
ELSE BEGIN P(WAITIO([TM],@40,OU),DEL); 28011840
P(WAITIO(LBL&@5000[CTF],@40,OU),DEL); 28011850
END; 28011860
IF NOT FROMCOPY THEN 28012000
BEGIN IF OU GEQ 0 THEN 28012010
BEGIN IF OU LSS 16 THEN 28012020
BEGIN BLASTQ(OU); 28012030
P(WAITIO([TM],@40,OU),DEL); 28012040
SETNOTINUSE(OU,1); 28012060
END; 28012070
STOPTIMING(0,1023); 28012080
END; 28012090
IF IU GEQ 0 THEN 28012100
IF IU LSS 16 THEN BLASTQ(IU); 28012110
END ELSE 28012120
WHILE CCA[29] NEQ 0 DO 28012130
BEGIN SEG:=CCA[29]; DISKWAIT(-CCA.[CF],30,SEG); 28012140
FORGETESPDISK(SEG); 28012150
END; 28012160
FOR TMP:=0 STEP 1 UNTIL (FAIN DIV 2) DO 28012800
IF (TEMP:=M[FAINFO+TMP]).[CF]=18 THEN 28013000
IF TEMP.[17:1] THEN ELSE 28013200
P(DIRECTORYSEARCH(-(TEMP.[FF]),13,20),DEL); 28013400
IF OE THEN P(DIRECTORYSEARCH(-MFID,FID,14),DEL); 28013600
IF FORKED 28013800
THEN BEGIN IF IU GEQ 0 THEN 28014000
IF IU LSS 16 THEN SETNOTINUSE(IU,0); 28014100
STOPTIMING(FPBPTR,1023); 28014200
END 28014400
ELSE FOR TMP:=5 STEP 5 UNTIL (NT1:=PRT[P1MIX,3]).[8:10]-5 DO 28014600
IF M[TN1 INX (TMP+4)] LSS 0 THEN 28014800
BEGIN IF (TEMP:=M[NT1 INX (TMP+3)].[36:6]-1) LSS 16 28015000
THEN SETNOTINUSE(TEMP,0); 28015200
STOPTIMING(TMP,1023); 28015400
END; 28015600
FOR TMP:=0 STEP 1 UNTIL 15 DO 28015800
IF LABELTABLE[TMP] LSS 0 THEN 28016000
IF RDCTABLE[TMP].[8:6]=P1MIX THEN SETNOTINUSE(TMP,0); 28016200
$ SET OMIT = PACKETS 28017200
STREAM(T:=T:=SPACE(5)); 28018000
BEGIN DS:=21LIT"LIBRARY COPY ABORTED~"; END; 28018200
SPOUT(T); 28018400
GO INITIATE; 28018600
END; 28018800
%*********************************************************** 28019000
BOOLEAN SUBROUTINE LABELCHECK; 28019200
BEGIN 28019400
TRYNEXT: 28019600
P(WAITIO(LAB INX @120540000000,0,IU),DEL); 28019800
$ SET OMIT = NOT(B6500LOAD) 28020000
IF @40!WAITIO(SPACER,@40,IU) THEN 28021800
P(WAITIO(@4740000050,0,IU),DEL); 28022000
IF DSED THEN ABORT; 28022200
IF (NOT B6500 AND ((NFLAG(LAB[0]).[6:42] EQV "LABEL ")!NOT 0 28022400
OR (NFLAG(LAB[2]).[6:24] EQV "FILE")!NOT 0)) 28022600
$ SET OMIT = NOT(B6500LOAD) 28022800
THEN BEGIN 28023600
STREAM(A:=[TINU[IU]],T:=T:=SPACE(10)); 28023800
BEGIN SI:=A;SI:=SI+5;DS:=LIT".";DS:=3 CHR; 28024000
DS:=21 LIT" NOT A LIBRARY TAPE~"; 28024200
END; 28024400
SPOUT(T); T:=1; 28024600
END ELSE T:=0; 28024800
IF T=0 AND NOT B6500 THEN 28025000
IF NFLAG(LAB[2]).[30:18]=0 AND SKIPDIR THEN 28025200
BEGIN 28025400
SPACITSW:=1; CHKLBL:=FALSE; 28025600
GO TO BACK; %BRANCH INTO SPACIT. 28025800
BAC: 28026000
SPACITSW:=0; CHKLBL:=TRUE; 28026200
GO TO TRYNEXT; 28026400
END; 28026600
LABELCHECK:=T; 28026800
END; 28027000
%*********************************************************** 28027200
SUBROUTINE FINDTHETAPE; 28027400
BEGIN 28027600
FINDIT: 28027800
IF (IU:=FINDINPUT(NM1,NM2,IREEL,-0,0,0,0,0,1,FPBPTR)) < 0 28028000
THEN ABORT: 28028100
NM1.UNITNUM:=0; %148-28028110
IREEL:=RDCTABLE[IU].[14:10]; %FORCE REEL CONTINUITY IF IL-ED. 28028200
RRRMECH:=TWO(IU) OR RRRMECH; 28028400
B6500:=PRNTABLE[IU].[2:1]; 28028600
$ SET OMIT = NOT(B6500LOAD) 28028800
IF CHKLBL THEN IF LABELCHECK THEN 28029400
BEGIN 28029600
SETNOTINUSE(IU,1); 28029800
GO FINDIT; 28030000
END; 28030200
% STARTIMING(FPBPTR,IU); DONE IN FINDINPUT 28030400
% M[PRT[P1MIX,3] INX (5|IREEL+3)].[23:1] := 1; 28030600
RDCTABLE[IU].[8:6]:=P1MIX; 28030800
STREAM (S:=PRNTABLE[IU].[18:30],T:=[T]); 28031000
BEGIN SI:=LOC S; DS:=8DEC; DI:=DI-7; DS:=6FILL; END; 28031200
$ SET OMIT = PACKETS 28031400
FILEMESSAGE(" IN "&TINU[IU][6:30:18],T, 28032000
NM1,NM2,IREEL,0,0,OPNMESS); 28032200
END; % OF FINDTHETAPE 28032400
%*********************************************************** 28032600
BOOLEAN PROCEDURE ENDOFREEL; 28032800
BEGIN 28033000
BLASTQ(IU); 28033200
IF P(WAITIO(LAB INX @120540000000,@2000040,IU),DUP)=@20 THEN 28033400
BEGIN % PAR OR ENDING LABEL:TEST FOR LAST FILE ON TAPE(EOF) 28033600
LAB[4]:=(*P(DUP))&(WAITIO(SPACER,@40,IU)=@40)[47:47:1]; 28033800
P(WAITIO(5&@3400[CTF],@377,IU),DEL); 28034000
END; 28034200
$ SET OMIT = NOT(B6500LOAD) 28034400
NT1:=P; 28036000
IF DSED THEN ABORT; 28036200
IF ((NOT B6500) AND NFLAG(LAB[4]) AND NT1!@40) 28036400
$ SET OMIT = NOT(B6500LOAD) 28036600
THEN BEGIN 28037200
STOPTIMING(FPBPTR,1023);% 28037400
SETNOTINUSE(IU,0); 28037600
IREEL:=IREEL+1; 28037800
$ SET OMIT = NOT(B6500LOAD); 28038000
NM2:=LAB[2]; 28039200
NM1:=LAB[1]; 28039400
FINDTHETAPE; 28039600
ENDOFREEL:=TRUE; 28039800
END ELSE ENDOFREEL:=FALSE; 28040000
END; % OF SUBROUTINE ENDOFREEL 28040200
%*******************************************************************28040400
SUBROUTINE WRITENDINGLABEL; 28040600
BEGIN 28040800
P(WAITIO([TM],@40,OU),DEL); 28041000
P(WAITIO(LBL&@5000[CTF],@40,OU),DEL); 28041400
IF DSED THEN ABORT; 28041600
END; % OF WRITE ENDING LABEL 28041800
%*********************************************************** 28042000
SUBROUTINE SPACIT;% 28042200
BEGIN 28042400
BACK: WHILE WAITIO(SPACER,MN,IU)!@40 DO 28042600
BEGIN 28042800
IF DSED THEN ABORT; 28043000
IF STOPSET(P1MIX) THEN STOPM(0); 28043200
END; 28043400
IF ENDOFREEL AND NOT SPACITSW THEN GO BACK; 28043600
IF SPACITSW THEN GO TO BAC; %BRNACH TO LABELCHECK ELSE EXIT 28043800
END; 28044000
%*******************************************************************28044200
SUBROUTINE SHORTHEADER; 28044400
BEGIN 28044600
P(WAITIO(H&@5000[CTF]&20[8:38:10],@40,OU),DEL); 28044800
WRITENDINGLABEL; 28045000
END; 28045200
%******************************************************** 28045400
SUBROUTINEBACKSPACIT; 28045600
BEGIN 28045800
WHILE WAITIO(BACKSPACER,MM,OU) ! @40 DO 28046000
BEGIN 28046200
IF DSED THEN ABORT; 28046400
IF STOPSET(P1MIX) THEN STOPM(0); 28046600
END; 28046800
P(WAITIO([TM],@40,OU),DEL); % WRITE THE TM BACK 28047000
END; 28047200
%*******************************************************************28047400
BOOLEAN SUBROUTINE NOTLOADINGFROMREEL1; 28047600
BEGIN %SKIP LAST PORTION OF FILE FROM PREVIOUS REEL 28047800
SPACIT; 28048000
IF LABELCHECK THEN P(0) ELSE 28048200
IF (NFLAG(LAB[2]) EQV "FILE000") = NOT 0 THEN 28048400
BEGIN REEL1START:=FALSE; P(1) END ELSE P(0); 28048600
NOTLOADINGFROMREEL1:=P; 28048800
END; 28049000
%******************************************************* 28049200
P(Z,RCW,MSCW,STF); RCW:=HCW&P(XCH)[CTC]; 28049400
TEMP:=P; FROMCOPY:=(TEMP=0) OR (TEMP=3) OR (TEMP=4) 28049600
GO TO SWIT[TEMP]; 28049800
CASE0: 28050000
CASE3: 28050100
TMP:=PRT[P1MIX,3]; 28050200
FPBPTR:=FPBPTR+5; 28050400
IF FPTPTR GTR 5 THEN 28050600
BEGIN TMP:=GETSPACE(FPBPTR+ETRLNG,FPBAREAV,1)+2;% %167-28050800
MOVE(FPBPTR,PRT[P1MIX,3],TMP); 28051000
FORGETSPACE(PRT[P1MIX,3].[CF]); 28051200
NFO[(P1MIX-1)|NDX]:=PRT[P1MIX,3]:= 28051400
[M[TMP]]&(FPBPTR+ETRLNG)[8:38:10]; 28051600
END; 28051800
IF TEMP=3 28052000
THEN BEGIN 28052200
STREAM(B:=TMP INX FPBPTR); 28052400
BEGIN DS:=16LIT"0DIRCTRY0DISK "; DS:=24LIT"0"; END; 28052600
STARTIMING(FPBPTR,18); 28052800
GO EXIT; 28053000
END 28053200
ELSE 28053400
STREAM(NM1:=NM1:=CCA[CCAIN+1],B:=(TMP INX FPBPTR)); 28053600
BEGIN DS:=LIT"0"; SI:=LOC NM1; SI:=SI+1; DS:=7CHR; 28053800
DS:=8LIT"0FILE000"; DS:=24LIT"0"; 28054000
END; 28054200
IREEL:=1; 28054400
NM1:=CCA[CCAIN+1]; 28054600
NM2:="FILE000"; 28054800
REEL1START:=TRUE; CHKLBL:=TRUE; 28055000
TRYAGAIN: FINDTHETAPE; 28055200
$ SET OMIT = NOT(B6500LOAD) 28055400
IF NM2!LAB[2] OR IREEL!1 THEN 28056000
IF NOT NOTLOADINGFROMREEL1 THEN 28056200
BEGIN STREAM(A:=[TINU[IU]],T:=T:=SPACE(10)); 28056400
BEGIN SI:=A;SI:=SI+5;DS:=LIT".";DS:=3CHR; 28056600
DS:=20 LIT" NOT A LIBRARY TAPE"; 28056800
DS:=LIT"~"; 28057000
END; 28057200
SPOUT(T); SETNOTINUSE(IU,1); 28057400
IREEL:=1; 28057600
GO TO TRYAGN; 28057800
END; 28058000
NM1:=LAB[1]; 28058200
SKIPDIR:=TRUE; 28058400
X:=[M[T:=SPACE(1024)]]&1023[8:38:10]; 28058600
P(WAITIO(( 28058800
$ SET OMIT = NOT(B6500LOAD) 28059000
X)&@5400[CTF],0,IU),DEL); 28059600
$ SET OMIT = NOT(B6500LOAD) 28059800
IF DSED THEN ABORT; 28061800
X:=[M[GETSPACE(DA:=M[T-1],0,1)+2]]&DA[8:38:10]; % RET XTRA SPACE 28062000
MOVE(DA,T,X); % AND MAKE X SAVE 28062200
FORGETSPACE(T); 28062400
CHKLBL:=FALSE; 28062600
TMP:=0; 28062800
IF @40=WAITIO(LAP INX @120540000000,@40,IU) THEN 28063000
IF B6500 THEN P(WAITIO(LAB INX @120540000000,0,IU),DEL) ELSE 28063200
TMP:=ENDOFREEL; 28063400
IF NOT TMP THEN% CHECK ENDING LABEL IF NOT LAST FILE OR B6500LOAD 28063600
IF ((NOT B6500) AND (NFLAG(LAB[1])EQV NM1)!NOT 0 OR 28063800
(NFLAG(LAB[2]) EQV "FILE000")!NOT 0) 28064000
$ SET OMIT = NOT(B6500LOAD) 28064200
THEN BEGIN STREAM(A:=[TINU[IU]],TMP:=TMP:=SPACE(10)); 28065000
BEGIN SI := A; SI := SI+5; DS := LIT"."; DS := 3 CHR; 28065200
DS := 29 LIT " BAD FILE000 ON LIBRARY TAPE~"; 28065400
END; SPOUT (TMP); ABORT; 28065600
END; 28065800
CHKLBL:=TRUE; 28066000
$ SET OMIT = NOT(B6500LOAD) 28066200
GO EXIT; 28067000
CASE1: 28067200
FINDTHETAPE; GO EXIT; 28067400
CASE2: % FROM LIBRARYTRANSFER 28067600
CASE4: % FROM LIBRARYCOPY 28067800
ABORT; 28068000
CASE5: 28068200
OU:=IU:=-1; DS:=@77777; % INITIALIZE 28068400
FPBPTR:=0; 28068600
CHKLBL:=TRUE; SKIPDIR:=TRUE; 28068800
IOD:=[M[GETSPACE(6,0,1)+2]]&2[8:38:10]; 28069000
WRDSZ:=4 INX IOD; 28069200
AROW:=2 INX IOD; 28069400
AROW[0]:=[M[GETSPACE(902,0,1)+2]]&901[8:38:10]; 28069600
AROW[1]:=AROW[0]&(GETSPACE(902,0,1)+2)[CTC]; 28069800
H:=[M[TYPEDSPACE(42,DISKHEADERAREAV))] & 30[8:38:10];% %167-28070000
IF DESTIN.UNITNUM = 19 THEN %148-28070200
BEGIN 28070400
COMMON:=IF DESTIN.[42:6] NEQ 0 THEN DESTIN OR M ELSE 28070600
IF DESTIN.[40:1] THEN 1 OR M ELSE 28070800
IF DESTIN.[41:1] THEN 2 OR M ELSE 0; 28071000
OU:=18; 28071200
STREAM(B:=PRT[P1MIX],3] INX 0); 28071400
BEGIN DS:=16LIT"0DIRCTRY0DISK "; DS:=24LIT"0"; END; 28071600
STARTIMING(0,OU); 28071800
END 28072000
ELSE 28072200
BEGIN OREEL:=1; 28072400
TM:=0&"}~"[1:37:11]; 28072600
LBL:=[M[TAPELABEL(DESTIN,NM2:-"FILE000",1,1,100)]]&10[8:38:10]; 28072800
IF (OU:=LABELASCRATCH(LBL)) LSS 0 THEN ABORT; 28073000
STREAM(N:=DESTIN,B:=PRT[P1MIX,3] INX 0); 28073200
BEGIN DS:=LIT"0"; SI:=LOC N; SI:=SI+1; DS:=7CHR; 28073400
DS:=8LIT"0FILE000"; DS:=24LIT"0"; 28073600
END; 28073800
STARTIMING(0,OU); 28074000
PRNTABLE[OU]:=(*P(DUP)) & (IOD)[15:33:15]; 28074050
SV:=M[FAINFO]; 28074200
M[FA+FASZ]:=@14; % TO REMIAN COMPATIBLE WITH EARLIER MCPS 28074400
P(WAITIO(FA&(FASZ+I)[8:38:10]&@5000[CTF],@40,OU),DEL); 28074600
M[FAINFO]:=SV; 28074800
WRITENDINGLABEL; 28075000
END; 28075200
GO EXIT; 28075400
CASE6: 28075600
IF Y.[7:1] AND Y.[27:1] THEN % END OF TAPE 28075800
IF Y.[24:1] 28076000
THEN % EOF ON SOURCE 28076200
BEGIN 28076400
IF NOT ENDOFREEL THEN 28076600
BEGIN 28076800
P(WAITIO(@4740000020,@377,IU),DEL); 28077200
TEMP:=-1; % FOR NOTCOPIED MESSAGE AT P1 28077400
IOD[1]:=IOD[0]:=IOMASK; GO P1; 28077600
END; 28077800
IF WAITIO(IOD[W] INX @16040540000000,SM,IU) NEQ 0 28078000
THEN GO P1; 28078200
IF IOD[1-W].[7:1] AND Y.[3:4]=IOD[1-W].[3:4] THEN 28078400
BEGIN 28078600
IF WAITIO(IOD[1-W],SM,IU) NEQ 0 THEN GO P1; 28078800
IOD[1-W]:=(*P(DUP)) OR IOMASK; 28079000
END; 28079200
END 28079400
ELSE 28079600
BEGIN % EOT ON DESTINATION 28079800
IF IOD[1-W].[7:1] AND Y.[3:4]=IOD[1-W].[3:4] THEN 28080000
BEGIN 28080200
SLEEP([IOD[1-W]],IOMASK); 28080400
IF IOD[1-W].[28:1] THEN GO P3; 28080600
IOD[1-W].[27:1]:=0; 28080800
END; 28081000
TAPEPAR:LBL[4]:=(*P(DUP)) OR 1; 28081200
IF LBL[2].[30:18]=0 THEN %FILE000 LAST FILE 28081400
STREAM(A:=J+2,B:=[LBL[2]]); 28081600
BEGIN SI:=LOC A; DI:=DI+5; DS:=3 DEC END; 28081800
P(WAITIO([TM],@40,OU),DEL); 28082000
P(WAITIO(LBL&@5000[CTF],@40,OU),DEL); 28082200
P(WAITIO([TM],@40,OU),DEL); 28082400
STOPTIMING(0,1023); 28082600
SETNOTINUSE(OU,1); 28082800
LBL[4]:=(*P(DUP)) AND NOT(1); 28083000
STREAM(OREEL:=OREEL:=OREEL+1,LBL); 28083200
BEGIN SI:=LOC OREEL; 28083400
DI:=DI+24; DS:=3 DEC; 28083600
END; 28083800
IF (OU:=LABELASCRATCH(LBL)) LSS 0 THEN 28084000
BEGIN COPYING:=FALSE; ABORT; END; 28084100
STARTIMING(0,OU); 28084200
PRNTABLE[OU]:=(*P(DUP)) & (IOD)[15:33:15]; 28084250
DUMPDIR:=TRUE; %DUMP DIRECTORY 28084400
END 28084600
ELSE 28084800
IF Y.[7:1] % TAPE PARITY 28085000
THEN IF Y.[24:1] 28085200
THEN BEGIN % PARITY ON INPUT TAPE 28085400
P1: COMPLEXSLEEP((((IOD[0] AND IOD[1]) AND IOMASK) NEQ 0) 28085600
OR DSED); 28085800
NOTCOPIED)27+((TEMP=10)|12)+((TEMP=(-1))|6)); 28086000
IF DSED THEN ABORT; 28086200
SKIPFILE:=TRUE; 28086400
P2: BLASTQ(IU); 28086600
P(WAITIO(@4740000020,@377,IU),DEL); 28086800
IF J NEQ ((FASZ DIV 2)-1) THEN SPACIT; 28087000
IF OU=18 28087200
THEN P(DIRECTORYSEARCH(MFID,FID,6),DEL) 28087400
ELSE BEGIN 28087600
BACKSPACIT; 28087800
SHORTHEADER; 28088000
END; 28088200
END 28088400
ELSE BEGIN % PARITY ON OUTPUT TAPE 28088600
P3: IF IU LSS 16 28088800
THEN BEGIN 28089000
WHILE WAITIO(BACKSPACER,MM,IU) NEQ @40 DO 28089200
BEGIN 28089400
IF DSED THEN ABORT; 28089600
IF STOPSET(P1MIX) THEN STOPM(0); 28089800
END; 28090000
P(WAITIO(SPACER,@40,IU),DEL); % READ TM 28090200
P(WAITIO((*[AROW[0]])&@5400[CTF],@2000000,IU),DEL); 28090400
$ SET OMIT = NOT (B6500LOAD) 28090600
IF M[AROW[0] INX NOT 0] NEQ 30 THEN ABORT; 28091200
END; 28091400
BACKSPACIT; 28091600
P(WAITIO(H&@5000[CTF],@40,OU),DEL); 28091800
OUTAPEPARITY:=TRUE; 28092000
GO TAPEPAR; 28092200
END 28092400
ELSE BEGIN % DISK PARITY 28092600
SKIPFILE:=TRUE; 28092800
BACKSPACIT; 28093000
SHORTHEADER; 28093200
NOTCOPIED(35); 28093400
P(DIRECTORYSEARCH(-DA.[FF]),13,20),DEL); 28093600
M[FAINFO+J].[17:1]:=1; % MARK CLOSED FOR ABORT 28093800
M[FAINFO+J].[8:1]:=0; % DONT REMOVE IF UNLOAD %757-28093900
END; 28094000
GO EXIT; 28094200
CASE7: 28094400
P(M[FA+1],M[FA]); % SAVE NAME FOR UNLOAD %757-28094500
M[FA]:=@114; M[FA+1]:=(J+1)|2;%FLAG [0], OFFSET [1] 28094600
LBL[2].[30:18]:=0; %FILE000 28094800
P(WAITIO(LBL&@5000[CTF],@40,OU),DEL); 28095000
P(WAITIO([TM],@40,OU),DEL); 28095400
IF DSED THEN ABORT; 28095600
IOD[0]:=0; W:=1; SIZE:=FASZ+1; 28095800
TMP:=M[FA+FASZ]; M[FA+FASZ]:=@14; 28096000
IOREQUEST(-(IOD[W]:=(FA INX @500000000)& 28096200
SIZE[8:38:10]&TINU[OU][3:3:5]) OR @2017700000, 28096400
IOD[W],[IOD[W]]&OU[12:42:6]); 28096600
COMPLEXSLEEP((((IOD[W]) AND IOMASK)+0) OR DSED); 28096800
M[FA+FASZ]:=TMP; 28097000
NT1:=P; M[FA]:=NT1; M[FA+1]:=P(XCH); % REPLACE NAMES %757-28097100
IF DSED THEN ABORT; 28097200
GO EXIT; 28097400
CASE9: 28097600
IF DESTIN.UNITNUM = 19 %148-28097800
THEN GO ST 28098000
ELSE BEGIN 28098200
SHORTHEADER; 28098400
IF IU=18 THEN 28098600
BEGIN 28098800
P(DIRECTORYSEARCH(-(DA.[FF]),13,20),DEL); 28099000
M[FAINFO+J].[17:1]:=1; % MARK CLOSED FOR ABORT 28099200
END ELSE 28099400
BEGIN 28099600
ST: H[2]:=LAB[2]; 28099800
SPACIT; 28100000
IF H[2] NEQ LAB[2] THEN ABORT; 28100200
END; 28100400
END; 28100600
NOTCOPIED(43); 28100800
GO EXIT; 28101000
EXIT: P(0,RDS,0,XCH,P&P[CTF],STF); 28101200
END OF LIBRARYHELP; 28101400
PROCEDURE LIBRARYTRANSFER; 28200000
% 28200002
%********************************************************************** 28200004
% 28200006
% 28200008
% LIBRARYTRANSFER PERFORMS THE ACTUAL PHYSICAL TRANSFER OF FILES 28200010
% BASED ON INFORMATION SUPPLIED BY LIBRARYCOPY. BASICALLY, ALL 28200012
% LIBRARYTRANSFER NEEDS FROM LIBRARYCOPY IS "FA" (THE FILE ARRAY 28200014
% WHICH CONTAINS THE NAME PAIRS TO BE TRANSFERRED), "FAINFO" 28200016
% (THE FILE ARRAY INFORMATION, WHICH CONTAINS NECESSARY INFO. 28200018
% ABOUT EACH NAME PAIR), AND "DESTIN" (THE USER SPECIFIED 28200020
% DESTINATION). 28200022
% 28200024
% TRANSFERS MAY BE MADE FROM TAPE TO TAPE, TAPE TO DISK, OR 28200026
% DISK TO TAPE. LIBRARYTRANSFER WILL ATTEMPT TO TRANSFER DATA 28200028
% FROM THE INPUT SOURCE SPECIFIED IN THE "FAINFO" ENTRY TO THE 28200030
% UNIT SPECIFIED THRU "DESTIN". THE BULK OF LIBRARYTRANSFER IS 28200032
% JUST LOOPING THROUGH "FAINFO" USING ONE ENTRY AT A TIME UNTIL 28200034
% THEY ARE EXHAUSTED. AT EACH CHANGE OF INPUT SOURCE THE FPB 28200036
% IS FIXED UP DIFFERENTLY DEPENDING UPON WHETHER THE JOB WAS 28200038
% FORKED OR NOT (REFER TO DOCUMENTATION). 28200040
% 28200042
% 28200044
% DA CURRENT "FAINFO" ENTRY 28200046
% .[CF] IF DISK THEN 18 28200048
% IF TAPE THEN UNIT NUMBER OF THE TAPE 28200050
% .[FF] IF DISK THEN DISK ADDRESS OF FILE HEADER 28200052
% IF TAPE THEN NUMBER OF THIS FILE ON TAPE 28200054
% .[5:1] SPECIFIES LATEST VERSION WANTED 28200056
% .[6:1] FILE TO BE ADDED 28200058
% .[8:1] FILE TO BE UNLOADED 28200060
% .[13:1] FILE TO BE ADDED (NOT ON DISK) %160-28200061
% 28200062
% NOTE: ANY OPTIONS SET THAT DO NOT APPLY TO A PARTICULAR 28200064
% CIRCUMSTANCE WILL BE IGNORED 28200066
% 28200068
% IU CURRENT INPUT UNIT 28200070
% 28200072
% OU " OUTPUT " 28200074
% 28200076
% IREEL CURRENT INPUT REEL NUMBER (IF TAPE) 28200078
% 28200080
% OREEL " OUTPUT " " " 28200082
% 28200084
% FA FILE ARRAY OF NAME PAIRS TO BE TRANSFERRED 28200086
% 28200088
% FAINFO TRANSFER INFO. FOR EACH NAME PAIR 28200090
% 28200092
% FPBPTR CURRENT FPB ENTRY INDEX 28200094
% 28200096
% H CURRENT FILE HEADER 28200098
% 28200100
% LAB LAST INPUT LABEL READ 28200102
% 28200104
% LBL LAST OUTPUT LABEL READ 28200106
% 28200108
% TOGS.[21:1] (BHS) INDICATES BAD HEADER 28200110
% [23:1] (FORKED) NOT ORIGINATING LIBMAIN/DISK 28200112
% [26:1] (OE) CURRENT <MFID>/<FID> HAS BEEN 28200114
% OPENED EXCLUSIVE 28200116
% 28200118
% [28:1] (SOMECOPIED) AT LEAST ONE FILE HAS BEEN 28200120
% TRANSFERED 28200122
% [38:1] (COPYING) NOTES STAGE OF PROCESSING FOR 28200124
% USE BY ABORT 28200126
% [40:1] (SKIPFILE) USED TO INDICATE ABRUPT EXIT TO 28200128
% NEXT FILE SHOULD BE TAKEN 28200130
% 28200132
% 28200134
%********************************************************************** 28200136
% 28200138
BEGIN 28200200
REAL COMMON=-4, 28200400
MSCW=-1, RCW=+0, 28200800
MFID=RCW+1, FID=MFID+1, 28201000
XX1=FID+1, XX2=XX1+1, 28201200
TMP=XX2+1, TEMP=TMP+1, 28201400
FA=TEMP+1, FAINFO=FA+1, 28201600
FASZ=FAINFO+1, FAIN=FASZ+1, 28201800
IU=FAIN+1, T=IU+1, 28202000
FPBPTR=T+1, IREEL=FPBPTR+1, 28202200
NM1=IREEL+1, NM2=NM1+1, 28202400
DESTIN=NM2+1, TOGS=DESTIN+1, 28202600
DA=TOGS+1, OU=DA+1, 28202800
OREEL=OU+1, N=OREEL+1, 28203000
CNT=N+1, INC=CNT+1, 28203200
OUC=INC+1, Y=OUC+1, 28203400
W=Y+1, SIZE=W+1, 28203600
Q=SIZE+1, J=Q+1, 28203800
TM=J+1, K=TM+1, 28204000
U=K+1, SV=U+1, 28204200
UNITNO=SV+1; 28204400
ARRAY 28204600
H=UNITNO+1[*], AROW=H+1[*], 28204800
IOD=AROW+1[*], LAB=IOD+1[*], 28205000
LBL=LAB+1[*], WRDSZ=LBL+1[*]; 28205200
ARRAY HDR=XX1[*]; 28205400
$ SET OMIT = NOT(B6500LOAD) 28205600
DEFINE 28206400
DSED = TERMSET(P1MIX)#, 28206600
SPOUNIT = 0#, 28206800
SPACER = 5&@1400[CTF]#, 28207000
MM = @37700040#, 28207200
FINDTHETAPE = LIBRARYHELP(1)#, 28207400
ABORT = LIBRARYHELP(2)#, 28207600
SWITCHREELS = LIBRARYHELP(11)#, 28207650
UNITNUM = [1:5]#, %160-28207700
LATEST = DA.[5:1]#, 28207800
ADDV = DA.[6:1]#, 28208000
UNLOAD = DA.[8:1]#, 28208200
MUSTADD = DA.[13:1]#, %160-28208300
BHS = TOGS.[21:1]#, 28208400
FORKED = TOGS.[23:1]#, 28208600
B6500 = TOGS.[24:1]#, 28208800
OE = TOGS.[26:1]#, 28209000
SOMECOPIED = TOGS.[28:1]#, 28209100
REELSW = TOGS.[33:1]#, 28209200
SKIPDIR = TOGS.[35:1]#, 28209400
SPACITSW = TOGS.[36:1]#, 28209600
CHKLBL = TOGS.[37:1]#, 28209800
COPYING = TOGS.[38:1]#, 28209900
OUTAPEPARITY = TOGS.[39:1]#, 28210000
SKIPFILE = TOGS.[40:1]#, 28210200
NOLBL = TOGS.[41:1]#, 28210400
DUMPDIR = TOGS.[42:1]#; 28210600
LABEL UP,BAC,WATE,LOOP,BACK,TTPF,BH,DK,WY,BADHDR,PRE; 28210800
LABEL TRYNEXT,PARERR,HANDLERR,NEXT,SKIPPER,FALLOUT; 28211000
%*********************************************************** 28211200
DEFINE NOTCOPIED(NOTCOPIED1) = 28211400
BEGIN NT3:=NOTCOPIED1; NOCOYMESS; END#; 28211600
SUBROUTINE NOCOPYMESS; 28211800
LBMESS( ABS(MFID), FID, -67, NT3, TINU[IU], SPOUTUNIT, 1 ); 28212000
%*********************************************************** 28212200
% 28212201
% - READS BEGINNING LABEL AND TAPE MARK CHECKING FOR 28212202
% CORRECTNESS OF LIBRARY TAPE SOURCE 28212203
% 28212204
%************************************************************ 28212205
% 28212206
BOOLEAN SUBROUTINE LABELCHECK; 28212400
BEGIN 28212600
TRYNEXT: 28212800
IF WAITIO(LAB INX @120540000000,@40&@20[CTF],IU)=@40 AND 28213000
NOT B6500 RHWN % PREMATURE EOT 28213200
BEGIN STREAM(T:=T:=SPACE(5)); 28213400
BEGIN DS:=16LIT". PREMATURE EOT~"; END; 28213600
GO PRE; 28213800
END; 28214000
$ SET OMIT = NOT(B6500LOAD) 28214600
IF @40!WIATIO(SPACER,@40,IU) THEN 28216400
P(WAITIO(@4740000005,0,IU),DEL); 28216600
IF DSED THEN ABORT; 28216800
IF (NOT B6500 AND ((NFLAG(LAB[0]).[6:42] EQV "LABEL ")!NOT 0 28217000
OR (NFLAG(LAB[2]).[6:42] EQV "FILE")!NOT 0)) 28217200
$ SET OMIT = NOT(B6500LOAD) 28217400
THEN BEGIN 28218200
STREAM(A:=[TINU[IU]],T:=T:=SPACE(10)); 28218400
BEGIN SI:=A;SI:=SI+5;DS:=LIT".";DS:=3 CHR; 28218600
DS:=21 LIT" NOT A LIBRARY TAPE~"; 28218800
END; 28219000
PRE: SPOUT(T); T:=1; 28219200
END ELSE T:=0; 28219400
IF T=0 AND NOT B6500 THEN 28219600
IF NFLAG(LAB[2]).[30:18]=0 AND SKIPDIR THEN 28219800
BEGIN 28220000
SPACITSW:=1; CHKLBL:=FALSE; 28220200
GO TO BACK; %BRANCH INTO SPACIT. 28220400
BAC: 28220600
SPACITSW:=0; CHKLBL:=TRUE; 28220800
GO TO TRYNEXT; 28221000
END; 28221200
LABELCHECK:=T; 28221400
END; 28221600
%*********************************************************** 28221800
% 28221801
% - READS ENDING LABEL CHECKING TO SEE IF INPUT TAPE 28221802
% REEL SWITCHING IS IN ORDER 28221803
% 28221804
%************************************************************ 28221805
% 28221806
BOOLEAN SUBROUTINE ENDOFREEL; 28222000
BEGIN 28222200
BLASTQ(IU); 28222400
IF P(WAITIO(LAB INX @120540000000,@2000040,IU),DUP)=@20 THEN 28222600
BEGIN % PAR ON ENDING LABEL:TEST FOR LAST FILE ON TAPE(EOF) 28222800
LAB[4]:=(*P(DUP))&(WAITIO(SPACER,@40,IU)=@40)[47:47:1]; 28223000
P(WAITIO(5&@3400[CTF],@377,IU),DEL); 28223200
END; 28223400
$ SET OMIT = NOT(B6500LOAD) 28223600
IF B6500 THEN P(DEL) ELSE NT1:=P; 28225000
IF DSED THEN ABORT; 28225200
IF ((NOT B6500) AND NFLAG(LAB[4]) AND NT1!@40) 28225400
$ SET OMIT = NOT(B6500LOAD) 28225600
THEN BEGIN 28226200
STOPTIMING(FPBPTR,1023);% 28226400
SETNOTINUSE(IU,0); 28226600
IREEL:=IREEL+1; 28226800
$ SET OMIT = NOT(B6500LOAD) 28227000
NM2:=LAB[2]; 28228200
NM1:=LAB[1]; 28228400
FINDTHETAPE; 28228600
ENDOFREEL:=TRUE; 28228800
END ELSE ENDOFREEL:=FALSE; 28229000
END; % OF SUBROUTINE ENDOFREEL 28229200
%*********************************************************** 28229400
SUBROUTINE SPACIT;% 28229600
BEGIN 28229800
BACK: WHILE WAITIO(SPACER,MM,IU)!@40 DO 28230000
BEGIN 28230200
IF DSED THEN ABORT; 28230400
IF STOPSET(P1MIX) THEN STOPM(0); 28230600
END; 28230800
IF ENDOFREEL AND NOT SPACITSW THEN GO BACK; 28231000
IF SPACITSW THEN GO BAC; % BRANCH TO LABELCHECK ELSE EXIT 28231200
END; 28231400
%*******************************************************************28231600
SUBROUTINE WRITENDINGLABEL; 28231800
BEGIN 28232000
P(WAITIO([TM],@40,OU),DEL); 28232200
P(WAITIO(LBL&@5000[CTF],@40,OU),DEL); 28232600
IF DSED THEN ABORT; 28232800
END; % OF WRITE ENDING LABEL 28233000
%*********************************************************** 28233200
% 28233201
% - HANDLES IO"S FOR DISK-TO-TAPE, TAPE-TO-DISK, OR TAPE- 28233202
% TO-TAPE TRANSFER INCLUDING B6500 TAPE SIZE ALTERATIONS 28233203
% 28233204
%************************************************************ 28233205
% 28233206
SUBROUTINE IO; 28233400
BEGIN 28233600
SIZE:=IF (N-CNT) GTR 30 THEN 900 ELSE (N-CNT)|30; 28233800
IF U LSS 16 28234000
THEN 28234200
BEGIN 28234400
TMP:=@500000000; 28234600
IF IOD[W].[24:1] 28234800
THEN TMP:=TMP+B6500 28235000
ELSE BEGIN SIZE:=SIZE+B6500; WRDSZ[W]:=SIZE; END; 28235200
IOREQUEST(-(IOD[W]:=(AROW[W] INX TMP)& 28235400
SIZE[8:38:10]& 28235600
TINU[U][3:3:5]& 28235800
(NOT IOD[W])[24:24:1]) OR @2017700000, 28236000
IOD[W], 28236200
[IOD[W]]&U[12:42:6]); 28236400
END 28236600
ELSE 28236800
BEGIN 28237000
DISKIO(IOD[W],(AROW[W] INX B6500-1)&(NOT IOD[W])[1:24:1], 28237200
SIZE,Q+CNT); 28237400
$ SET OMIT = NOT(STATISTICS) 28237600
END; 28238200
END; 28238400
%********************************************************** 28238600
% 28238601
% - COPYS EACH ROW OF A FILE CHECKING FOR ERRORS, INCORRECT 28238602
% RECORD SIZE IN TRANSFER, AND KEYIN REEL SWITCHING 28238603
% 28238604
%************************************************************ 28238605
% 28238606
SUBROUTINE COPYAROW; 28238800
BEGIN 28239000
N:= 28239200
$ SET OMIT = NOT(B6500LOAD) 28239400
H[8]; 28240000
Q:=H[K+9]; 28240200
CNT:=W:=INC:=0; OUC:=-30; 28240400
IOD[0]:=IOD[1]:=IOMASK; 28240600
U:=IU; 28240800
LOOP: 28241000
IO; 28241200
WATE: 28241400
W:=1-W; 28241600
IF IOD[W] NEQ IOMASK THEN 28241800
COMPLEXSLEEP((((IOD[W]) AND IOMASK) NEQ 0) OR DSED); 28242000
IF DSED THEN ABORT; 28242200
IF (Y:=IOD[W]).[27:2] NEQ 0 28242400
THEN BEGIN LIBRARYHELP(6); 28242600
IF OUTAPEPARITY OR SKIPFILE THEN GO HANDLERR; 28242800
END 28243000
ELSE IF (Y.[7:1] AND Y.[24:1]) 28243200
THEN IF (M[AROW[W] INX NOT 0]) NEQ WRDSZ[W] 28243400
THEN BEGIN LIBRARYHELP(10); 28243600
GO HANDLERR; 28243800
END ELSE ELSE 28244000
IF JAR[P1MIX[X,9].[1:1] % RC KEYIN 28244010
THEN BEGIN 28244020
JAR[P1MIX,9]:=(*P(DUP)) & 0[1:47:1]; 28244030
SWITCHREELS; 28244040
END; 28244050
IF IOD[W].[24:1] % LAST THING DONE ON THIS BUFFER WAS READ 28244200
THEN BEGIN U:=OU; CNT:=OUC:=OUC+30; GO LOOP; END; 28244400
IF (CNT:=INC:=INC+30) LSS N % MORE READING NECESSARY 28244600
THEN BEGIN U:=IU; GO LOOP; END; 28244800
IF IOD[1-W] NEQ IOMASK 28245000
THEN BEGIN IOD[W]:=IOMASK; GO WATE; END; 28245200
HANDLERR: 28245400
END; 28245600
%************************************************************ 28245800
P(MSCW,STF); RCW:=RCW&P(..LIBRARYTRANSFER,LOD)[CTC]; 28246000
IF FASZ GTR 0 THEN LIBRARYHELP(5) ELSE IU:=OU:=(FPBPTR:=0)-1; %134-28246200
FOR J:=0 STEP 1 UNTIL (FASZ DIV 2)-1 DO 28246400
BEGIN 28246600
COPYING:=FALSE; 28246700
% 28246701
%******************************************* 28246702
% FPB FIXUP ON CHANGE OF INPUT SOURCE 28246703
%******************************************* 28246704
% 28246705
IF DA.[CF] NEQ (TMP:=M[SV:=FAINFO+J].[CF]) THEN 28246800
BEGIN IF IU NEQ (-1) THEN 28247000
BEGIN IF IU LSS 16 THEN SETNOTINUSE(IU,0); 28247200
STOPTIMING(FPBPTR,1023); 28247400
END; 28247600
IF FORKED THEN 28247800
BEGIN 28248000
STARTIMING(FPBPTR:=5,TMP); 28248200
IF TMP LSS 16 THEN 28248400
STREAM(MF:=MULTITABLE[TMP],F:=LABELTABLE[TMP], 28248600
B:=PRT[P1MIX,3] INX 5); 28248800
BEGIN SI:=LOC MF; DS:=16CHR; 28249000
END 28249200
ELSE 28249400
STREAM(B:=PRT[P1MIX,3] INX 5); 28249600
BEGIN DS:=16LIT"0DIRCTRY0DISK "; END; 28249800
RDCTABLE[TMP].[8:10]:=P1MIX; 28250000
END ELSE 28250200
WHILE (TEMP:=M[(NT1:=(PRT[P1MIX,3] INX (FPBPTR:= 28250400
FPBPTR+5)))+3].[36:6]-1) NEQ TMP DO 28250600
IF M[NT1+4] LSS 0 THEN % NOT AREADY STOPPED 28250800
BEGIN IF TEMP LSS 16 THEN SETNOTINUSE(TEMP,0); 28251000
STOPTIMING(FPBPTR,1023); 28251200
END; 28251400
IU:=TMP; % AT THIS POINT IU CHANGES 28251600
IF IU LSS 16 THEN 28251800
IREEL:=RDCTABLE[IU].[14:10]; % PICK UP REEL NO. 28252000
$ SET OMIT = NOT(B6500LOAD) 28252200
END; 28252800
DA:=M[SV]; 28253000
MFID:=M[FA+J|2]; FID:=M[FA+1+J|2]; 28253200
SKIPFILE:=FALSE; 28253400
IF IU=18 28253600
THEN BEGIN 28253800
% 28253801
%******************************************* 28253802
% INPUT SOURCE DISK 28253803
%******************************************* 28253804
% 28253805
DISKWAIT(-H.[CF],30,DA.[FF]); 28254000
IF DESTIN.UNITNUM = 19 %148-28254200
THEN BEGIN 28254400
ABORT; 28254600
END 28254800
ELSE BEGIN 28255000
% 28255001
%******************************************* 28255002
% OUTPUT TO TAPE 28255003
%******************************************* 28255004
% 28255005
TIPE: STREAM(A:=J+1,B:=[LBL[2]]); 28255200
BEGIN SI:=LOC A;DI:=DI+5;DS:=3 DEC END; 28255400
LABELTABLE[OU]:=-LBL[2]; % ENTER FILE ID FOR OL MESSAGE 28255600
H[9]:=(*P(DUP)) AND 31; 28255800
IF NOLBL THEN NOLBL:=FALSE ELSE 28256000
BEGIN 28256200
P(WIATIO(LBL&@5000[CTF],@40,OU),DEL); 28256400
P(WAITIO([TM],@40,OU),DEL); 28256800
END; 28257200
IF BHS OR (P([H[9]],LOD,DUP)=0 OR P(XCH) GTR 20) 28257400
THEN BEGIN 28257600
BADHDR: LIBRARYHELP(9); 28257800
GO NEXT; 28258000
END; 28258200
P(WAITIO(H&@5000[CTF],@40,OU),DEL); 28258400
UP: COPYING:=TRUE; 28258600
IF DSED THEN ABORT; 28258700
FOR K:=1 STEP 1 UNTIL H[9].[43:5] DO% WRITE OUT FILE 28258800
IF H[K+9]!0 THEN 28259000
BEGIN 28259200
COPYAROW; 28259400
IF OUTAPEPARITY THEN 28259600
BEGIN 28259800
OUTAPEPARITY:=FALSE; 28260000
GO UP; 28260200
END; 28260400
IF SKIPFILE THEN GO NEXT; 28260600
IF STOPSET(P1MIX) THEN STOPM(0); 28260800
END; 28261000
COPYING:=FALSE; 28261100
IF OU LSS 16 THEN WRITENDINGLABEL; 28261200
IF IU LSS 16 THEN 28261400
$ SET OMIT = NOT B6500LOAD 28261600
IF WAITIO(SPACER,MM,IU) NEQ @40 THEN 28262200
BEGIN NOTCOPIED(56); LIBRARYHELP(8); GO NEXT; END; 28262400
$ SET OMIT = PACKETS 28262600
BEGIN 28263200
STREAM(MFID,FID,A:=TINU[IU],B:=TINU[OU],T:=T:=SPACE(10)); 28263400
BEGIN SI:=LOC MFID; SI:=SI+1; DS:=7CHR; DS:=LIT"/"; 28263600
SI:=SI+1; DS:=7CHR; DS:=13LIT" COPIED FROM "; 28263800
SI:=SI+5; DSD:=3CHR; DS:=4LIT" TO "; SI:=SI+5; 28264000
DS:=3CHR; DS:=LIT"~"; 28264200
END; 28264400
SPOUTER(T,0,L,LIBMSG); 28264600
END; 28264800
SOMECOPIED:=TRUE; 28264900
IF IU=18 THEN 28265000
BEGIN P(DIRECTORYSEARCH(-(DS.[FF],13,20),DEL); 28265200
M[FAINFO+J].[17:1]:=1; 28265400
END; 28266000
IF OU=18 THEN 28266200
BEGIN P(DIRECTORYSEARCH(-MFID,FID,14),DEL); OE:=0; END; 28266400
IF DUMPDIR THEN 28266600
BEGIN LIBRARYHELP(7); 28266800
IF (Y:=IOD[W]).[27:2] NEQ 0 THEN 28267000
IF Y.[28:1] THEN 28267200
BEGIN STREAM(T:=T:=SPACE(7)); 28267400
BEGIN DS:=31LIT"PARITY WHILE WRITING DIRECTORY~"; 28267600
END; 28267800
SPOUT(T); ABORT; 28268000
END ELSE 28268200
LIBRARYHELP(6); 28268400
IF NOT IOD[W].[27:1] THEN 28268600
BEGIN WRITENDINGLABEL; DUMPDIR:=0; END ELSE NOLBL:=1; 28268800
END; 28269000
IF IU LSS 16 THEN 28269400
$ SET OMIT = NOT B6500LOAD 28269600
GO FALLOUT; 28270200
END; 28270400
END 28270600
ELSE BEGIN % SOURCE TAPE 28270800
% 28270801
%******************************************* 28270802
% INPUT SOURCE TAPE 28270803
%******************************************* 28270804
% 28270805
%******************************************* %160-28270806
% CHECK IF FILE IS TO BE ADDED %160-28270807
%******************************************* %160-28270808
% %160-28270809
IF ADDV THEN %160-28270810
IF NOT MUSTADD THEN %160-28270812
IF DESTIN.UNITNUM = 19 THEN% TAPE TO DISK %160-28270814
IF DIRECTORYSEARCH(-MFID,FID,5) NEQ 0% ALREADY ON DISK %160-28270816
THEN BEGIN %160-28270818
LBMESS(ABS(MFID),FID,-67,68,TINU[IU],SPOUTUNIT,LIBMSG); 28270820
IF STOPSET(P1MIX) THEN STOPM(0); %160-28270822
IF DSED THEN ABORT; %160-28270824
GO NEXT; %160-28270826
END %160-28270828
ELSE BEGIN M[FAINFO+J].[13:1]:=1; MUSTADD:=1 END; %160-28270830
IF LABELCHECK THEN ABORT; 28271000
$ SET OMIT = NOT(B6500LOAD) 28271200
% 28272201
%******************************************* 28272202
% POSITION THE TAPE TO CORRECT FILE 28272203
% USING INFO. IN "FAINFO" ENTRY (UA) 28272204
%******************************************* 28272205
% 28272206
STREAM(B:=LAB[2],SV:=[SV]); 28272400
BEGIN SI:=LOC B; SI:=SI+5; DS:=3OCT; END; 28272600
IF SV NEQ DA.[FF] THEN BEGIN J:=J-1; GO SKIPPER; END; 28272800
IF WAITIO((*[AROW[0]])&@5400[CTF],@2000000,IU)=@20 28273000
THEN BEGIN P(1); GO BH; END; % RD HDR CHKING FOR PARITY 28273200
MOVE(30+5|B6500,AROW[0].[CF]+B6500,H); 28273400
$ SET OMIT = NOT B6500LOAD 28273600
T:=-1; 28275800
IF (NOT B6500) AND (M[AROW[0] INX NOT 0] NEQ 30) 28276000
THEN P(1) 28276200
ELSE 28276400
BEGIN STREAM(A:=0:D:=H); 28276600
BEGIN SI:=D; 30(IF SB THEN BEGIN TALLY:=1; JUMP OUT END28276800
ELSE SI:=SI+8); A:=TALLY; 28277000
END; 28277200
IF P THEN P(1) 28277400
ELSE IF (NT1:=H[9].[43:5]) GTR 20 OR NT1=0 28277600
THEN P(1) 28277800
ELSE 28278000
BEGIN SV:=0; 28278200
FOR W:=10 STEP 1 UNTIL 29 DO 28278400
BEGIN SV:=SV+(NT2:=(H[W] NEQ 0)); 28278600
IF W GEQ NT1+10 THEN IF NT2 THEN W:=31; 28278800
END; 28279000
IF ((W=31) OR (SV GTR NT1) OR ((SV NEQ 0) AND 28279200
(H[8]=0))) 28279400
THEN P(1) 28279600
ELSE P(0); 28279800
END; 28280000
END; 28280200
BH: BHS:=P(XCH); 28280400
IF BHS THEN 28280600
IF DESTIN.UNITNUM = 19 THEN GO BADHDR ELSE GO TTPE; %148-28280800
IF DESTIN.UNITNUM = 19 %148-28281000
THEN 28281200
BEGIN % TAPE TO DISK (LOAD) 28281400
% 28281401
%******************************************* 28281402
% OUTPUT TO DISK 28281403
%******************************************* 28281404
% 28281405
IF MUSTADD THEN T:=0 ELSE% ADD FILE NOT ON DISK %160-28281550
IF (T:=DIRECTORYSEARCH(MFID&(3+4|(ADDV))[1:45:3], 28281600
FID,4+ADDV)) GEQ 2 28281800
THEN 28282000
IF T=2 THEN NOTCOPIED(25) 28282200
ELSE BEGIN 28282400
IF (SV:=NOT ADDV AND M[T+2] NEQ 0 AND 28282600
((USERCODE[P1MIX] EQV ABS(MCP)) NEQ NOT 0) AND 28282800
((USERCODE[P1MIX] EQV ABS(M[T+2])) NEQ NOT 0)) OR 28283000
(LATEST AND M[T+3].[30:18] GTR H[3].[30:18]) THEN 28283200
BEGIN 28283400
HEADERUNLOCK(ABS(MFID),FID,T); 28283600
T:=-1; 28283800
NOTCOPIED(64-SV|23); 28284000
END; 28284200
END 28284400
ELSE 28284600
IF T=1 THEN % IT WAS "IF-ED" 28284800
BEGIN T:=-1; 28285000
NOTCOPIED(45); 28285200
END ELSE IF DSED THEN ABORT; 28285400
OE:=(T GEQ 64); 28285600
IF T=0 OR (T GEQ 64 AND NOT ADDV) THEN 28285800
BEGIN % LOAD IT 28286000
IF T GEQ 64 THEN 28286200
IF M[T+8]!H[8] THEN 28286400
BEGIN 28286600
FORGETSPACE(T); 28286800
P(DIRECTORYSEARCH(MFID,FID,6),DEL); 28287000
T:=0; 28287200
END; 28287400
IF T=0 THEN 28287600
BEGIN 28287800
T:=GETSPACE(30,DISKHEADERAREAV,1)+2;% %167-28288000
MOVE(30,T-1,T); 28288200
M[T+4]:=-0&SYSNO[4:46:2]&1[2:47:1]; 28288400
END ELSE 28288600
TMP:=T.[18:15]; 28288800
HDR := [M[T]] & 30[8:38:10]; 28289000
FOR W:=H[9].[43:5]+10 STEP 1 UNTIL 29 DO H[W]:=0; 28289200
IF (HDR[9]:=(*P(DUP)) AND 31) = 0 THEN HDR[7]:=-1; 28289400
FOR W:=HDR[9]+10 STEP 1 UNTIL 29 DO HDR[W]:=0; 28289600
W:=0; 28289800
WHILE (W:=W+1) LEQ H[9].[43:5] DO 28290000
IF H[9+W]!0 THEN 28290200
IF (H[9+W]:=HDR[9+W]) LEQ 0 THEN 28290400
OK: IF(H[9+W]:=PETUSERDISK(H[8] OR M,COMMON)) LSS 1 THEN 28290600
BEGIN 28290800
WY: TEMP:=SPACE(10); 28291000
STREAM(J:=JARROW[P1MIX],P1MIX,H:=H[8],M:=MFID,F:=FID,28291200
TEMP); 28291400
BEGIN DS:=14 LIT "#NO USER DISK:"; SI:=J;SI:=SI+1; 28291600
DS:=7CHR;DS:=LIT"/";SI:=SI+1;DS:=7CHR;DS:=LIT"="; 28291800
SI:=LOC P1MIX;DS:=2DEC;J:=DI;DI:=DI-2;DS:=FILL;DI:=J;28292000
DS:=LIT"(";SI:=LOC M;SI:=SI+1;DS:=7CHR;SI:=SI+1; 28292200
DS:=LIT"/";DS:=7CHR;DS:=2LIT")-";SI:=LOC H;DS:=8 DEC;28292400
DS:=7LIT" SEGS.~"; DI:=DI-15; DS:=7FILL; 28292600
END; 28292800
SPOUT(TEMP); 28293000
REPLY[P1MIX] := -(TEMP:=VIF&VWY[36:42:6]& 28293200
VOF[30:42:6]&VOK[24:42:6]); 28293400
COMPLEXSLEEP(REPLY[P1MIX]}0 OR DSED 28293600
OR PRT(P1MIX,@25]=5); 28293800
IF NOT WHYSLEEP(TEMP) THEN GO TO WY; 28294000
IF REPLY[P1MIX]=VOK THEN GO TO OK; 28294200
IF REPLY[P1MIX]=VOF THEN 28294400
BEGIN COMMON := COMMON AND NOT M; GO TO OK; END; 28294600
FOR W:=W STEP -1 UNTIL 1 DO 28294800
IF H[9+W]!0 THEN 28295000
IF HDR[9+W]=0 THEN 28295200
FORGETUSERDISK(H[9+W],-H[8]); 28295400
FORGETSPACE(T); 28295600
IF DSED THEN ABORT; 28295800
IF HDR[9]!0 THEN 28296000
BEGIN 28296200
P(DIRECTORYSEARCH(MFID,FID,14),DEL); 28296400
OE:=0; 28296600
END; 28296800
NOTCOPIED(31); 28297000
IF J NEQ ((FASZ DIV 2)-1) THEN SPACIT; 28297200
GO NEXT; 28297400
END; 28297600
STREAM(A:=[H[1]],D:=DATE); 28297800
BEGIN SI:=LOC D;DI:=LOC D;DS:=8 OCT; 28298000
SI:=SI-4;DI:=A;DS:=4 CHR; 28298200
END; 28298400
H[4]:=M[T+4]&H[4][8:8:3]&0[11:47:1]&H[4][36:36:6] 28298600
&H[4][43:43:1]; 28298800
H[1].[25:23]:=XCLOCK+P)RTR); 28299000
IF HDR[9]=0 THEN 28299200
ENTERUSERFILE(ABS(MFID),FID,H,[CF]-1) 28299400
ELSE 28299600
BEGIN W:=IF H[9] LSS HDR[9] THEN HDR[9] ELSE H[9]; 28299800
FOR W:=W+9 STEP -1 UNTIL 10 DO 28300000
IF H[W]=0 THEN 28300200
IF HDR[W]!0 THEN % EXTRA ROW IN DISK FILE 28300400
FORGETUSERDISK(HDR[W],HDR[8]) ELSE ELSE 28300600
$ SET OMIT = NOT SHAREDISK 28300800
;DISKWAIT(H INX 0,30,TMP); 28301600
END; 28301800
FORGETSPACE(T); 28302000
GO UP; 28302200
END % OF LOAD IT 28302400
ELSE IF J=((FASZ DIV 2)-1) THEN GO NEXT ELSE GO SKIPPER; 28302600
END % OF TAPE TO DISK 28302800
ELSE GO TIPE; 28303000
SKIPPER: DO UNTIL WAITIO(SPACER,MM,IU)=@40 OR DSED; 28303200
IF STOPSET(P1MIX) THEN STOPM(0); 28303400
IF DSED THEN ABORT; 28303600
FALLOUT: IF ENDOFREEL THEN GO SKIPPER; 28303800
END; 28304000
NEXT: 28304200
END; 28304400
IF NOT SOMECOPIED THEN 28304500
BEGIN STREAM(T:=T:=SPACE(5)); 28304510
BEGIN DS:=18LIT"NULL LIBRARY COPY~"; END; 28304520
SPOUT(T); 28304530
END; 28304540
IF OU GEQ 0 THEN % WE HAVE AN OUTPUT UNIT %130-28304590
IF (DESTIN.UNITNUM!19) THEN P(WAITIO([TM],@40,OU),DEL); %148-28304600
IF IU GEQ 0 THEN % WE HAVE AN INPUT UNIT %130-28304700
IF IU LSS 16 THEN SETNOTINUSE(IU,0); 28304800
IF FORKED 28305000
THEN STOPTIMING(FPBPTR,1023); 28305200
ELSE FOR TMP:=FPBPTR SETP 5 UNTIL (NT1:=PRT[P1MIX,3]).[8:10]-5 DO 28305400
IF M[NT1 INX (TMP+4)] LSS 0 THEN 28305600
BEGIN IF (TEMP:=M[NT1 INX (TMP+3)].[36:6]-1) LSS 16 THEN 28305800
SETNOTINUSE(TEMP,0); 28306000
STOPTIMING(TMP,1023); 28306200
END; 28306400
IF OU GEQ 0 THEN % WE HAVE AN OUTPUT UNIT %130-28306500
IF OU LSS 16 THEN SETNOTINUSE(OU,1); 28306600
STOPTIMING(0,1023); 28306800
$ SET OMIT = PACKETS 28307000
TMP:=FASZ DIV 2 - 1; %757-28307700
FOR J:=0 STEP 1 UNTIL TMP DO %757-28307705
IF (DS:=M[FAINFO+J]).[CF]=18 THEN % FROM DISK %757-28307710
IF UNLOAD THEN %757-28307715
BEGIN MFID:=M[FA+J|2]; FID:=M[FA+1+J|2]; %757-28307720
P(DIRECTORYSEARCH(-MFID&1[3:47:1].FID,7),DEL); %757-28307725
IF DSED THEN GO TO INITIATE; %757-28307730
END; %757-28307735
GO INITIATE; 28307800
END OF LIBRARYTRANSFER; 28308000
PROCEDURE LIBRARYCOPY; 28400000
% 28400002
%***********************************************************************28400004
% 28400006
% 28400008
% LIBRARYCOPY PERFORMS THE INITIAL SETUP OF FILE NAMES AND 28400010
% INFORMATION BASED ON DATA PASSED THROUGH ESPDISK FROM THE 28400012
% PROCEDURE CCLIB. THIS INFORMATION WILL BE PLACED IN THE 28400014
% FILE ARRAY "FA" AND ITS COUNTERPART "FAINFO" FOR USE LATER 28400016
% IN LIBRARYTRANSFER. IT OPERATES ON EACH <COPY SPECIFICATION> 28400018
% (REFER TO BNF DOCUMENTATION) ONE AT A TIME UNTIL THE CONTROL 28400020
% CARD HAS BEEN EXHAUSTED. 28400022
% 28400024
% THERE ARE TWO METHODS OF FINDING FILES ON A DISK INPUT SOURCE. 28400026
% ONE IS TO USE IT AS IF IT WERE A LARGE TAPE, USING THE DISK 28400028
% DIRECTORY LIKE A LARGE TAPE DIRECTORY (NOHASH); THE OTHER IS 28400030
% TO USE THE PROCEDURE SEEKNAM TO OBTAIN NAMES VIA A HASHING 28400032
% TECHNIQUE. IRREGARDLESS OF THE NAME FINDING METHOD, ONCE YOU 28400034
% HAVE A NAME PAIR THE PROCEDURE FOLLOWED IS THE SAME: 28400036
% 28400038
% 1: DETERMINE IF NAME PAIR HAS BEEN ASKED FOR BY CONTROL CARD 28400040
% 28400042
% 2: CHECK TO SEE IF IT APPEARS IN THE "EXCEPT" LIST FOR THAT 28400044
% NAME PAIR 28400046
% 28400048
% 3: IF DISK, MAKE SURE IT IS ACCESSABLE 28400050
% 28400052
% 4: CHANGE NAME IF SPECIFIED BY "AS" CLAUSE 28400054
% 28400056
% 5: CHECK THAT NAME PAIR HAS NOT ALREADY BEEN PROCESSED 28400058
% 28400060
% 6: INSERT NAME PAIR INTO "FA" 28400062
% INSERT NAME PAIR INFORMATION INTO "FAINFO" 28400064
% 28400066
% AT STEP 6, IT MUST BE DETERMINED AS TO WHETHER THE USER 28400068
% SPECIFIED MAXIMUM NUMBER OF FILES PER OUTPUT UNIT HAS BEEN 28400070
% EXCEEDED. IF SO, AN ATTEMPT TO FORK ANOTHER LIBMAIN/DISK TO 28400072
% HANDLE THE CURRENT "FA" WILL BE INITIATED (REFER TO DOCUMENTATION), 28400074
% AND THE PROCESS WILL CONTINUE WITH A NEW "FA". A LINKED LIST 28400076
% OF "FA"S IS KEPT BY THE ORIGINATING LIBMAIN/DISK FOR THE 28400078
% CONFLICT RESOLUTION OF STEP 5. 28400080
% 28400082
% 28400084
% COMMON.[2:1] INDICATES ORIGINATING LIBMAIN/DISK 28400086
% 28400088
% IF ORIGINATOR... 28400090
% 28400092
% .[3:6] UNITNO FOR PACKETS 28400094
% .[9:9] MAXIMUM NUMBER OF FILES PER OUTPUT UNIT 28400096
% .[CF] FIRST ESPDISK SEGMENT ADDRESS 28400098
% 28400100
% IF NOT ORIGINATOR... 28400102
% 28400104
% .[3:45] DISK ADDRESS OF "FA" AND "FAINFO" FOR THIS 28400106
% FORKED LIBMAIN/DISK 28400108
% 28400110
% FA FILE ARRAY FOR NAME PAIRS 28400112
% 28400114
% FAINFO TRANSFER INFORMATION FOR ASSOCIATED NAME PAIR 28400116
% 28400118
% FAIN INDEX INTO "FA" 28400120
% 28400122
% FASZ SIZE OF "FA" 28400124
% 28400126
% MFID MULTI-FILE ID 28400128
% 28400130
% FID FILE ID 28400132
% 28400134
% ASMFID MULTI-FILE ID AFTER STEP 4. 28400136
% 28400138
% ASFID FILE ID AFTER STEP 4. 28400140
% 28400142
% FPBPTR CURRENT INDEX OF FPB ENTRY 28400144
% 28400146
% DESTIN USER SPECIFIED DESTINATION 28400148
% 28400150
% TOGS.[3:1] (ACCESS0) SPECIFIES CHECK ACCESSD BIT 28400152
% .[4:1] (EXPIRED) CHECK FOR FILE BEING EXPIRED 28400154
% .[7:1] (NOHASH) USE DISK SERIALLY 28400156
% .[18:1] (OK) FILE HAS PASSED STAGE 3. 28400158
% .[19:1] (INXLST) FILE OCCURRED IN "EXCEPT" LIST 28400160
% .[20:1] (WEIRDFORK) SOME ALTERATIONS TO "FA" ARE 28400162
% NECESSARY BEFORE FORKING 28400164
% .[23:1] (FORKED) NOT ORIGINATING LIBRARYCOPY 28400166
% .[25:1] (SOURCEFILEFOUND) AT LEAST ONE FILE FROM THIS 28400168
% SOURCE WAS USED 28400170
% 28400172
% CCA HOLDS ESPDISK SEGMENTS FROM CCLIB 28400174
% 28400176
% NA, 28400178
% EA, 28400180
% POOL USED IN PREPROCESSING CONTROL CARD INFO, FROM 28400182
% CCLIB FOR USE B LIBRARYCOPY 28400184
% 28400186
% MAX USER SPECIFIED MAXIMUM NUMBER OF FILES PER 28400188
% OUTPUT UNIT 28400190
% 28400192
% X DIRECTORY OF CURRENT SOURCE (TAPE OR HOHASH) 28400194
% 28400196
% 28400198
%***********************************************************************28400200
% 28400202
BEGIN 28400300
REAL COMMON=-4, 28400400
MFID,FID,ASMFID,ASFID,TMP,TEMP, % ADD NEW LOCALS BEYOND HERE 28400600
FA,FAINFO,FASZ,FAIN, 28400800
U,T,FPBPTR,EA,NM1,NM2,DESTIN,TOGS,DA, 28401000
CCAIN,FAIN,NAIN,NA,NASZ, 28401200
LSX,BUMPFA,POOL,INDX, 28401400
UN,SEG,MAX,K,L,MIDPTR,UNITNO; 28401600
ARRAY CCA[*],X[*],PAP[*],LAB[*],LBL[*],WRDSZ[*]; 28401800
$ SET OMIT = NOT(B6500LOAD) 28402000
LABEL NEXTNAME,BACK,UP,QUIT,NEXTSEG,NXT,TRANSFER; 28402800
LABEL NEXTSOURCE,CONTINUE,ON,BADNM; 28403000
% 28403200
%***************************************************** 28403400
% 28403600
DEFINE 28403800
ACCWESS0 = TOGS.[3:1]#, 28404000
EXPIRED = TOGS.[4:1]#, 28404200
NOHASH = TOGS.[7:1]#, 28404400
OK = TOGS.[18:1]#, 28404600
INXLST = TOGS.[19:1]#, 28404800
WEIRDFORK = TOGS.[20:1]#, 28405000
FORKED = TOGS.[23:1]#, 28405200
B6500 = TOGS.[24:1]#, 28405400
SOURCEFILEFOUND=TOGS.[25:1]#, 28405600
REEL1START=TGOS.[34:1]#, 28405800
% 28406000
%***************************************************** 28406200
% 28406400
DEFINE DSED = (TERMSET(P1MIX))#, 28406600
ABORT = (LIBRARYHELP(4)#, 28406800
RB5 = @3677777777777777#, 28407000
RB4 = @3577777777777777#, 28407200
NUMOPT = 6#, 28407400
UNITNUM = [1:5]#, %148-28407500
SPOUTUNIT = 0#; 28407600
%***************************************************** 28407700
DEFINE NOTCOPIED(NOTCOPIED1) = 28407800
BEGIN NT1:=NOTCOPIED1; NOCOPYMESS; END#; 28408000
SUBROUTINE NOCOPYMESS; 28408200
LBMESS( MFID, FID, -67, NT1, TINU[U], SPOUTUNIT, 1 ); % 28408400
% 28408600
%***************************************************** 28408800
% 28409000
SUBROUTINE GETASEGMENT; 28409200
BEGIN 28409400
SEG=CCA[29]; 28409600
DISKWAIT(-CCA,[CF],30,SEG); 28409800
FORGETESPDISK(SEG); 28410000
CCAIN:=0; 28410200
END; 28410400
% 28410600
%***************************************************** 28410800
% 28411000
% - USED TO CHECK THAT FILE NAME PAIRS HAVE 28411001
% NOT APPEARED BEFORE IN THIS OR ANY OTHER "FA" 28411002
% 28411003
%****************************************************** 28411004
% 28411005
REAL STREAM PROCEDURE RESOLVE(DIRADDR,MFID); VALUE DIRADDR; 28411200
BEGIN LABEL FOUND,FINIS,AGAIN; 28411400
SI:=DIRADDR; 28411600
AGAIN: DI:=MFID; 28411800
IF SC="0" THEN 28412000
BEGIN SI:=SI-8; 28412200
IF 16 SC=DC THEN GO FOUND; 28412400
SI:=SI-24; GO AGAIN; 28412600
END ELSE 28412800
IF SC="+" THEN GO FINIS ELSE 28413000
IF SC="&" THEN BEGIN SI:=SI+5; SI:=SC; GO AGAIN; END; 28413200
FOUND: RESOLVE:=SI; 28413400
FINIS: 28413600
END; 28413800
% 28414000
%***************************************************** 28414200
% 28414400
% - USED TO RESOLVE CONFLICTS AND PROCESS 28414401
% OPTIONS ASSOCIATED ONLY WITH DISK SOURCES 28414402
% 28414403
%****************************************************** 28414404
% 28414405
SUBROUTINE SEARCHDIRECTORY; 28414600
BEGIN 28414800
OK:= FALSE; 28415000
IF NOT SYSTEMFILE(MFID,FID) 28415200
AND ((MFID EQV "BADISK ") NEQ NOT 0) %163-28415250
THEN IF (T:=DIRECTORYSEARCH(MFID&1[3:47:1],FID OR M,3)) LSS 6428415400
THEN 28415600
IF T=1 THEN NOTCOPIED(45) ELSE NOTCOPIED(15) 28415800
ELSE BEGIN 28416000
IF M[T+2] NEQ 0 THEN 28416200
IF (USERCODE[P1MIX] EQV ABS(MCP)) NEQ NOT 0 THEN 28416400
IF (USERCODE[P1MIX] EQV ABS(M[T+2])) NEQ NOT 0 THEN 28416600
BEGIN 28416800
P(DIRECTORYSEARCH(-MFID,FID,13),DEL); 28417000
NOTCOPIED(41); 28417200
GO NEXTNAME; 28417400
END; 28417600
IF EXPIRED OR ACCESSED THEN 28417800
IF EXPIRED THEN 28418000
BEGIN 28418200
STREAM(T:=0:A:=CALCULATEPURGE(-M[T+3].[2:10])); 28418400
BEGIN SI:=LOC A; DI:=LOC T; DS:=8OCT; END; 28418600
IF P GTR M[T+3].[12:18] THEN OK:=TRUE ELSE 28418800
P(DIRECTORYSEARCH(-MFID,FID,13),DEL); 28419000
END ELSE 28419200
IF M[T+4].[11:1] THEN OK:=TRUE ELSE 28419400
P(DIRECTORYSEARCH(-MFID,FID,13),DEL) 28419600
ELSE OK:=TRUE; 28419800
END 28420000
ELSE BEGIN NOTCOPIED(25); T:=2; END; 28420200
NEXTNAME: 28420400
IF T GEQ 64 THEN FORGETSPACE(T); 28420600
END; 28420800
% 28421000
%***************************************************** 28421200
% 28421400
% - USED TO DITECT THAT A PARTICULAR NAME PAIR 28421401
% IS WANTED...BASED ON DATA SUPPLIED BY CCLIB 28421402
% 28421403
%****************************************************** 28421404
% 28421405
REAL STREAM PROCEDURE COMPARE(MFID,STR); VALUE STR; 28421600
BEGIN LABEL AG,FINIS; 28421800
SI:=STR; 28422000
AG: DI:=MFID; 28422200
IF SC=">" THEN GO FINIS; % END OF NA 28422400
IF SC="+" THEN BEGIN SI:=SI+8; DI:=DI+8; END 28422600
ELSE IF 8 SC NEQ DC THEN BEGIN SI:=SI+8; GO AG; END; 28422800
IF SC="+" THEN SI:=SI+8 28423000
ELSE IF 8 SC NEQ DC THEN GO AG; 28423200
SI:=SI=16; COMPARE:=SI; 28423400
FINIS: 28423600
END; 28423800
% 28424000
%***************************************************** 28424200
% 28424400
SUBROUTINE ASIT; 28424600
BEGIN 28424800
IF PAP.[FF] 28425000
THEN BEGIN ASMFID:=IF (NT2:=M[NT1:=PAP.[CF]+(PAP.[FF] DIV 2)])28425200
LSS 0 THEN MFID ELSE NT2; 28425400
ASFID:=IF (NT2:=M[NT1+1]) LSS 0 THEN FID ELSE NT2; 28425600
END 28425800
ELSE BEGIN ASMFID:=MFID; 28426000
ASFID:=FID; 28426200
END; 28426400
END; 28426600
% 28426800
%*************************************************** 28427000
% 28427200
% - THIS ROUTINE IS RESPONSIBLE FOR EXTENDING THE SIZE 28427201
% OF AN "FA" UNTIL IT NEEDS FORKING, AT WHICH TIME IT 28427202
% WILL ATTEMPT TO START ANOTHER LIBMAIN/DISK TO HANDLE 28427203
% THE CURRENT "FA". PROCESSING SHOULD CONTINUE WITH 28427204
% A NEW "FA" (REFER TO DOCUMENTATION) 28427205
% 28427206
%******************************************************* 28427207
% 28427208
SUBROUTINE INSERTORFORK; 28427400
BEGIN 28427600
IF RESOLVE(FA+FAIN+1,ASMFID)=0 28427800
THEN IF (FAIN:=FAIN+2) LSS MAX 28428000
THEN BEGIN 28428200
ON: IF FAIN GEQ FASZ 28428400
THEN BEGIN 28428600
TMP:=SPACE((FASZ:=FASZ+BUMPFA)+ 28428800
(FASZ DIV 2)+2)+1; 28429000
M[TMP-1]:=M[FA-1]; 28429200
MOVE(TEMP:=FASZ-BUMPFA,FA,TMP); 28429400
MOVE(TEMP DIV 2,FA+TEMP,TMP+FASZ); 28429600
FORGETSPACE(FA-1); 28429800
FA:=TMP; 28430000
FAINFO:=FA+FASZ; 28430200
END; 28430400
CONTINUE: M[NT1:=FA+FAIN]:=ASMFID; 28430600
M[NT1:=ASFID; 28430800
M[FAINFO+(FAIN DIV 2)]:=T&U[CTC]; 28431000
SOURCEFILEFOUND:=TRUE; 28431200
END 28431400
ELSE BEGIN 28431600
IF (U NEQ 18 AND U=M[FAINFO+(FAIN DIV 2)-1].[CF]) 28431800
THEN IF LSX=0 THEN GO ON ELSE 28432000
BEGIN 28432200
M[(FAIN:=SPACE(FASZ+(FASX DIV 2)+2)+1)-1]:= 28432400
(FA+LSX-1)&"&"[1:43:5]; 28432600
MOVE((SEG:=FAIN-LSX),FA+LSX,EAIN); 28432800
MOVE(SEG DIV 2,FAINFO+(LSX DIV 2), 28433000
EAIN+FASZ); 28433200
WEIRDFORK:=TRUE; 28433400
FAIN:=LSX; 28433600
END; 28433800
MOVE(FAIN DIV 2,FAINFO,FA+FAIN); 28434000
FOR TMP:=5 STEP 5 UNTIL FPBPTR-5 DO 28434200
IF M[PRT[P1MIX,3] INX (TMP+4)] LSS 0 THEN 28434400
STOPTIMING(TMP,1023); 28434600
LBMESS("LIBMAIN","DISK ",50,0,0,SPOUTUNIT,1); 28434800
M[(TMP:=GETSPACE(12,CONTROLCARDAREAV,0)+4)-4] %167-28435000
.AREAMIXF:=0;% 28435010
IF (INDX:=USERCODE[P1MIX])= ABS (NOT 0) THEN 28435200
BEGIN INDX:=0; UN:=31; END ELSE UN:=26; 28435400
EA:=M[FA-1]; 28435600
COMMON:=GETUSERDISK(((TEMP:=FAIN+(FAIN DIV 2)+ 28435800
2) DIV 30)+1); 28436000
M[FA-1]:=FAIN; 28436200
M[FA+TEMP-2]:=DESTIN; 28436400
IF TEMP GTR 900 THEN 28436600
BEGIN NAIN:=M[FA+898]; 28436800
DISKWAIT(FA+899,TEMP-900,COMMON+30); 28437000
TEMP:=900; 28437200
M[FA+898]:=NAIN; 28437400
END; 28437600
DISKWAIT(FA-1,TEMP,COMMON); 28437800
M[FA-1]:=EA; 28438000
STREAM(INDX,COMMON,TMP); 28438200
BEGIN DS:=8LIT"CC USER="; SI:=LOC INDX; SI:=SI+1; 28438400
DS:=7CHR; DS:=24LIT";EX LIBMAIN/DISK;COMMON="; 28438600
DS:=8DEC; DS:=6LIT";END.~"; 28438800
END; 28439000
$ SET OMIT = NOT(PACKETS) 28439200
IF PSEUDOMIX[P1MIX] GEQ 32 THEN 28439400
NYLONZIPPER[P1MIX].[2:1]:=0; 28439600
$ POP OMIT 28439800
TMP:=TMP&P1MIX[18:42:6]&UN[3:43:5]; 28440000
INDEPENDENTRUNNER(P(.CONTROLCARD).TMP,192); 28440200
$ SET OMIT = NOT(PACKETS) 28440400
IF PSEUDOMIX[P1MIX] GEQ 32 THEN 28440600
SLEEP([NYLONZIPPER[P1MIX]],@1000000000000000); 28440800
$ POP OMIT 28441000
IF WEIRDFORK 28441200
THEN BEGIN 28441400
FA:=FAIN; 28441600
FAINFO:=FA+FASZ; 28441800
FAIN:=SEG; 28442000
WEIRDFORK:=FALSE; 28442200
END 28442400
ELSE BEGIN 28442600
TMP:=FA+FAIN-1; 28442800
M[(FA:=SPACE((FASZ:=BUMPFA)+(FASZ DIV 2)+2) 28443000
+1)-1]:=TMP&"&"[1:43:5]; 28443200
FAINFO:=FA+FASZ; 28443400
FAIN:=0; 28443600
END; 28443800
LSX:=0; 28444000
IF DESTIN.UNITNUM!19 THEN %148-28444100
BEGIN 28444150
STREAM(A:=MIDPTR:ONE:=1,MID:=[DESTIN]); 28444200
BEGIN SI:=LOC A; SI:=SI+7; IF SC="0" THEN 28444400
BEGIN TALLY:=2; SI:=MID; SI:=SI+2; 28444600
5(IF SC=" " THEN JUMP OUT; SI:=SI+1; 28444800
TALLY:=TALLY+1); A:=TALLY; DI:=DI+A; 28445000
DS:=LIT"1"; 28445200
END ELSE BEGIN DI:=DI+A; SI:=SI+16; DS:=ADD; END; 28445400
END; 28445600
MIDPTR:=P; 28445800
END; 28445900
GO CONTINUE; 28446000
END 28446200
ELSE IF U=18 THEN P(DIRECTORYSEARCH(-MFID,FID,13),DEL); %137-28446300
END; 28446400
% 28446600
%***************************************************** 28446800
% 28447000
SUBROUTINE SCANEXCEPT; 28447200
BEGIN 28447400
FOR L:=0 STEP 2 UNTIL TMP DO 28447600
IF (PAP[L] EQV MFID)= NOT 0 OR PAP[L] LSS 0 THEN 28447800
IF (PAP[L+1] EQV FID)= NOT 0 OR PAP[L+1] LSS 0 THEN 28448000
BEGIN INXLST:=TRUE; 28448200
IF NOT (PAP[L].[1:1] OR PAP[L+1].[1;1]) 28448400
THEN BEGIN 28448600
PAP[L]:=PAP[TMP]; 28448800
PAP[L+1]:=PAP[TMP+1]; 28449000
PAP.[8:10]:=PAP.[8:10]-2; 28449200
END; 28449400
L:=TMP; 28449600
END; 28449800
END; 28450000
% 28450200
%***************************************************** 28450400
% 28450600
% CODE STARTS HERE 28450800
% 28451000
%***************************************************** 28451200
% 28451400
STREAM(B:=PRT[P1MIX,3]); BEGIN 2(DS:=40LIT"0"); END; 28451600
LAB:= ARAYDESC(15,LABELAREAV); %167-28451800
IF NOT COMMON.[2:1] THEN 28452000
BEGIN 28452200
DISKWAIT(-[TEMP],1,COMMON); 28452400
FA:=TYPEDSPACE(TMP:=TEMP+(TEMP DIV 2)+2,DATAAREAV)+1;% %167-28452600
FAINFO:=FA+TEMP; 28452800
IF TEMP GTR 900 THEN 28453000
BEGIN NAIN:=M[FA+898]; 28453200
DISKWAIT(-(FA+899),TMP-900,COMMON+30); 28453400
TMP:=900; 28453600
M[FA+898]:=NAIN; 28453800
END; 28454000
DISKWAIT(-(FA-1),TMP,COMMON); 28454200
FAIN:=(FASZ:=TEMP)-2; 28454400
DESTIN:=M[FAINFO+(FASZ DIV 2)]; 28454600
FORKED:=TRUE; 28454800
LIBRARYTRANSFER; 28455000
END; 28455200
CCA:= SAVEARRAYDESC(30,ESPDISKAREAV); %167-28455400
CCA[29]:=COMMON.[CF]; 28455600
GETASEGMENT; 28455800
DESTIN:=CCA[1]; % DESTINATION 28456000
CCAIN:=2; 28456200
MAX:=COMMON.[9:9]|2; 28456400
UNITNO:=COMMON.[3:6]; 28456600
FA:=TYPEDSPACE((BUMPFA:=FASZ:=IF MAX > 128 THEN 128 ELSE MAX)+ %167-28456800
(FASZ DIV 2)+2,DATAAREAV)+1;% %167-28457000
FAINFO:=FA+FASZ; 28457200
M[FA-1]:=-0; % MARK INITIAL DIRECTORY 28457400
FAIN:=-2; 28457600
NEXTSOURCE: 28457800
X:=0; 28458000
SOURCEFILEFOUND:=FALSE; 28458200
TOGS:=0&CCA[CCAIN+1][3:3:NUMOPT]; % STORE OPTIONS 28458400
LSX:=FAIN+2; 28458600
POOL:=(EA:=(NA:=SPACE(U:=(NASZ:=CCA[CCAIN+1].[CF]+1)+ 28458800
(T:=CCA[CCAIN+1].[FF])+(NASZ DIV 2)))+NASZ)+T; 28459000
% 28459001
%***************************************** 28459002
% PREPROCESSING OF DATA FROM CCLIB 28459003
% INTO A RECOGNIZABLE FORM FOR LIBRARYCOPY 28459004
%***************************************** 28459005
% 28459006
MOVE(U,NA-1,NA); 28459200
EAIN:=NAIN:=-2; 28459400
BACK: 28459600
IF (CCAIN:=CCAIN+2) GEQ 28 THEN GETASEGMENT; 28459800
T:=CCA[CCAIN]; 28460000
UP: 28460200
IF T=@14 THEN GO QUIT; 28460400
IF T.[4:2]=0 THEN 28460600
BEGIN M[NA+(NAIN:=NAIN+2)]:=T; 28460800
M[NA+NAIN+1]:=CCA[CCAIN+1]; 28461000
GO BACK; 28461200
END ELSE K:=0; 28461400
WHILE T.[5:1] DO 28461600
BEGIN M[NT1:=EA+(EAIN:=EAIN+2)]:=(T AND RB5); 28461800
IF K=0 THEN M[POOL+(NAIN DIV 2)]:=[M[NT1]]; 28462000
M[NT1+1]:=(CCA[CCAIN+1] AND RB5); 28462200
K:=K+2; 28462400
IF (CCAIN:=CCAIN+2) GEQ 28 THEN GETASEGMENT; 28462600
T:=CCA[CCAIN]; 28462800
END; 28463000
M[NT2:=POOL+(NAIN DIV 2)].[8:10]:=K; 28463200
M[NT2]:=(*P(DUP))&(K|2)[CTF]; % NEEDED TO FIND "AS" 28463400
IF T.[4:1] THEN 28463600
BEGIN M[NT1:=EA+(EAIN:=EAIN+2)]:=(T AND RB4); 28463800
IF M[NT2]=0 THEN M[NT2]:=[M[NT1]]&1[32:47:1] 28464000
ELSE M[NT2]:=(*P(DUP))&1[32:47:1]; 28464200
M[NT1+1]:=(CCA[CCAIN+1] AND RB4); 28464400
GO BACK; 28464600
END ELSE GO UP; 28464800
QUIT: 28465000
M[NA+NAIN+2]:=0&">"[1:43:5]; % MARK END OF NA 28465200
% 28465201
%***************************************** 28465202
% BEGIN PROCESSING THE PREPROCESSED DATA 28465203
% ACCORDING TO THE SIX STAGES DETAILED ABOVE 28465204
%***************************************** 28465205
% 28465206
IF CCA[CCAIN+1].UNITNUM=19 %148-28465400
THEN BEGIN % SOURCE DISK 28465600
LIBRARYHELP(3); 28465800
U:=18; 28466000
IF NOHASH 28466200
THEN BEGIN % GO SERIALLY THRU DIRECTORY 28466400
X:=[M[SPACE(30)]]&30[8:38:10]; 28466600
DA:=3+DIRECTORYTOP; 28466800
NEXTSEG: DISKWAIT(-X.[CF],30,DA:=DA+16); 28467000
FOR K:=28 STEP -2 UNTIL 0 DO 28467200
BEGIN IF DSED THEN ABORT; 28467400
IF (MFID:=X[K])=@114 THEN GO TRANSFER; 28467600
FID:=X[K+1]; 28467800
IF MFID=@14 THEN ELSE 28468000
IF (INDX:=COMPARE(MFID,NA))=0 28468200
THEN 28468400
ELSE BEGIN PAP:=M[NT1:=POOL+((INDX-NA) DIV 2)]; 28468600
IF NOT PAP.[7:1] THEN M[NT1].[7:1]:=1; 28468800
INXLST:=FALSE; 28469000
IF (TMP:=PAP.[8:10]-2) GEQ 0 THEN %EXCEPT LIST HERE 28469200
SCANEXCEPT; 28469400
IF NOT INXLST THEN 28469600
BEGIN SEARCHDIRECTORY; 28469800
T:=0&T[FTF]&TOGS[3:3:NUMOPT]; 28470000
IF OK THEN BEGIN ASIT; INSERTORFORK; END; 28470200
END; 28470400
END; 28470600
END; % OF K LOOP 28470800
GO NEXTSEG; 28471000
END % OF LINEAR SEARCH 28471200
ELSE BEGIN % USE SEARCH 28471400
FOR K:=0 STEP 2 UNTIL NASZ-3 DO 28471600
BEGIN 28471800
NM1:=M[NT1:=NA+K]; 28472000
NM2:=M[NT1+1]; 28472200
L:=0; 28472400
PAP:=M[POOL+(K DIV 2)]; 28472600
NXT: IF DSED THEN ABORT; 28472800
IF (NM1 OR NM2) LSS 0 28473000
THEN SEEKNAM(NM1,NM2,L,MFID,FID,DA,PAP) 28473200
ELSE BEGIN MFID:=NM1; FID:=NM2; L:=1; END; 28473400
IF L LEQ 0 THEN 28473600
BEGIN SEARCHDIRECTORY; 28473800
T:=0&T[FTF]&TOGS[3:3[NUMOPT]; 28474000
IF OK THEN BEGIN ASIT; INSERTORFORK; END; 28474200
IF (NM1 OR NM2) LSS 0 THEN GO NXT; 28474400
END %589-28474500
ELSE IF DA=0 THEN LBMESS(NM1,NM2,-67,15,0,SPOUTUNIT,1); %589-28474600
END; % OF K LOOP 28474800
END % OF HASHED SEARCH 28475000
END 28475200
ELSE BEGIN % SOURCE TAPE 28475400
LIBRARYHELP(0); 28475600
$ SET OMIT = NOT B6500LOAD %123-28475605
FOR K:=(IF X[0]=@114 AND NOT REEL1START THEN X[1] ELSE 0) 28475800
STEP 2 UNTIL DA-2 DO 28476000
BEGIN IF DSED THEN ABORT; 28476200
IF ((MFID:=X[K]) OR (FID:=X[K+1])).[1:5] NEQ 0 28476400
THEN BEGIN NOTCOPIED(37); GO BADNM; END; 28476600
IF (INDX:=COMPARE(MFID,NA))=0 28476800
THEN 28477000
ELSE BEGIN PAP:=M[NT1:=POOL+((INDX-NA) DIV 2)]; 28477200
IF NOT PAP.[7:1] THEN M[NT1].[7:1]:=1; 28477400
INXLST:=FALSE; 28477600
IF (TMP:=PAP.[8:10]-2) GEQ 0 THEN % EXCEPT EXISTS 28477800
SCANEXCEPT; 28478000
IF NOT INXLST THEN 28478200
BEGIN T:=0&((K DIV 2)+1)[CTF]&TOGS[3:3:NUMOPT]; 28478400
ASIT; INSERTORFORK; 28478600
END; 28478800
END; 28479000
BADNM: END; % OF K LOOP 28479200
TRANSFER: 28479400
FOR K:=0 STEP 1 UNTIL (NASZ DIV 2)-1 DO 28479600
IF M[POOL INX K].[7:1] THEN ELSE 28479800
BEGIN MFID:=M[NT1:=NA+(K|2)]; 28480000
FID:=M[NT1+1]; 28480200
NOTCOPIED(17-(U=18)|2); 28480400
END; 28480600
END; 28480800
IF (CCAIN:=CCAIN+2) GEQ 28 THEN GETASEGMENT; 28481000
IF NOT SOURCEFILEFOUND THEN 28481200
BEGIN IF U LSS 16 THEN SETNOTINUSE(U,0); 28481400
STOPTIMING(FPBPTR,1023); 28481600
END; 28481800
IF X NEQ 0 THEN FORGETSPACE(X); 28482000
FORGETSPACE(NA); 28482200
IF CCA[CCAIN]=@114 THEN BEGIN FASZ:=FAIN+2; 28482400
FORGETSPACE(CCA); 28482600
LIBRARYTRANSFER; 28482800
END 28483000
ELSE GO NEXTSOURCE; 28483200
END OF LIBRARYCOPY; 28483400
PROCEDURE LIBRARYZERO; 28800000
BEGIN 28801000
REAL COMMON=-4; 28802000
REAL TYPE,SEG,I,J,K,N1,Q,N,W,T,THING,ZEROING; 28803000
ARRAY S[*],X[*],RSULT[*],BUFADR[*],IOD[*],H[*]; 28804000
LABEL GETONE,LOOP,WATE,ARD; 28806000
DEFINE DSED=TERMSET(P1MIX)#; 28807000
%******************************************************* 28808000
SUBROUTINE GETASEGMENT; 28809000
BEGIN 28810000
SEG:=S[29]; 28811000
DISKWAIT(-S,[CF],30,SEG); 28812000
FORGETESPDISK(SEG); 28813000
I:=0; 28814000
END; % OF GETASEGMENT 28815000
%******************************************************* 28816000
SUBROUTINE ABORT; 28817000
BEGIN 28818000
IF ZEROING THEN 28821000
BEGIN 28821500
H[4].[43:2]:=1; 28822000
H[4].[2:1]:=0; 28822500
DISKWAIT(THING,[CF],30,THING.[FF]); 28823000
FORGETSPACE(H); 28823500
END ELSE 28824000
WHILE S[29] NEQ 0 DO GETASEGMENT; 28824250
GO INITIATE; 28824500
END; % OF ABORT 28827000
%******************************************************* 28828000
SUBROUTINE IO; 28829000
BEGIN 28830000
STREAM(DSKADR:=Q+N,D:=(BUFFADR INX (2|W))); 28831000
BEGIN SI:=LOC DSKADR; DS:=8DEC; END; 28831500
RESULT[W]:=0; 28831600
IOREQUEST(-IOD[W]&@377[25:40:8], 28832000
IOD[W]&(IF (T:=N1-N) LSS 63 THEN 512+T ELSE 512+63) 28832500
[CTF],(W INX RSULT)); 28833000
N:=N+63; 28833500
END; % OF IO 28834000
%*********************************************************** 28834500
SUBROUTINE ZEROAROW; 28835000
BEGIN 28835500
N1:=W[8]; %NO. OF SEGMENTS/ROW 28836000
Q:=H[K+9]; %DISK ADDR OF ROW 28836500
W:=0; %BUFFER NO. 28837000
N:=0; %INDEX OF SEGMTS 28837500
IO; 28838000
W:=1; %SWAP BUFFERS 28838500
IF N GEQ N1 THEN RSULT[1]:=RSULT[1] OR IOMASK ELSE 28839000
LOOP: IO; 28847000
WATE: COMPLEXSLEEP((((RSULT[1-W]) AND IOMASK)!0) OR DSED); 28848000
IF DSED THEN ABORT; 28849000
W~IF (RSULT[0] AND RSULT[1] AND IOMASK)!0 THEN 1-W ELSE 28850000
((RSULT[1] AND IOMASK)!0); 28851000
IF N<N1 THEN GO TO LOOP;% ROW IS NOT FINISHED 28852000
COMPLEXSLEEP((((RSULT[1-W]) AND IOMASK) NEQ 0) OR DSED); 28852100
IF DSED THEN ABORT; 28852200
END;%OF ZEROAROW 28853000
%******************************************************* 28854000
S:= ARRAYDESC(30,ESPDISKAREAV); %167-28855000
X:=[M[SPACE(1023)]]&1023[8:38:10]; 28856000
TYPE:=COMMON.[FF]; 28857000
S[29]:=COMMON.[CF]; 28858000
GETASEGMENT; 28859000
X[0]:=@14; 28860000
MOVE(1022,X,[X[1]]); 28861000
GETONE: 28862000
IF DSED THEN ABORT; 28863000
X[J]:=S[I]; 28865000
X[J+1]:=S[I+1]; 28866000
J:=J+2; 28867000
IF (I:=I+2) GTR 26 THEN GETASEGMENT; 28868000
IF S[I] NEQ @14 THEN GO GETONE; 28868100
FORGETSPACE(S); % ZEROING IMPLIES S RETURNED. 28868200
MOVE(J+1,X,S:=GETSPACE(J+1,0,1)+2);% RETURN UNUSED SPACE AND MAKE X 28868300
FORGETSPACE(X); % INTO SAVE SPACE. 28868400
X:=[M[S]]&(J+1)[8:38:10]; 28868500
IOD:=[M[GETSPACE(8,0,1)+2]]&2[8:38:10]; 28869000
RSULT:=(2 INX IOD)&18[8:38:10]; 28870000
BUFFADR:=(4 INX 100)&4[8:38:10]; 28871000
IOD[0]:=(BUFFADR INX 0)&1[8:38:10]&3[5:46:2]; 28872000
IOD[1]:=(BUFFADR INX 2)&1[8:38:10]&3[5:46:2]; 28873000
J:=-2; 28877000
ZEROING:=1; 28878000
WHILE X[J~J+2]!@14 DO % 28879000
BEGIN 28880000
H:=[M[THING:=DIRECTORYSEARCH(X[J],X[J+1],5)]]&30[8:38:10]; 28881000
IF DSED THEN ABORT; 28882000
IF THING=0 THEN GO TO ARD; 28882100
IF M[THING+4].[42:3]=3 THEN 28882120
BEGIN FORGETSPACE(H); 28882140
GO TO ARD; 28882160
END; 28882180
H[4]:=(*P(DUP))&3[43:46:2]&1[2:47:1]&SYSNO[4:46:2]; 28882200
DISKWAIT(THING.[CF],30,THING.[FF]); 28882400
LBMESS( X[J], X[J+1], 62, 0,0,0, 1 ); % BEING BLANKED OUT 28883000
FOR K~1 STEP 1 UNTIL H[9].[43:5] DO% WRITE OUT FILE, ROW BY ROW28884000
IF H[K+9]!0 THEN BEGIN ZEROAROW; 28885000
IF STOPSET(P1MIX) THEN STOPM(0); 28885500
END; 28885600
H[4].[43:2]:=0; % NO LONGER SENSITIVE OR BEING ZEROED 28886000
DISKWAIT(THING.[CF],30,THING.[FF]); 28887000
FORGETSPACE(H); 28888000
P(DIRECTORYSEARCH(X[J],X[J+1],6),DEL); 28889000
ARD: 28889550
END; 28890000
GO INITIATE; 28891000
END; % OF LIBRARYZERO 28892000
$ SET OMIT = NOT(AUXMEM) 28999999
COMMENT ERRORMESSER IS CALLED BY ERRORFIXER (IF OPTION 33 IS ON) TO 30900000
TYPE OUT A PSEUDO-TERMINAL MESSAGE. IT DOES ABOUT THE SAME 30901000
THING AS THE FIRST PART OF TERMINALMESSAGE; 30902000
PROCEDURE ERRORMESSER(TYPE); VALUE TYPE: REAL TYPE; 30903000
BEGIN INTEGER S,ADR,BF,SA,N; 30904000
NAME SD; 30905000
LABEL L; 30906000
BF~SPACE(10); 30907000
SD~PRT[P1MIX,4]; 30908000
NT1~SD[0]; 30909000
ADR~M[PRT[P1MIX,8]].[CF]; 30910000
FOR S~1 STEP 1 UNTIL NT1 DO 30911000
IF (SA~SD[S].[18:15])>1023 AND SA{ADR AND SD[S]>0 THEN 30912000
IF M[SA-1].[18:15]+SA}ADR THEN GO L; 30913000
S~0; 30914000
L: SD~[M[SPACE(TERMSGSZ)]]; 30915000
ADR~ADR-SA; 30916000
DISKWAIT(-(SD INX 0),TERMSGSZ,MESSAGETABLE[1].[22:26]); 30917000
N~IF TYPE=1 THEN 11 ELSE IF TYPE=2 THEN 9 ELSE IF TYPE=4 THEN 30918000
7 ELSE IF TYPE=8 THEN 13 ELSE 5; 30919000
STREAM(M~[SD[N]],J~[JAR[P1MIX,0]],P1MIX,S,ADR,X~S!0,BF); 30920000
BEGIN SI~M; SI~SI+2; DS~6 CHR; BF~DI; DI~LOC M; SI+SI+1; 30921000
DI~DI+7; DS~CHR; DI~BF; DS~M CHR; DS~8 LIT" BRANCH "; 30922000
SI~J; SI+SI+1; DS~7 CHR; DS~LIT"/"; 30923000
SI~SI+1; DS~7CHR; DS~LIT"="; SI+LOC P1MIX; 30924000
DS~2DEC; BF~DI; DI~DI-2; DS~FILL; DI~BF; 30924500
X(DS~5 LIT", S ="; SI~LOC S; DS~4 DEC; DS~5 LIT", A ="; 30925000
DS~4 DEC; BF~DI; DI~DI-4; DS~3 FILL; 30926000
DI~BF; DI~DI-13; DS~3 FILL); 30927000
DI~BF; DS~ LIT"~"; 30928000
END; 30929000
FORGETSPACE(SD); 30929500
SPOUTER(BF,0,ERRORMSG); 30930000
END ERRORMESSER; 30931000
PROCEDURE ERRORFIXER(TYPE); VALUE TYPE; INTEGER TYPE; 31000000
COMMENT LOOKS FOR RUN-TIME-ERROR ACTION LABELS IN ALGOL PROGRAMS. 31001000
AND HANDLES THEM, RETURNING ONLY IF NO LABEL GIVEN; 31002000
BEGIN ARRAY AIT[*],PRTD[*]; 31003000
NAME ADDR; 31004000
REAL I, GOT, ADR=ADDR,LABLE; 31005000
CHECKSTACKSPACE; 31005010
IF TYPE =2 THEN%OVRFLW 31005050
IF JAR[P1MIX,2].[3:1] THEN 31005100
IF(PRT[P1MIX,@51]AND @20)!0 THEN 31005200
BEGIN I!M[ADR~PRT[P1MIX,8] INX 0; 31005300
STREAM(I~(I INX 0)&I[30:10:2],GOT~[GOT]); 31005310
BEGIN SI~I;SI~SI-2;DI~DI+6;DS~2 CHR END; 31005320
IF GOT.[45:3]=5 THEN M[ADR-3]~@7777777777777; 31005330
M[ADR-2]~@777777777777777; 31005350
PRT[P1MIX,@51].[45:2]~2; 31005400
GO TO INITIATE; 31005500
END; 31005600
PRTD ~ PRTROW[P1MIX]; 31006100
WHILE (AID~PRTD [AIDNDX]).PBIT=0 DO 31007000
MAKEPRESENT([PRTD [AITNDX]] INX 0); 31008000
I~AIT[0]+1; 31009000
DO I~I-1 UNTIL((GOT~ (ADDR~AIT[I]).OWNBIT AND ( ADR.[CF] 31010000
=TYPE)) OR(I{1)); % LOOK FOR ENTRY 31011000
IF GOT THEN % WILL REINITIATE THE GUY, SO SET HIM UP 31012000
BEGIN IF (LABLE~M[ ADR.MOM])!0 THEN 31013000
IF LABLE!15 THEN 31013050
IF LABLE.BLKCNTR{(PRTD[16]+(LABLE.MOM!0))THEN 31013100
BEGIN IF PRTD [CURBLKCNTR]>LABLE.BLKCNTR THEN 31014000
BEGIN PRTD [CURBLKCNTR]~LABLE.BLKCNTR+1; 31015000
ASRL 31016000
END; IF(ADDR~LABLE.MOM)=0 THEN 31017000
LABLE.MOM~ADDR~PRTD[10].MOM+2; 31017100
ADDR~ADDR&ADR[33:33:15]; 31017200
$ SET OMIT = PACKETS 31017209
ERRORMESSER(TYPE); 31017220
IF PRTD[LABLE.[CF]].PBIT=0 THEN 31017300
MAKEPRESENT([PRTD[LABLE.[CF]]].[CF]); 31017400
DO UNTIL(*(ADDR~HUNT(ADDR+1))).[1:3]=4; 31018000
ADDR [1]~M[PRTD [8] INX NOT 0]; 31019000
ADDR [2]~M[PRTD [8]]&0[10:10:2]& 31020000
(LABLE)[18:18:15]&PRTD [(LABLE).[CF]][33:33:15]; 31021000
PRTD [8]~P(DUP,LOD)&(ADDR INX 2)[33:33:15]; 31022000
GO INITIATE; 31023000
END; END; 31024000
END ERRORFIXER; 31025000
PROCEDURE JOBMESS(MIX,Q,A,B,C,D); VALUE MIX,Q,A,B,C,D;% 32000000
REAL MIX,Q,A,B,C,D;% 32000100
COMMENT : THIS PROCEDURE CAN BE USED TO BUILD AND SPOUT A MESSAGE 32000110
THAT IS TO BE PRECEEDED BY A <JOB SPECIFIER> WHICH IT 32000120
BUILDS AUTOMATICALLY FOR THE MIX GIVEN; 32000130
BEGIN REAL BUF,T;% 32000200
$ SET OMIT = NOT(PACKETS) 32000249
REAL UNITNO; 32000250
$ POP OMIT 32000251
LABEL EXIT; 32000280
BUF ~ SPACE(9); 32000300
IF MIX = 0 THEN 32000400
BEGIN T:=SPACE(30);DISKWAIT(-T,30,0); 32000500
STREAM(M:=M[T+10+5|SYSNO],F:=M[T+11+5|SYSNO],BUF); 32000510
BEGIN DS:=3 LIT" D:"; SI:=LOC M; SI:=SI+1; DS:=7 CHR; 32000520
DS:=LIT"/";SI:=SI+1;DS:=7CHR;DS:=3LIT"= 0"; 32000530
END; 32000540
FORGETSPACE(T); 32000600
T:=(BUF+2)&5[30:45:3]; 32000650
END ELSE% 32000700
IF JARROW[MIX[!0 THEN 32000750
BEGIN; STREAM(C!0:R~ IF (T~ PRYOR[MIX])<0 THEN T ELSE T INX 0, 32000800
J ~ JARROW[MIX],MIX,A ~ IF JAR[MIX,0]<0 THEN JAR[MIX,30] 32000810
ELSE 0,BUF); 32000812
BEGIN DS ~ LIT " "; SI ~ LOC R; DS ~ 6 DEC;% 32000850
DI ~ DI-6; DS ~ 5 FILL; DI ~ BUF; DI ~ DI+7;% 32001000
DS ~ LIT ":"; SI ~ J; 32001100
IF SC="+" THEN 32001120
BEGIN SI ~ SI+1; DS ~ 7 CHR; DS ~ LIT " "; 32001140
SI ~ SI+1; DS ~ 7 CHR; DS ~ LIT "/"; 32001160
SI ~ LOC A; SI ~ SI+1; DS ~ 7 CHR; 32001180
END ELSE 32001200
BEGIN SI ~ SI+1; DS ~ 7 CHR; DS ~ LIT "/"; 32001220
SI ~ SI+1; DS ~ 7 CHR; 32001240
END; 32001260
DS ~ LIT "="; SI ~ LOC MIX; DS ~ 2 DEC;% 32001300
C ~ DI; DI ~ DI -2; DS ~ 2 FILL;% 32001400
END STREAM; 32001450
T := POLISH; 32001475
$ SET OMIT = NOT(PACKETS) 32001499
IF Q.[CF]=MIX THEN UNITNO:=PSEUDOMIX[MIX]; 32001500
$ POP OMIT 32001501
END ELSE % NO SUCH MIX 32001550
BEGIN FORGETSPACE(BUF); 32001575
GO TO EXIT; 32001600
END; 32001625
STREAM(A~[A],Z~0,T);% 32001700
BEGIN SI ~ A; DS ~ LIT " ";% 32001800
4(IF SC ! "+" THEN 32001900
BEGIN TALLY ~ 7; SI ~ SI +1; % 32001910
6(L: IF SC = "0" THEN% 32001920
BEGIN TALLY ~ TALLY + 63; SI ~ SI + 1; 32002000
END ELSE JUMP OUT);% 32002050
Z ~ TALLY; DS ~ Z CHR;% 32002070
END ELSE SI ~ SI + 8);% 32002090
DS ~ LIT "~";% 32002100
END STREAM;% 32002200
SPOUTER(BUF & Q[9:9:9],UNITNO,1); 32002300
EXIT: 32002350
END JOBMESS;% 32002400
PROCEDURE MIXPRINT(Q); VALUE Q; REAL Q; 32100000
COMMENT THIS PROCEDURE INVOKES JOBMESS TO TYPE THE JOB SPECIFIERS 32100010
OF EACH ACTIVE MIX;% 32100020
BEGIN REAL T,I; 32100100
FOR I~1 STEP 1 UNTIL MIXMAX DO 32100200
IF JAR[I,*] ! 0 THEN% 32100300
BEGIN JOBMESS(I,Q,-0,-0,-0,-0); T ~ 1 END;% 32100350
IF NOT T THEN% NULL MIX 32100400
BEGIN; STREAM(T~T~SPACE(2)); DS~11LIT " NULL MIX~";% 32100500
SPOUT(T & Q[9:9:9]);% 32100600
END NULL MIX; 32100700
END MIXPRINT;% 32100800
$ SET OMIT = NOT(DATACOM AND DCSPO) 34999999
PROCEDURE DOLITTLE(OK,T,A,B,Z); VALUE T,A,B; REAL OK,T,A,B,Z; 36001000
BEGIN COMMENT FILE Q&A; 36002000
LABEL E,L; REAL Q; NAME N=Z; 36003000
DEFINE X=REPLY[P1MIX]#, DS=TERMSET(P1MIX)#; 36004000
IF OK THEN GO E; 36005000
L: FILEMESS(A,B,N[0],N[1],N[2],N[3],N[4]); 36006000
IF AUTODS THEN TERMINATE(P1MIX&61[CTF]) ELSE %747-36006500
BEGIN X~-T&1[2:47:1]; COMPLEXSLEEP(X>0 OR Q~OK OR DS); END; %747-36007000
IF DS THEN GO E; IF NOT Q THEN IF NOT WHYSLEEP(T) THEN GO L; 36008000
E: NT6~X; X~0 36009000
END OF DOLITTLE; 36010000
REAL PROCEDURE FINDOUTPUT(MID,FID,REEL,CDATE,CYCLE,TYPE,FORMS,KIND); 37000000
VALUE MID,FID,REEL,CDATE,CYCLE,TYPE,FORMS; 37001000
REAL MID,FID,REEL,CDATE,CYCLE,TYPE,FORMS,KIND; 37002000
BEGIN INTEGER GOTL,GOTT,GOTB,GOTP,GOTC; 37003000
REAL U; 37003100
LABEL EXIT,SW,ON,OWT,AROUND,OUKID,X,ROUND,CLAIMT,THERE,SOMEWHERE; 37004000
REAL MID=MID; % FAKE OUT COMPILER 37004100
$ SET OMIT = NOT(PACKETS) 37004199
REAL FREEF; LABEL FREEL; % FILE TO BE PRINTED ALONE 37004200
$ POP OMIT 37004201
LABEL W3; 37005000
DEFINE DSED = TERMSET(P1MIX)#; 37006000
LABEL CP,MT,SU,PP,CKFM,DOITOVER; %P 37007000
DEFINE PNTOG=(TYPE=0 OR TYPE GEQ 20)#; 37007100
DEFINE MAYBE(MAYBE1)=(IF FORMS THEN MAYBE1 ELSE 0)[30:42:6]#; 37007200
DEFINE UNITNUM = [1:5]#; %148-37007300
SWITCH TYPESW~CP,ROUND,MT,SU,ROUND,SU,ROUND,PP,PP,MT; %P 37008000
REAL SUBROUTINE PRINTER;% 37009000
BEGIN IF LABELTABLE[20]=0 THEN BEGIN U~20; P(1) END ELSE% 37010000
IF LABELTABLE[21]=0 THEN BEGIN U~21; P(1) END ELSE P(0);% 37011000
PRINTER~GOTL+P; 37012000
END PRINTER;% 37013000
REAL SUBROUTINE PTPUNCH;% 37014000
BEGIN IF LABELTABLE[26]=0 THEN BEGIN U~26; P(1) END ELSE% 37015000
IF LABELTABLE[29]=0 THEN BEGIN U~29; P(1) END ELSE P(0);% 37016000
PTPUNCH~GOTP~P;% 37017000
END PTPUNCH;% 37018000
REAL T1,T2,T3;% 37019000
REAL SUBROUTINE PUNCH;% 37019100
BEGIN IF LABELTABLE[22]=0 THEN BEGIN U~22;P(1) END ELSE P(0); 37019200
PUNCH~GOTC~P; 37019300
END PUNCH; 37019400
REAL SUBROUTINE MAGTAPE;% 37020000
BEGIN IF NOT(GOTL OR GOTB OR GOTC) THEN% 37021000
BEGIN IF (U:=T1,UNTINUM) ! 0 THEN %148-37022000
BEGIN U:=U-1; P(LABELTABLE[U]=0); GO OWT; END; %148-37022100
IF T1 ! 0 THEN %148-37022200
BEGIN FOR U~0 SETP 1 UNTIL 15 DO% 37023000
IF (MULTITABLE[U] EQV T1)=NOT 0 THEN% 37024000
IF LABELTABLE[U]<0 THEN% 37025000
IF RDCTABLE[U].[8:6]=P1MIX THEN% 37026000
IF (T3~PRNTABLE[U])<0 THEN% 37027000
IF T3.[15:15]!0 THEN % DONT USE NONEXISTENT FIB %548-37027500
IF M[M[T3.[15:15]-3] INX 5].[41:1] THEN% 37028000
BEGIN P(1); GO OWT END;% 37029000
END;% 37030000
FOR U~0 STEP ` UNTIL 15 DO% 37031000
IF LABELTABLE[U]=0 THEN BEGIN P(1); GO OWT END;% 37032000
END;% 37033000
P(0);% 37034000
OWT: MAGTAPE~GOTT~P;% 37035000
END MAGTAPE;% 37036000
SUBROUTINE BADFM; %BUILD AND SPOUT BAD FM MESSAGE % 37036100
BEGIN %RHR 37036200
T1~SPACE(10); 37036300
STREAM(A~TINU[U],MX~P1MIX,T1); %RHR 37036400
BEGIN DS~19 LIT "INVALID INPUT UNIT "; %RHR 37036500
SI~LOC MX; DS~2 DEC; DS~2 LIT"FM"; %RHR 37036600
SI~LOC A; SI~SI-5; DS~3 CHR; %RHR 37036800
DS~LIT "~"; DI~DI-8; DS~FILL; %RHR 37036900
END; SPOUT(T1); %RHR 37037000
LABELTABLE[U]~@114; READY~READY AND (U~NOT TWO(U)); 37037100
RRRMECH~RRRMECH AND U; SAVEWORD~SAVEWORD AND U; %RHR 37037200
END BADFM SUBROUTIN; %RHR 37037300
REAL SUBROUTINE BKUPTAPE;% 37038000
BEGIN IF NOT(GOTL OR GOTC) THEN 37039000
FOR U~0 STEP 1 UNTIL 15 DO% 37040000
IF (LABELTABLE[U] EQV T3)=NOT 0 THEN% 37041000
IF (MULTITABLE[U] EQV T2)=NOT 0 THEN% 37042000
BEGIN P(1); GO AROUND END;% 37043000
P(0); 37044000
AROUND: BKUPTAPE~GOTB~P;% 37045000
END BKUPTAPE;% 37046000
$ SET OMIT = NOT(PACKETS) 37046004
FREEF:=TYPE.[1:1]; TYPE:=ABS(TYPE); 37046005
$ POP OMIT 37046006
IF TYPE>1 AND TYPE!4 AND TYPE!6 AND TYPE<15 THEN GO SOMEWHERE; 37046020
ROUND: IF TYPE=1 OR TYPE=4 OR (TYPE>16 AND TYPE<19) THEN 37046040
IF PRINTER THEN BEGIN KIND~1; GO CKFM END; %P 37046060
IF TYPE=0 OR (TYPE>20 AND TYPE) THEN 37046070
IF PUNCH THEN BEGIN KIND~6; GO CKFM END; 37046075
IF TYPE=4 OR TYPE=6 OR TYPE=16 OR TYPE=18 OR 37046080
(TYPE GEQ 20 AND NOT TYPE.[46:1]) THEN 37046090
BEGIN T1~0; T2~IF TYPE GEQ 20 THEN "PUTMCP " ELSE "PBTMCP "; 37046100
T3~@122212342546447; 37046110
IF BKUPTAPE THEN GO THERE; %P 37046120
IF MAGTAPE THEN %P 37046140
CLAIMT: BEGIN MULTITABLE[U]~T2; LABELTABLE[U]~-T3; %P 37046160
RRRMECH~TWO(U) OR RRRMECH; %P 37046170
IF REEL=0 THEN REEL~1; 37046175
RDCTABLE[U]~P(DUP,LOD)&REEL[14:38:10]; %745-37046177
&CDATE[24:31:17]&CYCLE[41:41:7]; %745-37046178
T1~GETSPACE(10,0,0)+4; %P 37046180
STREAM(U:=TINU[U],N:=PRNTABLE[U],[30:18], 37046190
A~REEL,B~DATE,C~CYCLE,D~0,PN~TYPE GEQ 20, 37046192
T~T1-2); 37046194
BEGIN DS~12LIT" NEW PBT ON"; SI~LOC U; SI~SI+5; %P 37046200
PN(D~DI; DI~DI-6; DS~2LIT"UT"; DI~D); 37046205
DS~3 CHR;DS~25LIT"~ LABEL 0PBTMCP 0BACK-UP";%P 37046210
PN(D~DI; DI~DI-14; DS~2LIT"UT"; DI~D); 37046212
SI := LOC A; DS := 3 DEC; 37046215
SI:=SI+3;DS:=5CHR;SI:=SI+7;DI:=DI+1;DS:=CHR;37046217
15(DS:=2 LIT"0");DI:=DI-11;SI:=LOC N; 37046220
DS:=5 DEC; 37046221
END; %P 37046240
P(WAITIO(T1&8[8:38:10]&5[21:45:3],0,U),DEL); %P 37046260
SPOUT(T1-2); 37046270
T1.[1:11]:=@17437; 37046280
P(WAITIO([T1],0,U),DEL); %P 37046300
THERE: LABELTABLE[U].[1:5]~@20; KIND~7; GO EXIT %P 37046320
END; END; %P 37046340
IF (TYPE GEQ 15 AND TYPE LEQ 18) OR TYPE GEQ 22 THEN 37046350
BEGIN 37046360
$ SET OMIT = NOT(PACKETS) 37046369
IF (T1:=PSEUDOMIX[P1MIX])!0 AND TYPE<22 AND NOT FREEF THEN 37046370
BEGIN 37046380
T:=T1-32; 37046390
T2:=PACKETPBD[T1]; 37046400
T3:=CIDTABLE[T1,6].[6:24]; 37046410
IF T2=0 OR T3=0 OR (T2+10)>1000 THEN GO FREEL; 37046420
PACKETPBD[T1]:=T2+10; 37046430
END ELSE 37046440
$ POP OMIT 37046441
BEGIN 37046450
$ SET OMIT = NOT(PACKETS) 37046459
FREEL: 37046460
$ POP OMIT 37046461
T3:=NEXTCDNUM(1); 37046470
T2:=001; 37046480
END; 37046490
KIND:=12; 37046500
STREAM(T3,T2,D:=T1:=U:=SPACE(30)); 37046520
BEGIN 37046530
DS~8 LIT"0@+1.013"; 37046540
DS:=7 LIT"8400000";DS:=10 LIT"0"; 37046560
SI:=LOC T3;SI:=SI+4; DS:=4 CHR; 37046580
SI:=LOC T2; DS:=3 DEC; 37046590
46(DS~4 LIT"0"); 37046600
END; M[T1+1]+M[T1+8]~ PBDROWSZ+1; 37046620
$ SET OMIT = NOT(SHAREDISK) 37046624
M[T1+5]~MID&(TYPE GEQ 22)[3:47:1]; % CP BK UP TOG 37046630
GO EXIT %P 37046640
END; %P 37046660
W3: FILEMESS("# " 37046680
&(IF TYPE = 6 OR TYPE = 20 THEN " " 37046685
ELSE (IF PNTOG THEN "CP" ELSE "LP"))[12:36:12] 37046690
& (IF TYPE < 2 THEN " " 37046700
ELSE IF TYPE GEQ 20 THEN "PUT" ELSE "PBT")[30:30:18],37046710
" .. RQD" & (IF FORMS THEN "FM" ELSE " ")[12:36:12], 37046720
MID, FID, REEL, CDATE, CYCLE); 37046730
IF AUTODS THEN TERMINATE(P1MIX&61[CTF]) ELSE %747-37046735
BEGIN %747-37046737
REPLY[P1MIX] := -VWY & VOU[36:42:6] & MAYBE(VFW); 37046740
COMPLEXSLEEP(((IF (TYPE!6 AND TYPE!20) THEN IF PNTOG THEN 37046760
PUNCH ELSE PRINTER ELSE 0) OR REPLY[P1MIX] 37046770
>0 OR(IF TYPE>1 THEN BKUPTAPE OR MAGTAPE ELSE 0) OR 37046780
DSED); %747-37046800
END; %747-37046805
IF DSED THEN GO TO X; %747-37046810
IF NOT(GOTB OR GOTT OR GOTL OR GOTC) THEN 37046820
BEGIN IF NOT WHYSLEEP(VWY&VOU[36:42:6]&MAYBE(VFM)) 37046825
THEN GO TO W3; 37046826
IF REPLY[P1MIX] = VOK THEN GO TO W3; 37046829
IF REPLY[P1MIX].[CF] = VFM THEN BEGIN 37046830
LABELTABLE[U:=REPLY[P1MIX].[FF]] := -FID; 37046835
MULTITABLE[U] := MID; KIND := UNIT[U].[1:4]; 37046840
GO EXIT; 37046845
END; 37046850
IF PNTOG THEN BEGIN U:=REPLY[P1MIX].[FF]; GO CP END; 37046855
OUKID: TYPE~IF (U~REPLY[P1MIX].[FF])=1 THEN 4 ELSE %P 37046860
IF U=2 THEN 1 ELSE IF U=3 THEN 6 ELSE 15; 37046880
REPLY[P1MIX]~0; GO ROUND; %P 37046900
END; REPLY[P1MIX]~0; %P 37046920
IF GOTB THEN GO THERE ELSE IF GOTT THEN GO CLAIMT ELSE 37046940
IF GOTC THEN KIND~6 ELSE KIND~1; 37046950
CKFM: IF FORMS THEN %P 37046960
BEGIN LABELTABLE[U]~-FID; MULTITABLE[U]~MID; %P 37046980
DOLITTLE(FALSE, 37047000
VWY&VOK[35:42:6]&VOU[30:42:6]&VFM[24:24:6], 37047010
"#... FM"&TINU[U][12:30:18],"RQD ",MID); 37047020
IF NT6=VOK THEN GO EXIT; 37047100
IF DSED THEN GO TO INITIATE; 37047250
KIND:=LABELTABLE[U]:=MULTITABLE[U]:=GOTL:=GOTP:=U:=0; 37047500
IF NT6.[CF]=VFM THEN 37047600
IF (U:=NT6.[FF]) ! 20 AND U ! 21 AND KIND = 1 OR 37047605
U ! 22 AND KIND = 6 THEN 37047610
BEGIN BADFM; GO ROUND END ELSE 37047615
BEGIN LABELTABLE[U]~-FID; %RWR 37047625
MULTITABLE[U]~MID; KIND~UNIT[U].[1:4]; %RWR 37047650
GO EXIT; %RWR 37047660
END ELSE BEGIN REPLY[P1MIX]~NT6; GO OUKID; END; %RWR 37047670
END; GO X; %P 37047700
SOMEWHERE: IF NOT FORMS THEN GO SW; 37047800
DOLITTLE(FALSE,VWY&VFM[36:42:6],"#FM RQD",0,MID); U:=NT6.[FF]; 37048000
IF NOT DSED THEN 37048100
IF U LSS 16 THEN 37048200
IF PRINTABLE[U].[1:1] THEN ELSE %764-37048300
BEGIN LABELTABLE[U]:=-(*P(DUP));GO TO SOMEWHERE;END; %764-37048310
GO TO X; 37048400
SW: GO TO TYPESW[TYPE];% 37056000
CP: TYPE~IF U=1 THEN 21 ELSE IF U=3 THEN 20 ELSE 37058000
IF U=5 THEN 0 ELSE 22; REPLY[P1MIX]~0; GO ROUND; 37059000
PP: DOLITTLE(PTPUNCH,VWY,"#PP RQD",0,MID); GO X; 37085000
SU: T1~FID.[6:18];% 37096000
FOR U~0 STEP 1 UNTIL 31 DO% 37097000
IF TINU[U].[30:18]=T1 THEN GO ON;% 37098000
GO TO MT;% 37099000
ON: DOLITTLE(LABELTABLE[U]=0,VWY,"#... "&T1[12:30:18], 37100000
"RQD ",MID); GO X; 37100010
MT: T1~MID;% 37112000
DOLITTLE(MAGTAPE,VWY,"#MT RQD",IF MID.UNITNUM!0 THEN %148-37113000
"ON ..."&TINU[MID,UNITNUM-1][30:30:18] %148-37113100
ELSE 0,MID); %148-37113200
IF DSED THEN GO TO X; 37121000
IF (T1~PRNTABLE[U].[15:15])!0 THEN% 37122000
BEGIN FILECLOSE(T1&3[18:33:15]);% 37123000
M[M[T1-3] INX 5].[38:4]~1;% 37124000
END;% 37125000
X: IF DSED THEN U~-1 ELSE 37172000
BEGIN KIND~UNIT[U].[1:4]; 37173000
LABELTABLE[U]~-FID; MULTITABLE[U]~MID;% 37174000
RDCTABLE[U]~P(DUP,LOD)&REEL[14:38:10]&CDATE[24:31:17] 37174100
&CYCLE[41:41:7]; 37174200
END; EXIT: FINDOUTPUT~U 37175000
END FINDOUTPUT;% 37176000
REAL PROCEDURE FINDINPUT(MID,FID,REEL,CDATE,CYCLE,COBOL,UL,OF,MODE,FN); 37177000
VALUE MID,FID,REEL,CDATE,CYCLE,COBOL, OF,MODE,FN;% 37178000
REAL MID,FID,REEL,CDATE,CYCLE,COBOL,UL,OF,MODE,FN;% 37179000
BEGIN REAL T1,T2,U,LO,HI,FIRST,IL; 37180000
REAL A=COBOL; 37180100
INTEGER S,COUNT; 37180200
INTEGER USASI=IL; 37180300
ARRAY FPB=LO[*]; 37180400
LABEL LOOK,SEE,SRCHOUT; 37180500
LABEL START,WHY,SXIT,X,Y,READALABEL,REW,EXIT; 37180600
LABEL ONN,DUN,FAIL; 37180650
DEFINE UNLABELED = UL#; 37180700
DEFINE UNITNUM = [1:5]#; %148-37180800
37180990
REAL SUBROUTINE DSED; DSED:=TERMSET(P1MIX); 37181000
37185300
SUBROUTINE CHECKTERMIX; % LET CALLER ATTEND HIS RESPONSIBILITIES.37185310
BEGIN 37185320
IF DSED THEN 37185330
BEGIN 37185340
IF JAR[P1MIX,9].SYSJOBF THEN % MCP JOB 37185350
BEGIN 37185370
U:=-1; 37185380
GO TO EXIT; 37185390
END ELSE GO TO INITIATE; 37185400
END; 37185410
END; % CHECKTERMIX 37185420
37185990
REAL SUBROUTINE SEARCH;% 37186000
BEGIN COUNT:=0; 37186500
IF NOT DSED THEN 37186750
BEGIN 37187000
IF (LO:=(HI:=MID.UNITNUM-1)) GEQ 0 THEN %148-37187100
IF LABELTABLE[LO] GTR @314 THEN %148-37187110
BEGIN COUNT~COUNT+1; P(LO,XCH); %148-37187120
MID~MULTITABLE[LO]; GO SEE; %148-37187130
END; 37187140
$ SET OMIT = NOT PACKETS 37187200
IF (LO:=(HI:=PSEUDOMIX[P1MIX]))!0 THEN 37187250
$ SET OMIT = PACKETS 37187375
LOOK: FOR U:=LO STEP 1 UNTIL HI DO 37188500
BEGIN IF S GEQ 0 THEN 37188750
IF (LABELTABLE[U] EQV (-@14))=NOT 0 THEN 37189000
COMPLEXSLEEP((LABELTABLE[U] EQV (-@14))!NOT 0 OR 37189250
(IF U<32 THEN UNIT[U].[13:5]=16 ELSE 0)); 37189500
IF (LABELTABLE[U] EQV FID)=NOT 0 THEN% 37190000
IF (MULTITABLE[U] EQV MID)=NOT 0 THEN% 37191000
IF ((T1~RDCTABLE[U]).[14:10]=REEL) OR (REEL=0) THEN% 37192000
IF (T1.[24:17]=CDATE) OR (CDATE=0) THEN% 37193000
IF (T1.[41:7]=CYCLE) OR (CYCLE=0) THEN% 37194000
BEGIN 37195000
COUNT:=COUNT+1; P(U,XCH); 37195030
END; 37195040
END; 37195050
FAIL: 37195100
IF LO = HI THEN IF COUNT = 1 THEN GO SEE ELSE 37195200
IF LO=0 THEN IF (LO:=JAR[P1MIX,6].[2:6])=23 OR LO=24 37195250
THEN HI:=LO ELSE GO TO ONN ELSE 37195280
ONN: BEGIN LO:=23; HI:=24; END ELSE %754-37195300
IF LO=23 THEN BEGIN LO:= 0; HI:=15; END ELSE GO TO DUN; 37195400
GO TO LOOK; 37195450
DUN: IF CYCLE.[1:1] THEN % PBT 37195500
BEGIN 37195550
IF COUNT=0 THEN IF FID.[1:5]<3 THEN 37195600
BEGIN FID.[1:5]~FID.[1:5]+1; 37195650
LO~0; HI~15; GO LOOK; 37195700
END ELSE FID.[1:5]~1; 37195750
GO SRCHOUT; 37195800
END; 37195850
IF COUNT=0 THEN 37196200
IF MID!0 THEN% 37197000
IF NOT CDATE.[1:1] THEN % NOT LIBMAIN/DISK 37197500
FOR U~0 STEP 1 UNTIL 15 DO% 37198000
IF (MULTITABLE[U] EQV MID)=NOT 0 THEN% 37199000
IF (RDCTABLE[U].[24:17]=CDATE) OR (CDATE=0) THEN 37199100
IF LABELTABLE[U]>0 THEN% 37200000
BEGIN COUNT~COUNT+1; 37201000
P(U,XCH); 37202000
END ELSE% 37203000
IF RDCTABLE[U].[8:6]=P1MIX THEN% 37204000
IF (T1~M[M[PRNTABLE[U].[15:15]-3] INX 5]).[41:1] THEN 37205000
IF T1.[43:1] OR T1.[40:1]=0 THEN% 37206000
BEGIN COUNT~COUNT+1; P(U,XCH) END; 37207000
SEE: 37207500
END; 37208000
SRCHOUT: 37208500
SEARCH~S~COUNT>0; 37209000
END SEARCH;% 37210000
37210090
REAL SUBROUTINE RESEARCH; 37210100
BEGIN 37210150
S:=-2; 37210175
P(SEARCH); 37210200
DO P(DEL) UNTIL (COUNT:=COUNT-1) LSS 0; 37210250
RESEARCH~S; 37210300
END RESEARCH; 37210400
37210990
REAL SUBROUTINE REED;% 37211000
BEGIN IF CHI~WAITIO(T1,LO&@377[18:33:15],U) AND @367)!0 THEN 37212000
IF CHI AND NOT LO)!0 THEN 37213000
BEGIN BLASTQ(U); SETNOTINUSE(U,0); STOPTIMING(FN,1023); 37214000
FILEMESS(-:PARITY ","ON ... "&TINU[U][24:30:18],% 37215000
MID,FID,REEL,CDATE,CYCLE);% 37216000
END;% 37217000
IF DSED THEN 37218000
BEGIN 37218100
SETNOTINUSE(U,0); 37218200
STOPTIMING(FN,1023); 37218300
CHECKTERMIX; 37218400
END; 37219000
REED~HI;% 37220000
END REED;% 37221000
37221090
SUBROUTINE SEARCHCOM; % FILE SEARCH FOR COM 30 37221100
BEGIN P(DEL); 37221120
IF NOT SEARCH THEN U:=-1 ELSE 37221140
IF COUNT=1 THEN U:=P ELSE 37221160
BEGIN 37221180
S:=COUNT; T1:=0; 37221200
COUNT:=IF COUNT>8 THEN 8 ELSE COUNT; 37221220
WHILE (COUNT:=COUNT-1) GEQ 0 DO 37221240
BEGIN U:=P; 37221260
IF T1 THEN 37221280
BEGIN 37221300
T1:=0; M[A].[30:18]:=TINU[U].[30:18]; 37221320
A:=A+1; 37221340
END ELSE 37221360
BEGIN 37221380
T1:=1; M[A].[12:18]:=TINU[U].[30:18]; 37221400
END; 37221420
END; 37221440
U:=-5; 37221460
END; 37221480
GO EXIT; 37221500
END; 37221520
37221990
START:% 37222000
IF UL<0 THEN SEARCHCOM ELSE 37222100
IF UL THEN GO TO WHY ELSE % 37222500
IF NOT SEARCH THEN% 37223000
WHY: BEGIN FILEMESS("#NO FIL",IF MID.UNITNUM!0 THEN %148-37224000
"ON ..."&TINU[MID.UNITNUM-1][30:30:18] %148-37224100
ELSE 0,MID,FID,REEL,CDATE,CYCLE); %148-37224200
FIRST:=VOK&VWY[36:42:6]&VUL[30:42:6]&VIL[24:42:6]; 37225000
IF COBOL THEN 37225050
FIRST:=FIRST&(VOF|OF)[18:42:6]&(VFR|UL)[12:42:6]; 37225100
IF AUTODS THEN TERMINATE(P1MIX&61[CTF]) ELSE %747-37225800
BEGIN %747-37225900
REPLY[P1MIX]~-FIRST&1[2:47:1]; 37226000
COMPLEXSLEEP(RESEARCH OR (REPLY[P1MIX]>0) OR DSED); 37227000
END; %747-37227100
CHECKTERMIX; 37228000
IF S THEN S~SEARCH ELSE 37229000
BEGIN IF NOT WHYSLEEP(FIRST) THEN GO TO WHY; 37229500
IF (T2:=(T1:=REPLY[P1MIX]).[FF]) GTR 64 THEN % IL 37230000
BEGIN STREAM(T2:); % MID/FID37230250
BEGIN SI:=T2; 37230500
LL: SI:=SI+1; IF SC!"L" THEN GO TO LL; 37230750
SI:=SI+1; T2:=SI; 37231000
END; 37231250
T2:=P; 37231500
NAMEID(HI,T2); MID:=HI; NAMEID(HI,T2); 37232000
NAMEID(HI,T2); FID:=HI; 37232250
FORGETSPACE(T1.[FF]-1); 37232500
GO TO Y; 37232750
END; 37233000
IF T1=VOK THEN GO TO Y; % OK 37233250
IF NOT (IL:=T1.[CF]=VIL) THEN % OF, FR 37233500
BEGIN U:=-1; 37233750
REPLY[P1MIX]:=0; 37234000
GO TO EXIT; 37234250
END; 37234500
UNLABELED~-LABELTABLE[U~T1.[18:15]]=@314;% 37235000
P(U); 37235100
COUNT:=1; 37235250
IF LABELTABLE[U]=0 THEN 37235500
BEGIN MULTITABLE[U]:=MID; 37235750
LABELTABLE[U]:=FID; 37236000
END ELSE 37236250
BEGIN MID:=MULTITABLE[U].[6:42]; 37236500
FID:=LABELTABLE[U].[6:42]; 37236750
END; 37237000
END; 37238000
REPLY[P1MIX]:=0; 37239000
END;% 37240000
IF COUNT {0 THEN GO TO START; %120-37240050
IF COUNT>1 THEN 37240100
SXIT: BEGIN FILEMESS("#DUP ","FIL ",MID,FID,REEL,CDATE,CYCLE); 37240200
WHILE (COUNT~COUNT-1)}0 DO 37240300
BEGIN IF (U~P)<16 THEN IF MID!0 THEN 37240400
IF (T1~PRNTABLE[U].[15:15])!0 THEN 37240500
FILECLOSE(T1&@12[18:33:15]); 37240600
STREAM(X~[TINU[U]]:D~S~SPACE(10)); 37240700
BEGIN SI~X; SI~SI+5; DS~8 LIT " DUP ON "; 37240800
DS~3 CHR; DS~LIT "~"; 37240900
X~DI; 37240910
END; 37241000
T1~P; 37241010
IF U}32 THEN IF CIDROW[U -32]!0 THEN 37241020
STREAM(DK~CIDTABLE[U -32,2],T1); 37241030
BEGIN DI~DI-1; DS~6 LIT ",DECK "; 37241040
SI~LOC DK; SI~SI+1; DS~7 CHR; 37241050
END; 37241060
SPOUT(5); 37241100
END; 37241200
REPLY[P1MIX]:= -VWY&VOK[36:42:6]&VIL[30:42:6]; 37241300
COMPLEXSLEEP(DSED OR (REPLY[P1MIX]>0)); 37241400
CHECKTERMIX; 37241500
IF (T1:=REPLY[P1MIX]).[33:15]=VIL THEN 37241510
BEGIN REPLY[P1MIX]~0; 37241520
IF T1.[FF] > 64 THEN GO SXIT; 37241525
P(T1.[18:15]); 37241530
GO TO X; 37241540
END; 37241550
IF NOT WHYSLEEP(VWY&VOK[36:42:6]&VIL[30:42;6]) THEN 37241600
BEGIN S:=SEARCH;GO SXIT END; 37241610
Y: REPLY[P1MIX]:=0; GO TO START; 37241700
END; 37241800
X: 37241810
LABELTABLE[U~P].[1:5]~@20; 37241900
IF NOT UNLABELED THEN 37242000
BEGIN FPB:=PRT[P1MIX,3]; 37242100
FPB[FN]:=MID; 37242200
FPB[FN+1]:=FID; 37242300
END; 37242400
IF U LSS 16 THEN 37242600
IF MID!0 THEN 37242800
BEGIN IF (T1!PRNTABLE[U].[15:15])!0 THEN% 37243000
BEGIN FILECLOSE(T1&3[18:33:15]);% 37244000
M[M[T1-3] INX 5].[39:4]~1;% 37245000
END;% 37246000
RRRMECH~TWO(U) OR RRRMECH; STARTIMING(FN,U); 37248000
IF UNLABELED OR IL OR CYCLE.[1:1] THEN GO EXIT; 37248500
T1 ~ SPACE(11)&10[8:38:10]&MODE[21:47:1]% 37249000
&3[23:46:2];% 37250000
LO~@40; FIRST~1;% 37251000
READALABEL: IF REED ! 0 THEN IF FIRST THEN% 37252000
REW: BEGIN FIRST~WAITIO(@4200000000,0,U); GO READALABEL END ELSE 37253000
BEGIN SETNOTINUSE(U,I); FORGETSPACE(T1.[33:15]); 37254000
STOPTIMING(FN,1023); GO TO START END; 37255000
STREAM(Y:=0:X:=0,T1); 37255100
BEGIN DI:=LOC X; DS:=8 LIT "VOL1HDR1"; 37255200
SI:=T1; DI:=DI-8; 37255300
IF 4 SC=DC THEN TALLY:=1 ELSE 37255400
BEGIN SI:=T1; IF 4 SC=DC THEN TALLY:=2; END; 37255500
Y:=TALLY; 37255700
END; 37255800
IF(USASI:=P)>0 THEN USASITAPE(T1.[CF],USASI,2,U,0); 37255900
STREAM(M~0,F~0,R~0,D~0,C~0:S~T1 INX 1);% 37256000
BEGIN SI~S; SI~LOC M; DS~2 WDS; DS~3 OCT;% 37257000
DS:=5 OCT;DS:=2 OCT; 37258000
END;% 37259000
IF (P=CYCLE OR CYCLE=0) AND (P(XCH)=CDATE OR CDATE=0) AND% 37260000
(P(XCH)=REEL OR REEL=0)AND ((P(XCH) EQV FID)=NOT 0) AND% 37261000
((P(XCH) EQV MID)=NOT 0) THEN% 37262000
BEGIN FORGETSPACE(T1.[33:15]); T1~@340000005;% 37263000
LO~0;T1~REED; GO TO EXIT;% 37264000
END;% 37265000
IF FIRST THEN GO REW;% 37266000
LO:=@60; DO UNTIL (FIRST:=REED).[42:1]; DO UNTIL REED.[42:1]; 37267000
IF USASI>0 THEN DO UNTIL REED.[42:1] ELSE FIRST:=REED; 37267050
LO~@40; GO READALABEL; 37267100
END;% 37268000
EXIT: FINDINPUT~U;% 37269000
END FINDINPUT;% 37270000
PROCEDURE STARTIMING(FN,U); VALUE FN,U; REAL FN,U;% 37271000
BEGIN ARRAY FPB[*]; INTEGER I,J;% 37272000
FPB~PRT[P1MIX,3];% 37273000
IF U<32 THEN 37273100
BEGIN IF FPB[FN+4]}0 THEN 37274000
BEGIN IF (I+FPB[FN+3].[36:6])!0 THEN% 37275000
IF I NEQ U+1 OR FPB[FN+2].[8:10] NEQ RDCTABLE[U].[14:10] 37276000
THEN 37276010
IF (I~FPB.[8:10])<(1023-ETRLNG) THEN 37276100
BEGIN J~GETSPACE(I+ETRLNG,2,1)+2;% 37277000
$ SET OMIT = SHAREDISK 37277999
MOVE(I,FPB,J);% 37278000
$ POP OMIT 37278001
$ SET OMIT = NOT SHAREDISK 37278099
MOVE(ETRLNG,[FPB[FN]],J+I);% 37278200
FORGETSPACE(FPB.[33:15]);% 37279000
NFO[(P1MIX-1)|NDX]~ 37279100
PRT[P1MIX,3]~FPB~[M[J]]&(I+ETRLNG)[8:38:10];% 37280000
FPB[FN+4]+0; FPB[FN+3].[24:12]~0;% 37281000
END;% 37282000
FPB[FN+4]~FPB[FN+4]-CLOCK-P(RTR);% 37283000
FPB[FN+3].[36:6]~U+1;% 37284000
IF U LSS 16 THEN% RDC & PRN LOG ENTRIES 37284100
BEGIN ; 37284110
STREAM(R:=RDCTABLE[U].[14:10],D:=RDCTABLE[U].[24:17], 37284120
C:=RDCTABLE[U].[41:7],T:=[FPB[FN +2]]); 37284130
BEGIN SI:=LOC R;DS:=3DEC;DS:=5DEC;DS:=DEC END; 37284140
FPB[FN +3].[6:17]:=PRNTABLE[U].[31;17]; 37284150
END; 37284310
END END ELSE 37285000
BEGIN IF (I:=FPB[FN+4]) LSS 0 THEN 37285100
BEGIN FPB[FN+4]~I+CLOCK+P(RTR); I~FPB[FN+3].[36:6]-1; 37285200
FPB[FN+3].[24:12]~P(DUP).[24:12]+(J~TINU[I].[18:12]); 37285300
IF I<16 THEN 37285305
IF J>0 THEN FILEMESS("# IO"&TINU[I] 37285310
[12:30:18],-RETRIES",FPB[FN],FPB[FN+1],J,0,0); %715-37285320
TINU[I].[18:12]~0; 37285400
END END END TIMING; 37285500
REAL PROCEDURE DISKADDRESS(MID,FID,FPB3,A,H,IO); % (SHM)37286000
VALUE MID,FID,FPB3,A,H,IO; % (SHM)37286100
REAL MID,FID,FPB3,A,IO; % (SHM)37286200
ARRAY H[*]; 37286300
BEGIN LABEL EOF, EOF2; 37287000
INTEGER I; 37287250
REAL T, V; 37287500
IF A}0 THEN% 37288000
BEGIN T~(A DIV H[0].[30:12])|H[0].[42:6];% 37289000
IF H[9] LEQ I:=(IF H[1]=0 THEN 0 ELSE T DIV H[1]) THEN 37290000
GO TO EOF; 37290100
IF H[I:=I+10]=0 THEN % NEW ROW NEEDED. 37291000
IF IO THEN GO TO EOF ELSE % EOF ON A READ. 37291200
IF IO=2 THEN % CALLED FROM FILEOPEN SO 37291400
BEGIN % DONT EXPAND THE FILE YET. 37291600
T:=1; 37291800
GO TO EOF2; 37292000
END 37292200
ELSE 37292400
IF H[4] THEN % IN DIRECTORY, UPDATE HEADER. 37292600
P(DIRECTORYSEARCH(-MID,FID,-H&I[CTF]),DEL) 37292800
ELSE % NOT IN DIREECTORY. 37293000
BEGIN % (SHM)37293010
IF (V:=FPB3.[18:5]) GTR 0 THEN % EU SPECIFIED % (SHM)37293020
V:=(IF V GTR 20 THEN 0 ELSE -V) ELSE % (SHM)37293030
IF (V:=FPB3.[16:2]) GTR 0 THEN % SPEED SPECIFIED %(SHM)37293040
V:=(IF V GTR 2 THEN 0 ELSE V) ELSE % (SHM)37293050
V:=0; % NO SPEED OR EU SPECIFIED % (SHM)37293060
H[I] := PETUSERDISK(H[8],V); % (SHM)37293070
END; % (SHM)37293330
T~H[I]+I~T MOD H[1];% 37294000
STREAM(D~[T]); BEGIN SI~D; DS~8 DEC END;% 37295000
END ELSE% 37296000
EOF: T~0;% 37297000
EOF2: 37297500
DISKADDRESS~T;% 37298000
END DISKADDRESS;% 37299000
PROCEDURE SETNOTINUSE(U,RWL); VALUE U,RWL; REAL U,RWL; 37302000
BEGIN REAL I,J; 37303000
IF U<16 THEN P(WAITIO(@4200000000,@377,U),DEL); 37303200
SLEEP([TOGLE],STATUSMASK); 37304000
RRRMECH~((I~TWO(U)) AND SAVEWORD) OR ((I~NOT I) AND RRRMECH);% 37305000
READY~READY AND I;% 37306000
IF RWL THEN 37312000
BEGIN 37313000
STREAM(S~[TINU[U]],M~MULTITABLE[U],F~LABELTABLE[U], 37314000
N~IF U<16 THEN PRNTABLE[U].[30:18] ELSE 0, 37314100
T:=MULTITABLE[U]=0, TT:=U GEQ 16, D:=J:=SPACE(10)); 37314200
BEGIN SI~S; SI~SI+5; DS~LIT "#"; DS~3 CHR;% 37315000
DS~6 LIT " RW/L "; SI~LOC M; SI~SI+1; 37316000
DS~7 CHR; DS~LIT " "; SI~SI+1; DS~7 CHR; 37316100
T(M~DI;DI~DI-15;DS~7FILL;DI~M); TT(JUMP 37316200
OUT TO LA); DS~LIT "("; DS~5 DEC; DS~LIT")"; 37316300
LA: DS~LIT "~"; 37316400
END;% 37317000
SPOUT(J); 37318000
LABELTABLE[U]~@214; 37318100
END ELSE LABELTABLE[U]~@114; 37319000
MULTITABLE[U]~RDCTABLE[U]~0; 37319010
IF U<16 THEN PRNTABLE[U]~0 ; 37319020
END SETNOTINUSE; 37319100
PROCEDURE BLASTQ(U); 37320000
VALUE U; REAL U; 37321000
BEGIN 37322000
REAL I,X; 37323000
BOOLEAN SUBROUTINE CHECKIO; 37323100
BEGIN 37323200
CHECKIO:=(I:=UNIT[U]).[5:8]!0 OR (I.[14:1] AND I.[13:5]!@31); 37323300
END; 37323400
IF CHECKIO THEN COMPLEXSLEEP(NOT CHECKIO); 37324000
IF I.[16:1] THEN % SKIP I/O IN PROCESS 37326000
BEGIN I:=NFLAG(LOCATQUE[X:=I.[FF]]); 37327000
LOCATQUE[X].[FF]:=@77777; 37328000
UNIT[U].[CF]:=X; 37329000
END ELSE 37330000
UNIT[U].[5:43]:=(NOT 0).[18:30]; 37331000
WHILE (I:=I.[FF])!@77777 DO 37332000
BEGIN RETURNIOSPACE(I); 37333000
I:=NFLAG(LOCATQUE[I]); 37334000
END; 37335000
END BLASTQ; 37336000
PROCEDURE BUILDLABEL(LABLE,MID,FID,REEL,CDATE,CYCLE,PFACT,PTN,BLKODE,% 37337000
BSIZE,RSIZE);% 37338000
VALUE LABLE,MID,FID,REEL,CDATE,CYCLE,PFACT,PTN,BLKODE,37339000
BSIZE,RSIZE;% 37340000
ARRAY LABLE[*];% 37341000
REAL MID,FID,REEL,CDATE,CYCLE,PFACT,PTN,BLKODE,% 37342000
BSIZE,RSIZE;% 37343000
BEGIN;STREAM(D~[PFACT]); BEGIN SI~D; SI~SI+5; DS~3 OCT END;% 37344000
PFACT~CALCULATEPURGE(PFACT);% 37345000
STREAM(S~M[MID],LABLE);% 37346000
BEGIN DS~8 LIT " LABEL "; SI~S; DS~2 WDS;% 37347000
DS~3 DEC; DS~5 DEC; DS~2 DEC; SI~SI+3; DS~5 CHR;% 37348000
DS~14 LIT "0"; DS~5 DEC; SI~SI+7; DS~CHR;% 37349000
DS~5 DEC; DS~5 DEC; DS~11 LIT "0"% 37350000
END;% 37351000
IF (RSIZE~LABLE.[8:10])>10 THEN% 37352000
STREAM(J~JARROW[P1MIX],D~[LABLE[10]]);% 37353000
BEGIN SI~J; SI~SI+1; DS~LIT " "; DS~7 CHR;% 37354000
SI~SI+1; DS~LIT "/"; DS~7 CHR; 12(DS~2 LIT " ");% 37355000
END END GUILDLABEL;% 37356000
$ SET OMIT = PACKETS 37356999
$ SET OMIT = NOT(PACKETS) 37357299
PROCEDURE FILEMESSAGE(I,K,M,F,R,D,C,TYPE); 37357300
VALUE I,K,M,F,R,D,C,TYPE; 37357400
REAL I,K,M,F,R,D,C,TYPE; 37357500
$ POP OMIT 37357501
BEGIN REAL Z,L;% 37359000
L~SPACE(12);% 37360000
STREAM(Z:I~[I],J~[JAR[P1MIX,*]],P1MIX,L); 37361000
BEGIN SI~I; 37362000
IF SC="+" THEN BEGIN TALLY~1; DS~LIT "-"; SI~SI+1 END ELSE% 37363000
BEGIN SI~SI+1; IF SC!"#" THEN DS~LIT " " END;% 37364000
DS~7 CHR; DS~LIT " "; L~DI;% 37365000
2(DI~LOC Z; IF 8 SC!DC THEN BEGIN DI~L; SI~SI-7; DS~7 CHR;% 37366000
DS~LIT " "; L~DI END);% 37367000
DI~L; SI~SI+1; DS~7 CHR; DS~LIT " "; L~DI;% 37368000
3(DI~LOC Z; IF 8 SC!DC THEN BEGIN DI~L; SI~SI-8; DS~7 DEC; 37369000
L~DI; DI~DI-7; DS~6 FILL; 37370000
DI~L; DS~LIT " "; L~DI; 37371000
END); 37372000
DI~L; DS~SI-1; DS~LIT ":";% 37375000
Z~TALLY; SI~LOC Z; SI~SI+7;% 37376000
IF SC="0" THEN BEGIN SI~J; SI~SI+1; DS~7 CHR; DS~LIT "/";% 37377000
SI~SI+1; DS~7 CHR; DS~LIT "=";% 37378000
SI~LOC P1MIX; DS~2 DEC; 37379000
L~DI; DI~DI-2; DS~FILL; DI~L END; 37379500
DS~LIT "~";% 37380000
END;% 37381000
IF P THEN BEGIN TERMINATE(P1MIX); TERMINALMESSAGE(-L) END;% 37382000
SPOUTER(L,0,TYPE); 37383000
END FILEMESS;% 37384000
PROCEDURE FILLBUFFERS(CURRENT,FINAL,COBOL,NR); 37385000
VALUE CURRENT,FINAL,COBOL,NR; 37385500
REAL CURRENT,FINAL,COBOL,NR; 37386000
BEGIN ARRAY LOCAT[*];% 37387000
INTEGER I,J,K,D;% 37388000
INTEGER FIRSTLOC=J,PRELOC=K,CURLOC=D; 37388100
REAL T=LOCAT; 37388200
REAL T1; 37388250
REAL NF=T1+1; % MUST BE AT THE TOP OF THE STACK37388275
LABEL LINK; 37388300
REAL BSIZE=CURRENT,N=FINAL,U=COBOL,ALPHA=NR; 37388400
IF ALPHA<512 THEN 37388500
BEGIN 37388600
P(NR-(COBOL GTR 0)); % INITIALIZE NF 37388700
IF COBOL THEN FINAL:=CURRENT; 37388800
J~FINAL.[33:15]-K~CURRENT.[33:15];% 37389000
D~2&(NOT CURRENT)[1:22:1];% 37390000
LOCAT~M[K+D]; NR~NR-1;% 37391000
FOR I~1 STEP 1 UNTIL NF DO% 37392000
BEGIN IORREQUEST(FLAG(FINAL),CURRENT,LOCAT);% 37393000
M[LOCAT]~M[LOCAT]&0[26:26:7] AND NOT(M OR IOMASK);% 37394000
IF NOT COBOL THEN 37394025
IF I=1 THEN IF P(FINAL.[3:5],DUP)=6 OR P(XCH)=7 THEN 37394050
BEGIN 37394100
SLEEP(LOCAT & 0 [3:3:30],IOMASK); 37394150
STREAM(N~0,L~0:NDIV64~0,BACC~T1~FINAL.[7:1], 37394200
BUF ~ (M[LOCAT] INX T1)-(1-T1)); 37394250
BEGIN DI ~ LOC N; SI ~ BUF; BACC(SI ~ SI+4); 37394260
IF 4 SC!DC THEN GO OWT; 37394280
DI ~ LOC N; BACC(SI ~ BUF); DS ~ 4 OCT; 37394300
SI ~ LOC L; DI ~ LOC BACC; SI ~ SI-2; DI ~ DI-1; 37394350
DS ~ 1 CHR; SI ~ BUF; 37394360
CI ~ CI+BACC; GO FWD; 37394400
NDIV64(SI ~ SI-32; SI ~ SI-32); SI ~ SI-N; SI ~ SI+4; 37394450
GO ON; 37394460
FWD: NDIV64(SI ~ SI+32; SI ~ SI+32); SI ~ SI+N; 37394500
ON: DI ~ LOC L; DS ~ 4 OCT; 37394550
OWT: 37394560
END STREAM; 37394600
T1 ~ P; 37394650
IF P(DUP)=0 OR P(XCH)!T1 THEN TERMINATE(P1MIX&108[CTF]); 37394700
END; 37394800
IF NR>0 THEN STREAM(NR,T~M[LOCAT],LOCAT);% 37395000
BEGIN SI~LOCAT; SI~SI+8; DS~NR WDS;% 37396000
SI~LOC T; DS~WDS END;% 37397000
CURRENT.[33:15]~K~M[K+D].[18:15];% 37398000
FINAL.[33:15]~K+J;% 37399000
END END ELSE 37400000
BEGIN 37401000
T~ALPHA&U[12:42:6] OR M;% 37404000
FOR I~N-1 STEP -1 UNTIL 0 DO% 37405000
BEGIN M[ALPHA+I]~(CURLOC~GETSPACE(BSIZE+4,2,1)+2)+2; 37406000
$ SET OMIT = NOT(BREAKOUT) 37406099
IF FIRSTLOC=0 THEN FIRSTLOC~CURLOC;% 37407000
M[CURLOC+1]~0; MOVE(BSIZE+1,CURLOC+1,CURLOC+2); 37408000
LINK: M[CURLOC]~FLAG(T)&(PREVLOC+2)[18:33:15];% 37412000
M[CURLOC+BSIZE+3]~FLAG(T)&(PREVLOC+BSIZE+1)[18:33:15];% 37413000
PREVLOC~CURLOC;% 37414000
END;% 37415000
IF I=(-1) THEN BEGIN CURLOC~FIRSTLOC; GO TO LINK END;% 37416000
END END FILL OR GET BUFFERS; 37417000
REAL PROCEDURE FILEHEADER(MID,FID,NROWS,SIZE,BLEN,RLEN,S);% 37418000
VALUE MID,FID,NROWS,SIZE,BLEN,RLEN,S;% 37419000
REAL MID,FID;% 37420000
INTEGER NROWS,SIZE,BLEN,RLEN,S;% 37421000
BEGIN REAL Q,LPER,SPER; ARRAY T=Q[*]; 37422000
INTEGER N1,R1,L1,W; 37422100
$ SET OMIT = NOT SHAREDISK 37422199
LABEL T1FILL,EXIT; 37422300
SPER~(BLEN+29) DIV 30;% 37424000
IF SPER>63 THEN 37424100
FILEMESS(-"INVALID","BLOCK ",MID,FID,RLEN,BLEN,SPER); 37424200
IF S.[42:6]=0 THEN RLEN~BLEN;% 37425000
$ SET OMIT = SHAREDISK 37425499
Q:=S.[13:3]; 37425500
$ POP OMIT 37425501
$ SET OMIT = NOT SHAREDISK 37425599
LPER~BLEN DIV RLEN;% 37426000
IF (NROWS+SIZE)=0 THEN% 37427000
BEGIN 37428000
IF (N1:=SECURITYCHECK(MID,FID,USERCODE[P1MIX],Q)) LSS 0 THEN 37428100
$ SET OMIT = NOT SHAREDISK 37428199
GO TO EXIT; 37428300
$ SET OMIT = NOT SHAREDISK 37428399
T:=N1&P(.T,LOD,XCH)[CTF]; 37429000
$ SET OMIT = NOT SHAREDISK 37429099
N1~T[7]+1; 37430000
IF(L1~T[0].[1:14])=0 THEN L1~30; 37431000
R1~T[0].[30:12]; 37432000
W ~N1 DIV R1 | T[0].[42:6]|30 +N1 MOD R1|L1; 37433000
T[7]~ W~ W DIV 30 DIV SPER|LPER 37434000
+(W DIV 30 MOD SPER|30 + W MOD 30 + RLEN-1) 37435000
DIV RLEN-1; 37436000
T1FILL: T[1]~(T[8] DIV SPER)| SPER; 37437000
T[4]:=(*P(DUP))&0[11:47:1] OR 1; 37437500
END ELSE% 37439000
$ SET OMIT = SHAREDISK 37439999
BEGIN T:=M OR (GETSPACE(30,8,1)+@360000700002); 37440000
STREAM(T); BEGIN 60(DS~4 LIT "0") END;% 37441000
$ POP OMIT 37441001
$ SET OMIT = NOT SHAREDISK 37441099
T[3]~XCLOCK+P(RTR); 37441500
T[7] ~ -1; 37442000
T[1]:=T[8]:=((SIZE+(LPER-1))DIV LPER)| SPER; 37443000
T[9] ~ NROWS; 37444000
END;% 37445000
T[0] ~SPER&LPER[30:36:12]&BLEN[15:33:15]&RLEN[1:34:14]; 37446000
FILEHEADER ~ NFLAG(T); 37447000
EXIT: 37447500
END FILEHEADER;% 37448000
PROCEDURE PURGEIT(U); VALUE U; INTEGER U;% 37449000
BEGIN ARRAY LABLE=+1[*];% 37450000
REAL RCW=+0,EOF=+2;% 37451000
REAL MSCW=-2; 37451500
P(0,0); 37453000
P(WAITIO(@4200000000,@377,U),DEL); 37453100
LABLE~[M[SPACE(10)]]&10[8:38:10]&5[21:45:3];% 37454000
BUILDLABEL(LABLE,0,"X",1,0,1,0,PRNTABLE[U].[30:18],0,0,0);% 37455000
P(WAITIO(LABLE,@37700000,U),DEL);% 37456000
EOF~@1737000000000000;% 37457000
P(WAITIO([EOF],@37700000,U),DEL);% 37458000
FORGETSPACE(LABLE.[33:15]); 37463000
SETNOTINUSE(U,0); 37464000
KILL([MSCW]); 37465000
END PURGEIT; 37466000
PROCEDURE KRUNCHER(H) ARRAY H[*]; 37500000
BEGIN DEFINE E=H[7]#,RL=H[1]#,RPB=H[0].[30:12]#, 37501000
MAXROWS=H[9]#, 37501500
BCL=H[0].[42:6]#,BRL=H[8]#; 37502000
ARRAY A[*]; 37504000
LABEL FORGET,EXIT,AGAIN,DONE; 37505000
INTEGER NB,NBR; 37506000
REAL I,J,K,T; 37507000
A:=[M[SPACE(41)]]&40[8:38:10]; 37508000
MOVE(41,A.[CF]-1,A); 37509000
IF E LSS 0 THEN GO TO EXIT; 37510000
NB:=E DIV RPB; 37511000
NBR:=RL DIV BCL; 37512000
IF RL NEQ BRL THEN 37513000
FOR I:=10 STEP 1 UNTIL 29 DO 37514000
IF H[I] NEQ 0 THEN 37515000
$ SET OMIT = SHAREDISK 37515995
FORGETUSERDISK(H[I]+RL,BRL-RL); 37516000
$ SET OMIT = NOT SHAREDISK 37516050
BRL=RL; 37517000
IF NB LSS NBR THEN 37520000
BEGIN A[0]:=H[NT2:=10]; 37521000
NT4:=1; 37521100
RL:=(NB+1)|BCL; 37521200
GO TO FORGET; 37521300
END; 37521400
T:=(K:=J:=1)+NBR|20; 37522000
AGAIN: IF(NT1:=NBR DIV J)=0 THEN GO TO DONE; 37523000
IF (NT2:=NB DIV NT1) GTR 19 THEN GO TO DONE; 37524000
IF NBR MOD J=0 THEN 37525000
BEGIN IF (NT3:=NT1|NT2+NT1) LSS T THEN 37526000
BEGIN K:=J; T:=NT3; NT4:=NT2+1 END; 37527000
END; 37528000
J:=J+1; 37529000
GO TO AGAIN; 37530000
DONE: IF K=1 THEN GO TO EXIT; 37530100
NT2:=NB DIV NBR + 10; 37530200
RL:=RL DIV K; 37531000
FOR I:=10 STEP 1 UNTIL NT2 DO 37532000
BEGIN IF (NT1:=H[I]-RL) GTR 0 THEN 37533000
FOR J:=1 STEP 1 UNTIL K DO 37534000
A[(I-10)|K+J-1]:=NT1+J|RL; 37535000
END; 37536000
FOR K:=NT4 STEP 1 UNTIL 19 DO A[K]:=0; 37538000
IF MAXROWS LSS (NT5:=(NT4!20)+NT4) THEN MAXROWS:=NT5; 37538500
FORGET: IF NB+1 NEQ NBR THEN 37539000
$ SET OMIT = SHAREDISK 37541995
FORGETUSERDISK(A[NT4-1]+RL,(NT2-9)|BRL-NT4|RL); 37542000
$ SET OMIT = NOT SHAREDISK 37542005
MOVE(20,A,[H[10]]); 37543000
BRK:=RL; 37544000
EXIT: FORGETSPACE(A); 37545000
END; 37546000
PROCEDURE DISKFILEOPEN(ALPHA); VALUE ALPHA; INTEGER ALPHA; 38000000
BEGIN REAL RCW=+0,MSCW=-2; 38001000
REAL IOM=IOMASK,IOMASK=+1; 38002000
INTEGER NBUFS=+2,FNUM=+3,RLEN=+4,TYPE=+5,IO=+6,BLEN=+7,U=+8, 38003000
KIND=+9,MODE=+10,DIREC=+11,FORMS=+12,COBOL=+13, 38004000
UNLABELED=+14,OPTIONAL=+15,CNTCTL=+16; 38005000
REAL T1=+17,T2=+18,MASK=+19,STATE=+20; 38006000
REAL MFID=+21,FID=+22; INTEGER REEL=+23,CDATE=+24,CYCLE=+25; 38007000
ARRAY FIB=+26[*],FPB=+27[*];% 38008000
INTEGER ACCESS=+28,FIB7=+29; 38009000
LABEL AGN,EXIT; 38009100
ARRAY HEADER=+30[*];% 38010000
REAL TOG=+31;% 38010100
SUBROUTINE DISKSETUP;% 38011000
BEGIN IF STATE.[42:1] THEN% 38012000
BEGIN 38013000
IF MFID=0 AND USERCODE[P1MIX] ! 0 THEN %126-38013010
BEGIN %126-38013020
FPB[FNUM ]:=MFID:=FID; %126-38013030
FPB[FNUM+1]:=FID :=USERCODE[P1MIX]; %126-38013040
END; %126-38013050
IF NFLAG(FIX[14]~FLAG(FILEHEADER(MFID 38013100
$ SET OMIT = NOT SHAREDISK 38013199
,FID&FIB[5][1:45:1],FIB[8].[20:5] 38013300
,FIB[8].[25:23],BLEN,RLEN,STATE)))<6 THEN 38013400
BEGIN P(DEL); 38013500
TOG:= 1; 38013510
$ SET OMIT = NOT SHAREDISK 38013519
GO TO EXIT; 38013600
END; 38013700
IF FIB[8].[20:28]!0 THEN FPB[FNUM+2].[18:30]~DATE ELSE 38013900
BEGIN% OLD FILE,VERIFY LABEL EQUATION DATE IF ANY 38014000
HEADER := FIB[14];% 38014100
STREAM(H:=HEADER[3].[30:18],B:=[T2]); 38014200
BEGIN SI:=LOC H; DS:=8 DEC; END;% 38014300
AGN: IF CDATE NEQ 0 AND CDATE NEQ HEADER[3].[30:18] THEN38014400
BEGIN% WRITE DATE CHECK MESSAGE 38014500
DOLITTLE(FALSE, 38014600
VWY&VOF[36:42:6]&VOK[30:42:6], 38014610
"#DAT CK"," =00000"&T2[18:18:30],MFID); 38014620
IF TERMSET(P1MIX) THEN 38014700
BEGIN 38014800
FORGETSPACE(DIRECTORYSEARCH(MFID,FID, 38014900
$ SET OMIT = NOT SHAREDISK 38014949
FIB[5].[13:3]+10)); 38015000
GO TO INITIATE; 38015100
END;% 38015200
IF P(NT6,DUP)=VOK OR P(XCH)=VOF THEN CDATE~0; 38015400
GO AGN 38015500
END;% VERIFICATION 38015600
FPB[FNUM+2].[18:30]:=T2;% BCL DATE 38015700
END OLD FILES;% 38015800
STARTIMING(FNUM,18);% 38015900
FPB:=PRT[P1MIX,3]; % STARTIMING MOVES THE FPB 38015950
END;% 38016000
HEADER~FIB[14];% 38020000
KIND~4; U~18;% 38021000
MODE~0;% 38022000
IF NOT COBOL THEN UNLABELED~1;% 38023000
CNTCTL~BLEN{1023;% 38024000
$ SET OMIT = NOT SHAREDISK 38024004
IF COBOL>0 AND (FIB[13].[22:1] OR TYPE=10 OR TYPE=26) THEN 38024100
BEGIN COBOL:=3; %IF COBOL-IO OR COBOL-RANDOM 38024200
BLEN := BLEN + RLEN; % THEN CHANGE BUFFSIZE TO 38024300
END; % BUFFSIZE + RECSIZE 38024400
GETBUFFERS((IF CNTCTL THEN BLEN% 38025000
ELSE ((BLEN+29) DIV 30)|30)+1,% 38026000
NBUFS,U,ALPHA);% 38027000
IF COBOL = 3 THEN %IF COBOL-IO OR COBOL-RANDOM 38027100
BEGIN COBOL := 1; % THEN CHANGE BUFFSIZE TO 38027200
BLEN := BLEN - RLEN; % BUFFSIZE - RECSIZE 38027300
END; % (SEE ABOVE 38027400
FIB[16]~M[ALPHA]&CNTCTL[23:47:1]&10[24:47:1]% 38028000
&((BLEN+29) DIV 30)[27:42:6]% 38029000
&(IF CNTCTL THEN BLEN ELSE 1023)[8:38:10]% 38030000
&TINU[18][3:3:5] OR M OR IOMASK;% 38031000
FIB[16].[2:1]:=(HEADER.[31:2] AND (IO+1))!0; 38032000
FIB[5].[1:1]:= NOT FIB[16].[2:1]; 38033000
IF FIB[5].[1:1] THEN 38034000
FOR MASK:=10 STEP 1 UNTIL 29 DO HEADER[MASK]:=0; 38035000
FIB[19]~(IF DIREC THEN BLEN-RLEN+1 ELSE 1) 38036000
INX FIB[16]&0[27:27:6]; 38037000
IF STATE.[46:2]!0 THEN FIB[19].[8:10]~RLEN;% 38038000
FS[P1MIX,(T2:=(FNUM DIV ETRLNG)).[40:4]]~(*P(DUP)) OR 38039000
(TWO(0&T2[43:44:4])|((NOT HEADER).[31:2])); 38040000
T2~IF COBOL THEN 0 ELSE FIB[19].[33:15]-FIB[16].[33:15]; 38041000
FIB[10].[3:15]:=M[ALPHA]-2; %HEAD OF BUFFER RING 38041100
FOR MASK~0 STEP 1 UNTIL NBUFS-1 DO% 38042000
M[ALPHA+MASK]~(P(DUP,LOD)+T2)% 38043000
&P(FLAG(FIB[19-ABS(3|COBOL)]),XCH)[CTC]; 38044000
FIB[16]:=FIB[16] OR M; 38045000
FIB[5].[45:1]~0; 38045100
IF P([FIB[14]],LOD).[FF]=2 THEN FIB[5].[11:2]~1;%INPUT ONLY.38045105
IF HEADER[4].[10:1] AND NOT IO THEN 38045110
FILEMESS(-"CODE ","FILE ",MFID,FID,0,0,0); 38045120
$ SET OMIT = NOT(PACKETS) 38045149
IF PSEUDOMIX[P1MIX]!0 THEN 38045150
IF NOT FIB[5].[41:1] THEN 38045155
FILEMESSAGE((IF IO THEN " IN " ELSE "OUT") 38045160
&TINU[U][6:30:18], IF ACCESS=0 THEN " SER " 38045200
ELSE IF ACCESS=1 THEN IF TYPE=26 THEN " PRO " 38045300
ELSE " RDM " ELSE " UPD ", 38045310
MFID,FID,0,0,0,64); 38045400
$ POP OMIT 38045501
END DISKSETUP;% 38046000
P(RCW,MSCW,STF); 38047000
RCW:=RCW&P(XCH)[CTC]; 38048000
DISKSETUP; 38049000
IF COBOL<0 THEN % ADJUST UPPER BOUND FOR COBOL 68 38049200
BEGIN MASK ~ (IF IO AND NOT FIB[13].[22:1] 38049300
THEN HEADER[7] 38049400
ELSE (((HEADER[9] | HEADER[1]) DIV 38049500
HEADER[0].[42:6]) | HEADER[0].[30:12]) - 1);38049600
IF FIB[3]=0 OR FIB[3]>MASK THEN FIB[3]~MASK; %LESSOR OF 2 EVILS38049700
END; 38049800
IF P(TYPE,DUP)=10 OR P(XCH)=26 THEN 38050000
BEGIN 38051000
IF COBOL<1 THEN % ALGOL OR COBOL 68 38052000
FOR MASK ~ 0 STEP 1 UNTIL NBUFS-1 DO 38053000
IF COBOL THEN M[M[ALPHA+MASK] INX NOT 2] ~ NOT 0 38053500
ELSE M[ALPHA+MASK]~P(DUP,LOD)&1[27:47:1]; 38054000
FIB[6]~FIB[7]~0;% 38055000
FIB[17]~IF IO THEN 0 ELSE BLEN;% 38056000
END ELSE 38057000
BEGIN 38058000
T2~(MFID~FIB[16).[33:15];% 38059000
FIV7~FIB[7]; 38060000
IF COBOL THEN% 38061000
BEGIN IF COBOL>0 THEN 38062000
IF NOT (FIB7=0 OR FIB[13].[22:1]) THEN 38062500
BEGIN FIB7 ~ FIB7 - 1; 38063000
OPTIONAL ~ NBUFS - 1; 38063500
END ELSE OPTIONAL ~ NBUFS - 2 38064000
ELSE BEGIN % COBOL 68 38064200
OPTIONAL ~ NBUFS - 1; 38064400
IF DIREC THEN FIB7 ~ FIB[7] ~ FIB[3]; 38064600
END; 38065000
FID~FIB[16];% 38066000
MASK~0;% 38067000
END ELSE% 38068000
BEGIN OPTIONAL~NBUFS-1;% 38069000
MASK~(FID~FIB[19]).[33:15]-T2;% 38070000
END;% 38071000
IF (STATE.[46:2]!0 AND NOT COBOL) OR IO THEN 38072000
IF M[ALPHA].]2:1] THEN 38073000
FOR T1~0 STEP 1 UNTIL OPTIONAL DO% 38074000
BEGIN IF (M[T2]:= 38074500
DISKADDRESS(FPB[FNUM], FPB[FNUM+1], FPB[FNUM+3], 38075000
FORMS:=((HEADER[0].[30:12]|T1)&DIREC[1:47:1])+FIB7,38075500
HEADER, IO&(NOT HEADER[4])[46:47:1])) > 1 THEN 38076000
BEGIN 38076500
IF (USERCODE[P1MIX] EQV MCP)!NOT 0 THEN 38077000
IF P(M[MFID],DUP).[3:6]=0 AND 38077500
P(XCH)<DIRDSK|DSKTOG THEN 38078000
BEGIN 38078500
TERMINATE(P1MIX); 38079000
TERMINALMESSAGE(30); 38079500
END; 38080000
IOREQUEST(FLAG(FID),MFID&1[24:47:1],M[T2-2]); 38080500
M[ALPHA]:=FLAG(MFID)&0[26:26:7] AND NOT 38081000
(M OR IOMASK); 38081250
END ELSE 38081500
IF M[T2]=0 THEN % EOF IF INPUT, FULL HDR IF OUTPT38081750
M[ALPHA]:=P(DUP,LOD)&1[27:47:1] AND NOT M; 38082000
IF COBOL<0 THEN M[M[ALPHA] INX NOT 2] ~ 38082400
(IF FORMS}0 THEN FORMS DIV FIB[11] ELSE NOT 0); 38082500
STREAM(N~NBUFS-1,T~M[ALPHA],ALPHA);% 38083000
BEGIN SI~ALPHA; SI~SI+8; DS~N WDS;% 38084000
SI~LOC T; DS~WDS;% 38085000
END;% 38086000
MFID.[33:15]~T2~M[T2-2].[18:15];% 38087000
FID.[33:15]~T2+MASK;% 38088000
END;% 38089000
IF (NBUFS-1)!OPTIONAL THEN FIB[16].[33:15]~M[ALPHA] ;% 38090000
FORMS~(FORMS~FIB7 MOD HEADER[0].[30:12])|RLEN; 38091000
SLEEP([M[ALPHA]],IOMASK);% 38092000
IF COBOL } 0 THEN % NOT COBOL 68 38092900
IF FIB[13].[22:1]THEN M[ALPHA].[33:15]~FIB[16]INX 1 ELSE 38093000
M[ALPHA].[33:15]~FIB[16].[33:15]+FORMS+1;% 38094000
IF (NBUFS-1)!OPTIONAL AND IO AND NOT FIB[13].[22:1] THEN 38095000
FIB[ 17 ]~0 ELSE 38096000
FIB[17]~IF DIREC THEN FORMS~RLEN% 38097000
ELSE BLEN-FORMS;% 38098000
END; 38099000
EXIT: 38099100
P(P&RCW[CTC],0,RDS,0,XCH,P&P[CTF],STF); 38100000
END DISKFILEOPEN; 38101000
PROCEDURE OTHERFILEOPENIN(ALPHA); AVLUE ALPHA; INTEGER ALPHA; 38102000
BEGIN REAL RCW=+0,MSCW=-2; 38102100
REAL IOM=IOMASK, IOMASK=+1; 38102200
INTEGER NBUFS=+2,FNUM=+3,RLEN=+4,TYPE=+5,IO=+6,BLEN=+7,U=+8, 38102300
KIND=+9,MODE=+10,DIREC=+11,FORMS=+12,COBOL=+13, 38102400
UNLABELED=+14,OPTIONAL=+15,CNTCTL=+16; 38102500
REAL T1=+17,T2=+18,MASK=+19,STATE=+20; 38102600
REAL MFID=+21,FID=+22; INTEGER REEL=+23,CDATE=+24,CYCLE=+25; 38102700
ARRAY FIB=+26[*],FPB=+27[*];% 38102800
INTEGER ACCESS=+28,FIB7=+29; 38102900
ARRAY HEADER=+30[*];% 38103000
REAL TOG=+31; 38103100
REAL USASI=NT1, RHEAD=HEADER; 38103200
LABEL FIND,DCN,DC19; 38103300
SUBROUTINE TYPEOPEN;% 38103400
BEGIN 38103500
T1:=(OPNMESS AND ((T1:=JAR[P1MIX,0])>0 OR 38103600
COPNMESS AND T1<0)); 38103700
$ SET OMIT = PACKETS 38103800
BEGIN NT2:=0; 38104100
IF U<16 THEN 38104200
STREAM(S:=PRNTABLE[U].[30:18], D:=[NT2]); 38104300
BEGIN SI ~ LOC S; DS ~ 8 DEC; % 38104400
DI ~ DI-7; DS ~ 6 FILL; % 38104500
END; % 38104600
FILEMESSAGE((" IN ")& 38104700
TINU[U][6:30:18], NT2, FPB[FNUM], FPB[FNUM+1], 38104800
IF KIND=2 OR KIND=9 THEN P(REEL,CDATE) ELSE 38104900
P(0,0), P, CYCLE, T1) 38105000
END; 38105100
END; 38105200
SUBROUTINE REED;% 38105300
BEGIN IF (T2~WAITIO(T1,(MASK OR @40)&@377[CTF],U) AND @367)!0 THEN38105400
IF (T2 AND NOT MASK)!0 THEN 38105500
BEGIN STOPTIMING(FNUM,1023); BLASTQ(U); SETNOTINUSE(U,0); 38105600
FILEMESS(-"PARITY ","ON ... "&TINU[U][24:30:18],% 38105700
MFID,FID,REEL,CDATE,CYCLE);% 38105800
END;% 38105900
IF TERMSET(P1MIX) THEN 38106000
BEGIN STOPTIMING(FNUM,1023); SETNOTINUSE(U,0); 38106100
GO TO INITIATE; 38106200
END; 38106300
END REED;% 38106400
REAL SUBROUTINE CNTLBITS;% 38106500
CNTLBITS~IOMASK&MODE[21:47:1]&DIREC[22:47:1]&CNTCTL[23:47:1]38106600
&IO[24:47:1]&(KIND=7 OR KIND>9 AND KIND{12)[20:47:1] 38106700
&(IF KIND=1OR KIND=7OR KIND=12THEN@20ELSE 0)[27:42:6];38106800
SUBROUTINE LABELAREA;% 38106900
M[T1:=ALPHA-2]:=M OR (GETSPACE((T1:=M[T1],SIZE)+4, %167-38107000
LABELAREAV,1)+4) & T1[SIZE] & CNTLBITS[FTF];38107100
P(ALPHA); % DETERMINE IF BRANCH TO DC19 38109000
P(RCW,MSCW,STF); 38110000
RCW:=RCW&P(XCH)[CTC]; 38110500
IF P=2 THEN GO DC19; 38111000
IF STATE.[41:1] THEN% 38111500
BEGIN U~FIB[15].[25:5];% 38112000
END ELSE% 38112500
BEGIN IF (U~FINDINPUT(MFID,FID,REEL,CDATE,CYCLE,COBOL,UNLABELED, 38113000
OPTIONAL,MODE,FNUM))<0 THEN% 38113500
BEGIN FIB[5].[39:4]~9; GO TO FIND END;% 38114000
STARTIMING(FNUM,IF U>31 THEN 18 ELSE U); 38114500
FPB:=PRT[P1MIX,3]; % STARTIMING MAY HAVE MOVED IT. 38115000
KIND:=IF U GTR 31 THEN 11 ELSE UNIT[U].[1:4]; 38115100
TYPEOPEN;% 38115500
IF U<16 THEN BEGIN RRRMECH~TWO(U) OR RRRMECH; 38116000
PRNTABLE[U].[15:15]~ALPHA;% 38116500
END;% 38117000
% TGW38117500
IF (T1~RDCTABLE[U].[14:10])!0 THEN REEL~T1; 38118000
STATE.[39:4]~0;% 38118500
END;% 38119000
IF KIND=0 THEN% 38119500
BEGIN IF U=23 THEN BEGIN T1~READERA; READERA~0 END% 38120000
ELSE BEGIN T1~READERB; READERB~0 END;% 38120500
M[ALPHA-2]:=[M[T1]]&10[8:38:10]&1[24:47:1];% 38121000
M[T1-4]:=P(DUP,LOD)&P1MIX[AREAMIXF]&LABELAREAV[AREATYPEF];% 38121500
IF MODE := (MODE=0) AND BLEN=20 THEN %301-38122000
SAVEWORD:=SAVEWORD OR TWO(U); %301-38122100
CNTCTL:=DIREC:=0;% 38122500
IF BLEN<T1~(MODE+1)|10 THEN BLEN~T1;% 38123000
END ELSE% 38123500
IF KIND=2 THEN% 38124000
BEGIN IF NOT UNLABELED THEN BEGIN% 38124500
IF DIREC AND NOT FIB[16].[22:1] THEN 38125000
BEGIN IF NOT STATE.[40:1] THEN BEGIN% 38125500
T1~5&3[23:46:2] OR M;% 38126000
MASK~0; REED;% 38126500
MASK:=@60; DO REED UNTIL T2.[42:1]; 38127000
DO REED UNTIL T2.[42:1]; 38127500
MASK~0; REED; END;% 38128000
END; 38128500
CNTCTL~1; LABELAREA;% 38129000
T1:=NFLAG(M[ALPHA-2]);% 38129500
IF DIREC THEN T1:=T1.[8:10]-1 INX T1;% 38130000
MASK:=@40; REED; 38130500
STREAM(Y:=0:X:=0,X1:=0,X2:=0,Z:=T1); 38131000
BEGIN DI:=LOC X; DS:=24 LIT "VOL1HDR1HDR2EOF1EOF2EOV1"; 38131500
DI:=LOC X; 38132000
6(TALLY:=TALLY+1; 38132500
SI:=Z; 38133000
IF 4 SC=DC THEN 38133500
JUMP OUT TO B); 38134000
TALLY:=0; 38134500
B: 38135000
Y:=TALLY; 38135500
END; 38136000
IF (USASI:=P)>0 THEN 38136500
USASITAPE(T1.[CF],USASI,4,U,DIREC) ELSE 38137000
IF M[T1 INX 6].[24:6]=1 THEN 38137500
BEGIN 38138000
REED; 38138500
MASK~@60; 38139000
T1~5&3[23:46:2] OR M; 38139500
T2~0; 38140000
END; 38140500
IF T2 NEQ @40 THEN DO REED UNTIL T2.[42:1] ELSE 38141000
FOR CNTCTL~DIREC STEP 1 UNTIL 2 DO% DIREC = 0 OR 1 %DB 38141500
P(WAITIO(@4740000005&(NOT DIREC)[22:47:1],@377,U),DEL);%DB38142000
FWD;% 38142500
CNTCTL~BLEN{1023;% 38143000
END ELSE% 38143500
IF KIND=9 THEN% 38144000
BEGIN UNLABELED~CNTCTL~1;% 38144500
DIREC~0;% 38145000
END ELSE% 38145500
IF KIND=11 THEN 38146000
BEGIN T1~CIDROW[U-32].[18:15]; 38146500
CIDROW[U-32].[18:15]~0; 38147000
M[ALPHA-2]:=[M[T1]]&10[8:38:10]&1[24:47:1];% 38147500
M[T1-4]:=P(DUP,LOD)&P1MIX[AREAMIXF]&LABELAREAV[AREATYPEF];% 38148000
MODE:=0;% 38148500
CNTCTL:=DIREC:=0;% 38149000
FIB[13].[1:9]~NBUFS~1; FIB[13].[10:9]~1; 38149500
IF BLEN<10 THEN BLEN~10; 38150000
END ELSE 38150500
DCN:: FILEMESS(-"I/O ERR",0,MFID,FID,REEL,CDATE,CYCLE);% 38151000
P(1); 38151500
IF BLEN=0 THEN GO TO DCN;% 38151800
IF NOT FIB[18].[1:1] OR P THEN 38151900
GETBUFFERS(BLEN,NBUFS,U,ALPHA); 38152000
GO FIND; 38152100
DC19: 38152250
$ SET OMIT = NOT(DATACOM AND RJE ) 38152500
FIB[14]:=NBUFS; 38156500
U:=30; KIND:=13; 38157000
FIB[13].[1:9]~ NBUFS~2; 38157500
FIB[18]:=(*P(DUP))&(BLEN:=RLEN)[3:33:15]&BLEN[CTF]; 38158000
IF MFID>0 THEN 38158500
BEGIN ; 38159000
STREAM(A~0,B~0:MFID,FID,C~0); 38159500
BEGIN 38160000
SI~ LOC MFID; DI~ LOC A; 38160500
2(C~ SI; 8(IF SC}0 THEN IF SC{9 THEN TALLY~ TALLY+1 38161000
ELSE JUMP OUT ELSE JUMP OUT; SI~ SI+1);38161500
SI~ C; C~ TALLY; DS~ C OCT; TALLY~ 0; SI~ LOC FID);38162000
END; 38162500
FID~ P; 38163000
MFID~P; 38163500
END; 38164000
M[ALPHA-2]~ 0&MFID[9:44:4]&FID[14:44:4]; 38164500
FIND:: 38191500
P(P&RCW[CTC],0,RDS,0,XCH,P&P[CTF],STF); 38192000
END OTHER FILE OPEN IN; 38192500
PROCEDURE OTHERFILEOPENOUT(ALPHA); VALUE ALPHA; INTEGER ALPHA; 38200000
BEGIN REAL RCW=+0,MSCW=-2; 38200100
REAL IOM=IOMASK, IOMASK=+1; 38200200
INTEGER NBUFS=+2,FNUM=+3,RLEN=+4,TYPE=+5,IO=+6,BLEN=+7,U=+8, 38200300
KIND=+9,MODE=+10,DIREC=+11,FORMS=+12,COBOL=+13, 38200400
UNLABELED=+14,OPTIONAL=+15,CNTCTL=+16; 38200500
REAL T1=+17,T2=+18,MASK=+19,STATE=+20; 38200600
REAL MFID=+21,FID=+22; INTEGER REEL=+23,CDATE=+24,CYCLE=+25; 38200700
ARRAY FIB=+26[*],FPB=+27[*];% 38200800
INTEGER ACCESS=+28,FIB7=+29,; 38200900
ARREAY HEADER=+30[*]; 38201000
REAL TOG=+31; 38201100
REAL USASI=NT1, RHEAD=HEADER 38201200
LABEL LPS,FIND,DNC,PBS; 38201300
SUBROUTINE TYPEOPEN;% 38201400
BEGIN 38201500
T1:=(OPNMESS AND ((T1:=JAR[P1MIX,0])>0 OR 38201600
COPNMESS AND T1<0)); 38201700
$ SET OMIT = PACKETS 38201800
BEGIN NT2:=0; 38202100
IF U<16 THEN 38202200
STREAM(S:=PRNTABLE[U].[30:18], D:=[NT2]); 38202300
BEGIN SI ~ LOC S; DS ~ 8 DEC; % 38202400
DI ~ DI-7; DS ~ 6 FILL; % 38202500
END; % 38202600
FILEMESSAGE((" OUT")& 38202700
TINU[U][6:30:18], NT2, FPB[FNUM], FPB[FNUM+1], 38202800
IF KIND=2 OR KIND=9 THEN P(REEL,CDATE) ELSE 38202900
P(0,0), P, CYCLE, T1); 38203000
END; 38203100
END; 38203200
SUBROUTINE REED;% 38203300
BEGIN IF (T2~WAITIO(T1,(MASK OR @40)&@377[CTF],U) AND @367)!0 THEN38203400
IF (T2 AND NOT MASK)!0 THEN 38203500
BEGIN STOPTIMING(FNUM,1023); BLASTQ(U); SETNOTINUSE(U,0); 38203600
FILEMESS(-"PARITY ","ON ... "&TINU[U][24:30:18],% 38203700
MFID,FID,REEL,CDATE,CYCLE);% 38203800
END;% 38203900
IF TERMSET(P1MIX) THEN 38204000
BEGIN STOPTIMING(FNUM,1023); SETNOTINUSE(U,0); 38204100
GO TO INITIATE; 38204200
END; 38204300
END REED% 38204400
REAL SUBROUTINE CNTLBITS;% 38204500
CNTLBITS~IOMASK&MODE[21:47:1]&DIREC[22:47:1]&CNTCTL[23:47:1]38204600
&[24:47:1]&(KIND=7 OR KIND>9 AND KIND{12)[20:47:1] 38204700
&(IF KIND=1OR KIND=7OR KIND=12THEN@20ELSE 0)[27:42:6];38204800
SUBROUTINE LABELAREA;% 38204900
M[T1:=ALPHA-2]:=M OR (GETSPACE((T1:=M[T1],SIZE)+4, %167-38205000
LABELAREAV,1)+4) & T1[SIZE] & CNTLBITS[FTF];38205100
P(RCW,MSCW,STF); 38210000
RCW:=RCW&P(XCH)[CTC]; 38210500
IF STATE.[41:1] THEN% 38211500
BEGIN U~FIB[15].[25:5];% 38212000
END ELSE% 38212500
BEGIN T2:=FPB[FNUM+3]; % SAVES COPIES FOR BACK UP 38213000
IF (U:=FINDOUTPUT(MFID,FID,REEL,CDATE,CYCLE,TYPE 38213500
$ SET OMIT = NOT PACKETS 38214000
&FPB[FNUM-3][1:23:1] 38214500
$ POP OMIT 38215000
,FORMS,KIND))>40 THEN 38215500
BEGIN FIB[14].[3:15]~U; 38216000
FPB[FNUM+2],[18:30]~DATE; 38216500
IF MCP!NOT(-0) THEN M[U+2]~USERCODE[P1MIX]; 38217000
M[U+3]~XCLOCK+P(RTR); 38217500
T1:=SPACE(30); 38218000
MOVE(30,U,T1); 38218500
STREAM(DATE,B:=T1+3); 38219000
BEGIN SI:=LOC DATE;DS:=8OCT;DI:=DI-8;DS:=2LIT"+2";END; 38219500
M[T1+1]~(XCLOCK+P(RTR))&(M[T1+3])[6:30:18]; 38220000
M[T1+4]:= 0&SYSNO[4:46:2]&1[2:47:1]; 38220500
M[T1+5]~(*PDUP))&1[2:47:1]; %ABORTED PBD TOG. 38221000
$ SET OMIT = RJE AND DATACOM 38221500
P(0); 38222000
$ POP OMIT 38222500
$ SET OMIT = NOT(RJE AND DATACOM) 38223000
M[T1+6]~P(XCH); 38226500
M[U-1]:=EUF(IF TYPE NEQ 0 AND TYPE LSS 20 THEN 38227000
"PRD " ELSE "PUD ",M[U+6],T1-1); 38227500
FORGETSPACE(T1); 38228000
$ SET OMIT = PACKETS 38228500
FILEMESSAGE((IF TYPE GEQ 20 OR TYPE=0 THEN "PUD...." 38230000
ELSE "PBD....")&M[U+6][24:6:24], 38230500
"OUT "&M[U+6][30:30:18], 38231000
MFID,FID,0,0,0, 38231500
(PBDREL OR OPNMESS)); 38232000
STARTIMING(FNUM,U~18); 38232500
FPB:=PRT[P1MIX,3]; % STARTIMING MAY HAVE MOVED IT. 38233000
END ELSE 38233500
IF U LSS 0 THEN %DSED 38234000
BEGIN FIB[5].[39:4]:=9; GO FIND END ELSE 38234500
BEGIN 38235000
STARTIMING(FNUM,U);% 38235500
FPB:=PRT[P1MIX,3]; % WATCH OUT FOR STARTIMING, 38236000
IF KIND=7 THEN FPB[FNUM+3] := (*P(DUP))&T2[15:15:8]; 38236010
TYPEOPEN;% 38236500
IF TYPE=5 OR TYPE=8 OR TYPE=9 THEN UNLABELED~1;% 38237000
IF U<16 THEN BEGIN RRRMECH~TWO(U) OR RRRMECH; 38237500
PRNTABLE[U].[15:15]~ALPHA;% 38238000
END; END; 38238500
END;% 38239000
IF KIND=6 THEN% 38239500
BEGIN BLEN:=10; 38240000
FIB[18]:=(*P(DUP))&BLEN[CTC]&BLEN[CTF]&BLEN[3:33:15]; 38240500
MODE~DIREC~CNTCTL~0;% 38241000
END ELSE% 38241500
IF KIND=1 THEN% 38242000
BEGIN MODE~DIREC~CNTCTL~0;% 38242500
LPS: 38243000
IF NOT COBOL THEN M[ALPHA-2]~0&15[8:38:10];% 38243500
END ELSE% 38244000
IF KIND=12 THEN 38244500
BEGIN TYPE~IF (TYPE!0 AND TYPE<20) THEN 15 ELSE 22; 38245000
PBS: MODE~DIREC~0; FIB[13].[1:9]~NBUFS~CNTCTL~1; FIB[13].[10:9]~1; 38245500
BLEN~IF TYPE}20 THEN 10 ELSE IF BLEN>17 THEN 17 ELSE BLEN; 38246000
M[T1~GETSPACE(92,3,1)+2]~M[T1-1]~[M[ALPHA]]&(T1+2)[CTF]& 38246500
U[12:42:6]; 38247000
DISKIO(RHEAD,-T1-75,11,JAR[P1MIX,6].[CF]); 38247500
M[ALPHA]:=T1+2; 38248000
FIB[14]~(*P(DUP))&(T1+2)[CTC]&(T1+56)[CTF]; 38248500
FIB[18]~(*P(DUP))&BLEN[CTC]&BLEN[CTF]&BLEN[03:33:15]; 38249000
STREAM(D~T1+1); 2(36(DS~8 LIT"0")); 38249500
FIB[5].[FF]~(M[T1+91]~FIB[5].[FF]&1[18:47:1])+1; 38250000
SLEEP([RHEAD],IOMASK); 38250500
HEADER:=[M[T1]]&92[8:38:10]; 38251000
HEADER[74]~MFID; 38251500
HEADER[75]~FID; 38252000
HEADER[87]~FORMS; 38252500
HEADER[88]:=T2.[15:8]; % COPIES 38253000
HEADER[89]:=USERCODE[P1MIX]; %132-38253100
HEADER[76]~ABS(JAR[P1MIX,0]); 38253500
HEADER[77]~ABS(JAR[P1MIX,1]); 38254000
REEL~RDCTABLE[U].[14:10]; % GET ACTUAL REEL NUMBER %745-38254100
GO TO LPS; 38254500
END ELSE 38255000
IF KIND=7 THEN% 38255500
BEGIN TYPE~IF (TYPE!0 AND TYPE<20) THEN 6 ELSE 20; 38256000
IF SVPBT THEN SAVEWORD:=TWO(U) OR SAVEWORD; 38256500
GO TO PBS; 38257000
END ELSE% 38257500
IF KIND=2 THEN% 38258000
BEGIN IF PRNTABLE[U]}0 THEN GO TO DCN;% 38258500
CNTCTL~MODE;% 38259000
END ELSE% 38259500
IF KIND=8 THEN% 38260000
BEGIN UNLABELED~CNTCTL~1;% 38260500
DIREC~0;% 38261000
END;% 38261500
IF UNLABELED THEN% 38262000
BEGIN IF COBOL THEN% 38262500
BEGIN MASK~0;% 38263000
IF KIND=1 THEN BEGIN T1~@4000100000; REED END ELSE 38263500
IF KIND=7 OR KIND=12 THEN 38264000
BEGIN 38264500
IF TYPE < 20 THEN 38265000
BEGIN 38265500
HEADER[73]~@1540176000100000&FIB[5][FTC]; 38266000
FIB[5].[FF]~FIB[5].[FF]+1; 38266500
FIB[14].[FF]:=T1+38; 38267000
END; 38267500
GO FIND; 38268000
END; 38268500
END;% 38269000
END ELSE% 38269500
BEGIN IF COBOL THEN% 38270000
BEGIN M[ALPHA-2]~P(DUP,LOD)&CNTLBITS[18:18:15];% 38270500
IF U<16 THEN% 38271000
STREAM(N~PRNTABLE[U].[30:18],D~M[ALPHA-2]);% 38271500
BEGIN SI~LOC N; DI~DI+53; DS~5 DEC END;% 38272000
END ELSE% 38272500
BEGIN IF REEL=0 THEN REEL~1;% 38273000
IF CYCLE=0 THEN CYCLE~1;% 38273500
IF CDATE=0 THEN STREAM(DATE,CD~[CDATE]);% 38274000
BEGIN SI~LOC DATE; SI~SI+3; DS~5 OCT END; 38274500
LABELAREA;% 38275000
BUILDLABEL(M[ALPHA-2],MFID,FID,REEL,CDATE,CYCLE,% 38275500
FIB[4],(IF U<16 THEN PRNTABLE[U].[30:18] 38276000
ELSE 0),STATE.[46:2],% 38276500
BLEN,RLEN);% 38277000
END;% 38277500
M[M[ALPHA-2] INX P(DUP).[8:10]]~@3700000000000000;% 38278000
IF (P(KIND,DUP)=7 OR (P(XCH,DUP)=12 OR P(XCH)=1)) THEN 38278500
IF KIND=7 AND FIB[13].[28:10]!ABS(COBOL) THEN GO FIND ELSE 38279000
BEGIN IF TYPE GEQ 20 THEN % MAKE CP BACK-UP LABEL 38279500
BEGIN M[M[ALPHA-2] INX 4]:=FLAG(NABS(JAR[P1MIX,0])); 38280000
M[M[ALPHA-2] INX 5]:=FLAG(JAR[P1MIX,1]&17[1:43:5]); 38280500
STREAM(A:=[M[M[ALPHA-2] INX 6]]); 38281000
BEGIN DS:=15 LIT" PUNCH BACK-UP "; DS:=LIT"%"; 38281500
2(DS:=8 LIT"%%%%%%%%"); 38282000
END; 38282500
END ELSE % MAKE LP LABEL 38283000
BEGIN T1:=M[M[ALPHA-2]INX 3]; 38283500
DISKIO(T2,NABS(M[ALPHA-2]INX 1),11,JAR[P1MIX,6].[CF]);38284000
M[M[ALPHA-2]INX 13]:=FLAG(NABS(JAR[P1MIX,0])); 38284500
M[M[ALPHA-2]INX 14]:=FLAG(JAR[P1MIX,1]&17[1:43:5]); 38285000
SLEEP([T2],IOMASK); 38285500
M[M[ALPHA-2] INX 3]:=T1; 38286000
END; 38286500
M[M[ALPHA02] INX 1]:=MFID; 38287000
M[M[ALPHA-2] INX 2]:=FID; 38287500
IF KIND=1 THEN M[ALPHA-2]~P(DUP,LOD) & %150-38288000
(IF SEPARATE THEN 1 ELSE @20)[27:42:6] %150-38288100
ELSE %150-38288200
BEGIN HEADER[73]~(FIB[5].[FF] OR @360170100000000)& 38288500
(TYPE<20)[32:47:1]; 38289000
IF NOT SEPARATE THEN %150-38289100
IF (TYPE<20) THEN %150-38289200
HEADER[73]~P(DUP,LOD)&(@20)[27:42:6];%150-38289300
FIB[5]~P(DUP,LOD,0,1,CFX,+); 38289500
STREAM(L~M[ALPHA-2],B~[HEADER[56]]); 38290000
BEGIN SI~L; DS~17 WDS END; 38290500
FIB[14].[FF]~[HEADER[38]]; GO FIND; 38291000
END; END; 38291500
T1~NFLAG(M[ALPHA-2]);% 38292000
MASK~0L REEDL% 38292500
IF KIND=2 THEN% 38293000
BEGIN T2~@1737000000000000;% 38293500
T1~NFLAG([T2]);% 38294000
REED;% 38294500
END;% 38295000
END;% 38295500
P(0); 38296000
IF BLEN=0 THEN 38296500
DCN:: FILEMESS(-"I/O ERR",0,MFID,FID,REEL,CDATE,CYCLE); 38296750
IF NOT FIB[18].[1:1] OR P THEN 38297000
GETBUFFERS(BLEN,NBUFS,U,ALPHA); 38297500
FIND:: 38298000
P(P&RCW[CTC],0,RDS,0,XCH,P&P[CTF],STF); 38298500
END OTHER FILE OPEN OUT; 38299000
PROCEDURE DISKCLOSE(ALPHA); VALUE ALPHA; INTEGER ALPHA;% 38355000
BEGIN REAL RCW=+0,MSCW=-2; 38356000
ARRAY FIB=+1[*],FPB=+2[*],HEADER=+3[*];% 38357000
%%% DONT ADD ANY DECLARATIONS BETWEEN "HEADER" AND "KIND" %%% WCP 38358000
INTEGER KIND=+4,NUBFS=+5,U=+6,BLEN=+7,CODE=+8, 38359000
UNLABELED=+9,COBOL=+10,I=+11,J=+12, 38360000
FNUM=+13; 38361000
REAL MID=+14,FID=+15,H=+16,D=+17,C=+18,FORMS=+19,STATE=+20; 38362000
LABEL L1,L2,L3,EOF,CLEANUP; 38363000
LABEL OBJTYPE,DUMMY; 38364000
REAL STA=+21;% 38364100
REAL T1=+22,T2=+23,T3=+24,IOD=+25;% 38365000
ARRAY SEG0=+26[*],SKEL=+27[*];% 38366000
REAL T=+28,ACCESS=+29;% 38366010
BOOLEAN COMPGO=+30; 38366020
$ SET OMIT = NOT SHAREDISK 38366099
SUBROUTINE COOLOFF; 38370700
BEGIN FOR I~0 STEP 1 UNTIL NBUFS-1 DO% 38370800
BEGIN IF NOT M[ALPHA+1].[19:1] THEN% 38371000
SLEEP([M[ALPHA=I]],IOMASK);% 38372000
IF KIND!4 THEN 38373000
IF M[ALPHA+I].[27:1] THEN GO TO EOF;% 38374000
END;% 38375000
EOF: END COOLOFF;% 38376000
% 38376500
BOOLEAN SUBROUTINE WRITTENON; % PICKS UP THE ACCESSED BITS FROM38377000
BEGIN J:=0; % THE BUFFERS. 38377200
IF (T:=FIB[10].[3:15]) NEQ 0 THEN 38377400
BEGIN 38377600
FOR I:=NBUFS-1 STEP -1 UNTIL 0 DO 38377800
IF M[T].[11:1] THEN J:=I:=-1 ELSE T:=M[T].[FF]-2; 38378000
END; 38378200
WRITTENON:=J; 38378400
END; 38378600
% 38379000
DEFINE REW=CODE.[47:1]#,% 38380000
KRUNCH=NOT CODE.[42:1]#, 38381000
REL=CODE.[46:1]#,% 38382000
TIME=CODE.[45:1]#,% 38383000
LOCK=NOT CODE.[44:1]#,% 38384000
PURGE=NOT CODE.[43:1]#,% 38385000
DEFINE TECH=STATE.[46:2]#, OPENIO=FIB[13].[22:1]#, 38385400
WRITBACK=FIB[13].[23:1]#, LASTIO=FIB[13].[46:1]#, 38385500
WRITEAFTEREOF=FIB[13].[44:2]#, INPUT=STATE.[43:1]#; 38385600
% 38386000
% START OF CODE 38386010
% 38386020
P(RCW,MSCW,STF); RCW ~ RCW & P(XCH)[CTC]; 38387000
HEADER ~ FIB[14]; ACCESS ~ FIB[4].[27:3]; 38388000
IF COBOL THEN 38389000
BEGIN IF COBOL > 0 THEN % COBOL 61 38389100
BEGIN IF WRITBACK AND TECH=0 AND LASTIO AND 38389200
(OPENIO OR NOT(INPUT)) THEN 38389300
IF ACCESS=1 AND WRITEAFTEREOF!0 THEN 38389400
BEGIN FIB[7] ~ *P(DUP) - 1; 38389500
HEADER[7] ~ *P(DUP) - 1; 38389600
END ELSE WRITEAFTEREOF ~ 0; 38389700
IF TECH=0 THEN IF WRITEAFTEREOF=2 THEN 38389800
BEGIN FIB[7] ~ *P(DUP) + 1; 38389900
HEADER[7] ~ *P(DUP) + 1; 38390000
END ELSE IF WRITEAFTEREOF=1 THEN 38390100
BEGIN FIB[7] ~ *P(DUP) - 1; 38390200
HEADER[7] ~ *P(DUP) - 1; 38390300
END; 38390400
WRITEAFTEREOF ~ 0; 38390500
END; 38391000
IF ACCESS=1 THEN % IF RANDOM 38391010
BEGIN IF COBOL > 0 THEN % COBOL61 38391020
BEGIN ACCESS ~ 4; 38391025
IF FIB[13].[10:9] = 2 THEN % SEEK IN PROCESS 38391030
BEGIN 38391035
$ SET OMIT = NOT SHAREDISK 38391039
COOLOFF; FIB[13].[10:9] ~ 1; 38391050
END 38391055
END ELSE IF FIB[17]<BLEN THEN ACCESS~4; % COBOL68 38391060
END; 38391070
IF FIB[13].[23:1] AND ACCESS=0 THEN 38391080
BEGIN FIB[7]~P(DUP,LOD)-1; 38391090
ACCESS~4; 38391100
END; END; 38391110
IF NOT STATE.[41:1] THEN% 38392000
BEGIN IF ACCESS=1 THEN% 38393000
BEGIN 38394000
$ SET OMIT = NOT SHAREDISK 38394099
COOLOFF; 38394300
END ELSE% 38395000
IF ACCESS=0 THEN% 38396000
BEGIN COOLOFF; IF NOT STATE.[43:1] THEN% 38397000
IF FIB[17]<BLEN AND STATE.[46:2]!0 THEN% 38398000
BEGIN R:=SPACE(((BLEN+29) DIV 30)|30+1); 38399000
IF (M[R]~M[FIB[16]]~% 38400000
DISKADDRESS(MID,FID,FPB[FNUM+3],FIB[7]-1,HEADER,0)) NEQ 0 THEN % (SHM)38401000
BEGIN 38401100
P(WAITIO(FIB[16]&1[24:47:1]&R[33:33{15],% 38402000
0,U(,DEL);% 38403000
MOVE(FIB[17],R+BLEN-FIB[17]+1,% 38404000
FIB[16] INX BLEN-FIB[17]+1);% 38405000
P(WIATIO(FIB[16],0,U),DEL);% 38406000
IF NOT FIB[16].[24:1] THEN HEADER[4].[11:1]~1; 38406500
END; 38407000
FORGETSPACE(R);% 38408000
END;% 38409000
END ELSE% 38410000
BEGIN 38411000
$ SET OMIT = NOT SHAREDISK 38411009
COOLOFF; 38411030
IF (FIB[17]LSS BLEN AND STATE.[46:2]NEQ 0)OR ACCESS=4 THEN38411100
BEGIN IF ACCESS=4 THEN 38411200
IF FIB[13].[23:1] OR NOT STATE.[43:1] THEN 38411300
ACCESS:=2; 38411400
IF (M[FIB[16]]:=DISKADDRESS(MID,FID,FPB[FNUM+3], % (SHM)38411500
FIB[7],HEADER,0))=0 THEN ACCESS:=4; 38411600
IF ACCESS!4 THEN 38411700
BEGIN P(WAITIO(FIB[16]&0[24:24:1],0,U),DEL); 38411750
HEADER[4].[11:1]~1; END; 38411800
END; IF ACCESS = 4 THEN ACCESS := 2; 38411900
END;% 38412000
View Git Blame Copy Permalink