%.......................D I S C A R.....................................00000100 COMMENT DOCUMENT 00000200 * PAGE CENTER SKIP 15 UNDERLINE 00000300 D I S C A R 00000400 * CENTER SKIP 2 00000500 A B-5500 UTILITY PROGRAM FOR 00000600 PRINTING AND PUNCHING DISK AND TAPE FILES 00000700 * SKIP 10 00000800 ORIGINAL VERSION BY MURRAY FREEDMAN 00000900 MODIFICATIONS AND ADDITIONS BY 00001000 * INDENT 10 00001100 MURRAY FREEDMAN 00001200 VEER VASISHTA 00001300 BILL MOIR 00001400 * SKIP 2 00001500 BURROUGHS BUSINESS MACHINES LTD 00001600 TORONTO SPECIAL ACCOUNTS BRANCH 00001700 752 BAY STREET 00001800 TORONTO 101 ONTARIO 00001900 * PAGE UNDERLINE 00002000 INTRODUCTION 00002100 * DEFINE 1 = SKIP PARAGRAPH 1,72,0 * 00002200 * 1 00002300 DISCAR IS A MEDIA-TO-MEDIA UTILITY FOR THE B-5500. THE ORIGINAL 00002400 VERSION OF THE PROGRAM WAS WRITTEN AS A DISK TO PRINTER UTILITY, 00002500 AND HAS SINCE BEEN, AND IS BEING, EXPANDED TO ENCOMPASS VIRTUALLY ANY 00002600 MEDIA TO MEDIA REQUIREMENT. 00002700 * 1 00002800 THE PROGRAM HAS BEEN DESIGNED WITH CERTAIN FUNDAMENTAL SPECIFICATIONS: 00002900 * DEFINE 2 = PARAGRAPH - 5,72,0 * 00003000 * 2 00003100 1. PRINTED OUTPUT SHOULD BE, TO THE FULLEST EXTENT POSSIBLE, 00003200 COMPLETELY FORMATTED, NEAT, LEGIBLE, AND EASY TO FOLLOW - RATHER THAN 00003300 THE 00003400 CHARACTERISTIC UNFORMATTED BLIND TRANSCRIPTIONS OF MOST SUCH UTILITIES. 00003500 * 2 00003600 2. THE PROGRAMS USEFULNESS AND APPLICATION SHOULD BE AS UNIVERSAL AS 00003700 POSSIBLE. 00003800 *2 00003900 3. THE PROGRAM SHOULD BE ABSOLUTELY SIMPLE TO OPERATE. 00004000 * 2 00004100 4. PARAMETERS SHOULD BE AT AN ABSOLUTE BARE MINIMUM. 00004200 * 2 00004300 5. WHATEVER PARAMETERS ARE REQUIRED SHOULD BE FREE-FORM, SIMPLE, 00004400 AND LOGICAL. 00004500 * 2 00004600 6. THE OPERATOR SHOULD HAVE THE ABILITY TO SIMPLY ALTER THE FORMAT OF 00004700 PRINTOUTS IN BEING ABLE TO SWITCH BETWEEN SINGLE AND DOUBLE SPACING, 00004800 SIX AND EIGHT LINES PER INCH, WIDE AND NARROW PAPER, ET CETERA. 00004900 * PAGE UNDERLINE 00005000 GENERAL OPERATION 00005100 * SKIP 00005200 * 1 00005300 THE PROGRAM RECEIVES ITS CONTROL AND OPERATION INSTRUCTIONS THRU SPO 00005400 OR (ALTERNATELY) CARD-READER INPUT. SPO OPERATION ONLY WILL BE DISCUSSE00005500 D AS CARD-READER OPERATION IS MERELY A MATTER OF REPRESENTING EACH SPO 00005600 MESSAGE ON A SEPARATE CARD ON A CARD FILE. 00005700 * 1 00005800 THE OPERATOR COMMUNICATES WITH THE PROGRAM VIA FREE-FORM MESSAGES IN 00005900 THE FORM OF TRADITIONAL B-5500 FILE-NAMES, VIZ /. 00006000 THE PROGRAM RECOGNIZES BOTH ACTUAL FILE-NAMES OR GROUPS AND 00006100 PSEUDO-FILE-NAMES WHICH ARE USED FOR CONTROL INSTRUCTIONS FOR THE 00006200 PROGRAM. 00006300 * 1 00006400 ANY INPUT MESSAGE NOT RECOGNIZED AS A CONTROL INSTRUCTION IS 00006500 CONSIDERED AN ACTUAL FILE-NAME. A DISK FILE-NAME CAN TAKE ON 00006600 ANY 00006700 OF THE FORMS USED IN THE NORMAL "PD" MESSAGE WITH THE SAME MEANING 00006800 BEING IMPLIED. THEREFORE A DISK FILE-NAME MAY BE / OR 00006900 /= OR =/ OR =/=. 00007000 * 1 00007100 EITHER A FILE-NAME OR GROUP OR A PSEUDO FILE-NAME MUST BE 00007200 ENTERED ON THE SPO VIA AX EACH TIME THE PROGRAM 00007300 TYPES ON THE SPO "FILE PLEASE" FOLLOWED BY AN MCP ACCEPT REQUEST. 00007400 * 1 00007500 IN ORDER TO TERMINATE PREMATURELY THE PROCESSING OF ANY GIVEN FILE, 00007600 THE OPERATOR MAY TYPE IN AT THE SPO " IN 25 = 1". THIS WILL CAUSE 00007700 A BOOLEAN VARIABLE "COMMITSUICIDE" TO BE SET TRUE. THE PROGRAM CHECKS 00007800 COMMITSUICIDE ON EVERY PRINT CYCLE AND WILL TERMINATE THE PROCESSING 00007900 OF THE CURRENT FILE WHEN TRUE. NOTE THAT ON DISK FILE GROUPS ONLY 00008000 THE CURRENT FILE WILL BE SUICIDED. IF IN TAPE MODE, HOWEVER, 00008100 THE PROGRAM WILL CLOSE OFF THE TAPE AND REQUEST A NEW "FILE PLEASE". 00008200 THEREFORE, THIS CANNOT BE USED TO TERMINATE ONE FILE OF A MULTI-FILE 00008300 REEL. 00008400 * PAGE UNDERLINE 00008500 GENERAL DISK INFORMATION 00008600 * SKIP 00008700 * 1 00008800 ANY DISK FILE 00008900 MAY BE PRINTED THROUGH THIS PROGRAM, BUT ALL FILES ARE 00009000 ARBITRARILY DIVIDED INTO ONE OF TWO CATEGORIES FOR PRINTING 00009100 PURPOSES. IF A FILE HAS A LOGICAL RECORD LENGTH OF 80 CHARACTERS, IT IS00009200 ASSUMED TO BE CARD-IMAGES AND IS PRINTED IN AN APPROPRIATE FORMAT 00009300 AS DESCRIBED BRIEFLY BELOW. 00009400 ALL OTHER FILES ARE PRINTED IN A STANDARD FORMAT ALSO DESCRIBED BELOW. 00009500 * 1 00009600 THE ONLY PARAMETERS PASSED TO THE PROGRAM AS DATA (OTHER THAN THOSE 00009700 DESCRIBED UNDER CONTROL INFORMATION) ARE THE FILE NAMES, WHICH MAY BE 00009800 ANY DISK FILE NAME EXCEPT A NAME WHICH CORRESPONDS TO A SPECIAL 00009900 FUNCTION CONTROL AS 00010000 DESCRIBED UNDER CONTROL INSTRUCTIONS. ALL OTHER INFORMATION, INCLUDING 00010100 RECORD AND BLOCK LENGTHS, IS DERIVED BY THE PROGRAM FROM THE DISK 00010200 DIRECTORY. 00010300 * 1 00010400 THE PROGRAM WILL NOT HANDLE A FILE WHOSE LOGICAL RECORD 00010500 LENGTH EXCEEDS 1023 WORDS (8184 CHARACTERS), BUT A SUITABLE MESSAGE 00010600 WILL BE OUTPUT. IF FOR ANY REASON A RECORD OR BLOCK LENGTH OF ZERO IS 00010700 DETECTED, THE PROGRAM WILL FUDGE BOTH RECORD AND BLOCK LENGTHS AS 240 00010800 CHARACTERS, OUTPUT A SUITABLE MESSAGE, AND PRINT THE FILE. BE WARNED 00010900 THAT IN THIS INSTANCE THE DISK DIRECTORY ENTRY WILL BE CHANGED TO 00011000 REFLECT RECORD AND BLOCK LENGTHS OF 240 CHARACTERS BECAUSE OF MCP 00011100 OPERATION. 00011200 * 1 00011300 WHEN PRINTING A CARD-IMAGE FILE, EACH LINE PRINTED CONTAINS A 00011400 LOGICAL RECORD BOUNDED BY THE SYMBOLS "<" AND ">". EACH LOGICAL RECORD 00011500 NUMBER IS PRINTED AT THE EXTREME LEFT OF THE PRINTLINE. THE PROGRAM 00011600 EXAMINES COLUMNS 73-80 OF EACH RECORD, AND IF THESE COLUMNS ARE ALL 00011700 NUMERIC, ASSUMES THAT THIS IS A SEQUENCE NUMBER, AND WILL PRINT 00011800 THIS NUMBER AT THE IMMEDIATE LEFT OF THE RECORD IMAGE TO ENHANCE 00011900 READABILITY. 00012000 * 1 00012100 WHEN PRINTING A NON-CARD-IMAGE FILE, THE LOGICAL RECORD NUMBER AND THE 00012200 BLOCK NUMBER ARE PRINTED ONCE PER LOGICAL RECORD AND AFTER SKIPPING TO 00012300 A NEW PAGE. EACH LOGICAL RECORD IS BROKEN INTO AS MANY CHUNKS OF 100 00012400 CHARACTERS AS ARE NECESSARY TO PRINT IT. EACH LOGICAL RECORD CHUNK 00012500 IS IDENTIFIED UNDER THE COLUMN HEADING "POSITIONS". 00012600 * 1 00012700 FOR EACH DISK FILE TO BE PRINTED, THE PROGRAM CHECKS TO SEE IF THE USER 00012800 IS AN AUTHORIZED USER OF THE FILE, ASSUMING THERE IS FILE SECURITY 00012900 ATTACHED TO THIS DISK FILE. IF UNAUTHORIZED, THE PROGRAM WILL REJECT 00013000 THE REQUEST. 00013100 * PAGE UNDERLINE 00013200 CONTROL INSTRUCTIONS 00013300 * TITLE UNDERLINE 00013400 CONTROL INSTRUCTIONS (CONTD) 00013500 * DEFINE 3 = PARAGRAPH - 17, 72, 0 * 00013600 * DEFINE 4 = SKIP PARAGRAPH - 17,72,0 * 00013700 * 4 00013800 CARD/READER WILL CAUSE THE PROGRAM TO LOOK FOR ITS INPUT, FROM THIS 00013900 POINT ON, TO BE IN A CARD FILE ("FILES") INSTEAD OF FROM THE SPO. 00014000 THIS OPTION CANNOT BE REVERSED DURING A RUN. 00014100 * 4 00014200 SINGLE/SPACE . 00014300 * 3 00014400 DOUBLE/SPACE THESE INSTRUCTIONS CONTROL THE SPACING ON THE LINE 00014500 PRINTER. DEFAULT IS SINGLE. ONCE EITHER OPTION IS SET, IT WILL 00014600 BE IN FORCE UNTIL REVERSED BY ENTERING THE ALTERNATE OPTION. 00014700 *4 00014800 SIX/LINES . 00014900 * 3 00015000 EIGHT/LINES REFERS TO THE LINES PER INCH THE PROGRAM IS TO 00015100 CONSIDER EXISTS ON THE FORMS IN THE PRINTER, THE OVERALL DEPTH 00015200 ALWAYS ASSUMED AS 11 INCHES. SIX LINES PER INCH IS DEFAULT. 00015300 ONCE SET, THE OPTION IS HELD UNTIL REVERSED. 00015400 * 4 00015500 WIDE/PAPER . 00015600 *3 00015700 NARROW/PAPER 00015800 TELLS THE PROGRAM THAT IT MAY USE EITHER 120 PRINT POSITIONS 00015900 PER LINE OR 85 PRINT POSITIONS PER LINE. DEFAULT IS WIDE. ONCE 00016000 SET THE OPTION IS HELD UNTIL REVERSED. 00016100 * DEFINE 5 = SKIP PARAGRAPH 17, 72, 0 * 00016200 * 5 00016300 WHEN PRINTING TAPE FILES ON NARROW PAPER, 00016400 IF THE INPUT APPEARS TO BE CARD-IMAGES 00016500 (I.E. THE BLOCK IS EITHER AN UNLINKED NON-ALGOL-TYPE BLOCK 00016600 AND IS A MULTIPLE OF 80 CHARACTERS, OR THE BLOCK IS A LINKED 00016700 ALGOL-TYPE BLOCK IN CARD-IMAGES) THEN THE PRINTOUT IS ADJUSTED SO 00016800 THAT THE INDICATIVE INFORMATION SUCH AS BLOCK NUMBER, 00016900 RECORD NUMBER, BLOCK POSITIONS, PARITY, ETC ARE ELIMINATED. 00017000 FURTHER, IN THIS CASE, THE PRINTING (AND PUNCHING, IF SPECIFIED) 00017100 OF LINK WORDS IS INHIBITED. 00017200 * 5 00017300 IF, ON NARROW/PAPER, A NON-CARD-IMAGE TAPE FILE IS BEING PRINTED, 00017400 THE INDICATIVE BLOCK AND RECORD INFORMATION IS PRINTED ON A LINE 00017500 PRECEDING THE ACTUAL BLOCK CONTENTS INSTEAD OF ON THE SIDES OF 00017600 THE BLOCK PRINTOUT AS IS DONE ON WIDE/PAPER. 00017700 * 5 00017800 NOTE THAT ON WIDE PAPER FOR ALL TAPE FILES AND ON NARROW/PAPER 00017900 FOR NON-CARD-IMAGE TAPE FILES, IF THE BLOCK LOOKS LIKE A LINKED 00018000 ALGOL-TYPE BLOCK, THE LINK WORDS WILL BE PRINTED (AND PUNCHED IF SO00018100 SPECIFIED) ON SEPARATE LINES TO ENHANCE READABILITY. 00018200 * 5 00018300 NARROW/PAPER CANNOT BE USED ON NON-CARD-IMAGE DISK FILES. 00018400 IF AN ATTEMPT IS MADE TO DO SO, AN ERROR MESSAGE WILL BE TYPED ON 00018500 ON THE SPO, AND THE FILE REQUEST WILL BE REJECTED. 00018600 * 4 00018700 PUNCH/ON . 00018800 * 3 00018900 PUNCH/NEXT . 00019000 * 3 00019100 PUNCH/OFF THESE OPTIONS CONTROL PUNCHING OF FILES. 00019200 DEFAULT OPTION IS PUNCH/OFF WHICH ELIMINATES PUNCHING. 00019300 PUNCH/NEXT WILL TURN THE PUNCH ON FOR THE NEXT FILE ONLY. 00019400 PUNCH/ON WILL TURN THE PUNCH ON UNTIL REVERSED BY A PUNCH/OFF. 00019500 PUNCHING IS DONE BLINDLY IN GROUPS OF 80 CHARACTERS PER CARD 00019600 REGARDLESS 00019700 OF RECORD, FILE, OR BLOCK CHARACTERISTICS (EXCEPT FOR LINK 00019800 WORDS ON TAPE AS SPECIFIED UNDER NARROW/PAPER). THERE 00019900 ARE NO CONTROLS SUCH AS BLOCK NUMBERS ETC PUNCHED. REFORMATTING 00020000 OF PUNCHED OUTPUT ONTO ANOTHER MEDIA IS A USER RESPONSIBILITY. 00020100 NATURALLY, THIS IS NO PROBLEM FOR CARD-IMAGE FILES. 00020200 * 5 00020300 REMEMBER TO USE NARROW/PAPER WHEN PUNCHING LINKED ALGOL-TYPE 00020400 BLOCKED CARD-IMAGE TAPES SUCH AS 0CRDIMG AND SOLT TAPES. 00020500 * 4 00020600 TAPE/PRINT . 00020700 * 3 00020800 TAPE/BINARY . 00020900 * 3 00021000 TAPE/ALPHA . 00021100 * 3 00021200 TAPE/FILE . 00021300 * 3 00021400 TAPE/FILEA THESE OPTIONS CONDITION THE PROGRAM FOR TAPE INPUT. 00021500 TAPE/BINARY AND TAPE/ALPHA WILL CAUSE THE PROGRAM TO ASSUME THE 00021600 RECORDING MODE OF THE TAPE IS BINARY OR ALPHA (I.E. ODD OR EVEN 00021700 PARITY). TAPE/PRINT WILL ALLOW THE PROGRAM TO TRY TO DETERMINE 00021800 ITSELF THE PARITY OF THE TAPE, TRYING BINARY FIRST. 00021900 TAPE/FILE GIVES THE ABILITY TO SPECIFY TO THE PROGRAM A PARTICULAR 00022000 (NAMED) TAPE FILE TO BE PROCESSED, WHERE THE TAPE IS BINARY 00022100 RECORDING MODE. TAPE/FILEA IS THE SAME AS TAPE/FILE EXCEPT THAT 00022200 THE TAPE IS EXPECTED TO BE ALPHA RECORDING MODE. TAPE/FILE AND 00022300 TAPE/FILEA SHOULD BE USED WHEN THE OPERATOR WANTS THE INPUT 00022400 TO BE A SPECIFIC FILE ON A MULTI-FILE REEL. 00022500 * 5 00022600 WHEN ANY OF TAPE/PRINT OR TAPE/BINARY OR TAPE/ALPHA OPTIONS ARE 00022700 ENTERED, THE PROGRAM TYPES OUT 00022800 A MESSAGE "UL THE TAPE FOR DISCAR" AND THEN DOES AN INITIAL 00022900 READ ON THE TAPE FILE, CAUSING AN MCP "#NO FIL" MESSAGE. 00023000 THE OPERATOR MUST THEN UL THE SPECIFIC TAPE WANTED. 00023100 IF TAPE/PRINT IS USED, AND THE TAPE IS ALPHA, THERE WILL BE TWO 00023200 UL REQUESTS AND THE OPERATOR WILL HAVE TO UL THE TAPE TWICE. 00023300 * 5 00023400 WHEN TAPE/FILE OR TAPE/FILEA ARE USED, THE PROGRAM TYPES OUT A 00023500 MESSAGE "TAPE MFID/ID" FOLLOWED BY "FILE PLEASE". THE PROGRAM THEN00023600 EXPECTS THE OPERATOR TO ENTER THE / OF THE TAPE TO BE 00023700 PROCESSED. HOWEVER, IF THE OPERATOR TYPES IN FORMATTING CONTROLS 00023800 SUCH AS NARROW/PAPER ETC THEY WILL BE RECOGNIZED AND THE PROGRAM 00023900 WILL CONTINUE TO LOOK FOR A TAPE FILE NAME. ONCE THE NAME HAS BEEN00024000 ENTERED, THE PROGRAM (THRU THE MCP OF COURSE) WILL FIND AND 00024100 PROCESS THE SPECIFIED FILE WITHOUT FURTHER INTERVENTION. LABELS 00024200 AND TAPE MARKS WILL NOT BE PRINTED IN THIS MODE. NATURALLY, THIS 00024300 MODE IS MOST USEFUL WHEN WANTING TO PROCESS THE NTH FILE OF 00024400 A MULTI-FILE REEL. 00024500 * 5 00024600 AN EXPLANATION OF PRINT FORMATTING OF TAPE INPUT IS CONTAINED IN 00024700 WIDE/PAPER NARROW/PAPER. 00024800 * 5 00024900 WHEN IN TAPE MODE THE PROGRAM SHOULD HANDLE ANY KIND OF TAPE 00025000 WHETHER SINGLE OR MULTI-FILE REEL, WITHIN THE CONSTRAINT THAT THE 00025100 TAPE MUST FOLLOW NORMAL BURROUGHS STANDARDS FOR SUCH TAPES. 00025200 ON MULTI-FILE REELS EACH FILE WILL START ON A NEW PAGE. 00025300 * 5 00025400 STANDARD BURROUGHS LABELS FOR B-5500 AND TAPE MARKS ARE RECOGNIZED 00025500 AND ARE IDENTIFIED DISTINCTIVELY ON THE PRINTOUTS. 00025600 * 5 00025700 PARITY ERRORS ARE DETECTED AND INDICATED IN AN EYE-CATCHING MANNER 00025800 ON THE PRINTOUT, AND THE PARITY BLOCK IS PRINTED. NATURALLY, IF 00025900 TAPE/BINARY OR TAPE/ALPHA IS USED AND THE TAPE IS NOT THE 00026000 SPECIFIED PARITY, EACH BLOCK WILL INDICATE A PARITY ERROR. 00026100 * 4 00026200 CARDECK/||||||| CONDITIONS THE PROGRAM TO EXPECT A CARD INPUT FILE WHOSE00026300 LABEL (IE DATA) ID IS <|||||||>. THIS FUNCTION AUTOMATICALLY 00026400 INVOKES NARROW/PAPER AND WILL PROCESS THE CARD FILE AS IF IT 00026500 WERE AN UNBLOCKED CARD IMAGE TAPE. 00026600 * 4 00026700 NOMORE . 00026800 * 3 00026900 IF, IN RESPONSE TO THE PROGRAMS "FILE PLEASE" REQUEST AND 00027000 SUBSEQUENT SPO OR CARD READ, THE WORD "NOMORE" OR A NULL ENTRY 00027100 (OR BLANK CARD) IS ENTERED, THE PROGRAM WILL TERMINATE WITH EOJ. 00027200 *QUIT 00027300 ; 00027400 %...................D I S C A R................................ 00027500 BEGIN 00027600 % DO NOT PLACE ANY DECLARATIONS EXCEPT COMMENTS BETWEEN 00027700 % THE INITIAL BEGIN & THE DECLARATION "BOOLEAN COMMITSUICIDE;"; 00027800 BOOLEAN COMMITSUICIDE; 00027900 FORMAT VERSION ("DISCAR VERSION 70MAY21"); 00028000 INTEGER MAXLINES;DEFINE SIXLINES=50#,EIGHTLINES=70#; 00028100 DEFINE FORMATFILENAME=PREFIX.[6:36],PREFIX, 00028200 IF PREFIX="DECK "THEN SUFFIX.[6:30] 00028300 ELSE SUFFIX.[6:36],%WATCHES OUT00028400 %FOR LEFTARROW IN 6TH POSITION 00028500 %OF CONTROL DECK SUFFIX 00028600 %ZND DROPS IT SO SPO 00028700 %MESSAGES DONT TRUNCATE 00028800 SUFFIX#; 00028900 INTEGER DISKRECORDSIZE,DISKBLOCKSIZE,CHUNKSOF100,LESSTHAN100; 00029000 INTEGER CHUNKCOUNT,BLOCKNUMBER,RECORDNUMBER,RECORDSPERBLOCK; 00029100 FILE SPO 11(5,10); 00029200 FILE IN CARDRDR "FILES" (1,10); 00029300 FILE PRINT 18(2,15); 00029400 SWITCH FILE SOURCE:=SPO,PRINT; 00029500 FILE DISKIN DISK SERIAL"ANYOLD""DISKFIL"(2,0,0); 00029600 ALPHA FILE ALPHATAPE 9(1,1023);FILE BINARYTAPE 9(1,1023); 00029700 SWITCH FILE ANYTAPE:=ALPHATAPE,BINARYTAPE; 00029800 INTEGER ALPHAORBINARYTAPE; 00029900 INTEGER NUMBEROFLINKWORDS; 00030000 INTEGER THERECORDSIZE,NOOFTAPELINES,J; 00030100 INTEGER FILENO,BLOCKNO; 00030200 INTEGER RECORDCOUNT,PARITYCOUNT; 00030300 BOOLEAN LABELEXPECT; 00030400 INTEGER THEBINYR; 00030500 BOOLEAN ITSOVER,LABELREAD; 00030600 BOOLEAN FIRSTREAD,PREREADGAVETPMK; 00030700 BOOLEAN INBLOCK; 00030800 ALPHA PARITY,OUTSWITCH,FILEID,MFID; 00030900 ALPHA LABSWITCH; 00031000 ALPHA TLABEL; 00031100 ARRAY PRINTLINE [1:10]; 00031200 FILE DIRECTORY DISK RANDOM"DIRCTRY""DISK "(5,30); 00031300 FILE PUNCH 0(2,10); 00031400 FORMAT SUICIDE("XXXXXXXXXX OPERATOR HAS KILLED THIS FILE " 00031500 "BEFORE COMPLETION XXXXXXXXXXXXXXXXXXXX"); 00031600 ARRAY DISKIMAGE[0:1022]; 00031700 ARRAY CARDIMAGE[0:9]; 00031800 ARRAY PRINTIMAGE[0:15]; 00031900 ARRAY SEARCHREPLY[0:6]; 00032000 ARRAY SPIN[0:9]; 00032100 ARRAY DIRECORD,DIRFILEHDR[0:29]; 00032200 ARRAY MONTHNAMES[0:11],MONTHDAYS[0:11]; 00032300 FORMAT SPECTAPENAMEPLS("TAPE MFID/ID"); 00032400 FORMAT WHATFILE("FILE PLEASE"); 00032500 FORMAT SUFXERR("YOU LEFT OUT THE SLASH DUMMY, TRY AGAIN."); 00032600 FORMAT NEXTFILE("NEXT FILE IS ",A6,A1,"/",A6,A1); 00032700 FORMAT BYPASSOBJECTFILE("FILE ",A6,A1,"/",A6,A1," BYPASSED ", 00032800 "(OBJECT CODE)"); 00032900 FORMAT NULLFILEGROUP("SORRY, NULL FILE GROUP ",A6,A1,"/",A6,A1); 00033000 FORMAT TAPEFILE("UL THE TAPE FOR DISCAR"); 00033100 BOOLEAN SPECIFICTAPE; 00033200 BOOLEAN CARDECK; 00033300 BOOLEAN REMEMBERNARROWPAPER; 00033400 BOOLEAN NARROWPAPER; 00033500 BOOLEAN BLOCKISCARDIMAGES; 00033600 BOOLEAN NULLFILES; 00033700 LABEL GETANOTHER,STOPRUN,FREAKOUT; 00033800 LABEL NOTTAPEINPUT; 00033900 ALPHA PREFIX,SUFFIX,FROMHERE,TODAYSDATE; 00034000 INTEGER ERROR,WHICHSOURCE,DIRECKEY,POINTER,CURRENTIME,THEDAY; 00034100 INTEGER THEMONTH,LINECOUNT,PAGENUMBER; 00034200 BOOLEAN PUNCHIT,ALLSUFF,ALLPREF,SEARCHDIR,HOLDPUNCH,SINGLESPACE; 00034300 STREAM PROCEDURE COMPILEID(INPUT,PREFIX,SUFFIX,ERROR); 00034400 BEGIN 00034500 LABEL PRELOOP,SUFLOOP,EGZIT,GETSLASH,GOTSLASH; 00034600 LOCAL LEFTARROW,QUESTIONMARKS,HOLDINX; 00034700 DI:=LOC LEFTARROW;DS:=43RESET;DS:=5SET;%MAKE LEFTARROW 00034800 DI:=LOC QUESTIONMARKS;DS:=6RESET;7(DS:=2RESET;DS:=2SET;DS:=2RESET); 00034900 SI:=LOC LEFTARROW;SI:=SI+7;DI:=INPUT;DI:=DI+63;DI:=DI+8;DS:=1CHR; 00035000 % MAKE SURE LEFTARROW IN COL 73 IN CASE INPUT IS CARD AND NOT SPO 00035100 SI:=INPUT; 00035200 DI:=PREFIX;DS:=8LIT"0 "; 00035300 DI:=SUFFIX;DS:=8LIT"0 "; 00035400 DI:=PREFIX;DI:=DI+1; 00035500 7( 00035600 PRELOOP:IF SC=" "THEN BEGIN SI:=SI+1;GO TO PRELOOP END; 00035700 IF SC="/"THEN JUMP OUT TO GETSLASH; 00035800 HOLDINX:=DI;DI:=LOC LEFTARROW;DI:=DI+7; 00035900 IF SC=DC 00036000 THEN BEGIN 00036100 SI:=LOC QUESTIONMARKS; 00036200 DI:=SUFFIX;DS:=1WDS;%QU MRKS; 00036300 DI:=ERROR;DI:=DI+7;DS:=1LIT"1"; 00036400 JUMP OUT TO EGZIT 00036500 END; 00036600 SI:=SI-1;DI:=HOLDINX; 00036700 DS:=1CHR); 00036800 GETSLASH:IF SC="/" 00036900 THEN BEGIN 00037000 SI:=SI+1; 00037100 DI:=SUFFIX;DI:=DI+1; 00037200 GO TO GOTSLASH 00037300 END; 00037400 HOLDINX:=DI;DI:=LOC LEFTARROW;DI:=DI+7; 00037500 IF SC=DC 00037600 THEN BEGIN 00037700 SI:=LOC QUESTIONMARKS; 00037800 DI:=SUFFIX;DS:=1WDS;% QUESTN MKS 00037900 DI:=ERROR;DI:=DI+7;DS:=1LIT"2"; 00038000 GO TO EGZIT; 00038100 END 00038200 ELSE DI:=HOLDINX; 00038300 GO TO GETSLASH; 00038400 GOTSLASH: 00038500 7( 00038600 SUFLOOP:HOLDINX:=DI;DI:=LOC LEFTARROW;DI:=DI+7; 00038700 IF SC=DC THEN JUMP OUT TO EGZIT; 00038800 SI:=SI-1;DI:=HOLDINX; 00038900 IF SC=" "THEN BEGIN SI:=SI+1;GO TO SUFLOOP END; 00039000 DS:=1CHR); 00039100 EGZIT: 00039200 END OF COMPILEID; 00039300 PROCEDURE SETUPDATEANDTIME; 00039400 BEGIN 00039500 %THIS PROCEDURE ONLY ACCESSES THE SYSTEM DATE AND TIME AND 00039600 %STORES THEM,CONVERTING THE DATE INTO A FORM 00039700 %USABLE BY THE PAGE HEADING WRITE ROUTINE (I.E. ORIGINAL DATE 00039800 % IS YYDDD, & IS CONVERTED TO YY LEFT IN TODAYSDATE, DD IN 00039900 % THEDAY, AND MM IN THEMONTH). 00040000 TODAYSDATE:=TIME(0);CURRENTIME:=TIME(1); 00040100 THEBINYR~ TODAYSDATE.[18:6] |10 +TODAYSDATE.[24:6] ; 00040200 MONTHDAYS[1] ~ REAL(THEBINYR MOD 4 = 0) +28; 00040300 %CHECK FOR LEAP YR & ADJUST FEBRUARY DAYS ACCORDINGLY 00040400 THEDAY:=TODAYSDATE.[30:6]|100+TODAYSDATE.[36:6]|10+ 00040500 TODAYSDATE.[42:6]; 00040600 FOR THEMONTH:=0 STEP 1 WHILE THEDAY GTR MONTHDAYS[THEMONTH] 00040700 DO THEDAY:=THEDAY-MONTHDAYS[THEMONTH]; 00040800 END SETUPDATEANDTIME; 00040900 PROCEDURE TOPOFPAGE; 00041000 BEGIN 00041100 FORMAT NARROWPAGETOP(X27"LISTING OF FILE "A6,A1"/"A6,A1// 00041200 X29"TAKEN AT "I2":"I2" ON "A2,A3,I2,X15"PAGE "I3/ 00041300 I4" CHARACTER ("I4" WORD) RECORDS BLOCKED "I3" IN "00041400 I4" CHAR ("I4" WORD) BLOCKS"); 00041500 FORMAT PAGETOP(X44"LISTING OF FILE "A6,A1"/"A6,A1// 00041600 X46"TAKEN AT "I2":"I2 00041700 " ON "A2,A3,I2,X35"PAGE "I3/ 00041800 I4," CHARACTER (",I4," WORD) RECORDS BLOCKED ",I3, 00041900 " IN ",I4," CHARACTER (",I4," WORD, ", 00042000 I2" SEGMENT) BLOCKS"); 00042100 FORMAT HUNDREDHEAD(X20,"0",X8,"1",X9,"2",X9,"3",X9,"4",X9,"5",X9, 00042200 "6",X9,"7",X9,"8",X9,"9",X9,"+", / 00042300 "BLK RECD POSITIONS ",10("1234567890") / ); 00042400 FORMAT CARDHEAD(" RECD SEQ 0" 00042500 X8"1"X9"2"X9"3"X9 00042600 "4",X9,"5",X9,"6",X9,"7",X9,"8", / 00042700 X20,8("1234567890") / ); 00042800 FORMAT NARROWCARDHEAD(X1, 00042900 "0"X8"1"X9"2"X9"3"X9"4"X9"5"X9"6"X9"7"X9"8",/ 00043000 X1, 8("1234567890")/); 00043100 FORMAT PUNCHTOP("PUNCHOUT OF FILE ",A6,A1,"/",A6,A1, 00043200 " TAKEN AT ",I2,":",I2," ON ",A2,A3,I2); 00043300 WRITE(PRINT[PAGE]); 00043400 IF NOT NARROWPAPER 00043500 THEN WRITE(PRINT,PAGETOP, 00043600 PREFIX.[6:36],PREFIX,SUFFIX.[6:36],SUFFIX, 00043700 CURRENTIME DIV 216000,CURRENTIME MOD 216000 DIV 3600, 00043800 TODAYSDATE.[18:12],MONTHNAMES[THEMONTH],THEDAY, 00043900 PAGENUMBER:=PAGENUMBER+1, 00044000 DISKRECORDSIZE|8,DISKRECORDSIZE,RECORDSPERBLOCK, 00044100 DISKBLOCKSIZE|8,DISKBLOCKSIZE, 00044200 DISKBLOCKSIZE DIV 30 + 00044300 REAL(DISKBLOCKSIZE MOD 30 GTR 0)) 00044400 ELSE WRITE(PRINT,NARROWPAGETOP, 00044500 PREFIX.[6:36],PREFIX,SUFFIX.[6:36],SUFFIX, 00044600 CURRENTIME DIV 216000,CURRENTIME MOD 216000 DIV 3600, 00044700 TODAYSDATE.[18:12],MONTHNAMES[THEMONTH],THEDAY , 00044800 PAGENUMBER:=PAGENUMBER+1, 00044900 DISKRECORDSIZE|8,DISKRECORDSIZE,RECORDSPERBLOCK, 00045000 DISKBLOCKSIZE|8,DISKBLOCKSIZE); 00045100 IF PUNCHIT AND PAGENUMBER=1 00045200 THEN WRITE(PUNCH,PUNCHTOP, 00045300 PREFIX.[6:36],PREFIX,SUFFIX.[6:36],SUFFIX, 00045400 CURRENTIME DIV 216000,CURRENTIME MOD 216000 DIV 00045500 3600,TODAYSDATE.[18:12], 00045600 MONTHNAMES[THEMONTH],THEDAY); 00045700 LINECOUNT:=0; 00045800 IF DISKRECORDSIZE NEQ 10 AND NOT NARROWPAPER 00045900 THEN WRITE(PRINT,HUNDREDHEAD) 00046000 ELSE IF NOT NARROWPAPER THEN WRITE(PRINT,CARDHEAD) 00046100 ELSE WRITE(PRINT,NARROWCARDHEAD); 00046200 END OF TOPOFPAGE; 00046300 PROCEDURE STARTTHEPROGRAM; 00046400 BEGIN 00046500 WRITE(SPO,VERSION); 00046600 SINGLESPACE:=TRUE ; 00046700 MAXLINES:=SIXLINES;NARROWPAPER:=FALSE; 00046800 FILL MONTHNAMES[*]WITH"JAN","FEB","MAR","APR","MAY","JUN", 00046900 "JUL","AUG","SEP","OCT","NOV","DEC"; 00047000 FILL MONTHDAYS[*]WITH 31,28,31,30,31,30,31,31,30,31,30,31; 00047100 END OF START THE PROGRAM; 00047200 STREAM PROCEDURE CARDIMAGEPRINTSETUP(CARDIMAGE,PRINTIMAGE, 00047300 LINENUMBER,WIDEPAPER); 00047400 VALUE LINENUMBER,WIDEPAPER; 00047500 BEGIN 00047600 LABEL NOSEQUENCE; 00047700 DI:=PRINTIMAGE;DS:=8LIT" "; % BLANK OUT THE 00047800 SI:=PRINTIMAGE;DS:=14WDS; % PRINTLINE 00047900 SI:=CARDIMAGE;DI:=PRINTIMAGE; 00048000 WIDEPAPER(DI:=DI+19); DI:=DI+1; 00048100 2(DS:=40CHR); % PLACE CARDIMAGE IN PRINT POSITIONS 21-100 00048200 DI:=PRINTIMAGE; 00048300 2(DI:=DI+40);DI:=DI+1;WIDEPAPER(DI:=DI+19); 00048400 DS:=LIT">"; 00048500 DI:=PRINTIMAGE;WIDEPAPER(DI:=DI+19);DS:=LIT"<"; 00048600 SI:=CARDIMAGE;2(SI:=SI+36); 00048700 WIDEPAPER( 00048800 8(IF SC LSS"0"THEN JUMP OUT TO NOSEQUENCE;%IF THERE IS A 00048900 IF SC GTR"9"THEN JUMP OUT TO NOSEQUENCE;%SEQUENCE NUMBER 00049000 SI:=SI+1); % IN THE CARD, PRINT THE NUMBER TO THE LEFT 00049100 % OF THE LEFT COLON 00049200 SI:=SI-8;DI:=PRINTIMAGE;DI:=DI+9 ;DS:=8CHR;DI:=DI-8;DS:=8FILL; 00049300 NOSEQUENCE: 00049400 SI:=LOC LINENUMBER;DI:=PRINTIMAGE; 00049500 DS:=8DEC;DI:=DI-8;DS:=8FILL;%INSERT LINE NUMBER 00049600 ); 00049700 END OF CARDIMAGEPRINTSETUP; 00049800 STREAM PROCEDURE NOTCARDPRINTSETUP 00049900 (INPUTARRAY,PRINTIMAGE,CHUNKSDIV2,CHUNKSMOD2, 00050000 CHARSDIV2,BLOCKNUMBEROR0, 00050100 RECORDNUMBEROR0,FROMCHAR,TOCHAR); 00050200 VALUE CHARSDIV2,BLOCKNUMBEROR0,RECORDNUMBEROR0, 00050300 FROMCHAR,TOCHAR,CHUNKSDIV2,CHUNKSMOD2; 00050400 BEGIN 00050500 DI:=PRINTIMAGE;DS:=8LIT" ";SI:=PRINTIMAGE;DS:=14WDS; 00050600 % BLANK OUT PRINTLINE 00050700 SI:=LOC BLOCKNUMBEROR0;DI:=PRINTIMAGE; 00050800 DS:=3DEC;DI:=DI-3;DS:=3FILL;%INSERT BLOCK NUMBER 00050900 SI:=LOC RECORDNUMBEROR0;DI:=PRINTIMAGE;DI:=DI+4; 00051000 DS:=4DEC;DI:=DI-4;DS:=4FILL;%INSERT RECORD NUMBER 00051100 SI:=LOC FROMCHAR;DI:=PRINTIMAGE;DI:=DI+9; 00051200 DS:=4DEC;DI:=DI-4;DS:=4FILL;%INSERT FROM CHAR 00051300 DI:=PRINTIMAGE;DI:=DI+14;DS:=1LIT"-"; 00051400 SI:=LOC TOCHAR; 00051500 DS:=4DEC;DI:=DI-4;DS:=4FILL;% INSERT TO CHAR 00051600 DI:=PRINTIMAGE;DI:=DI+20; 00051700 SI:=INPUTARRAY; 00051800 2(2(CHUNKSDIV2(SI:=SI+50)));% INDENT INTO INPUT BY 00051900 CHUNKSMOD2(2(SI:=SI+50)); % NUMBER OF CHUNKS 00052000 2(CHARSDIV2(DS:=1CHR));% FILL IN PRINTLINE WITH DATA 00052100 END OF NOTCARDPRINTSETUP; 00052200 STREAM PROCEDURE MAKEACARD(WORDSINCARD,INPUTARRAY,CARDIMAGE); 00052300 VALUE WORDSINCARD; 00052400 BEGIN 00052500 DI:=CARDIMAGE;DS:=8LIT" ";SI:=CARDIMAGE;DS:=7WDS; 00052600 SI:=INPUTARRAY;DI:=CARDIMAGE; 00052700 WORDSINCARD(DS:=1WDS); 00052800 END OF MAKEACARD; 00052900 PROCEDURE FETCHANDANALYZE; 00053000 BEGIN 00053100 LABEL DOITAGIN,NOTSPACE,NOTLINES,NOTPAPER; 00053200 DOITAGIN: 00053300 IF WHICHSOURCE = 0 THEN BEGIN 00053400 WRITE(SOURCE[WHICHSOURCE],WHATFILE);READ(SPO,10,SPIN[*]); 00053500 END ELSE READ (CARDRDR,10,SPIN[*]); 00053600 COMPILEID(SPIN[0],PREFIX,SUFFIX,ERROR); 00053700 IF PREFIX="NOMORE " OR PREFIX=" " THEN GO TO STOPRUN; 00053800 IF ERROR=1 OR ERROR=2 00053900 THEN BEGIN 00054000 WRITE(SOURCE[WHICHSOURCE],SUFXERR); 00054100 ERROR:=0; 00054200 GO TO DOITAGIN 00054300 END; 00054400 IF SUFFIX="SPACE " 00054500 THEN BEGIN 00054600 IF PREFIX="SINGLE " 00054700 THEN SINGLESPACE:=TRUE 00054800 ELSE 00054900 IF PREFIX="DOUBLE " 00055000 THEN SINGLESPACE:=FALSE 00055100 ELSE GO TO NOTSPACE; 00055200 GO TO DOITAGIN; 00055300 END; 00055400 NOTSPACE: 00055500 IF PREFIX="PUNCH " 00055600 THEN BEGIN 00055700 IF SUFFIX="NEXT " 00055800 THEN BEGIN 00055900 PUNCHIT:=TRUE; 00056000 HOLDPUNCH:=FALSE 00056100 END 00056200 ELSE 00056300 IF SUFFIX="ON "THEN PUNCHIT:=HOLDPUNCH:=TRUE 00056400 ELSE 00056500 IF SUFFIX="OFF "THEN PUNCHIT:=HOLDPUNCH:=FALSE; 00056600 IF PREFIX="PUNCH "AND(SUFFIX="NEXT "OR SUFFIX="ON " OR 00056700 SUFFIX="OFF ") 00056800 THEN GO TO DOITAGIN; 00056900 END;%OF PREFIX IS PUNCH 00057000 IF SUFFIX="LINES " 00057100 THEN BEGIN 00057200 IF PREFIX="SIX " 00057300 THEN MAXLINES:=SIXLINES 00057400 ELSE 00057500 IF PREFIX="EIGHT " 00057600 THEN MAXLINES:=EIGHTLINES 00057700 ELSE GO TO NOTLINES; 00057800 GO TO DOITAGIN; 00057900 END OF SUFFIX LINES PER PAGE; 00058000 NOTLINES: 00058100 IF SUFFIX="PAPER " 00058200 THEN BEGIN 00058300 IF PREFIX="NARROW " 00058400 THEN NARROWPAPER:=TRUE 00058500 ELSE 00058600 IF PREFIX="WIDE " 00058700 THEN NARROWPAPER:=FALSE 00058800 ELSE GO TO NOTPAPER; 00058900 GO TO DOITAGIN; 00059000 END OF PAPER WIDTH; 00059100 NOTPAPER: 00059200 IF PREFIX="CARD "AND SUFFIX="READER " 00059300 THEN BEGIN WHICHSOURCE:=1;GO TO DOITAGIN END; 00059400 END OF FETCHANDANALYZE; 00059500 PROCEDURE DOTHERESTOFYOURTHING;FORWARD; 00059600 PROCEDURE DOYOURTHING; 00059700 BEGIN 00059800 LABEL MYTHINGDONE; 00059900 FORMAT NOFILE("SORRY, FILE ",A6,A1,"/",A6,A1," IS NOT ON DISK."); 00060000 FORMAT NOTYOURS("SORRY, FILE ",A6,A1,"/",A6,A1," IS A NO-NO ", 00060100 "U R NOT AN AUTHORIZED USER."); 00060200 FORMAT YOUGOTTABEKIDDIN("SORRY, CANNOT HANDLE ",A6,A1,"/",A6,A1, 00060300 ", RECORD SIZE GTR 1023 WORDS - WOW"); 00060400 FORMAT NOSIZE("FILE ",A6,A1,"/",A6,A1," MISSING RECORD/BLOCK SIZE " 00060500 "R=",I4," B=",I4, ", ASSUME BOTH 240"); 00060600 FORMAT TOOWIDE("FILE "A6,A1"/"A6,A1" CANNOT USE NARROW/PAPER OPTION"); 00060700 FILL DISKIN WITH PREFIX,SUFFIX; 00060800 SEARCH(DISKIN,SEARCHREPLY[*]); 00060900 IF SEARCHREPLY[0]=-1 00061000 THEN BEGIN 00061100 WRITE(SOURCE[WHICHSOURCE],NOFILE,FORMATFILENAME); 00061200 GO TO MYTHINGDONE 00061300 END; 00061400 IF SEARCHREPLY[0]=0 00061500 THEN BEGIN 00061600 WRITE(SOURCE[WHICHSOURCE],NOTYOURS,FORMATFILENAME); 00061700 GO TO MYTHINGDONE 00061800 END; 00061900 IF DISKRECORDSIZE:=SEARCHREPLY[3]GTR 1023 00062000 THEN BEGIN 00062100 WRITE(SOURCE[WHICHSOURCE],YOUGOTTABEKIDDIN, 00062200 FORMATFILENAME); 00062300 GO TO MYTHINGDONE; 00062400 END; 00062500 IF DISKRECORDSIZE>10 AND NARROWPAPER 00062600 THEN BEGIN 00062700 WRITE(SOURCE[WHICHSOURCE],TOOWIDE,FORMATFILENAME); 00062800 GO TO MYTHINGDONE 00062900 END; 00063000 DISKBLOCKSIZE:=SEARCHREPLY[4]; 00063100 IF DISKRECORDSIZE=0 OR DISKBLOCKSIZE=0 00063200 THEN BEGIN 00063300 WRITE(SOURCE[WHICHSOURCE],NOSIZE,FORMATFILENAME, 00063400 DISKRECORDSIZE,DISKBLOCKSIZE); 00063500 WRITE(PRINT,NOSIZE,FORMATFILENAME,DISKRECORDSIZE,DISKBLOCKSIZE00063600 ); 00063700 DISKRECORDSIZE:=DISKBLOCKSIZE:=30; 00063800 END; 00063900 RECORDSPERBLOCK:=DISKBLOCKSIZE DIV DISKRECORDSIZE; 00064000 CHUNKSOF100:=(DISKRECORDSIZE|8)DIV 100; 00064100 LESSTHAN100:=(DISKRECORDSIZE|8)MOD 100; 00064200 BLOCKNUMBER:=RECORDNUMBER:=0; 00064300 SETUPDATEANDTIME; 00064400 TOPOFPAGE; 00064500 DOTHERESTOFYOURTHING; 00064600 MYTHINGDONE: 00064700 END; % OF DOYOURTHING(PART I) 00064800 PROCEDURE DOTHERESTOFYOURTHING; 00064900 BEGIN 00065000 LABEL FILEND; 00065100 FILE DISKIN DISK SERIAL"ANYOLD""DISKFIL"(2,DISKRECORDSIZE, 00065200 DISKBLOCKSIZE); 00065300 ARRAY DISKIMAGE[0:DISKRECORDSIZE]; 00065400 FILL DISKIN WITH PREFIX,SUFFIX; 00065500 WHILE TRUE DO 00065600 BEGIN 00065700 READ(DISKIN,DISKRECORDSIZE,DISKIMAGE[*])[FILEND]; 00065800 BLOCKNUMBER:=IF(RECORDNUMBER:=RECORDNUMBER+1)MOD RECORDSPERBLOCK=100065900 OR RECORDSPERBLOCK=1 00066000 THEN BLOCKNUMBER+1 00066100 ELSE BLOCKNUMBER; 00066200 IF DISKRECORDSIZE NEQ 10 00066300 AND NOT NARROWPAPER 00066400 THEN BEGIN % ******RECORDS ARE NOT CARD IMAGES 00066500 FOR CHUNKCOUNT:=0 STEP 1 UNTIL CHUNKSOF100 00066600 DO BEGIN 00066700 IF LINECOUNT GEQ MAXLINES THEN TOPOFPAGE; 00066800 NOTCARDPRINTSETUP(DISKIMAGE[*],PRINTIMAGE[*], 00066900 CHUNKCOUNT DIV 2, 00067000 IF CHUNKCOUNT MOD 2=1 THEN 1 ELSE 0, 00067100 IF CHUNKCOUNT LSS CHUNKSOF100 00067200 THEN 100 DIV 2 00067300 ELSE LESSTHAN100 DIV 2, 00067400 IF CHUNKCOUNT=0 OR LINECOUNT=0 00067500 THEN BLOCKNUMBER 00067600 ELSE 0, 00067700 IF CHUNKCOUNT=0 OR LINECOUNT=0 00067800 THEN RECORDNUMBER 00067900 ELSE 0, 00068000 (CHUNKCOUNT|100)+1, 00068100 IF CHUNKCOUNT LSS CHUNKSOF100 00068200 THEN(CHUNKCOUNT+1)|100 00068300 ELSE(CHUNKCOUNT|100)+LESSTHAN100); 00068400 IF SINGLESPACE 00068500 THEN WRITE(PRINT,15,PRINTIMAGE[*]) 00068600 ELSE WRITE(PRINT[DBL],15,PRINTIMAGE[*]); 00068700 LINECOUNT:=LINECOUNT+(IF SINGLESPACE THEN 1 ELSE 2); 00068800 END; 00068900 IF LINECOUNT GEQ MAXLINES 00069000 THEN TOPOFPAGE 00069100 ELSE BEGIN 00069200 IF SINGLESPACE THEN WRITE(PRINT)ELSE WRITE(PRINT[DBL]); 00069300 LINECOUNT:=LINECOUNT+(IF SINGLESPACE THEN 1 ELSE 2); 00069400 END; 00069500 IF PUNCHIT 00069600 THEN FOR POINTER:=0 STEP 10 UNTIL DISKRECORDSIZE-1 00069700 DO BEGIN 00069800 MAKEACARD(IF POINTER+9 LSS DISKRECORDSIZE 00069900 THEN 10 00070000 ELSE DISKRECORDSIZE MOD 10, 00070100 DISKIMAGE[POINTER], 00070200 CARDIMAGE[*]); 00070300 WRITE(PUNCH,10,CARDIMAGE[*]) 00070400 END; 00070500 IF COMMITSUICIDE 00070600 THEN BEGIN 00070700 COMMITSUICIDE:=FALSE; 00070800 WRITE(PRINT,SUICIDE); 00070900 IF PUNCHIT THEN WRITE(PUNCH,SUICIDE); 00071000 GO TO FILEND 00071100 END; 00071200 END % OF RECORDS NOT CARD IMAGES 00071300 ELSE BEGIN % ::::: RECORDS ARE CARD IMAGES 00071400 IF LINECOUNT GEQ MAXLINES THEN TOPOFPAGE; 00071500 CARDIMAGEPRINTSETUP(DISKIMAGE[*],PRINTIMAGE[*], 00071600 RECORDNUMBER,IF NARROWPAPER THEN 0 ELSE 1); 00071700 IF SINGLESPACE 00071800 THEN WRITE(PRINT,15,PRINTIMAGE[*]) 00071900 ELSE WRITE(PRINT[DBL],15,PRINTIMAGE[*]); 00072000 IF SINGLESPACE THEN LINECOUNT:=LINECOUNT+1 00072100 ELSE LINECOUNT:=LINECOUNT+2; 00072200 IF PUNCHIT THEN WRITE(PUNCH,10,DISKIMAGE[*]); 00072300 IF COMMITSUICIDE 00072400 THEN BEGIN 00072500 COMMITSUICIDE:=FALSE; 00072600 WRITE(PRINT,SUICIDE); 00072700 IF PUNCHIT THEN WRITE(PUNCH,SUICIDE); 00072800 GO TO FILEND 00072900 END; 00073000 END; 00073100 END OF WHILE TRUE LOOP; 00073200 FILEND: 00073300 IF PUNCHIT AND NOT HOLDPUNCH 00073400 THEN BEGIN 00073500 PUNCHIT:=FALSE; 00073600 CLOSE(PUNCH,RELEASE) 00073700 END; 00073800 WRITE(PRINT[PAGE]); 00073900 PAGENUMBER:=RECORDNUMBER:=0; 00074000 CLOSE(DISKIN,RELEASE); 00074100 END OF DOYOURTHING; 00074200 PROCEDURE TOPOFTAPEPAGE; 00074300 BEGIN 00074400 FORMAT HEADING(X44,"LISTING OF FILE "A6,A1,"/"A6,A1// 00074500 X46"TAKEN AT "I2":"I2,X1"ON "A2,X1,A3,X1,I2, 00074600 X35,"PAGE",X2,I3// 00074700 "FILE BLOCK TYPE POSITION 0", 00074800 X8,"1",X9,"2",X9,"3",X9,"4",X9,"5",X9,"6",X9,"7", 00074900 X9,"8",X2,"MODE",/, 00075000 "NO NO ",X18,8("1234567890")/); 00075100 FORMAT NARROWHEADING(X27"LISTING OF FILE "A6,A1"/"A6,A1// 00075200 X29"TAKEN AT "I2":"I2" ON "A2,X1,A3,X1,I2, 00075300 X15"PAGE "I3// 00075400 X1"0"X8"1"X9"2"X9"3"X9"4"X9"5"X9"6"X9"7"X9"8"/ 00075500 X1,8("1234567890")/); 00075600 FORMAT PUNCHHEADING("PUNCHOUT OF FILE "A6,A1,"/"A6,A1" TAKEN AT " 00075700 I2":"I2" ON "A2,A3,I2); 00075800 WRITE(PRINT[PAGE]); 00075900 IF NARROWPAPER 00076000 THEN WRITE(PRINT,NARROWHEADING, 00076100 MFID.[6:36],MFID,FILEID.[6:36],FILEID, 00076200 CURRENTIME DIV 216000,CURRENTIME MOD 216000 DIV 3600, 00076300 TODAYSDATE.[18:12],MONTHNAMES[THEMONTH],THEDAY, 00076400 PAGENUMBER:=PAGENUMBER+1) 00076500 ELSE 00076600 WRITE(PRINT,HEADING,MFID.[6:36],MFID,FILEID.[6:36],FILEID, 00076700 CURRENTIME DIV 216000,CURRENTIME MOD 216000 DIV 3600, 00076800 TODAYSDATE.[18:12],MONTHNAMES[THEMONTH],THEDAY, 00076900 PAGENUMBER ~ PAGENUMBER +1); 00077000 IF PUNCHIT AND PAGENUMBER =1 00077100 THEN WRITE(PUNCH,PUNCHHEADING,MFID.[6:36],MFID, 00077200 FILEID.[6:36],FILEID,CURRENTIME DIV 216000, 00077300 CURRENTIME MOD 216000 DIV 3600, 00077400 TODAYSDATE.[8:12],MONTHNAMES[THEMONTH],THEDAY); 00077500 LINECOUNT ~ 0; 00077600 OUTSWITCH~ " "; 00077700 END OF TOPOFTAPEPAGE; 00077800 PROCEDURE FINISHUP; 00077900 BEGIN 00078000 IF HOLDPUNCH THEN PUNCHIT:=TRUE;%IN CASE SET FALSE BY TPMARK 00078100 IF COMMITSUICIDE 00078200 THEN BEGIN 00078300 COMMITSUICIDE:=FALSE; 00078400 WRITE(PRINT,SUICIDE); 00078500 IF PUNCHIT THEN WRITE(PUNCH,SUICIDE); 00078600 END; 00078700 IF PUNCHIT AND NOT HOLDPUNCH THEN 00078800 BEGIN PUNCHIT~FALSE; CLOSE(PUNCH,RELEASE); END; 00078900 WRITE(PRINT[PAGE]); PAGENUMBER~RECORDNUMBER~0; 00079000 FILEID:=MFID:=0; 00079100 CLOSE(ANYTAPE[ALPHAORBINARYTAPE],RELEASE);ITSOVER:=TRUE;END; 00079200 INTEGER STREAM PROCEDURE RECORDSIZE(R); 00079300 BEGIN SI~R; SI~SI-8; DI~ LOC RECORDSIZE; 00079400 DS~1 WDS; END; 00079500 PROCEDURE DOONELINE; 00079600 BEGIN 00079700 IF LINECOUNT GEQ MAXLINES THEN TOPOFTAPEPAGE; 00079800 IF SINGLESPACE THEN WRITE(PRINT,15,PRINTIMAGE[*]) 00079900 ELSE WRITE(PRINT[DBL],15,PRINTIMAGE[*]); 00080000 IF SINGLESPACE THEN LINECOUNT~LINECOUNT +1 00080100 ELSE LINECOUNT ~ LINECOUNT +2; 00080200 IF PUNCHIT THEN WRITE(PUNCH,10,PRINTLINE[*]); 00080300 IF COMMITSUICIDE THEN FINISHUP; 00080400 END OF DOONELINE; 00080500 BOOLEAN PROCEDURE ISITALINKEDRECORD; 00080600 BEGIN 00080700 INTEGER LINKWORD,PREVLINKWORD,LINKCHARVALUE; 00080800 INTEGER VALU; 00080900 BOOLEAN STREAM PROCEDURE FOUNDAFLAGBIT(TESTWORD); 00081000 BEGIN SI:= TESTWORD;DI:=LOC FOUNDAFLAGBIT;DI:=DI+7; 00081100 IF SB THEN DS:=LIT"1"ELSE DS:=LIT"0"; 00081200 END OF CHECKFORFLAGBIT; 00081300 LABEL FORWARDLINKSOK,NOTLINKEDRECORDS,BACKWARDLINKSOK,EXITLINKCHECK; 00081400 DEFINE RECORDIMAGE=DISKIMAGE#, 00081500 FORWARDLINKVALUE= 00081600 IF FOUNDAFLAGBIT(RECORDIMAGE[LINKWORD]) 00081700 THEN 88888 00081800 ELSE IF(LINKCHARVALUE:=RECORDIMAGE[LINKWORD].[24:6]|1000 00081900 +RECORDIMAGE[LINKWORD].[30:6]|100 00082000 +RECORDIMAGE[LINKWORD].[36:6]|10 00082100 +RECORDIMAGE[LINKWORD].[42:6]) 00082200 MOD 8 =0 THEN LINKCHARVALUE DIV 8 00082300 ELSE 99999#, 00082400 BACKWARDLINKVALUE= 00082500 IF FOUNDAFLAGBIT(RECORDIMAGE[LINKWORD]) 00082600 THEN 88888 00082700 ELSE IF(LINKCHARVALUE:=RECORDIMAGE[LINKWORD].[1:5]|1000 00082800 +RECORDIMAGE[LINKWORD].[6:6]|100 00082900 +RECORDIMAGE[LINKWORD].[12:6]|10 00083000 +RECORDIMAGE[LINKWORD].[18:6]) 00083100 MOD 8=0 THEN LINKCHARVALUE DIV 8 00083200 ELSE 99999 # 00083300 ; 00083400 NUMBEROFLINKWORDS:=2; 00083500 NOOFTAPELINES:=3; 00083600 BLOCKISCARDIMAGES:=TRUE; 00083700 PREVLINKWORD:=LINKWORD:=0; 00083800 WHILE LINKWORD:=PREVLINKWORD+VALU :=FORWARDLINKVALUE LSS 1024 00083900 AND LINKWORD LSS THERECORDSIZE 00084000 DO BEGIN 00084100 IF VALU:=FORWARDLINKVALUE=0 00084200 THEN IF LINKWORD=THERECORDSIZE-1 00084300 THEN GO FORWARDLINKSOK ELSE GO NOTLINKEDRECORDS; 00084400 IF BLOCKISCARDIMAGES 00084500 THEN IF LINKWORD-PREVLINKWORD NEQ 11 00084600 THEN BLOCKISCARDIMAGES:=FALSE; 00084700 NUMBEROFLINKWORDS:=NUMBEROFLINKWORDS+1; 00084800 NOOFTAPELINES:=NOOFTAPELINES+1 00084900 +((LINKWORD-PREVLINKWORD-1)DIV 10) 00085000 +(IF(LINKWORD-PREVLINKWORD-1)MOD 10=0 00085100 THEN 0 ELSE 1); 00085200 PREVLINKWORD:=LINKWORD; 00085300 END OF CHECKFFORWARDLLINKS; 00085400 GO NOTLINKEDRECORDS; 00085500 FORWARDLINKSOK: 00085600 PREVLINKWORD:=LINKWORD; 00085700 WHILE LINKWORD:=PREVLINKWORD-VALU :=BACKWARDLINKVALUE GTR-1 00085800 DO BEGIN 00085900 IF VALU :=BACKWARDLINKVALUE=0 00086000 THEN IF LINKWORD=0 00086100 THEN GO BACKWARDLINKSOK ELSE GO NOTLINKEDRECORDS; 00086200 PREVLINKWORD:=LINKWORD; 00086300 END; 00086400 NOTLINKEDRECORDS: 00086500 NUMBEROFLINKWORDS:=NOOFTAPELINES:=0; 00086600 BLOCKISCARDIMAGES:=FALSE; 00086700 ISITALINKEDRECORD:=FALSE; 00086800 GO EXITLINKCHECK; 00086900 BACKWARDLINKSOK: 00087000 ISITALINKEDRECORD:=TRUE; 00087100 EXITLINKCHECK: END OF ISITALINKEDRECORD; 00087200 PROCEDURE DATAPRNT; 00087300 BEGIN 00087400 INTEGER POSDIV64X64,XTRAPOSDIV64,POSMOD64,ALINE,PRINTLINECHARS,POSITION,00087500 NEXTLINKLOCNCHARS,POSITIONEND,CHARSDIV40,CHARSMOD40; 00087600 INTEGER VALU; 00087700 BOOLEAN ITLOOKSLIKELINKEDRECORDS; 00087800 FORMAT NARROWBLOCKHDG("FILE "I3", BLOCK "I4", TYPE "A5 00087900 ", BLOCK LENGTH "I5", MODE "A6); 00088000 STREAM PROCEDURE TRANSFER(DISKIMAGE,PRINTLINE,POSDIV64X64, 00088100 XTRAPOSDIV64,POSMOD64,CHARSDIV40,CHARSMOD40); 00088200 VALUE POSDIV64X64,XTRAPOSDIV64,POSMOD64,CHARSDIV40,CHARSMOD40; 00088300 BEGIN DI~PRINTLINE; DS~8LIT" "; SI~PRINTLINE; DS~9WDS; 00088400 SI~DISKIMAGE; 00088500 POSDIV64X64(63(SI:=SI+63;SI:=SI+1);SI:=SI+63;SI:=SI+1); 00088600 XTRAPOSDIV64(SI:=SI+63;SI:=SI+1);SI:=SI+POSMOD64;DI:=PRINTLINE; 00088700 SI~SI-1; 00088800 CHARSDIV40(DS:=40CHR);DS:=CHARSMOD40 CHR;END; 00088900 STREAM PROCEDURE FILLONE(PRINTIMAGE,FILENO,BLOCKNO,POSITION,PRINTLINE, 00089000 PARITY,OUTSWITCH,LABSWITCH,POS2,WIDEPAPER, 00089100 CHARSDIV40,CHARSMOD40); 00089200 VALUE FILENO,BLOCKNO,POSITION,PARITY,OUTSWITCH,LABSWITCH,POS2,WIDEPAPER,00089300 CHARSDIV40,CHARSMOD40; 00089400 BEGIN 00089500 LABEL BYLABEL,NEXTFLD; 00089600 DI~PRINTIMAGE; DS~8LIT" "; SI~PRINTIMAGE; 00089700 DS~14 WDS; 00089800 WIDEPAPER( 00089900 SI~LOC OUTSWITCH; SI~SI+1; 00090000 IF SC = "C" THEN GO TO NEXTFLD; 00090100 SI~LOC PARITY; SI~SI+1; DI~PRINTIMAGE; 00090200 2(DI~DI+56); DS~7 CHR; 00090300 SI~LOC LABSWITCH; SI~SI+1; IF SC ="L" THEN GO TO BYLABEL; 00090400 SI~LOC FILENO; DI~PRINTIMAGE; 00090500 DS~3DEC; DI~DI-3; DS~3FILL; 00090600 DI~PRINTIMAGE; DI~DI+5; 00090700 SI~LOC BLOCKNO; DS~4DEC; DI~DI-4; DS~4FILL; 00090800 DI~PRINTIMAGE; DI~DI+11; 00090900 SI~LOC LABSWITCH; SI~SI+1; IF SC ="L" THEN GO TO BYLABEL; 00091000 DS~6LIT"DATA "; GO TO NEXTFLD; 00091100 BYLABEL: DI~PRINTIMAGE; DI~DI+11; DS~6LIT"LABEL "; 00091200 NEXTFLD: DI~PRINTIMAGE; DI~DI+16; 00091300 SI~LOC POSITION; 00091400 DS~5DEC; DI~DI-5; DS~5FILL; 00091500 SI~LOC POS2; DI~PRINTIMAGE; DI~DI+21; 00091600 DS~5DEC; DI~DI-5; DS~5FILL; 00091700 ); 00091800 DI:=PRINTIMAGE;WIDEPAPER(DI:=DI+28);DS:=LIT"<"; 00091900 SI:=PRINTLINE;CHARSDIV40(DS:=40CHR);DS:=CHARSMOD40 CHR; 00092000 DS~1LIT">"; 00092100 END; 00092200 IF ITLOOKSLIKELINKEDRECORDS:=ISITALINKEDRECORD 00092300 THEN BEGIN 00092400 NEXTLINKLOCNCHARS:=1; 00092500 COMMENT NOOFTAPELINES HAS BEEN SET UP IN ISITALINKEDRECORD; 00092600 END 00092700 ELSE BEGIN 00092800 NOOFTAPELINES:=THERECORDSIZE DIV 10 00092900 +(IF THERECORDSIZE MOD 10=0 THEN 0 ELSE 1); 00093000 IF THERECORDSIZE MOD 10 =0 AND LABSWITCH NEQ "LABEL " 00093100 THEN BLOCKISCARDIMAGES:=TRUE 00093200 ELSE BLOCKISCARDIMAGES:=FALSE; 00093300 END; 00093400 PRINTLINECHARS:=POSITION:=0; 00093500 FOR ALINE:=1 STEP 1 UNTIL NOOFTAPELINES 00093600 DO BEGIN 00093700 OUTSWITCH:=IF ALINE GTR 1 THEN "CONTINU"ELSE" "; 00093800 POSITION:=IF ALINE=1 THEN 1 ELSE 00093900 POSITION+PRINTLINECHARS;%AT THIS POINT PRINTLINECHAR00094000 % CONTAINS THE PREV PRINTED LINE LENGTH 00094100 POSDIV64X64:=POSITION DIV 64 DIV 64; 00094200 XTRAPOSDIV64:=POSITION DIV 64 MOD 64; 00094300 POSMOD64:=POSITION MOD 64; 00094400 PRINTLINECHARS:=IF NOT ITLOOKSLIKELINKEDRECORDS 00094500 THEN IF ALINE =NOOFTAPELINES 00094600 THEN THERECORDSIZE|8-POSITION+1 ELSE 80 00094700 ELSE 00094800 IF NEXTLINKLOCNCHARS=POSITION THEN 8 ELSE 00094900 IF POSITION+80 LSS NEXTLINKLOCNCHARS 00095000 THEN 80 ELSE NEXTLINKLOCNCHARS-POSITION; 00095100 CHARSDIV40:=PRINTLINECHARS DIV 40; 00095200 CHARSMOD40:=PRINTLINECHARS MOD 40; 00095300 POSITIONEND:=POSITION+PRINTLINECHARS-1; 00095400 IF(NOT NARROWPAPER) 00095500 OR(NARROWPAPER AND NOT BLOCKISCARDIMAGES) 00095600 OR(NARROWPAPER AND BLOCKISCARDIMAGES 00095700 AND NEXTLINKLOCNCHARS NEQ POSITION) 00095800 %THIS PREVENTS PRINTING OF LINKWORDS 00095900 %IF CARDIMAGES AND NARROWPPER 00096000 THEN BEGIN 00096100 TRANSFER(DISKIMAGE,PRINTLINE,POSDIV64X64,XTRAPOSDIV64,POSMOD6400096200 ,CHARSDIV40,CHARSMOD40); 00096300 IF LINECOUNT GEQ MAXLINES THEN OUTSWITCH :=" "; 00096400 FILLONE(PRINTIMAGE,FILENO,BLOCKNO,POSITION,PRINTLINE,PARITY, 00096500 OUTSWITCH,LABSWITCH,POSITIONEND, 00096600 IF NARROWPAPER THEN 0 ELSE 1, 00096700 CHARSDIV40,CHARSMOD40); 00096800 IF NARROWPAPER AND NOT BLOCKISCARDIMAGES 00096900 AND OUTSWITCH NEQ "CONTINU" AND LABSWITCH NEQ"LABEL " 00097000 THEN BEGIN 00097100 IF LINECOUNT+1 GEQ MAXLINES THEN TOPOFTAPEPAGE; 00097200 WRITE(PRINT,NARROWBLOCKHDG, 00097300 FILENO,BLOCKNO, 00097400 IF LABSWITCH="LABEL "THEN"LABEL"ELSE" DATA", 00097500 THERECORDSIZE|8,PARITY.[6:36]); 00097600 LINECOUNT:=LINECOUNT+1; 00097700 END; 00097800 DOONELINE; 00097900 END; 00098000 IF NEXTLINKLOCNCHARS=POSITION 00098100 THEN NEXTLINKLOCNCHARS:=NEXTLINKLOCNCHARS 00098200 +VALU:=DISKIMAGE[NEXTLINKLOCNCHARS DIV 8].[24:6]|1000 00098300 +DISKIMAGE[NEXTLINKLOCNCHARS DIV 8].[30:6]|100 00098400 +DISKIMAGE[NEXTLINKLOCNCHARS DIV 8].[36:6]|10 00098500 +DISKIMAGE[NEXTLINKLOCNCHARS DIV 8].[42:6]; 00098600 IF ITSOVER THEN ALINE:=NOOFTAPELINES; 00098700 END; 00098800 IF (NOT NARROWPAPER)OR(NARROWPAPER AND NOT BLOCKISCARDIMAGES) 00098900 THEN % DONT SPACE BETWEEN BLOCKS IF NARROWPAPER CARDIMAGES 00099000 IF LINECOUNT +1 LSS MAXLINES THEN 00099100 BEGIN WRITE(PRINT);LINECOUNT:=LINECOUNT+1;END 00099200 ELSE TOPOFTAPEPAGE; 00099300 END; 00099400 PROCEDURE LABELPRNT; 00099500 BEGIN 00099600 STREAM PROCEDURE PULLOFFID(DISKIMAGE,FILEID,MFID); 00099700 BEGIN SI~DISKIMAGE; SI~SI+9; DI~MFID; DI~DI+1; DS~7 CHR; 00099800 SI~SI+1; DI~FILEID; DI~DI+1; DS~7 CHR; END; 00099900 PULLOFFID(DISKIMAGE,FILEID,MFID); 00100000 LABSWITCH~"LABEL "; 00100100 FIRSTREAD~ FALSE; 00100200 DATAPRNT; END; 00100300 PROCEDURE TAPEMKPRNT; 00100400 BEGIN 00100500 BOOLEAN REMEMBERPUNCHIT; 00100600 STREAM PROCEDURE TPMARK(PRINTIMAGE,WIDEPAPER);VALUE WIDEPAPER; 00100700 BEGIN DI~PRINTIMAGE; DS~8LIT" "; SI~PRINTIMAGE; 00100800 DS:=14WDS;DI:=PRINTIMAGE;WIDEPAPER(DI:=DI+10); 00100900 DS:=9LIT"TAPE MARK";WIDEPAPER(DI:=DI+10); 00101000 DS:=63LIT"*";DS:=9LIT"*";WIDEPAPER(DS:=8LIT"*"); 00101100 END OF TPMARK; 00101200 TPMARK(PRINTIMAGE,IF NARROWPAPER THEN 0 ELSE 1); 00101300 IF PUNCHIT THEN BEGIN PUNCHIT:=FALSE;REMEMBERPUNCHIT:=TRUE END; 00101400 DOONELINE; 00101500 IF REMEMBERPUNCHIT THEN BEGIN REMEMBERPUNCHIT:=FALSE;PUNCHIT:=TRUE 00101600 END; 00101700 IF LINECOUNT +1 LSS MAXLINES THEN BEGIN 00101800 WRITE(PRINT);LINECOUNT:=LINECOUNT+1;END 00101900 ELSE TOPOFTAPEPAGE; 00102000 END; 00102100 PROCEDURE READTHETAPE; 00102200 BEGIN 00102300 STREAM PROCEDURE CHECKLABEL(DISKIMAGE,TLABEL); 00102400 BEGIN DI~TLABEL; DS~8LIT"0"; SI~DISKIMAGE; SI~SI+1; 00102500 DI~TLABEL; DI~DI+3; DS~ 5 CHR; END; 00102600 FORMAT BUFOVF("RECORD GTR THEN 1023 WDS- FILE ABT"); 00102700 FORMAT FMTY(2("********************"/),"** PARITY ERROR **"/, 00102800 2("********************"/)); 00102900 LABEL PARCONT; 00103000 LABEL PARBRANCH,EOFBRANCH,CONT,GETOUT; 00103100 READ(ANYTAPE[ALPHAORBINARYTAPE][NO],1,DISKIMAGE[*]) 00103200 [EOFBRANCH:PARBRANCH]; 00103300 IF ALPHAORBINARYTAPE = 1 THEN PARITY ~ "BINARY " 00103400 ELSE PARITY ~ "ALPHA "; 00103500 PARCONT:THERECORDSIZE:=RECORDSIZE(ANYTAPE[ALPHAORBINARYTAPE](0)); 00103600 IF THERECORDSIZE LEQ 1023 THEN 00103700 BEGIN 00103800 READ(ANYTAPE[ALPHAORBINARYTAPE],THERECORDSIZE,DISKIMAGE[*]) 00103900 [EOFBRANCH:PARBRANCH]; 00104000 GO TO CONT; 00104100 END 00104200 ELSE BEGIN 00104300 WRITE(SPO,BUFOVF);FINISHUP;GO GETOUT; 00104400 END; 00104500 CONT: 00104600 CHECKLABEL(DISKIMAGE,TLABEL); 00104700 IF TLABEL="LABEL" AND NOT INBLOCK THEN 00104800 BEGIN IF LABELEXPECT THEN LINECOUNT~MAXLINES; LABELPRNT; 00104900 LABELREAD~TRUE; 00105000 IF LABELEXPECT THEN BEGIN 00105100 PREREADGAVETPMK~FALSE; LABELEXPECT~FALSE; END; 00105200 IF PREREADGAVETPMK THEN LABELEXPECT ~TRUE; END 00105300 ELSE 00105400 BEGIN BLOCKNO~BLOCKNO+1; 00105500 IF FIRSTREAD THEN FILENO~FILENO+1; 00105600 IF PREREADGAVETPMK THEN BEGIN FILENO~FILENO+1; 00105700 BLOCKNO~1; END; 00105800 IF LABELEXPECT THEN BEGIN 00105900 FINISHUP; GO TO GETOUT; END; 00106000 LABELREAD~ FALSE; 00106100 PREREADGAVETPMK~FALSE; 00106200 LABSWITCH~" "; 00106300 LABELEXPECT~FALSE; 00106400 FIRSTREAD~FALSE; 00106500 INBLOCK:=TRUE; 00106600 DATAPRNT; END; 00106700 GO TO GETOUT; 00106800 PARBRANCH: PARITY~ "PARITY "; 00106900 IF LINECOUNT +5 GTR MAXLINES THEN TOPOFTAPEPAGE; 00107000 WRITE(PRINT,FMTY); LINECOUNT~LINECOUNT+6; 00107100 GO TO PARCONT; 00107200 EOFBRANCH: 00107300 IF CARDECK OR SPECIFICTAPE THEN BEGIN FINISHUP;GO GETOUT END; 00107400 PREREADGAVETPMK:=TRUE;TAPEMKPRNT; 00107500 INBLOCK:= FALSE; 00107600 IF LABELEXPECT THEN FINISHUP; 00107700 GETOUT: END; 00107800 PROCEDURE INNERLOOP; 00107900 BEGIN 00108000 LABEL EXITFROMHERE,RPT; 00108100 IF SUFFIX = "BINARY " OR SUFFIX = "ALPHA " THEN 00108200 WRITE(SPO,TAPEFILE); 00108300 LABELEXPECT~FALSE; LABELREAD ~ FALSE; 00108400 INBLOCK:=FALSE; 00108500 FILENO~BLOCKNO~0; 00108600 FIRSTREAD~TRUE; PREREADGAVETPMK~FALSE; 00108700 RPT: 00108800 READTHETAPE; 00108900 IF ITSOVER THEN GO TO EXITFROMHERE; 00109000 GO TO RPT; 00109100 EXITFROMHERE: END; 00109200 PROCEDURE TAPESECTIONOUTER; 00109300 BEGIN 00109400 SETUPDATEANDTIME; 00109500 LINECOUNT~MAXLINES; ITSOVER ~FALSE; 00109600 INNERLOOP; 00109700 END; 00109800 PROCEDURE FIRSTRECORDREAD; 00109900 BEGIN 00110000 LABEL TPEMRKREAD,BINARYPARITYERR, ENDFIRSTRECORDREAD; 00110100 LABEL BINARYREAD,NONBINARYREAD; 00110200 LABEL CHECKRECORDCOUNT,REWINDTAPE,NONBINARYPARITYERR; 00110300 FORMAT READERROR("FIRST 10 RECORDS UNREADABLE"); 00110400 FORMAT TPEMRKERR("TAPE MARK AT RECORD NO. ",I2, 00110500 "PRECEEDS VALID DATA"); 00110600 PARITYCOUNT:=RECORDCOUNT:= 0; 00110700 CHECKRECORDCOUNT: 00110800 WRITE(SPO,TAPEFILE); 00110900 PARITYCOUNT:=RECORDCOUNT:=RECORDCOUNT + 1; 00111000 IF RECORDCOUNT GTR 11 THEN BEGIN 00111100 WRITE(SOURCE[WHICHSOURCE],READERROR); 00111200 GO TO STOPRUN; 00111300 END; 00111400 IF RECORDCOUNT GTR 1 THEN 00111500 CLOSE(ANYTAPE[ALPHAORBINARYTAPE],RELEASE); 00111600 ALPHAORBINARYTAPE ~ 1; 00111700 BINARYREAD: 00111800 READ(ANYTAPE[ALPHAORBINARYTAPE],1,DISKIMAGE[*]) 00111900 [TPEMRKREAD:BINARYPARITYERR]; 00112000 REWINDTAPE: 00112100 REWIND(ANYTAPE[ALPHAORBINARYTAPE]); 00112200 GO TO ENDFIRSTRECORDREAD; 00112300 BINARYPARITYERR: 00112400 IF PARITYCOUNT GTR 1 THEN 00112500 BEGIN 00112600 PARITYCOUNT:=PARITYCOUNT - 1; 00112700 GO TO BINARYREAD; END; 00112800 CLOSE(ANYTAPE[ALPHAORBINARYTAPE],RELEASE); 00112900 ALPHAORBINARYTAPE ~0; 00113000 WRITE(SPO,TAPEFILE); 00113100 NONBINARYREAD: 00113200 READ(ANYTAPE[ALPHAORBINARYTAPE],1,DISKIMAGE[*]) 00113300 [:NONBINARYPARITYERR]; 00113400 GO TO REWINDTAPE; 00113500 NONBINARYPARITYERR: 00113600 IF PARITYCOUNT GTR 1 THEN 00113700 BEGIN 00113800 PARITYCOUNT:=PARITYCOUNT - 1; 00113900 GO TO NONBINARYREAD; 00114000 END ELSE GO TO CHECKRECORDCOUNT; 00114100 TPEMRKREAD: 00114200 IF RECORDCOUNT < 3 THEN 00114300 BEGIN 00114400 CLOSE(ANYTAPE[ALPHAORBINARYTAPE],*); 00114500 GO TO CHECKRECORDCOUNT; 00114600 END; 00114700 WRITE(SOURCE[WHICHSOURCE],TPEMRKERR,RECORDCOUNT); 00114800 GO TO STOPRUN; 00114900 ENDFIRSTRECORDREAD:END; 00115000 PROCEDURE CARDINPUT; 00115100 BEGIN 00115200 SETUPDATEANDTIME; 00115300 LABELEXPECT:=LABELREAD:=INBLOCK:=PREREADGAVETPMK:=FALSE; 00115400 FIRSTREAD:=TRUE; 00115500 LINECOUNT:=MAXLINES; 00115600 ITSOVER:=FALSE; 00115700 CARDECK:=TRUE; 00115800 ALPHAORBINARYTAPE:=1; 00115900 IF NARROWPAPER THEN REMEMBERNARROWPAPER:=TRUE; 00116000 NARROWPAPER:=TRUE; 00116100 FILL BINARYTAPE WITH 0,SUFFIX; 00116200 MFID:=0;FILEID:=SUFFIX; 00116300 WHILE NOT ITSOVER DO 00116400 READTHETAPE;% TAPE PROCEDURE SHOULD NOW RUN OK ON CARD FILE 00116500 CARDECK:=FALSE; 00116600 MFID:=FILEID:=0; 00116700 FILL BINARYTAPE WITH 0,"BINARYT"; 00116800 IF NOT REMEMBERNARROWPAPER THEN NARROWPAPER:=FALSE; 00116900 REMEMBERNARROWPAPER:=FALSE; 00117000 END OF CARDINPUT; 00117100 PROCEDURE SPECIFICTAPEFILE; 00117200 BEGIN 00117300 SPECIFICTAPE:=TRUE; 00117400 LABELEXPECT:=LABELREAD:=INBLOCK:=PREREADGAVETPMK:=FALSE; 00117500 FIRSTREAD:=TRUE; 00117600 FILENO:=BLOCKNO:=0; 00117700 IF SUFFIX ="FILEA "THEN ALPHAORBINARYTAPE:=0 00117800 ELSE ALPHAORBINARYTAPE:=1; 00117900 WRITE(SPO,SPECTAPENAMEPLS); 00118000 FETCHANDANALYZE; 00118100 FILL ANYTAPE[ALPHAORBINARYTAPE]WITH PREFIX,SUFFIX; 00118200 MFID:=PREFIX;FILEID:=SUFFIX; 00118300 SETUPDATEANDTIME;LINECOUNT:=MAXLINES;ITSOVER:=FALSE; 00118400 WHILE NOT ITSOVER DO READTHETAPE; 00118500 MFID:=FILEID:=0; 00118600 IF ALPHAORBINARYTAPE=0 THEN FILL ALPHATAPE WITH 0,"ALPHATA" 00118700 ELSE FILL BINARYTAPE WITH 0,"BINARYT"; 00118800 FILENO:=BLOCKNO:=0; 00118900 SPECIFICTAPE:= FALSE; 00119000 END OF SPECIFICTAPEFILE; 00119100 STARTTHEPROGRAM; 00119200 GETANOTHER: 00119300 FETCHANDANALYZE; 00119400 IF PREFIX="CARDECK"THEN BEGIN CARDINPUT;GO GETANOTHER END; 00119500 IF PREFIX = "TAPE " THEN 00119600 BEGIN 00119700 IF SUFFIX = "BINARY " THEN ALPHAORBINARYTAPE:= 1 00119800 ELSE 00119900 IF SUFFIX = "ALPHA " THEN ALPHAORBINARYTAPE:= 0 00120000 ELSE 00120100 IF SUFFIX = "PRINT " THEN FIRSTRECORDREAD 00120200 ELSE IF SUFFIX="FILE "OR SUFFIX="FILEA " 00120300 THEN BEGIN SPECIFICTAPEFILE;GO GETANOTHER END 00120400 ELSE GO TO NOTTAPEINPUT; 00120500 TAPESECTIONOUTER; 00120600 GO TO GETANOTHER; 00120700 NOTTAPEINPUT:END; 00120800 IF PREFIX="= " THEN ALLPREF:=SEARCHDIR:=TRUE; 00120900 IF SUFFIX="= " THEN ALLSUFF:=SEARCHDIR:=TRUE; 00121000 IF NOT SEARCHDIR 00121100 THEN BEGIN 00121200 DOYOURTHING; 00121300 GO TO GETANOTHER; 00121400 END; 00121500 DIRECKEY:=-1; 00121600 NULLFILES:=TRUE; 00121700 WHILE SEARCHDIR 00121800 DO BEGIN 00121900 DIRECKEY:=DIRECKEY+16; 00122000 READ(DIRECTORY[DIRECKEY],30,DIRECORD[*]); 00122100 FOR POINTER:=28 STEP-2 UNTIL 0 00122200 DO BEGIN 00122300 IF DIRECORD[POINTER]=76%DIRECTORY END OF FILE 00122400 THEN BEGIN 00122500 IF NULLFILES 00122600 THEN WRITE(SOURCE[WHICHSOURCE],NULLFILEGROUP, 00122700 IF ALLPREF THEN" "ELSE PREFIX.[6:36]00122800 ,IF ALLPREF THEN"="ELSE PREFIX, 00122900 IF ALLSUFF THEN"= "ELSE SUFFIX.[6:36]00123000 ,IF ALLSUFF THEN" "ELSE SUFFIX); 00123100 SEARCHDIR:=ALLPREF:=ALLSUFF:=FALSE; 00123200 POINTER:=DIRECKEY:=-50; 00123300 GO TO FREAKOUT 00123400 END; 00123500 IF ALLPREF THEN PREFIX:=DIRECORD[POINTER]; 00123600 IF ALLSUFF THEN SUFFIX:=DIRECORD[POINTER+1]; 00123700 IF DIRECORD[POINTER] NEQ 12%12 MEANS NULL ENTRY 00123800 THEN BEGIN 00123900 IF PREFIX=DIRECORD[POINTER] 00124000 AND SUFFIX=DIRECORD[POINTER+1] 00124100 THEN BEGIN 00124200 READ(DIRECTORY[DIRECKEY-16+((POINTER+2)DIV 2)],00124300 30,DIRFILEHDR[*]); 00124400 IF DIRFILEHDR[4].[10:1] NEQ 1 00124500 THEN 00124600 BEGIN 00124700 WRITE(SOURCE[WHICHSOURCE], 00124800 NEXTFILE,FORMATFILENAME); 00124900 DOYOURTHING; 00125000 NULLFILES:=FALSE; 00125100 END 00125200 ELSE WRITE(SOURCE[WHICHSOURCE],BYPASSOBJECTFILE00125300 ,FORMATFILENAME); 00125400 END; %OF PROCESSING A FILE NAME HIT 00125500 END; 00125600 FREAKOUT: 00125700 END; 00125800 END; 00125900 GO TO GETANOTHER; 00126000 STOPRUN: 00126100 END. 00126200