/ P?S/8 ABSOLUTE BITMAP UTILITY / LAST EDIT: 09-FEB-1986 15:00:00 CJL / MUST BE ASSEMBLED WITH '/J' SWITCH SET. / P?S/8 BITMAP IS A BINARY-ORIENTED UTILITY TO CREATE A LOADING MAP OF / ALL LOCATIONS ACTUALLY LOADED BY A STREAM OF INPUT FILES WERE THEY / TO BE BINARY LOADED. THE FILES ARE NOT ACTUALLY LOADED, RATHER THEY ARE / JUST ACCOUNTED FOR IN A "BITMAP" FORMAT WHICH DISPLAYS THE COUNT / OF HOW MANY TIMES EACH AND EVERY LOCATION IN ALL OF MEMORY WAS LOADED. / THE OUTPUT OF BITMAP WILL GO TO THE SYSTEM LPT: IF AVAILABLE, ELSE TO / THE SYSTEM CONSOLE (SEE /T). ALL CONSOLE OVERLAY OPTIONS APPLY. BITMAP / RESPONDS TO THE STANDARD CONTROL CHARACTERS (<^S>/<^Q>, <^O>, , <^A>, / <^B>, <^C>). / BITMAP DOES NOT REQUIRE ANY EXTENDED MEMORY TO MAP THE ENTIRE MEMORY SPACE / FROM 00000-77777 AS IT DOES THE MAPPING ONE FIELD AT A TIME, WHICH ONLY / REQUIRES 4000 LOCATIONS. / RESTRICTIONS: / BITMAP CANNOT ACCURATELY MAP FILES CONTAINING FIELD SETTINGS TO FIELDS / LARGER THAN 7; LOADING WILL APPEAR TO BE ACCOUNTED FOR IN FIELD MODULO 10. / BITMAP CANNOT ACCURATELY DETERMINE MULTIPLE ATTEMPTS TO LOAD A LOCATION / BEYOND SIX TIMES. A "*" WILL BE USED TO INDICATE MULTIPLE LOADING OF / SEVEN OR MORE TIMES. ALL LOCATIONS WILL THEREFORE HAVE A LOAD COUNT OF / 0-6 OR "*". / MODES OF OPERATION. / BITMAP CAN BE USED IN SEVERAL MODES OF OPERATION: / MODE (A) MAP PASSED FILES. EXIT. / MODE (B) MAP PASSED FILES. CHAIN TO "BIN" WHICH LOADS THE FILES. / MODE (C) MAP PASSED FILES. CHAIN TO "BIN" WHICH PUNCHS THE FILES. / MODE (D) "PAL" CHAINS TO "MAP". PASSED FILES ARE MAPPED. EXIT. / MODE (E) "PAL" CHAINS TO "MAP". PASSED FILES ARE MAPPED. CHAIN / TO "BIN" WHICH LOADS THE FILES. / MODE (F) "PAL" CHAINS TO "MAP". PASSED FILES ARE MAPPED. CHAIN / TO "BIN" WHICH PUNCHES THE FILES. / EACH MODE OF OPERATION HAS ITS OWN OPTIONS; SEVERAL SWITCH OPTIONS HAVE / ANALOGOUS MEANINGS IN DIFFERENT MODES. / ANY MODE WHICH CHAINS TO "BIN" WILL ALWAYS DELETE THE '/P' OPTION TO / PREVENT "BIN"'S BINARY PAPER TAPE INPUT MODES. THE ACTUAL MODE OF / "BIN" OPERATION IS DETERMINED BY WHETHER '/W' IS USED. THE CHAIN TO / "BIN" WILL NOT BE PERFORMED IF "MAP" WAS CHAINED TO BY "PAL" UNLESS / THERE WERE NO ASSEMBLY ERRORS DETECTED BY "PAL". I. E., THE DOUBLE CHAIN / IMPLIED BY SUCH SYNTAX AS: ".PAL FILES/M/G" WILL BE DOWNGRADED TO: / ".PAL FILES/M" IF ANY ASSEMBLY ERRORS. THIS WILL ACTUALLY BE DETERMINED / BY "MAP" WHEN IT IS CHAINED TO (OVERLAYING "PAL"). / MODE (A): MAP PASSED FILES AND THEN EXIT. / THIS IS THE BASIC MODE OF OPERATION WHICH JUST PRODUCES THE MAP OUTPUT / AND THEN EXITS. / ALL FILES ARE CHECKED FOR BINARY VALIDITY BEFORE MAPPING; BAD FORMAT FILES / WILL CAUSE AN ERROR MESSAGE AND WILL ABORT THE MAPPING PROCESS. / MAP MODE (A) OPTIONS. / MAP %:[BOOTSTRAP] UNIT. ALL FIELDS ARE ELEGIBLE FOR MAPPING. / /A SELECT ALL FIELDS 0-7 AS ELEGIBLE FOR MAPPING. THIS IS THE / DEFAULT MODE OF OPERATION AND OVERRIDES /0-/7 IF PRESENT. / /B SAME AS PASSING NO OPTIONS. USED TO ESTABLISH %:[BOOTSTRAP UNIT] / AS THE FILE TO BE MAPPED. THIS OPTION IS IGNORED IF INPUT FILES / ARE PASSED. / /D SAME AS /B ALSO LOAD $:[BOOTSTRAP UNIT] AS A SECOND FILE. / /O ONLY USE INDIVIDUAL FIELDS IN THE RANGE 0-7 AS INDICATED BY / /0-/7. USES ALL FIELDS IF /0-/7 NOT PRESENT. / /P WIDE PRINTER FORMAT. OUTPUT CONSISTS OF GROUPS OF EIGHT / LOCATIONS SEPARATED BY SPACES. DEFAULT IS PACKED HALF-PAGES WITH / ZONE HEADERS. / /T DISABLE CHECK FOR SYSTEM LPT: AND OUTPUT TO SYSTEM CONSOLE / EVEN IF LPT: IS AVAILABLE. / /U SAME AS /B BUT CHANGES THE FILE(S) TO %:[BOOTSTRAP UNIT XOR ONE] / (AND $:[BOOTSTRAP UNIT XOR ONE] IF /D). / /0-/7 SELECT FIELD(S) FOR MAPPING. IF ONLY ONE FIELD SWITCH IS SET, / THAT SWITCH SELECTS THE LOWER LIMIT OF ELEGIBILITY FOR MAPPING; / THIS IMPLICITLY SETS THE UPPER LIMIT AS SEVEN. IF TWO FIELD / SWITCHES ARE SET, THEN SELECT ALL FIELDS FROM THE LOWER TO THE / UPPER INCLUSIVE. IF THREE OR MORE FIELD SWITCHES ARE SET, EACH / REPRESENTS AN INDIVIDUALLY SELECTED FIELD. USE OF /O MAKES ALL / PASSED FIELD SWITCHES ACT INDIVIDUALLY EVEN IF THERE ARE ONLY / ONE OR TWO PRESENT. / PASSING EXPLICIT INPUT FILES CAUSES /B, /D, /U TO BE IGNORED. / PASSED OUTPUT FILES ARE ALWAYS IGNORED AS IF NOT PASSED AND SERVE ONLY / TO WASTE SPACE IN THE FILE LIST. / MODE (B): MAP PASSED FILES THEN CHAIN TO "BIN" TO LOAD THE FILES. / THIS MODE IS USED TO MAP THE FILES AND THEN ACTUALLY LOAD THEM. ALL OF / THE OPTIONS OF MODE (A) APPLY. / RESTRICTIONS: / THE FIELD SWITCHES /1-/7 MUST NOT BE USED AS IN MODE (A) WHEN CHAINING / TO "BIN" AS THEY IMPLY THE STARTING FIELD TO THE LOADER. TO PREVENT / CONFUSION WHEN THE PROGRAM IS TO BE STARTED IN EXTENDED MEMORY, ALWAYS / USE /A TO FORCE THE FIELD SWITCHES TO BE IGNORED BY "MAP". THIS WILL / ALLOW A STARTING FIELD TO BE PASSED TO "BIN". / ADDITIONAL OPTIONS OF MODE (B). / /G CHAIN TO "BIN" AFTER MAPPING. OTHER SWITCHES MAY SELECT / ADDITIONAL LOADING OPTIONS. / /H SET /G AND FILL ALL UNPROTECTED MEMORY WITH HLT INSTRUCTIONS / (7402) BEFORE STARTING THE LOADER (P?S/8 CORE SIZE PROTECTION / APPLIES.). / /I SET /G AND RELOAD THE SYSTEM I/O ROUTINES AFTER LOADING. ALL / RESTRICTIONS ON THIS OPTION OF "BIN" APPLY. SEE "BIN" FOR / ADDITIONAL INFORMATION. / /V SET /G AND USE VIRTUAL LOADER. SEE "BIN" FOR ADDITIONAL INFORMATION. / /Z SET /G AND ZERO ALL UNPROTECTED MEMORY BEFORE STARTING THE LOADER / (P?S/8 CORE SIZE PROTECTION APPLIES.). / =NNNN STARTUP USER PROGRAM AT NNNN IN DESIGNATED FIELD. SEE "BIN" FOR / ADDITIONAL INFORMATION. / /1-/7 STARTING FIELD. SEE "BIN" FOR MORE INFORMATION. / MODE (C); MAP PASSED FILES THEN CHAIN TO "BIN" TO PUNCH THE FILES. / THIS IS ESSENTIALLY THE SAME AS MODE (B), EXCEPT THAT '/W' IS SET / TO INDICATE THAT "BIN" IS TO PUNCH THE FILES INSTEAD OF LOADING THEM. / ALL LOADING OPTIONS OF "BIN" WILL BE IGNORED AS PUNCHING HAS PRIORITY / OVER LOADING WITHIN "BIN". / THE RESTRICTION OVER /1-/7 DOES NOT APPLY, AS THESE SWITCHES ARE IGNORED / BY "BIN" WHEN IN THIS MODE. / ADDITIONAL OPTIONS. / /F SET /W AND USE HIGH-SPEED PUNCH (DEVICE 02) AS PAPER TAPE / OUTPUT DEVICE. DEFAULT IS THE CONSOLE TELETYPE EQUIPPED WITH / A PAPER TAPE PUNCH (DEVICE O4). / /G SET BY /W TO INDICATE CHAIN TO "BIN". OTHER SWITCHES WILL / DETERMINE PUNCHING OPTIONS. / /R OUTPUT IN RIM FORMAT; DEFAULT IS BIN FORMAT. / /W MUST BE PRESENT OR IMPLIED. SETS /G AND CHAINS TO "BIN" AFTER / MAPPING TO PUNCH THE FILES. SEE "BIN" FOR MORE INFORMATION. / MODE (D): "PAL" CHAINS TO "MAP" TO MAP THE NEWLY CREATED BINARY FILES. / IN THIS MODE, OUTPUT FILES OF "PAL" WILL BE MAPPED BY "MAP". THE BITMAP OUTPUT / WILL BE SPECIALLY ADAPTED TO CONFORM TO THE FORMAT OF THE "PAL" OUTPUT. / ALL BASIC OPTIONS OF MODE (A) APPLY EXCEPT FOR THE FOLLOWING: / ALL FIELD SWITCHES /0-/7 WILL BE IGNORED AND TREATED AS IF /A WERE GIVEN. / ALL FILES ORIGINALLY PROCESSED BY "PAL" AS OUTPUT FILES WILL BE MAPPED / AS INPUT FILES BY "MAP". THE ORIGINAL INPUT (SOURCE) FILES AND ANY / EXTRANEOUS OUTPUT FILES WILL BE IGNORED. / THE '/N' OPTION OF "PAL" WILL CAUSE THE BITMAP OUTPUT TO PAGINATE / ACCORDING TO THE "NEATNESS" RULES OF "PAL" WHEN CHAINING TO "MAP". / MODE (E): "PAL" CHAINS TO "MAP" TO MAP THE NEWLY CREATED BINARY FILES; / "MAP" CHAINS TO "BIN" TO LOAD THE FILES. / THIS MODE IS A COMBINATION OF MODE (B) AND MODE (D). ALL RESTRICTIONS OF / BOTH MODES APPLY. THE CHAIN TO "BIN" WILL ONLY OCCUR IF THERE WERE NO / ASSEMBLY ERRORS, ELSE THE ACTION WILL BE DOWNGRADED TO MODE (D). / MODE (F): "PAL" CHAINS TO "MAP" TO MAP THE NEWLY CREATED BINARY FILES; / "MAP CHAINS TO "BIN" TO PUNCH THE FILES. / THIS MODE IS A COMBINATION OF MODE (C) AND MODE (D). ALL RESTRICTIONS OF / BOTH MODES APPLY. THE CHAIN TO "BIN" WILL ONLY OCCUR IF THERE WERE NO / ASSEMBLY ERRORS, ELSE THE ACTION WILL BE DOWNGRADED TO MODE (D). / EQUATED SYMBOLS. BINADR= 0020 /"%" BLOCK BSGRP= 0003 /CURRENT BASE YEAR GROUP VALUE CHTEST= 3210 /P7TSF IN PAL! DOLBLK= 0040 /"$" BLOCK INCON= 0031 /EQUATED FROM CONSOLE! JMSC= JMS . /CURRENT PAGE JMS INSTRUCTION LPT= 0066 /SYSTEM LPT: DEVICE CODE MAPLEN= 2000 /LENGHT OF MAP BUFFER IN WORDS NL0001= CLA IAC /LOAD AC WITH 0001 NL0002= CLA CLL CML RTL /LOAD AC WITH 0002 NL2000= CLA CLL CML RTR /LOAD AC WITH 2000 NL4000= CLA CLL CML RAR /LOAD AC WITH 4000 NL7775= CLA CLL CMA RTL /LOAD AC WITH 7775 NL7776= CLA CLL CMA RAL /LOAD AC WITH 7776 NL7777= CLA CMA /LOAD AC WITH 7777 OUTCON= 0033 /EQUATED FROM CONSOLE! OUTLPT= 0035 /EQUATED FROM CONSOLE! REVISIO="E&77 /EDIT LEVEL SBLOCK= 7635 /SYSTEM LOADER BLOCK ARGUMENT SBOOT= 7600 /SYSTEM BOOTSTRAP ADDRESS SBTFUN= 7602 /SYSTEM BOOTSTRAP FUNCTION SCORE= 7633 /SYSTEM LOADER CORE ARGUMENT SCRSIZE=7611 /SYSTEM CORE SIZE WORD SDATE= 7610 /SYSTEM DATE WORD SFILES= 7757 /SYSTEM FILE SPECIFICATIONS SFUN= 7634 /SYSTEM LOADER FUNCTION ARGUMENT SLOAD= 7632 /SYSTEM LOADER LOCATION SOUTFLS=7607 /NUMBER OF OUTPUT FILES HERE SPARM= 7756 /SYSTEM EQUALS PARAMETER SWAL= 7604 /SWITCHES /A-/L SWMX= 7605 /SWITCHES /M-/X SWY9= 7606 /SWITCHES /Y-/9 SYSCAT= 0063 /SYSTEMS CATALOG SYSIO= 7640 /SYSTEM I/O ROUTINES ENTRY POINT SYSTART=7637 /SYSTEM LOADER START ADDRESS TTY= 0003 /SYSTEM CONSOLE DEVICE CODE VERSN= 0004 /VERSION NUMBER XPCRLF= 3246 /EQUATED FROM PAL! / DEPENDENT DEFINITIONS. JMSSYSI=SYSIO&177+JMSC /CALL TO SYSIO FROM ITS PAGE KCCIOT= TTY^10+6002 /CLEAR KEYBOARD FLAG KRBIOT= TTY^10+6006 /READ KEYBOARD BUFFER, CLEAR FLAG KRSIOT= TTY^10+6004 /READ KEYBOARD BUFFER KSFIOT= TTY^10+6001 /SKIP ON KEYBOARD FLAG LLSIOT= LPT^10+6006 /LOAD LPT: SEQUENCE LSFIOT= LPT^10+6001 /SKIP ON LPT: FLAG OUTCALL=JMS OUTCON /LOGICAL CONSOLE OUTPUT CALL TLSIOT= TTY+1^10+6006 /LOAD TELEPRINTER SEQUENCE TSFIOT= TTY+1^10+6001 /SKIP ON TELEPRINTER FLAG PAGE 0 /START AT THE BEGINNING IFNZRO . TEMP, VERSN^100+REVISION /PRELOADED WITH VERSION TEMP2, FETAB-1 /PRELOADED FOR TEMP3, FETAB-1 /ONCE-ONLY CODE BINBUT, SBOOT /OR SLOAD IF CHAINING TO "BIN" FILPTR, 0 /POINTER TO FILE SPECIFICATIONS /INITIALIZED AS SWITCH COUNTER BLKCNT, -7 /BLOCK COUNTER; INITIALIZED FOR ONCE-ONLY CODE CURFLD, .-. /CURRENT FIELD CURLOC, .-. /CURRENT MAPPED LOCATION *10 /DEFINE AUTO-INDEX AREA IFNZRO 10-. XR1, DATMSG-1 /AUTO-INDEX NUMBER 1 XR2, .-. /AUTO-INDEX NUMBER 2 GRPCNT, .-. /GROUP COUNTER LSEP, "-&77 /*** LPT: **** LSTCHR, .-. /LAST CHARACTER OUTPUTTED P7TEMP, .-. /PRINTING TEMPORARY STRMODE,0 /"*" MODE FLAG WRDCNT, .-. /WORD COUNTER *20 /GET PAST AUTO-INDEX AREA ECHOSW, 0 /ECHO SWITCH FRSTBUF,.-. /FIRST BUFFER LINCNT, -2 /LINE COUNTER MAPFLG, .-. /MAPPING FLAG (4000=IGNORE) MAPLOC, .-. /MAP BUFFER POINTER NULFLG, -1 /NULL-OUTPUT FLAG PAGNUM, 0 /PAGE NUMBER / THE FOLLOWING LITERALS ALLOW FOR INSTRUCTIONS ON THE END OF PAGE ZERO. FOO= [DCA MAPLOC] /0177 FOO= [DCA FILPTR] /0176 FOO= [TAD 172] /0175 NXTFLD= [TAD I 173] /0174 FOO= [SOUTFLS] /0173 FOO= [SFILES-1] /0172 CHKUP, .-. /CHECK FOR <^P>, ETC. ROUTINE JMS I [CTLCTST] /CHECK FOR <^C>, ETC. TAD [-"O!300] /COMPARE TO <^O> SNA /SKIP IF DIFFERENT JMP DOUO /JUMP IF IT MATCHES TAD [-"S+"O] /COMPARE TO <^S> PSYSIO, SZA CLA /SKIP IF IT MATCHES JMP I CHKUP /RETURN IF NOT JMS I [CTLCTST] /CHECK FOR <^C>, ETC. TAD [-"Q!300] /COMPARE TO <^Q> SZA CLA /SKIP IF IT MATCHES JMP .-3 /JUMP IF NOT JMP I CHKUP /RETURN IF SO DOUO, TAD ["^&177] /GET AN "^" JMS P7OUT /PRINT IT TAD ["O&177] /GET AN "O" JMS P7OUT /PRINT IT NL4000 /SET INVERSION BIT TAD ECHOSW /INVERT ECHO STATUS DCA ECHOSW /STORE IT BACK JMP I CHKUP /RETURN P7CH, .-. /SEVEN-BIT PRINT ROUTINE DCA P7TEMP /SAVE PASSED VALUE TAD P7TEMP /GET IT BACK AND [177] /JUST SEVEN BITS TAD [-12] /COMPARE TO SZA /SKIP IF IT MATCHES DCA LSTCHR /ELSE SAVE LATEST-12 FOR TESTING LATER P7AGN, JMS CHKUP /CHECK FOR <^C>, ETC. TAD ECHOSW /GET ECHO SWITCH SPA CLA /SKIP IF ECHO ON JMP P7OFF /ELSE FORGET IT TAD P7TEMP /GET THE VALUE P7TSF, TSFIOT /**** LPT: **** LSFIOT /**** CONSOLE **** CIF MCS+10 /**** LOGLPT: **** CIF MCS+10 P7JMP, JMP P7AGN /**** LPT: **** JMP P7AGN /**** CONSOLE **** JMS OUTCON /**** LOGLPT: **** JMS OUTLPT P7TLS, TLSIOT /**** LPT: **** LLSIOT /**** CONSOLE **** JMP P7AGN /**** LOGLPT: **** JMP P7AGN P7OFF, JMS CHKUP /CHECK FOR <^C>, ETC. JMP I P7CH /RETURN P7OUT, .-. /DEDICATED OUTPUT ROUTINE P7OTSF, TSFIOT /**** CONSOLE **** CIF MCS+10 P7OJMP, JMP P7OTSF /**** CONSOLE **** JMS OUTCON P7OTLS, TLSIOT /**** CONSOLE **** JMP P7OTSF L7600, CLA!400 /CLEAN UP JMP I P7OUT /RETURN PAGE / THE FOLLOWING FOUR INSTRUCTIONS ARE ACTUALLY THERE IN LITERAL FORM. /NXTFLD,TAD I [SOUTFLS] /GET OUTPUT FILE COUNT / TAD [SFILES-1] /ADJUST INPUT FILE POINTER / DCA FILPTR /SAVE FOR RETRIEVAL / DCA MAPLOC /NO LOADS IN THIS FIELD YET TAD [FETAB] /SETUP THE ELEGIBILITY DCA TEMP /TABLE POINTER TAD [-10] /SETUP TO TEST DCA TEMP2 /ALL 8 FIELDS GT1LUP, ISZ I TEMP /LOADING INTO AN AVAILABLE FIELD? SKP /NOT THIS ONE JMP GOT1 /WE GOT ONE! ISZ TEMP /BUMP TO NEXT FIELD ISZ TEMP2 /DONE ALL YET? JMP GT1LUP /NO, GO DO ANOTHER ISZ NULFLG /ANYTHING PRINTED? NNZAP2, JMS I [NEWPAGE] /**** CHAINING AND NOT /N **** 0000 TAD NULFLG /GET INDICATOR AGAIN SZA CLA /SKIP IF NOTHING MAPPED JMP I BINBUT /JUMP IF ANYTHING HAPPENED JMS I [SCRIBE] /ELSE TELL THEM NOMSG /NO INPUT JMS I [CRLF] /DO A , JMP I BINBUT /EITHER SBOOT TO BOOTSTRAP OR SLOAD TO CHAIN TO BIN GOT1, TAD TEMP /GET POINTER AND [7] /JUST FIELD BITS DCA CURFLD /SAVE AS LATEST FIELD TAD CURFLD /GET IT BACK SZA CLA /FIELD 0? NL4000 /NO, AN EXPLICIT FIELD SETTING IS REQUIRED FIRST DCA MAPFLG /SO PREVENT MAPPING INITIALLY TAD [-MAPLEN] /SETUP THE MAP DCA TEMP /BUFFER COUNTER TAD [MAPBUF-1] /SETUP THE MAP DCA XR1 /BUFFER POINTER DCA I XR1 /CLEAR A WORD L2000, ISZ TEMP /DONE ALL YET? JMP .-2 /NO, GO BACK GOTEOF, ISZ FILPTR /BUMP TO NEXT FILE TAD I FILPTR /GET THE FILE ARGUMENT SNA CLA /? JMP I [PRNMAP] /YES, GO PRINT OUT THE LATEST MAP NL7777 /INDICATE DCA FRSTBUF /FIRST BUFFER TAD INFUN /GET THE READ FUNCTION AND [7] /JUST UNIT BITS TAD INBLK /ADD ON BLOCK BITS CIA /INVERT FOR TEST TAD I FILPTR /COMPARE TO LATEST SNA CLA /SKIP IF DIFFERENT JMP DONTRD /JUMP IF EQUAL TAD I FILPTR /GET FILE ARGUMENT BACK AND [7] /JUST UNIT BITS TAD L2000/(20^100) /ADD ON 20 PAGE READ DCA INFUN /STORE INTO CALL NXTCHNK,TAD I FILPTR /GET FILE ARGUMENT AGAIN AND [7770] /JUST BLOCK BITS DCA INBLK /SAVE LATEST BLOCK NUMBER JMS I PSYSIO/[SYSIO] /CALL I/O ROUTINES INCORE, BINBUF /READ INTO HERE INFUN, 20^100+.-. /UNIT FILLED IN INBLK, .-. /BLOCK FILLED IN DONTRD, NL7777 /BACKUP TAD INCORE/(BINBUF) /SETUP THE DCA XR1 /BINARY BUFFER POINTER ISZ FRSTBUF /VALIDATED ALREADY? JMP FILOK /YES, DON'T CHECK TAD XR1 /NO, COPY THE DCA XR2 /BUFFER POINTER TAD I XR2 /GET THE FIRST WORD AND [6000] /JUST FIRST FLAG PAIR TAD I XR2 /ADD ON SECOND ORIGIN TAD [-4200] /SHOULD BE ORIGIN TO 0200 SNA CLA /SKIP IF BAD JMP FILOK /JUMP IF VALID FILE JMS I [SCRIBE] /COMPLAIN OF BDFLMSG /INVALID INPUT FILE TAD FILPTR /GET CURRENT POINTER TAD [-SFILES+1] /MAKE INTO ORIGIN ONE FILE COUNT JMS I [DECPRT] /PRINT OUT THE FILE NUMBER JMS I [CRLF] /DO A , JMP I L7600/[SBOOT] /BYE, BYE! FILOK, TAD [-20] /SETUP THE DCA BLKCNT /BLOCK COUNT NXTBLK, TAD [-22] /SETUP THE DCA GRPCNT /GROUP COUNT NXTGRP, TAD [-6] /SETUP THE DCA WRDCNT /WORD COUNTER TAD I XR1 /GET A FLAG WORD FROM THE BUFFER CLL RAR /DO INITIAL ADJUST SKP /NOT THIS TIME! GRPLUP, TAD TEMP /RETRIEVE FLAG WORD RTL /SHIFT TO NEXT LOAD WORD DCA TEMP /SAVE IT BACK TAD TEMP /GET IT AGAIN SPA CLA /SKIP IF DATA OR ORIGIN SETTING JMP EOFFLD /JUMP IF OR FIELD SETTING TAD I XR1 /GET THE WORD SNL /ORIGIN SETTING? JMP UPDATE /NO, DATA WORD DCA CURLOC /YES, UPDATE LOCATION COUNTER NXTWRD, ISZ WRDCNT /DONE WITH THIS GROUP? JMP GRPLUP /NO, GO DO ANOTHER WORD ISZ GRPCNT /YES, DONE WITH THIS BLOCK? JMP NXTGRP /NO, GO DO ANOTHER GROUP ISZ XR1 /YES, BUMP TO BEGINNING ISZ XR1 /OF THE NEXT BLOCK ISZ BLKCNT /DONE WITH THIS BUFFER? JMP NXTBLK /NO, GO DO ANOTHER BLOCK TAD [20] /YES, GET UPDATE FACTOR JMP NXTCHNK /GO READ IN ANOTHER BUFFER'S WORTH EOFFLD, SNL /SKIP IF FIELD SETTING JMP GOTEOF /JUMP IF TAD I XR1 /GET THE "CDF N" INSTRUCTION RTR;RAR /MOVE DOWN THE FIELD BITS AND [7] /JUST THE FIELD BITS TAD [FETAB] /POINT TO ELEGIBILITY ENTRY DCA TEMP2 /STASH THE POINTER TAD TEMP2 /GET IT BACK AND [7] /JUST FIELD BITS CIA /INVERT FOR TESTING TAD CURFLD /COMPARE TO CURRENT FIELD SNA CLA /SKIP IF DIFFERENT JMP SAMFLD /JUMP IF A MATCH TAD I TEMP2 /GET THE ELEGIBILITY ENTRY SPA /SKIP IF DISALLOWED NL7777 /INDICATE NEED TO MAP THIS FIELD DCA I TEMP2 /SAVE NEW ELEGIBILITY STATUS NL4000 /PREVENT CURRENT LOADING SAMFLD, DCA MAPFLG /SAVE GOOD/BAD LOADING STATUS JMP NXTWRD /GO BACK FOR MORE UPDATE, CLA /CLEAN UP TAD MAPFLG /CURRENT LOADING VALID? SPA CLA /SKIP IF SO JMP WRNGFLD /JUMP IF NOT TAD CURLOC /GET CURRENT LOCATION COUNTER CLL RAR /DIVIDE CLL RAR /BY FOUR TAD (MAPBUF) /ADD ON BUFFER BASE DCA MAPLOC /SAVE POINTER TO BUFFER WORD TAD CURLOC /GET CURRENT LOCATION COUNTER AGAIN AND (3) /JUST IN-WORD BITS CLL RAL /*2 TAD (IMTABLE-1) /ADD ON TABLE BASE DCA XR2 /STASH THE POINTER TAD I MAPLOC /GET THE MAP WORD TAD I XR2 /INCREMENT THE RIGHT NYBBLE DCA TEMP3 /SAVE IT TAD I XR2 /GET THE RIGHT NYBBLE MASK AND TEMP3 /JUST ACTIVE BITS SNA CLA /SKIP IF NO OVERFLOW JMP WRNGFLD /JUMP IF ALREADY SEVEN TAD TEMP3 /GET THE UPDATED VALUE DCA I MAPLOC /STORE BACK INTO THE MAP BUFFER WRNGFLD,JMS CHKUP /CHECK FOR <^C>, ETC. ISZ CURLOC /UPDATE CURRENT LOCATION COUNTER JMP I (NXTWRD) /GO BACK FOR MORE JMP I (NXTWRD) /JUST IN CASE! PRNMAP, TAD MAPLOC /ANY LOADS? SNA CLA /SKIP IF SO JMP NXTFLD /FORGET IT DCA NULFLG /WE WILL PRINT SOMETHING DCA CURLOC /ZERO PRINTED ADDRESS TAD [MAPBUF-1] /SETUP THE MAP DCA XR1 /BUFFER POINTER NL7776 /SETUP THE PRINTED DCA MAPFLG /PAGE COUNTER NXTPAGE,JMS I [DEJECT] /GO TO NEXT PAGE TAD [-20] /SETUP THE CORE DCA BLKCNT /PAGE COUNTER NXTCPG, JMS I [CRLF] /GOTO NEXT LINE BETWEEN CORE PAGES NL7776 /SETUP THE HALF DCA GRPCNT /PAGE COUNTER NXTLINE,TAD CURFLD /GET LATEST FIELD JMS I [OUTDIG] /PRINT IT TAD CURLOC /GET HALF-PAGE INDEX CLL RTL /\ RTL / >ADJUST TO HALF-PAGE ADDRESS RTL // JMS I [PRTOCT] /PRINT IT TAD [-20] /SETUP THE DCA TEMP2 /TEST COUNTER DCA TEMP /INDICATE NO LOADS TAD XR1 /SAVE THE CURRENT DCA XR2 /MAP BUFFER POINTER TAD I XR1 /GET 4 MAP NYBBLES SZA CLA /SKIP IF NO LOADS HERE ISZ TEMP /INDICATE LOADS PRESENT ISZ TEMP2 /TESTED ALL YET? JMP .-4 /NO, GO BACK TAD TEMP /WERE ANY LOADED? SNA CLA /SKIP IF SO JMP NOLODS /JUMP IF NOT TAD [" -"0] /FUDGE A JMS I [OUTDIG] /PRINT IT TAD [-10] /SETUP THE DCA FILPTR /8-WORD GROUP COUNTER NXT8, NL7776 /SETUP THE DCA MAPLOC /QUAD NYBBLE COUNT NXT4, NL4000 /INDICATE DCA STRMODE /"*" MODE TAD I XR2 /GET 4 NYBBLES JMS I [PRTOCT] /PRINT THEM ISZ MAPLOC /DONE 8 WORDS? JMP NXT4 /NO, GO DO 4 MORE TAD XR2 /GET THE LATEST POINTER AND [77] /JUST HALF-PAGE BITS SNA CLA /SKIP IF NOT AT END OF LINE JMP WDZAP2+1 /DON'T PRINT EXTRANEOUS TAD [" -"0] /FUDGE A WDZAP2, JMS I [OUTDIG] /**** NOT /P **** CLA!400 ISZ FILPTR /DONE THE WHOLE LINE? JMP NXT8 /NO, GO DO 8 MORE WORDS NOLODS, JMS I [CRLF] /YES, GOTO NEXT LINE ISZ CURLOC /BUMP ADDRESS INDEX ISZ GRPCNT /DONE WITH THIS PAGE? JMP NXTLINE /NO, GO DO ANOTHER HALF PAGE ISZ BLKCNT /DONE WITH THIS PRINTED PAGE? JMP NXTCPG /NO, GO DO ANOTHER CORE PAGE ISZ MAPFLG /YES, DONE WITH THIS FIELD? JMP NXTPAGE /NO, GO DO ANOTHER HALF FIELD JMP NXTFLD /YES, GO DO ANOTHER FIELD PRTOCT, .-. /OCTAL PRINT ROUTINE DCA TEMP /SAVE PASSED NUMBER TO BE PRINTED TAD [-4] /SETUP THE DCA TEMP2 /DIGIT COUNTER DIGLUP, TAD TEMP /GET THE NUMBER RTL;RAL /MOVE UP THREE BITS DCA TEMP /SAVE IT BACK TAD TEMP /GET IT AGAIN AND (3) /JUST LATEST DIGIT BITS TAD STRMODE /ADD ON "*" MODE FLAG RAL /NOW HAVE "*" MODE IN LINK AND DIGIT IN AC SNL /"*" MODE SET? JMP REGLAR /NO, JUST PRINT IT TAD [-7] /COMPARE TO MAXIMUM VALUE SNA /SKIP IF NOT 7 TAD ("*-"0-7) /FUDGE A "*" TAD [7] /RESTORE TO DIGIT OR "*" REGLAR, JMS OUTDIG /PRINT IT ISZ TEMP2 /DONE 4 YET? JMP DIGLUP /NO, GO DO ANOTHER DCA STRMODE /DEFAULT IS REGULAR MODE JMP I PRTOCT /RETURN OUTDIG, .-. /OUTPUT A DIGIT ROUTINE TAD ["0&77] /MAKE INTO A DIGIT JMS P6CH /PRINT IT JMP I OUTDIG /RETURN P6CH, .-. /PRINT SIX-BIT ROUTINE TAD [" &77] /INVERT IT AND [77] /JUST SIX-BIT TAD [" &77] /INVERT IT AGAIN JMS P7CH /PRINT IT JMP I P6CH /RETURN PAGE IFNZRO .&7 FETAB, ZBLOCK 10 /FIELD ELIGIBILITY TABLE IMTABLE,1000 /\ 7000 / \ 100 / \ 700 / \BIT INCREMENT 10 / /AND MASK TABLE 70 / / 1 / / 7 // CRLF, .-. /, ROUTINE NL7775 /-12-15 TAD LSTCHR /WAS LAST NON- OUTPUTTED A ? SNA CLA /SKIP IF NOT JMP NOCR /JUMP IF SO TAD [15] /GET A JMS P7CH /PRINT IT NOCR, TAD [12] /GET A JMS P7CH /PRINT IT ISZ LINCNT /ACCOUNT FOR IT NOP /JUST IN CASE JMP I CRLF /RETURN DECPRT, .-. /DECIMAL PRINT ROUTINE DCA TEMP /SAVE PASSED NUMBER TAD TEMP /GET IT BACK TAD [-12] /COMPARE TO 10 SPA CLA /SKIP IF GREATER THAN 9 JMP NOFRST /JUMP IF 9 OR LESS NL0001 /GET A ONE JMS I [OUTDIG] /PRINT LEADING ONE TAD [-12] /SUBTRACT 10 FROM THE NUMBER NOFRST, TAD TEMP /GET THE NUMBER JMS I [OUTDIG] /PRINT IT JMP I DECPRT /RETURN NEWPAGE,.-. /PRINT ROUTINE JMP I .+1 /GO WHEREVER CHNZAP, DOFF /**** CHAINING AND /N AND FIRST TIME **** NEWXIT DOFF, JMS PRNLFS /**** LPT: **** 0000 LPZAP1, TAD [-6] /**** LPT: **** NL7777 DCA LINCNT /STASH THE COUNT TAD LSEP /GET "-" OR JMS P7CH /PRINT IT ISZ LINCNT /DONE ENOUGH? JMP .-3 /NO, GO DO ANOTHER ONE NEWXIT, JMS CRLF /YES, DO A , NL7775 /SETUP FOR DCA LINCNT /3 'S LPZAP2, JMS PRNLFS /**** LPT: **** 0000 TAD [DOFF] /RESET FOR DCA CHNZAP /NEXT TIME JMP I NEWPAGE /RETURN PRNLFS, .-. /PRINT 'S ROUTINE JMS CRLF /DO A (MAYBE), TAD LINCNT /GET LINE COUNTER SZA CLA /SKIP IF IT OVERFLOWED JMP .-3 /JUMP IF NOT JMP I PRNLFS /RETURN DEJECT, .-. /DO A PAGE EJECT AND TITLE ROUTINE NNZAP1, JMS I [NEWPAGE] /**** CHAINING AND NOT /N **** JMP SBTIT2 TAD CURFLD /GET THE LATEST FIELD TAD [4060] /MAKE INTO MESSAGE DIGIT DCA I [HDRFLD] /STORE INTO MESSAGE JMS I [SCRIBE] /PRINT OUT HDRMSG /THE HEADER ISZ PAGNUM /BUMP UP THE PAGE NUMBER TAD PAGNUM /GET THE PAGE NUMBER JMS I [DECPRT] /PRINT IT JMS I [CRLF] /DO A , JMS I [SCRIBE] /**** AFTER FIRST TIME **** SKP SBTITL, NRESMSG /**** RESTRICTED MAPPING **** FLDMSG TAD [SKP] /PREVENT ANY DCA .-3 /FURTHER SUB-TITLES SBTIT2, TAD [-4] /SETUP FOR DCA LINCNT /4 'S JMS PRNLFS /GO PRINT THEM WDZAP1, JMP HDRXIT /**** NOT CHAINING AND NOT /P **** TAD [RAR] SETSW, DCA SW /SAVE THE INSTRUCTION TAD [-6] /SETUP FOR DCA TEMP2 /6 'S TAD [" -"0] /FUDGE A JMS I [OUTDIG] /GO PRINT IT ISZ TEMP2 /DONE 6 YET? JMP .-3 /NO, GO BACK TAD [-100] /SETUP THE DCA TEMP2 /DIGIT COUNT LUP, TAD TEMP2 /GET THE COUNTER ITSELF SW, .-. /RAR OR SKP RTR /NOW HAVE 10'S OR 1'S DIGIT AND [7] /JUST ONE DIGIT JMS I [OUTDIG] /PRINT IT ISZ TEMP2 /DONE ALL YET? JMP LUP /NO, GO BACK JMS I [CRLF] /GOTO NEXT LINE TAD SW /GET THE INSTRUCTION TAD [400] /RAR BECOMES SKP, SKP BECOMES AND 10 SPA /GONE TOO FAR? JMP SETSW /NO, GO BACK FOR A SECOND TIME NL0002 /YES, INDICATE EXTRA LINES WERE PRINTED HDRXIT, TAD [7707] /GET NEW PAGE LINE COUNT DCA LINCNT /SETUP FOR OTHERS JMP I DEJECT /RETURN JMPSBT= JMP SBTIT2 /DEFINITION NEEDED ELSEWHERE NOMSG, TEXT "NO INPUT!" HDRMSG, TEXT "MAP OF FIELD" HDRFLD, TEXT " 0 P?S BITMAP V" VERSN%12^66+VERSN+6060 REVISION^100+" -200 DAYBLB, TEXT " MON " DATMSG, TEXT "UN-DAT-ED PAGE M-";0 FLDMSG, TEXT "ELIGIBLE FIELDS:" ZEFLOC, ZBLOCK 11 /ROOM FOR GENERATED MESSAGE SCRIBE, .-. /MESSAGE OUTPUT ROUTINE TAD I SCRIBE /GET THE ADDRESS DCA TEMP3 /SAVE IT ISZ SCRIBE /BUMP PAST IT SCRLUP, TAD I TEMP3 /GET A PAIR RTR;RTR;RTR /MOVE OVER JMS SCR6CH /PRINT LEFT HALF TAD I TEMP3 /GET IT AGAIN JMS SCR6CH /PRINT RIGHT HALF ISZ TEMP3 /BUMP TO NEXT PAIR JMP SCRLUP /GO BACK FOR MORE SCR6CH, .-. /SCRIBE'S SIX-BIT ROUTINE AND [77] /JUST SIX-BIT SNA /SKIP IF NOT JMP I SCRIBE /RETURN IF IT IS JMS I [P6CH] /GO PRINT IT JMP I SCR6CH /RETURN TO SCRIBE CTLCTST,.-. /TEST FOR <^C>, ETC. CLA /CLEAN UP CHKKSF, KSFIOT /**** CONSOLE **** CIF MCS+10 CHKJMP, JMP I CTLCTST /**** CONSOLE **** JMS INCON CHKKRS, KRSIOT/OR KRBIOT /**** CONSOLE **** JMP I CTLCTST AND [177] /JUST SEVEN-BIT DCA CTLTMP /SAVE IT NL7775 /-3 TAD CTLTMP /COMPARE TO CHARACTER SNA /SKIP IF NOT <^C> ISZ I (SCRSIZE) /ELSE SET SOFT INDICATOR SPA SNA CLA /SKIP IF GREATER THAN <^C> JMP I L7600/[SBOOT] /ELSE GET OUT OF HERE CHKKCC, KCCIOT/OR 0000 /**** CONSOLE **** 0000 TAD CTLTMP /GET THE CHARACER JMP I CTLCTST /RETURN CTLTMP, .-. /TEMPORARY NRESMSG,TEXT "NO MAPPING RESTRICTIONS" BDFLMSG,TEXT "INVALID BINARY - FILE #";0 PAGE MAPBUF= . /MAP CREATED HERE IFNZRO .&177 MAP= . /MAP SYSTEM STARTS HERE MAP, JMP STRTMAP /"R MAP" MAPCHAN,JMS I (CONTEST) /TEST FOR OVERLAY SO WE CAN COMPLAIN ON RIGHT CONSOLE TAD I (LLZAP1) /GET POSSIBLY ZAPPED INSTRUCTION SNA CLA /SKIP IF PHYSICAL LPT: STILL POSSIBLE JMP CNTEST /JUMP IF LOGICAL DEVICES ONLY TAD I (CHTEST) /GET PAL'S OUTPUT TEST INSTRUCTION TAD (-TSFIOT) /COMPARE TO POSSIBLE VALUE SNA /SKIP IF OTHER JMP CHANOK /JUMP IF IT MATCHES TAD (-LSFIOT+TSFIOT)/COMPARE TO LPT: VALUE SZA CLA /SKIP IF IT MATCHES JMP STRTMAP /JUMP IF ALIEN CHAIN ATTEMPT JMP LPTOK /GO DO LPT: ZAPS CNTEST, TAD I (CHTEST) /GET PAL'S OUTPUT TEST INSTRUCTION CIA /INVERT FOR TESTING TAD I (LPCHK) /COMPARE TO LOGICAL TEST VALUE SZA CLA /SKIP IF IT MATCHES JMP STRTMAP /JUMP IF ALIEN CHAIN ATTEMPT TAD I (CHTEST+1) /GET THE OUTPUT CALL INSTRUCTION TAD (-OUTCALL) /COMPARE TO WHAT IT SHOULD BE SNA /SKIP IF DIFFERENT JMP CHANOK /JUMP IF IT MATCHES TAD (-OUTLPT+OUTCON)/COMPARE TO LOGICAL LPT: VALUE SZA CLA /SKIP IF IT MATCHES JMP STRTMAP /JUMP IF ALIEN CHAIN ATTEMPT LPTOK, DCA DOLPT /INDICATE LPT: ZAPS CHANOK, DCA I (COMZAP) /FORCE "/P"-LIKE OUTPUT IF CHAINING JMS I (COMMON) /DO COMMON ONCE-ONLY STUFF DOLPT, SKP /**** LPT: **** 0000 JMS I (ZAPLPT) /DO LPT: ZAPS IF ENABLED NL7777 /FORCE AT LEAST DCA I PFETAB /ONE PASS STBLUP, ISZ PFETAB /BUMP TO NEXT NL4000 /MAKE EACH ONE DCA I PFETAB /ELEGIBLE ISZ BLKCNT /DONE ALL YET? JMP STBLUP /NO, GO BACK NL2000 /GET /N MASK AND I (SWMX) /JUST /N SNA CLA /SKIP IF SET JMP STPEJCT /JUMP IF NOT TAD (NEWXIT) /MAKE IT NOT DO A DCA I (CHNZAP) /THE FIRST TIME MSTART, DCA LINCNT /CLEAR THE LINE COUNT JMP NXTFLD /GO START IT UP STPEJCT,TAD (JMPSBT) /DELETE THE DCA I (NNZAP1) /TITLES DCA I (NNZAP2) /DELETE THE 'S JMP MSTART /CONTINUE THERE / COMES HERE IF "R MAP" OR NON-PAL CHAIN. STRTMAP,DCA I (XPCRLF) /INDICATE NO PAL ERRORS FOR CHAINING TAD I (SWAL) /GET /A SPA CLA /SKIP IF OFF JMP DOALL /JUMP IF ON TAD I (SWY9) /GET THE NUMERIC SWITCHES AND (1774) /JUST /0-/7 SNA /SKIP IF ANY ON DOALL, TAD (1774) /SET THEM ALL ON CLL RTL /DO INITIAL ADJUST DCA TEMP /SAVE THE BITS FLOOP, ISZ TEMP2 /BUMP TO NEXT TABLE ENTRY L1000, TAD TEMP /GET THE SWITCH BITS SNA /SKIP IF ANY STILL THERE JMP DUNPRS /JUMP IF ALL GONE CLL RAL /MOVE UP DCA TEMP /SAVE THEM BACK SNL /THIS ONE SET? JMP FLOOP /NO, GO DO ANOTHER ONE NL4000 /YES, MAKE THIS FIELD DCA I TEMP2 /ELEGIBLE FOR MAPPING ISZ FILPTR /INDICATE HOW MANY WERE SET JMP FLOOP /GO DO ANOTHER ONE DUNPRS, ISZ TEMP3 /BUMP TO NEXT ENTRY TAD I TEMP3 /GET A TABLE ENTRY SMA CLA /SKIP IF ELEGIBLE JMP DUNPRS /JUMP IF NOT NL7777 /MAKE IT MAP DCA I TEMP3 /THE LOWEST ELEGIBLE ONE TAD I (SWMX) /GET /O AND L1000/(1000) /JUST /O SZA CLA /SKIP IF NOT SET JMP I (ESETDN) /JUMP IF IT IS SET NL7776 /-2 TAD FILPTR /DID WE GET LESS THAN 3? SMA SZA /SKIP IF SO JMP I (ESETDN) /JUMP IF NOT SZA /ONLY ONE? DCA I (FETAB+7) /YES, MAKE THE OTHER ONE /7 (IMPLIED) FILLUP, ISZ TEMP3 /BUMP TO NEXT TAD I TEMP3 /GET ANOTHER ENTRY SPA CLA /SKIP IF IT'S OFF JMP I (ESETDN) /JUMP IF IT'S NOT NL4000 /MAKE IT DCA I TEMP3 /ELEGIBLE JMP FILLUP /KEEP GOING PFETAB, FETAB /POINTER TO FIELD TABLE PAGE ESETDN, TAD [-10+2] /GOT EXACTLY 8 FIELDS? SNA CLA /SKIP IF NOT JMP TRYP /JUMP IF SO TAD (FLDMSG) /CHANGE THE DCA I (SBTITL) /MESSAGE POINTER NL7777 /INDICATE NO DCA TEMP3 /LEADING "," MAKMSG, TAD I FTABPTR /GET AN ENTRY SMA CLA /SKIP IF ELEGIBLE JMP NOTELG /JUMP IF NOT NL4000 /GET A SHIFTED ISZ TEMP3 /SHOULD BE A COMMA? TAD (",-" ^100) /YES, CHANGE IT DCA I PUTPTR /PUT INTO THE HEADER TAD FTABPTR /GET THE POINTER ITSELF AND [7] /JUST FIELD BITS TAD ["0&77] /MAKE INTO ASCII TAD I PUTPTR /GET THE OLD PAIR DCA I PUTPTR /STORE THEM BOTH BACK ISZ PUTPTR /BUMP TO NEXT PAIR NOTELG, ISZ FTABPTR /BUMP TO NEXT ENTRY ISZ FTABCT /DONE ALL YET? JMP MAKMSG /NO, GO BACK TRYP, JMS CONTEST /TEST FOR CONSOLE SUPPORT TAD I (SWMX) /GET /M-/X SWITCHES AND [20] /JUST /T SWITCH SZA CLA /SKIP IF OFF JMP LPFAIL /JUMP IF ON NL7777 /SETUP AN EXTENDED OUTINIT,LLSIOT /**** CONSOLE **** JMS I (LPWAIT) CLA /CLEAN UP TAD [" &177] /GET A LPJMS, JMS I (LPWAIT) /TRY TO OUTPUT IT AFTER TAD [" &177] /GET ANOTHER JMS I (LPWAIT) /TRY TO OUTPUT IT AFTER TAD [15] /GET A JMS I (LPWAIT) /TRY TO OUTPUT IT AFTER DCA I (LPTMZAP) /NOW IT WILL WAIT FOR ALL CHARACTERS TAD [" &177] /GET A JMS I (LPWAIT) /OUTPUT IT TAD [15] /GET A JMS I (LPWAIT) /OUTPUT IT TAD [12] /GET A JMS I (LPWAIT) /OUTPUT IT TAD [14] /GET A JMS I (LPWAIT) /OUTPUT IT DCA I (COMZAP) /FORCE "/P"-LIKE OUTPUT IF USING LPT: DCA DOLPT2 /ENABLE LPT: ZAPS LPFAIL, JMS I (COMMON) /DO COMMON STUFF DOLPT2, SKP /**** LPT: **** 0000 JMS I (ZAPLPT) /DO LPT: ZAPS IF ENABLED JMP NXTFLD /GO START IT UP CONTEST,.-. /CONSOLE TEST ROUTINE TAD I L7600/[SBOOT] /GET BOOTSTRAP INSTRUCTION TAD (-JMSSYSIO) /COMPARE TO POSSIBLE VALUE SNA CLA /SKIP IF DIFFERENT JMP CHKCOVRLAY /JUMP IF IT MATCHES ISZ I (CHKKRS) /TURN "KRSIOT" ISZ I (CHKKRS) /INTO "KRBIOT" DCA I (CHKKCC) /DESTROY "KCCIOT" CHKCOVR,NL0002 /SET "C" BIT MASK AND I (SCRSIZE) /GET THE BIT SNA CLA /SKIP IF SET JMP I CONTEST /ELSE JUST RETURN TAD I (SCRSIZE) /GET THE CORE SIZE WORD RTR;RAR /MOVE DOWN THE MCS BITS AND (70) /JUST MCS BITS TAD (CIF 10) /MAKE INTO "CIF MCS+10" DCA I (CHKKSF) /STORE OVER THE "KSFIOT" TAD I (CHKJMP) /GET THE "JMP I CTLCTST" DCA I (CHKKRS) /STORE OVER THE "KRSIOT" OR "KRBIOT" TAD (JMS INCON) /GET INPUT CALL DCA I (CHKJMP) /STORE OVER THE "JMP I CTLCTST" DCA I (CHKKCC) /DESTROY THE "KCCIOT" TAD I (CHKKSF) /GET THE "CIF MCS+10" DCA P7TSF /STORE OVER "TSFIOT" TAD P7JMP /GET "JMP P7AGN" DCA P7TLS /STORE OVER "TLSIOT" TAD (JMS OUTCON) /GET OUTPUT CALL DCA P7JMP /STORE OVER "JMP P7AGN" TAD P7TSF /GET "CIF MCS+10" DCA P7OTSF /STORE OVER "TSFIOT" TAD P7OJMP /GET "JMP P7OTSF" DCA P7OTLS /STORE OVER "TLSIOT" TAD P7JMP /GET "JMS OUTCON" DCA P7OJMP /STORE OVER "JMP P7OTSF" TAD I (CHKKSF) /GET THE "CIF MCS+10" DCA I (LPCHK) /STORE OVER THE "LSFIOT" TAD I (LPJMP) /GET THE "JMP LPTIME" DCA I (LPRNT) /STORE OVER THE "LLSIOT" TAD (JMS OUTLPT) /GET LPT: OUTPUT CALL DCA I (LPJMP) /STORE OVER THE "JMP LPTIME" TAD LPJMS /GET "JMS I (LPWAIT)" DCA OUTINIT /STORE OVER "LLSIOT" DCA I (LLZAP1) /INDICATE LOGICAL LPT: ZAPS JMP I CONTEST /RETURN FTABPTR,FETAB /POINTER TO FIELD TABLE FTABCT, -10 /FIELD COUNTER PUTPTR, ZEFLOC /WHERE TO PUT ELEGIBLE FIELDS IN HEADER PAGE DECIMAL /MAKE IT EASIER BSGROUP,BSGRP /CURRENT BASE YEAR GROUP VALUE COMMON, .-. /COMMON INITIALIZING ROUTINE REM, TAD I (SDATE) /GET THE DATE WORD JMS DIVIDE /DIVIDE BY 372 372 /TO GET YEAR YEAR, DCA YEAR /SAVE IT TAD REM /GET DAYS LEFT IN YEAR JMS DIVIDE /DIVIDE BY 31 TO GET 31 /MONTH (ORIGIN ZERO) MONTH, DCA MONTH /SAVE IT NL0001 /MAKE ORIGIN ONE TAD REM /GET DAY OF THE MONTH DAY, DCA DAY /SAVE IT TAD YEAR /GET THE YEAR TAD (3) /ROUND UP FOR LEAP YEARS CLL RAR /DIVIDE CLL RAR /BY FOUR LPYRCT, DCA LPYRCT /SAVE AS EXTRA LEAP DAYS COUNT TAD YEAR /GET THE YEAR AGAIN AND (3) /JUST LEAP BITS SNA CLA /SKIP IF NOT A LEAP YEAR ISZ FEBENT /BUMP FEBRUARY IF IT IS TAD MONTH /GET THE MONTH CMA /INVERT FOR COUNTING MONCNT, DCA MONCNT /SAVE IT JMP .+3 /JUMP INTO IT TAD I ENTPTR /GET A PREVIOUS MONTH'S COUNT ISZ ENTPTR /BUMP TO NEXT ISZ MONCNT /DONE ENOUGH MONTHS? JMP .-3 /NO, GO DO ANOTHER ONE TAD DAY /ADD ON DAY TAD YEAR /ADD ON YEAR TAD LPYRCT /ADD ON EXTRA LEAP DAYS TAD BSGROUP /\ TAD BSGROUP / >ADD ON BASE INFLUENCE TAD BSGROUP // JMS DIVIDE /DIVIDE BY 7 TO GET 7 /DAY OF THE WEEK CLA /THROW QUOTIENT AWAY TAD REM /GET THE REMAINDER CLL RAL /*2 FOR DOUBLE-WORDS TAD (DAYS-1) /ADD ON TABLE POINTER DCA XR1 /STASH IT TAD (DAYBLB+1-1) /GET MESSAGE POINTER DCA XR2 /STASH IT TAD I XR1 /GET A DAY WORD DCA I XR2 /STORE INTO MESSAGE TAD I XR1 /GET OTHER DAY WORD DCA I XR2 /STORE INTO MESSAGE OCTAL /BACK TO NORMAL ISZ XR2 /BUMP TO DATE FIELD TAD DAY /GET DAY OF THE MONTH JMS DIVIDE /DIVIDE BY 10 TO 12 /GET TEN'S DIGIT TAD ["0&77] /MAKE IT ASCII CLL RTL;RTL;RTL /MOVE UP TAD REM /ADD ON UNIT'S DIGIT TAD ["0&77] /MAKE IT ASCII ALSO DCA I XR2 /STORE INTO THE MESSAGE TAD MONTH /GET THE MONTH CLL RAL /*2 FOR DOUBLE-WORDS TAD (MONLST-1) /ADD ON LIST POINTER DCA XR1 /STASH IT TAD I XR1 /GET A MONTH PAIR DCA I XR2 /STORE INTO MESSAGE TAD I XR1 /GET THE OTHER PAIR DCA I XR2 /STORE INTO MESSAGE TAD BSGROUP /GET GROUP CLL RTL;RAL /*8 TAD YEAR /ADD ON RELATIVE YEAR TAD (74) /ADD ON (19)60 JMS DIVIDE /DIVIDE 144 /BY 100 CLA /THROW AWAY QUOTIENT TAD REM /GET THE REMAINDER 60-99 OR 00-59 JMS DIVIDE /DIVIDE BY 10 TO GET 12 /THE TEN'S DIGIT TAD ("-^100+"0-200) /GET "-" AND MAKE IT ASCII DCA I XR2 /STORE INTO MESSAGE TAD REM /GET THE UNIT'S DIGIT CLL RTL;RTL;RTL /MOVE UP TAD ("0^100+" -200) /MAKE IT ASCII AND ADD ON A DCA I XR2 /STORE INTO MESSAGE JMS I (COMORE) /DO FURTHER STUFF THERE JMP I COMMON /RETURN DIVIDE, .-. /DIVIDE ROUTINE DCA REM /SAVE IN REMAINDER DCA TEMP3 /CLEAR QUOTIENT TAD REM /GET IT BACK STL CIA /INVERT SKP /DON'T FIRST TIME DVLOOP, ISZ TEMP3 /BUMP UP QUOTIENT TAD I DIVIDE /ADD ON ARGUMENT SNA SZL /UNDERFLOW? JMP DVLOOP /NO, KEEP GOING CIA /YES, INVERT IT BACK TAD I DIVIDE /RESTORE LOST VALUE DCA REM /SAVE AS REMAINDER TAD TEMP3 /GET THE QUOTIENT ISZ DIVIDE /BUMP PAST ARGUMENT JMP I DIVIDE /RETURN ENTPTR, JANENT /POINTER TO MONTH LENGTH TABLES DECIMAL /MAKE IT EASIER JANENT, 31 /31 DAYS IN JANUARY FEBENT, 28 /29 IN LEAP YEAR! 31 /31 DAYS IN MARCH 30 /30 DAYS IN APRIL 31 /31 DAYS IN MAY 30 /30 DAYS IN JUNE 31 /31 DAYS IN JULY 31 /31 DAYS IN AUGUST 30 /30 DAYS IN SEPTEMBER 31 /31 DAYS IN OCTOBER 30 /30 DAYS IN NOVEMBER / 31 /31 DAYS IN DECEMBER OCTAL /BACK TO NORMAL PAGE COMORE, .-. /CONTINUATION OF ONCE-ONLY CODE TAD I (SWMX) /GET /M-/X AND [400] /JUST /P COMZAP, SZA CLA /**** CHAINING **** 0000 JMP PEON /JUMP IF IT'S ON TAD (TAD [RAR]) /GET INSTRUCTION DCA I (WDZAP1) /MAKE IT DO ZONES TAD L7600/[CLA!400] /REMOVE SPACE BETWEEN EVERY 8 BITS DCA I (WDZAP2) /ON NARROW OUTPUT DEVICES PEON, CLA /CLEAN UP TAD I (SOUTFLS) /GET OUTPUT FILE COUNT TAD [SFILES] /POINT TO FIRST INPUT FILE DCA TEMP2 /STASH IT TAD I TEMP2 /GET THE FIRST FILE SZA CLA /SKIP IF NO INPUT FILE JMP TESTFR /JUMP IF ANY INPUT FILES DCA I (SOUTFLS) /DESTROY OUTPUT FILES TAD [SFILES] /SETUP POINTER DCA TEMP2 /TO NEW ONES TAD I (SBTFUN) /GET BOOTSTRAP FUNCTION AND [7] /JUST UNIT BITS TAD [BINADR] /ADD ON "%" BITS DCA I TEMP2 /STORE AS FIRST FILE TAD I (SWMX) /GET SWITCHES /M-/X AND [10] /JUST /U SNA CLA /SKIP IF ON JMP TESTD /JUMP IF OFF TAD I TEMP2 /GET THE FIRST FILE CLL RAR /MOVE LOW-ORDER TO LINK CML RAL /INVERT AND MOVE BACK DCA I TEMP2 /STORE XOR-ED VALUE TESTD, TAD I (SWAL) /GET SWITCHES /A-/L AND [400] /JUST /D SNA CLA /SKIP IF SET JMP BDUXIT /JUMP IF OFF TAD I TEMP2 /GET FIRST FILE TAD [DOLBLK-BINADR] /UPDATE TO "$" VALUE ISZ TEMP2 /BUMP TO NEXT SLOT DCA I TEMP2 /STORE AS SECOND FILE BDUXIT, ISZ TEMP2 /BUMP TO NEXT SLOT DCA I TEMP2 /STORE AT END OF LIST TESTFR, TAD I (XPCRLF) /GET ERROR INDICATOR SZA CLA /SKIP IF NO ERRORS COMBAK, JMP I COMORE /JUMP IF ERRORS TAD I (SWAL) /GET SWITCHES /A-/L AND (100) /JUST /F SNA /SKIP IF SET TAD I (SWMX) /ELSE GET SWITCHES /M-/X AND (100) /JUST /R SNA CLA /SKIP IF /F OR /R SET JMP TESTG /JUMP IF NEITHER SET NL7775 /SETUP /W MASK AND I (SWMX) /REMOVE OLD /W TAD (2) /OR IN NEW /W BIT DCA I (SWMX) /STORE ALL BACK TESTG, TAD I [SPARM] /GET EQUALS PARAMETER IAC /COMPARE TO 7777 SZA CLA /SKIP IF NONE GIVEN JMP DOGEE /JUMP IF ANYTHING GIVEN TAD I (SWAL) /GET SWITCHES /A-/L AND (170) /JUST /F, /G, /H, /I SZA CLA /SKIP IF NONE GIVEN JMP DOGEE /JUMP IF ANY GIVEN TAD I (SWMX) /GET SWITCHES /M-/X AND (106) /JUST /R, /V, /W SZA CLA /SKIP IF NONE GIVEN JMP DOGEE /JUMP IF ANY GIVEN NL2000 /SET /Z MASK AND I (SWY9) /GET /Z BIT SNA CLA /SKIP IF SET JMP I COMORE /JUMP IF NOT DOGEE, TAD I (SWMX) /GET SWITCHES /M-/X AND (-400-1) /REMOVE /P BIT DCA I (SWMX) /STORE ALL BACK TAD I (SBTFUN) /GET BOOTSTRAP FUNCTION AND [7] /JUST UNIT BITS DCA I (SFUN) /SAVE FOR OTHERS TAD I (SFUN) /GET IT BACK TAD [4^100] /ADD ON READ BITS DCA CATFUN /STORE IN-LINE JMS I PSYSIO/[SYSIO] /\ CATPTR, BINBUF / \READ IN THE CATFUN, 4^100+.-. / /SYSTEMS CATALOG SYSCAT // LNL7777,NL7777 /BACKUP TAD CATPTR /GET CATALOG START JMP I (LOOK) /CONTINUE THERE ZAPLPT, .-. /LPT: ZAP ROUTINE DCA I (DOFF) /NO EXTRA 'S TAD LNL7777/(NL7777)/MAKE IT DO DCA I (LPZAP1) /ONLY ONE DCA I (LPZAP2) /PREVENT TRAILING 'S TAD [14] /GET A DCA LSEP /USE INSTEAD OF "-" LLZAP1, SKP /**** CONSOLE **** 0000 JMP LLZAPS /USE LOGICAL LPT: ZAPS INSTEAD TAD I (LPCHK) /GET THE "LSFIOT" DCA P7TSF /STORE OVER THE "TSFIOT" TAD I (LPRNT) /GET THE "LLSIOT" DCA P7TLS /STORE OVER THE "TLSIOT" JMP I ZAPLPT /RETURN LLZAPS, TAD (JMS OUTLPT) /GET LOGICAL LPT: OUTPUT CALL DCA P7JMP /STORE OVER THE "JMS OUTCON" JMP I ZAPLPT /RETURN PAGE LKUPLP, TAD ENTCNT /GET LEFTOVER COUNT CMA /INVERT TAD XR1 /ADD ON POINTER TAD (3) /ADJUST TO NEXT ENTRY LOOK, DCA XR1 /SAVE IT BACK TAD (BINNAM-1) /GET NAME ADDRESS DCA XR2 /STASH IT NL7775 /SETUP THE DCA ENTCNT /LOOKUP COUNT TAD I XR1 /GET A CATALOG WORD SNA /END OF CATALOG? JMP NOBIN /BARF SKP /DON'T NEED IT AGAIN COMPLP, TAD I XR1 /GET A CATALOG WORD CIA /INVERT FOR TEST TAD I XR2 /COMPARE TO A NAME WORD SZA CLA /SKIP IF IT MATCHES JMP LKUPLP /FORGET IT ISZ ENTCNT /LOOKED FOR ENOUGH WORDS YET? JMP COMPLP /NO, GO BACK TAD I XR1 /YES, GET THE STARTING BLOCK NUMBER DCA I (SBLOCK) /SAVE IN THE SYSTEM LOADER BLOCK ARGUMENT TAD I XR1 /GET THE COMPOSITE WORD DCA TEMP /SAVE IT TAD TEMP /GET IT BACK AND L7600/[7600] /JUST PAGE BITS DCA I (SCORE) /SAVE AS CORE ARGUMENT IN LOADER TAD TEMP /GET IT AGAIN AND (37) /JUST LENGTH BITS CLL RTL;RTL;RTL /MOVE UP TAD I (SFUN) /ADD ON BOOTSTRAP UNIT BITS DCA I (SFUN) /SAVE AS FUNCTION WORD TAD I XR1 /GET THE STARTING ADDRESS AND L7600/[7600] /JUST PAGE BITS IAC /BUMP UP FOR CHAINING DCA I (SYSTART) /SAVE IN LOADER STARTUP ADDRESS TAD (SLOAD) /MAKE IT GO TO THE LOADER DCA BINBUT /INSTEAD OF BOOTSTRAPPING JMP I (COMBAK) /FINISH THERE NOBIN, JMS I [SCRIBE] /COMPLAIN OF BNFMSG /MISSING BIN JMP I L7600/[SBOOT] /BYE, BYE! ENTCNT, .-. /ENTRY COUNTER BNFMSG, TEXT "BIN NOT FOUND!";0 LPWAIT, .-. /LPT: TIME-OUT ROUTINE DCA LPTEMP /SAVE PASSED VALUE LPAGN, TAD LPTEMP /GET IT BACK LPCHK, LSFIOT /**** CONSOLE **** CIF MCS+10 LPJMP, JMP LPTIME /**** CONSOLE **** JMS OUTLPT LPRNT, LLSIOT /**** CONSOLE **** JMP LPTIME TAD [7700] /RESET THE DCA LPTMOUT /TIME-OUT COUNTER JMP I LPWAIT /RETURN LPTIME, ISZ I (COMMON) /WASTE JMP LPTIME /SOME TIME CLA /CLEAN UP LPTMZAP,ISZ LPTMOUT /**** ZAPPED **** 0000 JMP LPAGN /TRY AGAIN JMP I (LPFAIL) /GIVE UP AND JUST USE CONSOLE LPTEMP, .-. /TEMPORARY LPTMOUT,-100 /LPT: TIME-OUT FACTOR BINNAME,TEXT "BIN";0 /CHAIN TO "BIN" MONLST, TEXT "-JAN" /JANUARY TEXT "-FEB" /FEBRUARY TEXT "-MAR" /MARCH TEXT "-APR" /APRIL TEXT "-MAY" /MAY TEXT "-JUN" /JUNE TEXT "-JUL" /JULY TEXT "-AUG" /AUGUST TEXT "-SEP" /SEPTEMBER TEXT "-OCT" /OCTOBER TEXT "-NOV" /NOVEMBER TEXT "-DEC" /DECEMBER DAYS, TEXT " THU" /DAYS OF THE WEEK TEXT " FRI" TEXT " SAT" TEXT " SUN" TEXT " MON" TEXT " TUE" TEXT " WED" PAGE NOPUNCH /TURN OFF BINARY OUTPUT *MAPBUF+MAPLEN /DEFINE END OF MAP BUFFER BINBUF= . /BINARY INPUT BUFFER HERE *BINBUF+4000 /END OF BINARY INPUT BUFFER; MUST BE LESS THAN 7600! ENPUNCH /RESUME BINARY OUTPUT $ /HERE COME THE LITERALS!