IN :CNSL,SOURCE CRCC(1/PLN2),T#### LIST,OBJECT #PROGRAM CRCC88/MASTER # # RE-CREATED SOURCE FOR CARD CONSOLIDATOR XPCC # ============================================ # # MAY 2014, W.J.GALLAGHER # # THIS SOURCE WHEN COMPILED UNDER PLAN4 (#XPLT) WILL BUILD # AN IMAGE FUNCTIONALLY IDENTICAL TO THE #XPCC FOUND ON A # MAGNETIC TAPE. # # TO CREATE XPCC: # 1 COMPILE AND CONSOLIDATE AS NORMAL # 2 LOAD THE #CRCC PROGRAM JUST CREATED. # 3 ASSIGN THE GPL IMAGE DECK AS *CR0 (GEORGE) OR PLACE # THE GPL DECK IN THE READER. # 4 GO#CRCC 23 # THIS WILL LOAD THE GPL INTO THE PROGRAM FOR USE LATER. # 5 SAVE OR DUMP THE PROGRAM AS APPROPRIATE. # # THE RESULTING IMAGE SHOULD BE AN IDENTICAL COPY (BAR SOME # WORDS IN LOCATIONS BELOW 45) OF THE XPCC IMAGE. # # I HAVE USED #CUE TO MAKE IMPORTANT LABELS EASILY VISIBLE # DURING THE RECREATION PROCESS. I SUSPECT THAT THEY WOULD NOT # HAVE BEEN USE SO PROFLIGATELY BY ICL. # # THE PROGRAM ALSO CAN BE COMPILED BY THE PLAN2 #XPLC CARD # COMPILER. TO DO SO THE STEERING LINE 'LIST,OBJECT' NEEDS # TO BE AT THE HEAD OF THE SOURCE. # #PAGE # # CAVEATS: # ======== # # THE PROGRAM WAS LIKELY TARGETTED ON 1901/1901A AND 1902/3 # MACHINES WITHOUT MAGNETIC STORAGE PERIPHERALS. THIS MEANS # THAT ORDERS SUCH AS BCT WERE UNAVAILABLE. THESE CONSIDERAIONS # *MIGHT* EXPLAIN THE PREFERENCE FOR MPY/DVD RATHER THAN THE # EXTRACODE CBD. (IF CCF/SCF WAS FITTED, THEN 043 & 047 WERE # STILL EXTRACODES.) # # IF ANY CHANGES ARE MADE, THEY SHOULD KEEP THIS IN MIND. # # THE PROGRAM DATES FROM AN ERA BEFORE THE REVISION OF THE # EXECUTIVE TO SUPPORT THE LATER MULTI-MEMBER/RCTP PACKAGE. # # IT WAS WRITTEN I PRESUME TO CONSOLIDATE THE BASIC PERIPHERAL # PLAN COMPILERS, SUCH AS #XPLC, AND THEREFORE MIGHT NOT # HANDLE INFORMATION FROM LATER COMPILERS IF EXPORTED TO BP # FORMAT. # #PAGE # # CONVERSION OF A SET OF SEMICOMPILED RECORDS TO A FINAL # LOADABLE BINARY IMAGE COMPRISES SEVERAL PHASES: # # 1 READING THE SEMICOMPILED RECORDS # 2 PARSING THE RECORDS READ TO DETERMINE WHETHER THEY # ARE RELEVANT AT THIS TIME # 3 FOR THOSE CARDS CONSIDERED RELEVANT, UPDATE ANY # TABLES OR LISTS USING DATA IN THE RECORD JUST READ. # 4 PUNCHING A REQUEST SLIP FOR THE GPL # 5 PUNCHING THE (OPTIONAL) GPL IMAGE # 6 PUNCH A SET OF 'CONSOLIDATED SEMI-COMPILED' CARDS # 7 THE LOADING OF THE PUNCHED GPL WITH THE ORIGINAL # SEMICOMPILED CARDS APPENDED. # 8 SAVING OF THE FINAL IMAGE # # THIS PROGRAM IMPLEMENTS PHASES 1 THROUGH 6. # PHASE 7 IS A MECHANICAL OPERATION DONE BY THE PROGRAMMER # OR OPERATOR. # PHASE 8 IS THE FINAL PHASE OF CONSOLIDATION PERFORMED BY # THE GPL (#XP0N) IMAGE, WHICH THEN READS THE CARDS OUTPUT # BY THIS PROGRAM AND THEN THE COMPILER'S OUTPUT DECK(S) # LONG WITH ANY SYSTEM AND IN-HOUSE LIBRARIES REQUIRED. # #PAGE #LOWER # DEFINITIONS OF CONSOLIDATED SEMICOMPILED RECORD TYPES # # I'M USING 'END' INSTEAD OF 'TERMINATOR' TO KEEP THE MNEMONICS # SHORT AND UNIQUE. # # NOT ALL OF THESE VALUES ARE REFERENCED IN THIS PROGRAM, BUT # PLACING THEM HERE HAS CREATED A SET OF CARDS USEFUL AT ANY # TIME CONSOLIDATED DATA IS TO BE ACCESSED. # #DEFINE SDR = #00 [ SEGMENT DATA RECORD #DEFINE SDTR = #03 [ SEGMENT DATA TITLE RECORD #DEFINE SDER = #04 [ SEGMENT DATA END RECORD #DEFINE CCMDR = #11 [ CONSOLIDATED COMMAND RECORD #DEFINE CIAR = #12 [ INLAY ADDRESS RECORD #DEFINE PSR = #13 [ PAUSE RECORD #DEFINE CLER = #14 [ CONSOLIDATED LEADER END RECORD #DEFINE CRR = #15 [ CONS. RELATIVISER RECORD #DEFINE CPR = #16 [ CONS. PARAMETER RECORD #DEFINE CCR = #17 [ CONS. CUE RECORD. #DEFINE PNR = #30 [ PRIORITY AND NAME RECORD #DEFINE CMDR = #31 [ COMMAND RECORD #DEFINE SLTR = #33 [ SEGMENT LEADER TITLE RECORD #DEFINE SLER = #34 [ SEGMENT LEADER END RECORD #DEFINE SLCR = #37 [ SEGMENT LEADER CUE RECORD #DEFINE RCR = #47 [ RECORD COUNT RECORD #DEFINE NSRR = #50 [ NEXT SUBROUTINE RECORD #DEFINE MNR = #70 [ MARK NUMBER RECORD #DEFINE SLPR = #71 [ SEGMENT LEADER POINTER RECORD #DEFINE CTBLANK = #00 [ BLANK CUE #DEFINE CTOMIT = #01 [ OMIT CUE #DEFINE CTENTRY = #02 [ ENTRY CUE #DEFINE CTCUV = #03 [ UV COMMON #DEFINE CTPERIPH = #04 [ PERIPHERAL CUE #DEFINE CTOVERLAY = #05 [ OVERLAY #DEFINE CTOVERENT = #06 [ OVERLAY ENTRY #DEFINE CTUVOC = #07 [ UV OVERCOMMON #DEFINE CTUPC = #13 [ UP COMMON #DEFINE CTUPOC = #17 [ UP OVERCOMMON #DEFINE CTLVC = #23 [ LV COMMON #DEFINE CTLVOC = #27 [ LV OVERCOMMON #DEFINE CTLPC = #33 [ LP COMMON #DEFINE CTLPOC = #37 [ LP OVERCOMMON #DEFINE CTPROGRAM = #41 [ PROGRAM #DEFINE CTUVTC = #43 [ UV TOPCOMMON #DEFINE CTOVC = #45 [ OVERLAY COMMON #DEFINE CTUCP = #53 [ UPPER PURE COMMON #DEFINE CTLCP = #73 [ LOWER PURE COMMON # THE ABOVE TYPES ARE QUITE WELL STRUCTURED AND ARE BIT-SIGNIFICANT # # WHEN BITS 4 AND 5 ARE BOTH SET, THE CUE REFERS TO A COMMON ITEM # OF SOME KIND. THE DETAILS CAN BE GLEANED FROM THE OTHER BITS. # # BIT SIGNIFICANCE # 0 0 # 1 0 # 2 0 # 3 PERIPHERAL(1), BLANK(0) # 4 0 # 5 0 # # BIT SIGNIFICANCE # 0 PROGRAM(1), OMIT(0) # 1 ? # 2 ? # 3 OVERLAY # 4 0 # 5 1 # # BIT SIGNIFICANCE # 0 'TOP' COMMON # 1 ? # 2 ? # 3 OVERLAY(1), ENTRY(0) # 4 1 # 5 0 # # BIT SIGNIFICANCE # 0 'TOP' COMMON # 1 COMMON IS IN 'LOWER' # 2 TYPE IS PRESET IF SET, VARIABLE IF UNSET # 3 'OVER' COMMON # 4 1 - FOR ALL COMMONS # 5 1 - " " " # #PAGE # # DEFINITION OF A CUE/NAMED ITEM BLOCK # # #DEFINE CBNEXT=0 [ LENGTH OF NEXT/POINTER TO NEXT #DEFINE CBVALUE=CBNEXT+1 [ TYPE & VALUE FOR THIS ITEM #DEFINE CBNAME=CBVALUE+1 [ NAME (VARIABLE LENGTH UP TO 3 WDS) # # THE TYPE AND VALUE WORD CONTAINS THE CUE TYPE IN BITS 0..5 # AND THE VALUE/ADDRESS IN BITS 6..23. THIS ALLOWS ANY ADDRESS # WITHIN 256K TO BE USED. # # # NOTE: LENGTH IS APPARENTLY HELD IN THE COUNT FIELD OF THE # POINTER ADDRESSING THE BLOCK! # # THE ACTUAL LENGTH OF A CUE BLOCK (CB) IS BETWEEN 3 AND 5, BUT THE # LENGTH ENCODED IN THE POINTER TO THE BLOCK IS THE NUMBER OF WORDS # USED TO HOLD THE NAME. # # THE NAME STRING ENDS EITHER WHEN A SPACE IS ENCOUNTERED OR WHEN # THE NUMBER OF WORDS IS EXHAUSTED. # # # LIMITATIONS: # THE NAMED ITEM LIST, IS HELD IN UPPER STORAGE WITH 660 WORDS # AND WITH THE ITEMS CONSISTING OF 3,4 OR 5 WORD BLOCKS, THE LIMIT # ON SEGMENT / CUE NAMES IS THEREFORE AT BEST 660/3 OR 220 ENTRIES # OR AT WORST 660/5 OR 132 ENTRIES. EVEN THE LOWEST OF THESE ALLOWS # FOR A *VERY* LARGE NUMBER OF CUES. I SUSPECT THAT IT IS UNLIKELY # THAT THIS VALUE COULD POSE A LIMIT. AS THE LIST IS THE UPPERMOST # AREA IN STORE, IT WOULD HAVE BEEN SIMPLE TO LOAD #XPCC WITH AN # EXTENDED AMOUNT OF AVAILABLE CORE. THE UPPER LIMIT IS WHEN IT IS # LOADED INTO 32K OF STORE (15AM ONLY), GIVING (32768-1740)/5 THE # REALLY RATHER SILLY 'LIMIT' OF 6205 CUES OR SEGMENTS. # # THERE IS NO ERROR REPORTING, SHOULD THE NAMED ITEM LIST OVERFLOW # THIS RARE EVENT IS SIGNALLED TO THE OPERATOR BY THE PROGRAM # GOING ILLEGAL. # #PAGE # NOW FOR THE ACTUAL CODE. I HAVE DETECTED THE USAGE OF 'LITERALS' # IN THE ORIGINALS AND THEY APPEAR TO ME TO FALL NATURALLY. # # ICL APPEAR TO HAVE CAREFULLY ADHERED TO THE 'ONE TRUE WAY' # AS FOUND IN THE PLAN REFERENCE MANUAL, PLAN TRAINING MANUAL, AND # VARIOUS OTHER TEXTS. THIS HAS GREATLY ASSISTED IN THE DELINEATION # OF THE VARIOUS REGIONS OF THE PROGRAM. FOR WHICH, MANY THANKS. #PAGE # # LOWER VARIABLE # ============== # #LOWER FLAG45 # RELATIVISERS # # INITIALLY THESE ARE ZERO, AND AS EACH SEGMENT IS PROCESSED THEY # SIMPLY ACCUMULATE THE RESPECTIVE SIZES. # # DURING THE RESOLUTION PHASE THESE WILL BE ALTERED TO THE BASE # ADDRESSES OF THE RESPECTIVE AREAS. # R1 [ LW R2 [ LV R3 [ R3 R4 [ LP R5 [ LT R6 [ R6 R7 [ UP R8 [ R8 R9 [ UV R10 [ R# #DEFINE NRELS=*-R1 # # MANY OF THESE NAMES COULD BE REVISED. # # IT IS SLIGHTLY DIFFICULT TO ASSIGN UNIQUELY MEANINGFUL NAMES # TO EVERY VARIABLE HERE. SOME OF THEM ARE USED FOR MULTIPLE # PURPOSES. THE NAMES USED REFLECT MY THINKING AT THE FIRST POINT # WHEN I SAW THE VARIABLE BEING USED IN CODE THAT I WAS EXAMINING. # # THE FIRST NUMBER IN THE COMMENT FIELDS IS THE ORIGINAL ADDRESS # FROM THE VERSION BEING REVERSE-ENGINEERED. THESE *MUST* MATCH # THE ADDRESSES IN THE NEWLY COMPILED VERSION. # UNK56 HEAPBASE [ 57 START OF AVAILABLE STORAGE NAMELIST [ 58 POINT TO NAMED ITEM LIST CURSEG(3) [ 59 NAME OF CURRENT SEGMENT INPSEL [ 62 WHICH INPUT BUFFER UNK63 UNK64 UNK65 PRIORS(3) [ 66 MEMBER PRIORITY WORDS UNK69 # # CARD BUFFERS HAVE AN EXTRA WORD AT THE END TO ACT AS A # 'WICKET KEEPER' TO ENSURE THAT A TERMINATING CHARACTER # CAN ALWAYS BE FOUND. # CARDBUFF1(21) [ 70 CR & CP BUFFER 1 CARDBUFF2(21) [ 91 CR & CP BUFFER 2 IDLEN [ 112 LENGTH OF IDENT ON CARDS, UNK113 GPLCARDS [ 114 NUMBER OF CARDS IN GPL IMAGE UNK115 SHRTNAME [ 116 NAME FOR CARD CHECKS UNK117 [ 117 OUTPUT SEQUENCE NUMBER UNK118 [ 118 OVERPUNCH 80 CONTROL UNK119 NOGPL [ 120 NZ TO SUPPRESS GPL PUNCHING # POSSIBLE LV FOR LP CODE PFCC [ 121 LPBUFFER(30) [ 122 LINE PRINTER BUFFER LPREPLY [ 152 REPLY TO LP ALLOT ORDER LPBUFFP [ 153 CURRENT POSITION IN LP BUFFER UNK154(7) [ 154 ??? NAME [ 161 NAME FOR CHECK IN COLS 73..76 SEQNUM [ 162 NUMBER EXPECTED ON NEXT CARD BUFFADDR [ 163 CURRBUFADR [ 164 HIGHMEMNO [ 165 HIGHEST MEMBER # IN PROG [0..2] NOCHECKS [ 166 NZ TO SUPPRESS SEQNO/NAME CHECK LOWBASE [ 167 START OF #LOWER (45,64 OR 80) PUNCHBLANK [ 168 NZ TO PUNCH 2 EXTRA BLANK CARDS SRLINK DUMP1 INIDX [ 171 INPUT BUFFER POSITION DUMP2 #UPPER GPLBUFFER(660) [ SPACE FOR 33 CARDS #XP05 IMAGE # # PUT THIS ITEM LAST TO ALLOW THE PROGRAM TO BE LOADED WITH EXTRA # STORE IF DESIRED. # HEAP(660) [ SPACE FOR CUELIST #PAGE # # LOWER PRESETS # ============= # #LOWER BUFFADDRS /CARDBUFF1 [ 173 /CARDBUFF2 [ 174 # [ 175(8) # I WOULD HAVE USE A MACRO TO BUILD THESE ENTRIES, BUT THEN # IT WOULDN'T COMPILE UNDER XPLC. # SCTABLE #00400000 [ SEGMENT DATA RECORD #37740000 [ SEGMENT LEADER CUE RECORD #33240000 [ SEGMENT LEADER TITLE RECORD #34700000 [ SEGMENT LEADER TERMINATOR RECORD #03200000 [ SEGMENT DATA TITLE RECORD #04600000 [ SEGMENT DATA TERMINATOR RECORD #13000000 [ PAUSE RECORD #30300000 [ PRIORITY AND NAME RECORD #DEFINE NTYPES=*-SCTABLE SPACES 4H XCOP 4HXCOP [ DEFAULT NAME OF GPL IMAGE RPERI REL 0 3 LOWBASES 45,64,80 [ 186..188 TABLE WHERE #LOWER STARTS L189 1/*+1-2 [ 189 C/M TO SET UP TO PRINT 'NIL' 4HNIL [ 190 AS IF IT WAS A CUENAME 8HNEEDS - [ 192 # # THIS AREA IS USED DURING THE INPUT PHASE TO HOLD NAMES (IN # IDENT AS 3 WORDS), OR IN THE PUNCHING PHASE AS A SET OF 5 # 'INLAY ADDRESSES' TREATED SIMILARLY TO RELATIVISERS. # (MORE RESEARCH REQUIRED) # IDENT 0 [ CUV WHEN OUTPUTTING XRA 0 [ CUP " " XRB 0 [ CLV " " XRC 0 [ CLP " " XRD 0 L198 0,0,0,0,0,0 [ NEEDS NAMING (MORE RELS??) L204 12H^*^ ^ ^ ;0^* [ WHAT IS THIS ABOUT - LOOKS 'PT' LOCMD 12HLO # 0^* [ LOAD CARD FOR MPOE EXECS READCR 3/0,0,80,0 [ 210 CARD READER CONTROL AREA # # TABLE OF ADDRESSES OF RELATIVISERS OR INLAY ADDRESSES # # SEE SCM 2.7.2 (I /THINK/ :-) # RELADRS /R1 /R2 /R3 /XRB /R4 /R5 /R6 /XRC /UNK56 /R7 /R8 /XRA /R9 /R10 /IDENT #DEFINE NFIXUPS=*-RELADRS [ SHOULD BE 15 # # CARD PUNCH CONTROL AREA # PUNCHCP 4/0,0,80,0 [ CARD PUNCH CONTROL AREA OOHNASTY 28H LOWER LIMIT VIOLATION RELNAMES 10HLLRLLRURUR [ 240 1ST CHAR OF RELATIVISOR NAMES 10HWV3PT6P8V# [ 243 2ND CHAR OF REL. NAMES WORK 8H # # CONTROL AREAS USED BY PRINTING CODE # WRITELP 2/0,0,121,/PFCC.3 [ 248 LINE PRINTER C/A LPTOF 2/0,0,1,/LPTOF+4.3 [ 252 LP THROW TO T.O.F. #11 [ T.O.F. # ================================================================ # # ENTRY POINTS # ============ # # 0 CONSOLIDATE, PUNCH REQUEST SLIP, GPL & CONS S/C # 1 CONSOLIDATE, PUNCH REQUEST SLIP & CONS S/C # 2 FORCE PUNCHING OF CONSOLIDATED S/C, EVEN IF BLANK CUES # REMAIN. # 3 LOAD A GPL IMAGE FROM *CR0 (UNDOCUMENTED) # # ================================================================ #PAGE #PROGRAM #CUE ENTRY1 #ENTRY 1 LDN 3 1 STO 3 NOGPL [ SAY NOT TO PUNCH GPL BRN *+2 #CUE ENTRY0 #ENTRY 0 STOZ NOGPL [ GPL WANTED LDCT 3 #400 STO 3 FLAG45 [ SET CONTEXT LDCT 3 CARDBUFF1-R1+1 [ ?? NOT SURE THE +1 IS RIGHT STOZ R1(3) BUX 3 *-1 [ RESET RELATIVISORS ETC. LDX 7 '/HEAP' [ SET UPPER STORAGE AREA STO 7 HEAPBASE # ALLOT 0 2 [ ATTEMPT TO GET AN LP LDX 2 9 STO 2 LPREPLY [ SET LP AVAILABLE FLAG # ALLOT 0 3 [ ALLOT S/C INPUT DEVICE LDX 7 9 BPZ 7 *+3 SUSWT 2HCR BRN *-4 [ WE NEED A CR # ALLOT 0 4 [ GET A CARD PUNCH LDX 7 9 BPZ 7 *+3 SUSWT 2HCP BRN *-4 # LOOP LDX 1 INPSEL [ WHICH BUFFER TO USE [0 OR 1] LDX 2 BUFFADDRS(1) LDX 7 '#20202020' [ STO 7 0(2) [ SPACEFILL CURRENT BUFFER LDX 3 2 ADN 3 1 MOVE 2 19 LDX 7 '#20001020' [ TERMINATOR STO 7 20(2) [ PLANTED AFTER EACH INPUT BUFFER LDX 6 BUFFADDRS(1) STO 6 READCR+3 [ WHERE TO READ THIS CARD PLEASE PERI 0 READCR SUSBY 0 3 [ AWAIT READING CALL 4 CDVALIDATE [ RETURNS IF OK. # # CARD IS KOSHER, LETS SEE IF WE ARE INTERESTED IN IT. # LDCH 7 0(2) [ GET TYPE BCHX 2 *+1 [ ADVANCE OVER LENGTH BCHX 2 *+1 [ SO WE POINT AT THE START OF DATA # # ANALYSE TYPE TO DETERIME WHAT ACTIONS TO TAKE, IF ANY # LDCT 3 NTYPES [ NUMBER OF INTERESTING S/C TYPES LDCH 6 SCTABLE(3) [ GET ENTRY TXU 6 7 BCC *+3 [ J IF FOUND BUX 3 *-3 [ TRY NEXT ENTRY IN TABLE BRN LOOP [ NEXT CARD - IGNORE 'UNINTERESTING' # # RECORD RECOGNISED # # THE BITS FOLLOWING THE TYPE IN THE WORD IN THE TABLE CONTROL # PROCESSING. THEIR SIGNIFICANCE IS (POSSIBLY) NOT THE SAME FOR # ALL RECORD TYPES. # LDX 4 SCTABLE(3) [ GET FULL ENTRY FOR THIS RECORD TYPE SLC 4 6 [ BNG 4 B6SET [ B6 THAT THE NAME *MUST* MATCH SLC 4 1 BNG 4 B7SET [ B7 CARD SERIAL TO BE CHECKED LDN 3 NAMELIST [ POINT AT CUE LIST LDX 3 CBNEXT(3) BNZ 3 *+3 [ J IF THERE IS AN ENTRY LDX 3 L189 [ BRN *+3 LDX 6 CBVALUE(3) BNZ 6 *-5 [ VALUE ALREADY SET, IGNORE NEW CALL 0 LPSUSB [ QUIETEN LP IF IN USE LDX 6 L189+2 [ STO 6 LPBUFFER+4 LDX 6 L189+3 STO 6 LPBUFFER+5 LDN 2 6 LDX 6 CBNAME(3) [ ADDRESS NAME BLOCK OR MESSAGE STO 6 LPBUFFER(2) ADN 2 1 BUX 3 *-3 CALL 0 LPWRITE [ DISP 2HMO [ 'MO' - CUES OR SEGEMENTS MISSING BRN LOOP P351 CALL 0 GETOCTAL [ X7 IS VALUE CALL 0 GETNAME [ IDENT ETC IS NAME CALL 0 SRCHNAME [ SEARCH FOR EXISTING CUE ENTRY CALL 0 NEWNAME [ CREATE NEW IF FAILED BZE 7 LOOP [ JUST CREATED A BLANK CUE BNZ 6 P373 LDX 5 7 SLC 5 6 ANDN 5 7 SBNC 5 3 BCC *+10 ADNC 5 1 BCS *+7 LDX 6 UNK56 STO 6 UNK65 ADX 6 7 DLA 6 UNK56 LDN 6 0 DLA 6 7 ADX 7 UNK65 STO 7 CBVALUE(1) [ UPDATE VALUE BRN LOOP P373 LDX 5 6 SLC 5 6 ANDN 5 7 SBN 5 3 BNZ 5 LOOP # COMMON, BUT NOT OVERCOMMON LDX 5 7 ORX 5 6 SLC 67 9 TXL 6 7 BCS *+2 LDX 7 6 SRC 7 9 DLA 7 5 STO 5 CBVALUE(1) BRN LOOP #PAGE # # CONVERT STRING OF DIGITS AT X2 AS OCTAL NO, UNTIL # A NON-OCTAL IS ENCOUNTERED. # #CUE GETOCTAL CALL 3 SKIPSPACES [ LDN 7 0 [ RESULT BUILDS IN X7 LDCH 6 0(2) [ GET INPUT CHARACTER SRC 6 3 SLC 67 3 BNZ 6 *+2 [ J IF NOT OCTAL DIGIT BCHX 2 *-4 SRC 67 3 [ CORRECT LAST EXTRA SHIFT EXIT 0 0 #PAGE # # INPUT A NAME (SPACE TERMINATED) TO IDENT. RETURN # X3 WITH COUNT SET TO NAME LENGTH IN WORDS. ALSO IN IDLEN # #CUE GETNAME CALL 3 SKIPSPACES LDN 3 0 LDCH 6 0(2) [ GET CHARACTER DCH 6 IDENT(3) SBN 6 #20 BZE 6 *+3 [ J IF SPACE (END OF NAME) BCHX 2 *+1 BCHX 3 *-5 LDN 6 #20 [ RE-CREATE SPACE BCHX 3 *+1 BPZ 3 *+3 DCH 6 IDENT(3) [ STORE CHAR IN IDENTIFIER BRN *-3 [ AND GET NEXT LDCT 3 0(3) [ FORM A COUNT (WORDS) STO 3 IDLEN EXIT 0 0 #PAG # # SEARCH THE CB CHAIN FOR THE CUE NAMED IN IDENT. IDLEN DEFINES # AS A COUNT, THE NUMBER OF WORDS TO BE COMPARED. # # ALSO, UPDATES UNK113 TO POINT TO CURRENT CB UNDER INVESTIGATION # SO THAT IT CAN BE REFERENCED SHOULD A NEW CB NEED TO BE ENCHAINED. # #CUE SRCHNAME LDN 1 NAMELIST STO 1 UNK113 [ CURRENT ITEM SAVE P415 LDX 6 IDENT [ FIRST WORD OF NAME LDX 1 UNK113 [ RELOAD P417 LDX 1 CBNEXT(1) [ GET FIRST/NEXT ITEM ON LIST BNZ 1 *+2 EXIT 0 0 [ NOT FOUND EXIT STO 1 UNK113 TXU 6 CBNAME(1) [ CHECK THIS PART OF THE NAME BCS P417 [ NOPE, TRY NEXT NAME IN LIST LDX 3 IDLEN [ NAME LENGTH IN WORDS P424 BUX 1 *+5 BUX 3 P415 LDX 1 UNK113 LDX 6 CBVALUE(1) [ RETURN X6 AS TYPE/VALUE EXIT 0 1 [ SUCCESSFUL RETURN BUX 3 *+2 BRN P415 LDX 6 IDENT(3) [ NEXT PART OF IDENTIFIER TXU 6 2(1) [ CHECK AGAINST CUELIST ENTRY BCS P415 BRN P424 # # ALLOCATE AND FILL IN A NEW CUE BLOCK ON THE END OF THE CUE LIST # # THIS ROUTINE IS ONLY CALLED AFTER A FAILED CALL TO SRCHNAME, SO # UNK113 WILL POINT TO THE LAST NAMED ITEM, OR TO WORD 58(HEAPBASE) # #CUE NEWNAME LDX 1 IDLEN [ LENGTH OF NAME IN WORDS (IN COUNT) ADX 1 HEAPBASE [ FORM C:M TO FREE AREA LDX 3 UNK113 [ POINTS TO TAIL END STO 1 0(3) [ APPEND TO CHAIN STO 1 UNK113 [ UPDATE TAIL END /CURR PTR # # BLOCK ENCHAINED, NOW POPULATE IT. # STOZ CBNEXT(1) [ ENSURE NO FWD LINK STOZ CBVALUE(1) [ AND MAKE A BLANK CUE LDN 3 0 LDX 6 IDENT(3) [ GET NAME WORD STO 6 CBNAME(1) [ PUT INTO BLOCK ADN 3 1 BUX 1 *-3 [ COPY ALL WORDS ADN 1 2 [ ADJUST HEAP START STO 1 HEAPBASE [ ADJUST FREE STORE START LDX 1 UNK113 [ FETCH POINTER TO ALLOCATED CB LDN 6 0 [ RETURN A TYPE/VALUE FOR BLANK EXIT 0 0 # # ADVANCE X2, ACCORDING TO ITS COUNT, UNTIL IT POINTS TO # A NON-SPACE CHARACTER. # #CUE SKIPSPACES LDCH 6 0(2) [ GET CHAR FROM INPUT BUFFER SBN 6 #20 BNZ 6 *+2 BCHX 2 *-3 EXIT 3 0 # # CONVERT VALUE IN X7 TO AN OCTAL STRING AT LOCATION ADDRESSED # BY X2. ANY LEADING ZEROS ARE OMITTED. # #CUE OCTOUT LDCT 3 8 [ MAX NO OF CHARS LDN 6 0 SLC 67 3 BNZ 6 *+5 BUX 3 *-2 [ KEEP GOING UNTIL NZ OR ALL 0 LDCT 3 1 LDN 6 0 SLC 67 3 DCH 6 0(2) BCHX 2 *+1 BUX 3 *-4 LDN 6 #20 [ APPEND A SPACE DCH 6 0(2) BCHX 2 *+1 EXIT 0 0 #PAGE # # VALIDATE A CARD IN THE BUFFER ADDRESSED BY X2 # # THE CARD MUST BE EITHER A VALID, CORRECTLY CHECKSUMMED SC # CARD OR BE ENTIRELY BLANK. # # THE PROGRAM WILL HALT 'CE' RESUMING WILL CAUSE THE CARD TO # BE IGNORED # #CUE CDVALIDATE STO 2 BUFFADDR [ SAVE BUFFER ADDRESS BCHX 2 *+1 [ POINT AT LENGTH CHAR LDCH 3 0(2) [ GET LENGTH BZE 3 CDVOK [ ZERO LENGTH -> NON-CHECKSUMMED REC LDX 2 BUFFADDR [ RESTORE ADDRESS SUM 1 0(3) BZE 1 CDVOK [ ALL LOVELY # # WE ALSO IGNORE /ENTIRELY/ BLANK CARDS # LDCT 1 20 LDX 2 163 [ GET ADDRESS LDX 3 0(2) SBX 3 SPACES BNZ 3 CDBAD BUX 2 *+1 BUX 1 *-4 CDVOK LDX 2 BUFFADDR [ RESTORE EXIT 4 0 CDBAD SUSWT 2HCE BRN LOOP [ IGNORE CARD IF BAD AND CU # # 'FINALISE' A CONSOLIDATED SEMICOMPILED CARD OR BINARY CARD # # CALULATES THE WORD LENGTH OF THE RECORD # INSERTS A CHECKSUM AT THE END OF THE RECORD # # X2 POINTS TO THE CHARACTER JUST AFTER THE END OF THE RECORD # CURRBUFADR POINTS TO THE START OF THE CURRENT BUFFER. # #CUE MAKECARD SLC 2 2 ADN 2 7 [ ADD 1.3 SRL 2 2 [ ROUNDED WORD ADDRESS LDX 1 CURRBUFADR [ SBX 2 1 [ CALCULATE THE LENGTH LDX 3 1 [ POINT TO START BCHX 3 *+1 [ TO COLUMN 2 DCH 2 0(3) [ SET LENGTH CHARACTER SUM 0 0(2) [ ADX 1 2 SBN 1 1 SBS 0 0(1) [ ADJUST SUM IN IMAGE EXIT 4 0 # # PUNCH A CARD, FROM THE CURRENT OUTPUT BUFFER # # THIS S/R WILL ONLY START THE PERI, IT THEN SWAPS THE # ACTIVE BUFFERS. # #CUE PUNCHCSC LDX 1 INPSEL [ OK, ALSO UED FOR OUTPUT LDX 1 BUFFADDRS(1) [ GET BUFFER ADDRESS CALL 0 PUNCHIT [ DO THE PUNCHING LDX 1 INPSEL [ TOGGLE ACTIVE BUFFER ERN 1 1 STO 1 INPSEL EXIT 4 0 #CUE B7SET CALL 0 GET OCTAL CALL 0 GETNAME LDX 6 NAMELIST [ HEAD OF NAME LIST SLC 4 1 [ TEST BIT 8 BNG 4 P552 SLC 4 1 [ TEST B 9 SRC 7 9 BZE 6 P530 CALL 0 SRCHNAME [ FIND CUE / SEG IN LIST BNG 7 P530 [ J IF NOT FOUND & X7-VE BZE 6 P530 [ J IF BLANK CUE FOUND P521 STOZ UNK63 LDX 1 INPSEL LDX 3 BUFFADDRS(1) LDX 1 18(3) [ NAME IN CHECK SEQ STO 1 NAME CALL 3 GETSEQNO ADN 7 1 STO 7 SEQNUM BRN LOOP P530 BNG 4 *+3 LDXC 6 FLAG45 BCS P521 SLC 7 2 LDX 3 7 SLC 3 7 ANDN 3 3 STO 3 HIGHMEMNO [ SET HIGHEST MEMBER# LDN 6 #7700 [START FORMING PRIORITY WORDS ORS 6 PRIORS(3) ORS 3 PRIORS(3) LDCT 6 #400 STO 6 UNK63 LDX 1 INPSEL LDX 3 BUFFADDRS(1) LDX 1 18(3) STO 1 NAME CALL 3 GETSEQNO ADN 7 1 STO 7 SEQNUM STO 3 NOCHECKS BRN B6SET P552 LDXC 6 UNK63 BCC LOOP LDX 3 HIGHMEMNO LDX 6 PRIORS(3) [ GET MEMBER PRIORITY SRL 6 12 [ ELIMINATE ALLBUT PRIOR CHARS BNZ 6 *+3 [ J IF ALREADY DEFINED SLL 7 12 ORS 7 PRIORS(3) LDX 6 CURSEG [ CURENT SEGMENT NAME BNZ 6 B6SET LDX 6 IDENT BPZ 6 B6SET LDX 3 IDLEN LDX 6 IDENT(3) STO 6 CURSEG(3) BUX 3 *-2 #CUE B6SET LDX 1 NOCHECKS [ IS THIS CARD TO BE SEQ. CHECKED? BNZ 1 *+2 [ J IF NOT CALL 1 CHKSEQNO STOZ NOCHECKS [ CHECK NEXT LDXC 6 UNK63 BCC LOOP LDN 6 1 ERS 6 INPSEL [ TOGGLE ACTIVE BUFFER SLC 4 1 BPZ 4 LOOP [ DONE IF B7 NOT SET IN CONTROL WORD SLC 4 1 BNG 4 *+3 [ J IF B8 STOZ UNK63 BRN LOOP SLC 4 1 BNG 4 P351 [ J IF P9 ALSO # # UPDATE RELATIVISERS # # THIS APPLIES ONLY TO SDER & SLER RECORDS. # THESE RECORDS HAVE TEN OCTAL FIELDS, ONE PER RELATIVISER # ALL THAT NEEDS TO BE DONE IS TO ADD THE RESPECTIVE VALUES # TO THE RELATIVISERS. # LDCT 1 NRELS CALL 0 GETOCTAL [ GET RELATIVISOR ADS 7 R1(1) BUX 1 *-2 [ READ THEM ALL IN LDX 7 UNK56 STO 7 UNK65 LDN 3 NAMELIST LDX 3 0(3) [ GET FIRST/NEXT ENTRY BZE 3 ALLDONE [ DONE IF END RECORD AND NO CUES LDX 6 1(3) [ GET TYPE/VALUE BNZ 6 *-3 [ SET BRN LOOP [ BLANK CUE, KEEP READING # # CHECK THE CARD SEQUENCE INFORMATION FIELD IN COLS [73..76] # # COLS 73..76 ARE THE NAME # COLS 77..80 ARE A SEQUQNCE NUMBER, WITH OPTIONAL OVERPUNCH # #CUE CHKSEQNO STO 1 UNK113 [ SAVE LINK LDX 1 INPSEL LDX 3 BUFFADDRS(1) [ GET BUFFER ADDRESS LDX 1 18(3) [ COLS 73..76 TXU 1 NAME [ IS THE NAME FIELD RIGHT? BCS *+4 CALL 3 GETSEQNO TXU 7 SEQNUM BCC *+2 SUSWT 2HES [ SEQUENCE ERROR LDX 0 0 [ I DON'T KNOW WHAT THIS FOR LDN 7 1 ADS 7 SEQNUM [ BASIC SEQUENCE NUMBER LDX 0 0 LDX 1 UNK113 [ RELOAD LINK EXIT 1 1 #CUE GETSEQNO # # OBTAINS SEQUENCE NUMBER FROM CARD, OBSERVING POSSIBLE # OVERPUNCHINGS # LDX 1 INPSEL BZE 1 *+3 LDX 5 CARDBUFF2+19 [ GET SEQUENCE FIELD FROM CARD BRN *+2 LDX 5 CARDBUFF1+19 LDCH 6 5 [ DEAL WITH COL 80 OVERPUNCHES CALL 0 GETOVER DCH 6 5 [ PUT (POSSIBLY) CORRECTED CH BACK LDN 1 0 LDCH 6 5(1) [ DEAL WITH COL 77 CALL 0 GETOVER DCH 6 5(1) ANDX 5 '#17777717' [ CORRECT VALUES LDN 6 0 LDN 7 0 LDCT 1 4 [ NO OF CHARS CDB 6 5(1) BCHX 1 *-1 EXIT 3 0 #CUE GETOVER TXU 6 '#26' [ 10,0 OVERPUNCH BCS *+3 [ J IF NOT LDN 6 0 [ CORRECTED 0 BRN *+4 [ DONE TXU 6 '#22' [ 11,0 BCS *+2 LDN 6 0 EXIT 0 0 #PAGE # # CALCULATE RELATIVISERS FOR FINAL IMAGE, WRITE # OUT CONSOLDATED RECORDS, GPL ETC IF REQUIRED # #ENTRY 2 #CUE ALLDONE #CUE ENTRY2 REL 0 3 [ WE ARE DONE WITH THE READER LDCT 3 NRELS STOZ IDENT(3) BUX 3 *-1 # # I *CURRENTLY* DON'T UNDERSTAND ANY OF THE FOLLOWING # # I THINK THAT IT BETRAYS SOME STRUCTURE IN THE NUMBERING # OF CUE TYPES. SEE S.C.M. 2.8. # # IF THE LOW 2 BITS ARE SET, THEN THE TYPE REFERS TO A # COMMON OF SOME SORT. # LDN 3 NAMELIST [ ADDRESS OF CUE LIST P644 LDX 3 CBNEXT(3) [ GET FIRST/NEXT BZE 3 P661 [ END OF LIST LDX 7 CBVALUE(3) [ GET TYPE/VALUE LDN 6 0 SLC 67 3 [ PART OF CUE TYPE->X6 LDX 2 6 [ TOP 3 BITS OF TYPE->X2 ANDN 2 3 SLC 67 3 ANDN 6 7 [ BITS 3..5 TO X6 SBN 6 3 BNZ 6 P644 [ J IF NOT 'COMMON' # [ OR IS *OVER*COMMON # DO SOMETHING 'COMMON' HERE # SRC 7 6 [ LOW 18 BITS OF VALUE LDX 0 0 LDX 6 IDENT(2) [ PICK UP RELATIVISOR ADS 7 IDENT(2) [ UPDATE RELATIVISOR DLA 6 CBVALUE(3) [ UPDATE CUE VALUE WITH OLD REL BRN P644 [ 'NEXT PLEASE' # # CLEAR CARD IMAGE BUFFERS # P661 LDCT 3 21 [ NO OF WORDS LDX 6 SPACES STOZ CARDBUFF1(3) STO 6 CARDBUFF2(3) BUX 3 *-2 # # COPY LOAD COMMAND TO CARD # LDCT 1 3 LDX 3 LOCMD(1) STO 3 CARDBUFF2(1) BUX 1 *-2 # # START TO CREATE 1ST TWO CARDS PUNCHED # # 1 LO #FRED # 2 REQUEST SLIP # LDCT 3 3 [ MAX NUMBER OF MEMBERS LDX 4 PRIORS(3) [ GET PRIORITY WORD BZE 4 P678 LDX 2 3 SLL 2 1 STO 4 CARDBUFF1+7(2) LDX 4 LOWBASES(3) STO 4 LOWBASE P678 BUX 3 *-7 [ NEXT MEMBER STOZ CARDBUFF1+8 # # CALCULATE 'SHIFT' - SIZE OF THE GPL + SIZEOF CUELIST # LDX 6 HEAPBASE [ JUST AFTER THE CUE LIST SBX 6 '1255' [ WHAT IS THIS 'MAGIC' NUMBER? SBX 6 LOWBASE ADN 6 35 SBX 6 R1 [ LW SBX 6 R2 [ LV SBX 6 R3 [ R3 SBX 6 XRB BPZ 6 *+2 LDN 6 0 [ STO 6 HEAPBASE [ VARIABLES RE-USED HERE SBX 6 R9 [ UV SBX 6 R10 [ R# SBX 6 IDENT BPZ 6 *+2 LDN 6 0 [ ADS 6 IDENT # # AT THIS POINT THE RELATIVISORS ARE SIMPLY THE TOTAL SIZE # OF THE RESPECTIVE REGIONS. # # THESE ARE NOW UPDATED, TO THE FINAL RUNTIME ADDRESSES # 1 LW IS SET TO THE START OF LOWER, AS DEFINED BY THE MEMBERS # 2 LV IS SET TO THE VALUE ORIGINALLY IN LW PLUS ITS BASE # BASE IS SET TO START OF LV + SIZE OF LV. # 3 LT IS ... # ETC. ETC. ETC. OR MORE FORMALLY: # # # BASE := 45; (* OR 64, OR 80 *) # # FOR N := 0 TO NFIXUPS DO # BEGIN # TMP := REL[N]; # REL[N] := BASE; # BASE := BASE + TMP; # END; # LDCT 2 NFIXUPS [ RELATIVISERS & INLAY ADDRESSES LDX 4 LOWBASE [ BASE := LOWBASE; P699 LDX 3 RELADRS(2) [ BEGIN LDX 7 0(3) [ TMP := REL[N]; STO 4 0(3) [ REL[N] := BASE; ADX 4 7 [ BASE := BASE + TMP; BUX 2 P699 [ END; # # CALCULATE IMAGE CORE REQUIEMENT # # WHY NOT ADN 4 #77, ANDX 4 '#77700' ? # SAME NUMBER OF WORDS USED, TO *ME* THE ABOVE IS CLEARER, # BUT MAYBE THAT WASN'T IN THE CODER'S M.O. # ADN 4 #77 [ INTO NEXT BLOCK, EXCEPT IF ALIGNED ORN 4 #77 [ THIS *COULD* BE SIMPLER ?? SBN 4 #77 [ THE ABOVE ORN ENSURE THAT THIS ZAPS # [ THE 6 LOW BITS. LDX 7 4 [ COPY FOR DECIMAL OUTPUT TO LP LATER SLC 4 9 [ PUT # OF 64 WORD BLOCKS IN TOP 9 STO 4 CARDBUFF1+3 [ REQUEST SLIP CORE REQUEST LDX 2 LPREPLY BNG 2 P718 [ SAVE MILL IF NO LP CALL 0 LPSUSB [ QUIESCE LP LDX 0 '4HCORE' [ STO 0 LPBUFFER LDX 2 '/LPBUFFER+1.2' [ ADDRESS FOR VALUE CALL 0 DECIMAL5 CALL 0 LPWRITE [ WRITE CORE NNNNN P718 LDX 7 UNK56 TXL 7 '4097' [ LIMIT+1 BCS LOWOK # # LOWER STORAGE HAS OVERFLOWED, INFORM ANYONE LISTENING # CALL 0 LPSUSB LDN 2 6 LDCT 3 RELNAMES-OOHNASTY [ LENGTH OF MESSAGE LDX 7 OOHNASTY(3) [ COPY THE MESSAGE STO 7 LPBUFFER(2) [ TO THE LINE PRINTER ADN 2 1 BUX 3 *-3 CALL 0 LPWRITE [ AND START IT WRITING DISP 2HLM [ DISPLAY: LM LOWOK LDX 7 CURSEG [ NAME BNZ 7 *+3 LDX 7 XCOP STO 7 CURSEG STO 7 CARDBUFF1+1 [ INTO REQUEST SLIP STO 7 CARDBUFF2+1 [ INTO LO #FRED CARD LDN 1 CARDBUFF2 CALL 0 PUNCHIT [ PUNCH LOAD CARD LDN 3 NAMELIST P739 LDX 3 CBNEXT(3) [ GET FIRST/NEXT CUE BZE 3 P773 [ ALL DONE LDX 7 CBVALUE(3) [ GET TYPE /ADDRESS LDN 6 0 SLC 67 3 LDX 2 6 ANDN 2 3 SLC 67 3 ANDN 6 7 SRC 7 6 BNZ 6 *+3 [ J IF NOT A BLANK CUE LDX 7 '#70077' [ VALUE FOR BLANK CUES BRN *+7 # # HERE IF NOT A BLANK CUE # SBN 6 3 LDX 5 UNK56 BNG 6 *+3 [ J IF BLANK, OMIT OR ENTRY CUE BNZ 6 *+5 [ J IF NOT UV COMMON LDX 5 IDENT(2) ADX 7 5 DLA 7 CBVALUE(3) [ UPDATE VALUE IN CUE BLOCK BRN P739 LDX 2 7 SRC 2 3 ANDN 2 7 TXU 2 '5' BCS *+3 LDN 6 2 STO 6 CARDBUFF1+19 ANDN 7 7 ADN 7 1 TXL 7 CARDBUFF1+13(2) BCS P739 STO 7 CARDBUFF1+13(2) BRN P739 P773 LDX 7 RPERI [ ORDER TO RELEASE PERIPHERAL STO 7 UNK113 [ (NEEDED BY GPL) LDX 5 CARDBUFF1+18 BZE 5 *+3 STOZ UNK113 BRN *+4 LDX 5 CARDBUFF1+16 BZE 5 *+2 STOZ UNK113 LDN 6 0 LDN 7 4 ADS 7 CARDBUFF1+19 LDCT 3 8 P786 LDX 7 CARDBUFF1+13(3) SRC 7 3 SLL 67 3 BUX 3 P786 SRC 6 6 STO 6 CARDBUFF1+2 LDN 1 14 [ ASSUME SHORT REQUEST SLIP LDX 6 CURSEG+1 TXU 6 '4H ' [ SET? BCC *+2 LDN 1 16 STO 6 CARDBUFF1+14 LDX 6 CURSEG+2 STO 6 CARDBUFF1+15 STO 1 2 SLL 2 12 ORX 2 '#73000001' [ REQUEST SLIP STO 2 CARDBUFF1 LDN 7 CARDBUFF1 SUM 6 0(1) SBS 6 CARDBUFF1+13 LDN 1 CARDBUFF1 CALL 0 PUNCHIT [ PUNCH REQUEST SLIP # # NOW PUNCH THE GPL IF PRESENT AND REQUESTED # LDX 3 GPLCARDS [ HOW MANY CARDS IN LOADER GPL IMAGE LDCT 3 0(3) [ FORM A COUNTER BZE 3 P821 [ J IF NO GPL LOADED LDX 1 NOGPL [ TEST WANTED BNZ 1 P821 # # GPL PRESENT AND WANTED # LDX 1 '/GPLBUFFER' [ START ADDRESS OF GPL IMAGE STO 1 UNK115 SUSBY 0 4 CALL 0 PUNCHIT LDX 1 UNK115 ADN 1 20 BUX 3 *-5 # # THE REQUEST SLIP AND (OPTIONAL) GPL HAVE BEEN PUNCHED # P821 LDX 1 INPSEL LDX 2 BUFFADDRS(1) STO 2 CURRBUFADR LDN 4 32 SUSBY 0 4 STO 4 UNK117 # # WRITE THE CONSOLIDATED RELATIVISER RECORD # # #15 LEN .. # # LW # LV # ETC ETC. # LDN 4 CRR [ CSC RELATIVISER RECORD DCH 4 0(2) BCHX 2 *+1 BCHX 2 *+1 [ SKIP OVER LENGTH CHAR LDCT 1 NRELS CALL 0 LPSUSB CALL 0 WRITEREL [ WRITE THIS REL NAME LDX 7 R1(1) [ CALL 0 OCTOUT BUX 1 *-3 CALL 4 MAKECARD [ FINALISE THE RELATIVISOR CARD CALL 0 LPWRITE CALL 4 PUNCHCSC LDX 2 BUFFADDRS(1) [ GET CURRENT BUFFER (ABOVE CHANGES) STO 2 CURRBUFADR # # WRITE THE CONSOLIDATED LEADER PARAMETER RECORD # # #16 LEN # # THE 'SHIFT' FACTOR # ORDER TO RELEASE THE LOAD PERIPHERAL # NAME OF THE PROGRAM AS OCTAL VALUE # LDN 4 CPR [ CSC PARAMETER RECORD DCH 4 0(2) BCHX 2 *+1 BCHX 2 *+1 [ SKIP OVER LENGTH CHAR # # 'SHIFT' FACTOR, ACCORDING TO THE FINE MANUALS, THIS IS THE SIZE OF # THE GPL AND THE STORE REQUIRED FOR THE CUE LIST IN THE GPL FOR THE # PROGRAM BEING CONSOLIDATED. - ENLIGHTENMENT AWAITS THE # DECYPHERING OF THE INNARDS OF THE GPL, SOMETHING THAT DOES NOT # APPEAR TO BE A TRIVIAL TASK. # LDX 7 HEAPBASE [ THIS IS THE ADDRESS ABOVE THE LAST # [ CUELIST BLOCK. CALL 0 OCTOUT LDX 7 UNK113 CALL 0 OCTOUT LDX 7 CURSEG [ PROGRAM NAME CALL 0 OCTOUT CALL 4 MAKECARD CALL 4 PUNCHCSC # # NOW PUNCH CUE RECORDS FOR EACH CUE # LDN 3 NAMELIST P855 LDX 3 CBNEXT(3) [ GET FIRST/NEXT BZE 3 P888 [ DONE CALL 0 LPSUSB [ LDN 2 0 [ OUTPUT INDEX (LP & CSC CARD) STO 3 UNK113 [ SAVE POINTER TO CURRENT CUE BLOCK LDX 7 CBVALUE(3) [ GET VALUE CALL 0 WRITECUE [ OUTPUT TYPE/VALUE LDX 6 CBNAME(3) [ GET NAME WORD(S) STO 6 IDENT(2) STO 6 LPBUFFER+4(2) ADN 2 1 BUX 3 *-4 [ DO ALL NAME WORDS LDX 6 SPACES STO 6 IDENT(2) LDX 2 BUFFADDRS(1) STO 2 CURRBUFADR # # WE NEED TO WRITE A 'CONSOLIDATED CUE RECORD' FOR EACH CUE # LDN 6 CCR [ CSC CUE RECORD TYPE CODE DCH 6 0(2) BCHX 2 *+1 BCHX 2 *+1 [ SKIP OVER LENGTH CHAR CALL 0 OCTOUT [ TYPE/VALUE IN OCTAL # # NOW THE CUE'S NAME # LDN 3 0 LDCH 6 IDENT(3) DCH 6 0(2) BCHX 2 *+1 BCHX 3 *+1 SBN 6 #20 BNZ 6 *-5 [ COPY UNTIL SPACE CALL 4 MAKECARD [ CHECKSUM, SET LENGTH CALL 0 LPWRITE [ CALL 4 PUNCHCSC [ AND PUNCH IT LDX 3 UNK113 [ RESTORE CURRENT CUE POINTER BRN P855 # # ALL CUES PUNCHED, ALL THAT WE NEED DO IS PUNCH THE # CONSOLIDATED LEADER TERMINATOR RECORD. # P888 LDX 2 BUFFADDRS(1) [ UPDATE CURRENT BUFFER STO 2 CURRBUFADR LDN 7 CLER [ CONS. LEADER TERMINATOR DCH 7 0(2) BCHX 2 *+1 BCHX 2 *+1 [ SKIP OVER LENGTH CHAR CALL 4 MAKECARD CALL 4 PUNCHCSC REL 0 4 [ NO MORE OUTPUT LDX 1 LPREPLY [ LEAVE THE LP AS WE'D LIKE BNG 1 *+3 [ TO FIND IT. PERI 0 LPTOF REL 0 2 [ WE'RE DONE WITH THIS TOO SUSWT 2HAE [ WE'RE DONE, LADS, PUB! BRN *-1 #PAGE # # LOAD A NEW GPL IMAGE # # THE GPL IMAGE IS LOADED INTO STORE FROM *CR0 AND HELD # AS AN ARRAY OF 20 WORD CARD IMAGES. - THEY ARE ONLY EVER # USED WHEN THE GPL IS PUNCHED BACK TO CARDS. # #ENTRY 3 #CUE ENTRY3 ALLOT 0 3 [ GPL IS LOADED FROM *CR0 LDX 7 9 BPZ 7 *+3 SUSWT 2HCR BRN *-4 # E3IGN LDN 6 0 [ COUNT CARDS IN X6 LDX 3 '/GPLBUFFER' [ WHERE THEY GO E3NXT STO 3 READCR+3 [ SET ADDRESS PERI 0 READCR SUSBY 0 3 [ READ A CARD LDX 7 0(3) [ FETCH 1ST WORD ANDN 7 #77 [ TYPE FIELD SBN 7 1 [ IS IT A REQUEST SLIP? BZE 7 E3IGN [ YES, IGNORE IT ADN 3 20 [ ADDRESS := ADDRESS+20 ADN 6 1 [ COUNT := COUNT + 1 BNG 7 E3NXT STO 6 GPLCARDS [ SET CARD COUNT FOR LATER USE REL 0 3 [ DONE WITH READER SUSWT 2HIN OBEY 20 [ IN CASE OF A GO#XPCC 0 [ NO IDEA WHAT THIS IS. #CUE PUNCHIT # # PUNCH THE CARD FROM BUFFER ADDRESSED BY X1 # STO 1 PUNCHCP+3 [ SET ADDRESS IN PERI C/A LDX 5 0(1) [ GET 1ST WORD OF BUFFER LDN 1 0 LDCH 6 5(1) [ GET TYPE TXU 6 '#73' [ GPL/REQUEST SLIP ETC BCS NOTBN LDCH 6 5 TXU 6 '1' [ REQUEST BCS NOTRQ # # PUNCHING A REQUEST SLIP # LDX 1 PUNCHCP+3 [ GET BUFFER ADDRESS LDX 5 1(1) [ GET NAME STO 5 SHRTNAME [ STORE PROGRAM NAME STOZ UNK117 [ RESET SEQUENCE NUMBER STOZ UNK118 [ OVERPUNCH CONTROL BRN *+5 NOTBN TXU 6 'CLER' [ PUNCHING A CLER? BCS *+2 [ J IF NOT STO 6 UNK118 LDX 1 PUNCHCP+3 LDX 5 SHRTNAME STO 5 18(1) [ CREATE SEQUENCING NOTRQ LDX 5 UNK117 [ GET SEQ. NO. LDN 6 0 DVD 5 '10000' [ WANT 4 DIGITS LDX 5 6 ADN 5 1 LDX 6 PUNCHCP+3 LDCT 1 4 DLA 6 1 [ X1 POINTS TO BUFFER LDN 6 0 MODE 0 [ NO ZERO SUPRESSION CBD 5 19(1) BCHX 1 *-1 [ CONVERT NUMBER LDX 1 PUNCHCP+3 LDCH 6 19(1) [ COL 77 BZE 6 *+2 ADN 6 #27 [ OVERPUNCH ADN 6 #22 DCH 6 19(1) [ PUT IN OVERPUNCHED CHAR LDX 5 UNK118 BZE 5 *+8 LDCT 6 #600 [ .3 ORX 1 6 LDCH 6 19(1) [ GET COLUMN 80 CHARACTER BZE 6 *+2 ADN 6 #12 ADN 6 #26 DCH 6 19(1) [ STORE BACK 'OVERPUNCHED' CHAR LDN 6 1 ADS 6 UNK117 ADS 5 UNK117 PERI 0 PUNCHCP [ START PUNCH STO 5 PUNCHBLANK LDX 1 PUNCHCP+3 LDX 5 SPACES SUSBY 0 4 [ AWAIT COMPLETION STO 5 0(1) [ SPACEFILL BUFFER AFTER PUNCHING LDX 5 1 LDX 6 1 ADN 6 1 MOVE 5 19 LDX 5 PUNCHBLANK [ HAVE 2 BLANK CARDS BEEN REQUESTED? BNZ 5 *+2 [ J IF YES. EXIT 0 0 PERI 0 PUNCHCP PERI 0 PUNCHCP BRN *-3 # # OUTPUT A NUMBER IN X6 AS DECIMAL, 5 DIGITS # # WHY NOT USE CBD??? # #CUE DECIMAL5 LDCT 5 5 [ NUMBER OF DIGITS BVCI *+3 BCHX 2 *+1 [ ADVANCE MPY 6 '10' DVS 6 '10000' BVC *+5 BNZ 7 *+3 LDN 7 #20 [ LEADING ZERO SUPPRESSION BVCI *+1 BVCI *+1 DCH 7 0(2) BUX 5 DECIMAL5+2 [ NEXT DIGIT BVCR *+2 DCH 6 0(2) BCHX 2 *+1 EXIT 0 0 #PAGE # # PRINTER SUPPORT # =============== # # # AWAIT COMPLETION OF LP ACTIVITY # #CUE LPSUSB STO 0 SRLINK [ SAVE LINK LDX 0 LPREPLY [ DID WE GET A PRINTER? BNG 0 LPSX [ NO, EXIT STO 1 DUMP1 LDX 0 SPACES STOZ INIDX [ WHY? SUSBY 0 2 [ AWAIT LP SILENCE STO 0 LPBUFFER LDN 0 LPBUFFER STO 0 LPBUFFP [ SAVE POINTER TO ACTIVE LP BUFFER LDN 1 LPBUFFER+1 MOVE 0 29 [ PROPAGATE THROUGH THE BUFFER LDX 1 DUMP1 LPSX LDX 0 SRLINK EXIT 0 0 # # ISSUE LP PERI # #CUE LPWRITE STO 0 SRLINK [ SAVE LINK LDX 0 LPREPLY [ DID WE GET A PRINTER? BNG 0 LPWX [ NO, EXIT LDN 0 #41 STO 0 PFCC PERI 0 WRITELP LPWX LDX 0 SRLINK EXIT 0 0 #PAGE # # WRITE A RELATIVSER NAME AND ITS VALUE TO THE LP BUFFER # # SAMPLE OUTPUT (FOLDED) # LW 45 LV 45 R3 173 LP 173 LT 257 R6 279 # UP 1080 R8 1080 UV 1080 R# 2400 # #CUE WRITEREL STO 0 SRLINK LDX 0 LPREPLY BNG 0 WREX [ NO LP, WE ARE DONE LDX 7 R1(1) [ GET RELATIVISER VALUE STO 1 DUMP1 STO 2 DUMP2 LDX 1 INIDX LDCH 0 RELNAMES(1) LDX 3 LPBUFFP [ GET 1ST CHAR OF NAME DCH 0 0(3) [ PUT INTO LP BCHX 3 *+1 LDCH 0 RELNAMES+3(1) [ GET 2ND CHARACTER DCH 0 0(3) [ TO LP BUFFER BCHX 3 *+1 LDN 2 WORK CALL 0 DECIMAL5 [ CONVERT ADDRESS TO CHARS LDCT 2 6 LDCH 0 WORK(2) [ GET CONVERTED CHAR TXU 0 '#20' [ BCC *+3 [ J IF SPACE BCHX 3 *+1 DCH 0 (3) [ INTO LP BUFFER BCHX 2 *-5 BUX 3 *+1 STO 3 LPBUFFP [ SAVE ADVANCED LP PTR BCHX 1 *+1 STO 1 INIDX LDX 1 DUMP1 LDX 2 DUMP2 WREX LDX 0 SRLINK EXIT 0 0 #PAGE # # WRITE A CUE RECORD DATA FIELD TO THE LP BUFFER # # X2 IS BUFFER POINTER # X7 IS THE VALUE TO BE PRINTED # # # WRITE A CUE TO THE LP BUFFER # # SAMPLE OUTPUTS: # 41000427 279 MASTER # 02000427 279 ENTRY1 # 02000432 282 ENTRY0 # 02000604 388 GETOCTAL # 02000615 397 GETNAME # 02000635 413 SRCHNAME # 02000663 435 NEWNAME # 02000704 452 SKIPSPACES # 02000711 457 OCTOUT # 02000730 472 CDVALIDATE # ... # #CUE WRITECUE STO 0 SRLINK LDX 0 LPREPLY BNG 0 WCEX [ EXEUNT OMNES, STAGE LEFT STO 2 DUMP1 STO 7 DUMP2 LDCT 2 8 [ NO OF DIGITS LDN 6 0 SLL 67 3 DCH 6 LPBUFFER(2) BCHX 2 *-3 LDX 7 DUMP2 ANDX 7 '#77777' [ MASK VALUE OUT LDX 2 '/LPBUFFER+2.1' CALL 0 DECIMAL5 LDX 7 DUMP2 LDX 2 DUMP1 WCEX LDX 0 SRLINK EXIT 0 0 #END #FINISH #### IN :CNSL,Q,T//// PLANCOMP *IDCRCC LF CRCCCOMPLIST //// IN :CNSL,P2COM,T//// DP 0, PLAN 2 COMPILATION OF %(*ID) WE COMERR,GO 9CE LO :LIB.PROGRAM XPLC IF NOT COR, GO9NP # CP, CR ON 22,23 AS *CR,SOURCE %(*ID) AS *LP,%(*ID)COMPLIST AS *CP,%(*ID)SEMICOMP EN 0 IF NOT HAL(END OF COMPILATION),GO 9ER IF COR,DL DP 0, COMPILATION COMPLETED IF PRE(/CONS),XPCC *ID%(*ID) IF PRE(/LIST),DOLIST *ID%(*ID) EX 9ER DP 0,COMPILATION TERMINATED /BADLY/. EX 9NP DP 0,UNABLE TO LOAD COMPILER EX 9CE DP 0,COMMAND ERROR IN MACRO IF COR,DL EX ////