/ WPSR.PA - 278 MULTI KEY SORT / **************** / * EDIT HISTORY * / **************** / / 025 EMcD 27-Sep-85 Add Dutch and Spanish Xlations (conditionalised) / 024 EMcD 14-Sep-85 Add Nordic Translations (conditionalised) / 023 EMcD 03-Sep-85 Fix bug induced by moving stuff in panel / memory. / 022 RCME 25-Jun-85 Fix bug in 021 which caused errors on MC's in / numeric fields. / 021 RCME 03-APR-85 Sort multinational and tech characters / Accept dead key characters in field names / / ---------------- All below refer to V2.0 and earlier ----------------------- / / 020 EJL 06-SEP-84 Allow pound sign for numeric data / 019 WCE 31-OCT-83 Change CHRCNT label to CHARCT for prefix change / 018 TCW 31-OCT-83 ADD TEXT "OUTPUT VOLUME FULL" FOR WINCHESTER / 017 WCE 17-AUG-83 Change HDRBUF label to HEADBF because of prefix / module definition of HDRBUF for WPFILS & EDIT / 017 HLP 29-AUG-83 Make Beep if don't hit Gold Menu / when done / 016 DFB 12-MAY-83 Change collating sequence / 015 MJS 24-MAR-83 BUG FIX - algorithm at "TSTOK" was ok / but the constant didn't allow / that the values of the addresses / were of active (valid) data / not empty locations / 014 MJS 11-JUN-82 BUG FIX - to 'JMP E13' from within / subroutine 'QUXEAL' if no more / blocks remain to be allocated / 013 MJS 16-FEB-82 BUG FIX - to execute 'GET DENSITY' (via QURX) / of system diskette at Gold MENU / within 'WAITM' before reading the / HOME block. / / added - Memory Reference Map / / changed - the 4 occurances of 'T2' within / the MERGE to 'PEIOFFSET' because / subroutine 'KEYSEARCH' uses 'T2' / (and would clobber the value left / by the MERGE) / / renamed - references to 'T2VAT' (used by / the MERGE) to 'INVVAT' / / renamed - references to 'OFFSET' (used by / the MERGE) to 'HEADER' / 012 JRF 14-JAN-82 Improve RANDR2 for handling double density / header blocks. Fix code for handling / justify bit in GETBNO and PUTBNO / 011 MJS 06-NOV-81 BUG FIX - numeric value fields are / now ordered algebraically / / AND - changed cdf's and cif's to be / absolute equates / / AND - MOVED THE 'XXSDFNBUFFER' FROM / FIELD 5 (THIS FIELD) TO FIELD / 4 (THE BUFFER FIELD) / 010 EH 22-OCT-81 BUG FIX - FLAGGING ILLEGAL CHARS / DURING SORT ON NUMERIC FIELDS / 009 MJS 16-OCT-81 BUG FIX - 2nd half of '0008' bug fix / 008 WCE 09-OCT-81 BUG FIX - GOLD HALT FOLLOWED BY GOLD / MENU (REQUIRING SYSTEM DISK TO BE / REPLACED) FOLLOWED BY RETURN / DESTROYED SYSTEM DISK. / 007 DIM 3-SEPT-81 Merge Dutch forin changes / 006 GDH 26-AUG-81 WPFILS calling seq changes. / 005 DSS 17-APR-81 Addition of accented character / handling code for foreign systems. / 004 JM 11-MAR-81 Added CANADIAN text / 003 JM 09-MAR-81 Added DUTCH text / 002 JM 06-MAR-81 Added FRENCH text / 001 JM 06-MAR-81 Replaced all instances of '<' and / '>' within text statements with their / octal values of 74 and 76 so as to / allow foreign conditionals / WTSORT.PA FIELD 0 *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . / ...................................... / NOTE THAT THE 'CDF 20' WITHIN THE FOLLOWING LINE / DEFINES TO THE 'WRITE OUT TO THE FLOPPY CODE' / WHICH FIELD WITHIN [STERNO] THE EMEULATOR / CONTAINS THE PROGRAM TO BE WRITTEN OUT / 'WPCMND.PA' DEFINES THE (USER) FIELD / IN WHICH THE PROGRAM WILL EXECUTE / CONFUSING, ISN'T IT ? IFNDEF DECDEV < DLOSRT; 100; CDF 20; -DSOSRT > IFDEF DECDEV < DLOSRT; 100; CDF 50; -DSOSRT > / ...................................... 0 ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// WPSRSL.PA - MULTIKEY SORT SELECTOR \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ / This memory reference map was added for the convenience of future /a0013 / developers requiring an overall view of system resource referencing /a0013 / FIELD 3 0000-5377 open / 5400-6377 Merge 'INBLOCK' / 6400-6777 Merge 'OUTBLOCK' / 7000-7377 Random Read II 'READ DATA BUFFER' / 7400-7777 Random Read II 'HEADER BLOCK BUFFER' / / FIELD 4 0000-3427 'XXSDFNBUFFER' / 3430-3577 open / 3600-4027 'FNBUFFER' / 4030-5777 open / 6000-7777 'SCROLL's BUFFERS / / FIELD 5 0000-7777 WPSR.PA executable code / / FIELD 6 0000-appro- / aching-7777 'FNVBUFFER' / / 7775-appro- / aching-0000 'FNVARBUFFER' / .............................................................................. / .............................................................................. / ................. .... / .... CAUTION .... THIS PROGRAM [ONLY] ASSEMBLES 'INTO' [STERNO::] FIELD 2 .... / .... CAUTION .... IT IS LOADED INTO [WP-278] FIELD 5 (USER FIELD 3) .......... / .... CAUTION .... AS DEFINED WITHIN 'WPCMND.PA' .............................. / ................. .... / .............................................................................. / .............................................................................. IFNDEF DECDEV < FIELD 2 > IFDEF DECDEV < FIELD 5 > / PROGRAM LOCATIONS: T1, T2 AND T3 ARE USED (AT TIMES) FOR MORE THAN / JUST LOCAL TEMPORARY STORAGE ----- BE CAREFUL ----- / ----------------------------------------------------------------- / -------- THE FOLLOWING IS ORDER IMPORTANT -------- / -------- AND REFERRED TO IN:: 'WPSRDF.PA' -------- / ----------------------------------------------------------------- *SOTFL / 20-77 ARE USED FOR COMMON SYSTEM CONSTANTS / (E.G. T1, T2, T3, P177, ETCETERA.) 0 / F-3 /SOTFL, - 'OUTPUT' DRIVE AND DOCUMENT NUMBER 0 / F-3 /SLSTFL, - 'LIST' DRIVE AND DOCUMENT NUMBER 0 / F-3 /ORDER, - SORT ORDER: XXX XXX XXX XXX 0 / F-3 /MMRETURN, - RETURN ADDRESS TO MAIN MENU XXSDFNBUFFER/ F-4 /SDFNBUFFER, - SPEC DOC KEY BUFFER ADDRESS SELECTOR/ F-5 /PARSELIST, - STARTING ADDRESS OF THIS PROGRAM 0 / F-3 /DSKID, - SYSTEM DISK ID: 0YY III III III 0 / F-3 /FTYPE, - FIELD TYPE (ALP-NUM): TTT TTT TTT TTT / ----------------------------------------------------------------- / -------- END OF ORDER IMPORTANT CODE -------- / ----------------------------------------------------------------- MKSVAT, ZBLOCK 1 / ADDRESS POINTING TO [VAT] WITHIN FNV TABLE / DEFINE THE cdf and cif INSTRUCTIONS ABSOLUTELY (to gain useable memory)/a0011 /a0011 CDFMNU= 6221 /a0011 CIFMNU= 6222 /a0011 CIFIOA= CIFMNU /a0011 CDFEDT= 6231 /a0011 CDFSDFN=6241 /a0011 CDFMYF= 6251 /a0011 CDFF06= 6261 /a0011 CDFFNV= CDFF06 /a0011 CDFFNB= CDFSDFN /a0021 PR3=6236 /A021 /D0011 USRFL0= -30 / USER FIELD 0 (PHYSICAL FIELD 2) A.K.A. 'MENU' FIELD /D0011 USRFL1= -20 / USER FIELD 1 (PHYSICAL FIELD 3) A.K.A. 'EDITOR' FIELD /D0011 /USRFL2= -10 / USER FIELD 2 (PHYSICAL FIELD 4) A.K.A. 'BUFFER' FIELD /D0011 USRFL3= 0 / USER FIELD 3 (PHYSICAL FIELD 5) /D0011 USRFL4= +10 / USER FIELD 4 (PHYSICAL FIELD 6) /D0011 /D0011 CDFMNU= JMS .; XX; JMS CDFCIF; USRFL0+CDF / CDF TO THE 'MENU' FIELD /D0011 CIFIOA=CIFMNU / DEFINED FOR CREF CONTINUITY /D0011 / /D0011 CIFMNU= JMS .; XX; JMS CDFCIF; USRFL0+CIF / CIF TO THE 'MENU' FIELD /D0011 CDFFNV=CDFF06 / DEFINED FOR CREF CONTINUITY /D0011 / /D0011 CDFEDT= JMS .; XX; JMS CDFCIF; USRFL1+CDF / CDF TO THE 'EDITOR' FIELD /D0011 CDFF06= JMS .; XX; JMS CDFCIF; USRFL4+CDF / CDF TO THE PHYSICAL FIELD #6 /D0011 CDFMYF= JMS .; XX; JMS CDFCIF; USRFL3+CDF / CDF TO THE FIELD OF THIS PROGRAM FNVBUFFER= 0 / STARTS AT ADDRESS 0 OF FIELD: USRFL4 FNVARBUFFER= 7775 / STARTS AT ADDRESS 7775 OF FIELD: USRFL4 / (NOTE THAT 'FNVARBUFFER' CAN BE 7774; 7773, ETC) / (BUT NEVER 7776, OR 7777 BECAUSE OF 'ISZ'S IN 'TSTSIZE') FNBUFFER= 4600 / Starts at address 4600 of field 4 KCCRECORD= 4704 / 2500 PRINTABLE CHARACTERS IS A 'LIST' RECORD SIZE KCCFNSIZE= FNSIZE / 30 PRINTABLE CHARACTERS IS A 'LIST' SIZE KCCVALUE= 74 / 60 CHAR'S WITHIN 'VALUE' FIELD (OVER 60 IGNORED) DCAFNV= JMS I .; XFNVPSH/ CROSS DATA FIELDS FOR 'DCA I FNV' THEN BACK DCAFNB= JMS I .; XFNBPSH/ Cross data fields for 'DCA I FN' then back /a021 TADFNB= JMS I .; XFNBGET/ Cross data fields for 'TAD I FN' then back /a021 SORTKEY, ZBLOCK 1 / NUMBER OF KEY S DEFINED WITHIN SPEC DOC KEYNO, ZBLOCK 1 / THE ABSOLUTE KEY # 'KKKK' FROM WITHIN 'FNKEYFOUND' LABFLG, ZBLOCK 1 / 0 MEANS NO < FOUND, XXX MEANS < FOUND RECNUM, ZBLOCK 1 / RECORD # BEING PARSED [1 TO 4095 TO 0 TO 4095 ETC.] KEYFNTOTAL, ZBLOCK 1 / TOTAL # OF RECORDS WITHIN THE LIST DOCUMENT / CONTAINING ALL THE KEY S / DEFINED WITHIN THE SPECIFICATION DOCUMENT SRBUGSWITCH, ZBLOCK 1 / NOT = 0 MEANS WE'RE IN ERROR TYPEOUT ROUTINE / HANDLE TEXT TO SCREEN APPROPRIATELY CCFNSIZE,-KCCFNSIZE-1 / CHARACTER COUNTER [FNSIZE=30] CCRECORD,-KCCRECORD-1 / RECORD CHARACTER COUNTER [KCCRECORD=2500] CCVALUE,-KCCVALUE-1 / 'VALUE' CHARACTER COUNTER SFTSPC, 2040 / Soft space value defined here to make room /a021 CHARIN, ZBLOCK 1 / 12-BIT CHARACTER FROM 'ZRDNXCH': MMMMMCCCCCCC CHR177, ZBLOCK 1 / 7-BIT CHARACTER FROM 'CHARIN': 00000CCCCCCC DEADKEY,ZBLOCK 1 / Flag inicating dead key processing status /a021 / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / PROGRAM LOCATIONS: / T1RR, T2RR ARE RESERVED EXCLUSIVELY / FOR USE BY THE RANDOM READ UTILITY / THE RANDOM READ UTILITY IS A REWORKED VERSION OF RDFILP.PA / AND NO LONGER RESEMBLES RDFILP.PA THAT'S WHY IT'S NOT CALLED RDFILP / BUT IT WASN'T TOTALLY REWRITTEN / WHICH MEANS RDFILP USED PROGRAMM LOCATIONS: T1, T2 T1RR, ZBLOCK 1 T2RR, ZBLOCK 1 / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / AUTO-INDEX REGISTER DEFINITIONS FNV= 15 / X5 / FNV, FNVBUFFER-1 / OF FIELD: USRFL4 FN= 14 / X4 / FN, FNBUFFER-1 SDFN= 13 / X3 / SDFN, SDFNBUFFER-1 / X2 / X1 / X0 FNVAR, FNVARBUFFER+1 / THEN: FNVARBUFFER, FNVARBUFFER-1, ETC. /----------------- PAGE / THE SPECIFICATION DOCUMENT HAS BEEN PARSED SUCCESSFULLY BY A PREVIOUS PROGRAM / AND THE KEY TO SORT ON HAVE BEEN LOADED INTO THE SDFN BUFFER / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!! !!!! / !!!! PARSE THE LIST DOCUMENT !!!! / !!!! !!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / PARSE THE LIST DOCUMENT RECORD BY RECORD BY / LOOKING FOR KEY S TO 'SORT ON' / AS DEFINED WITHIN THE SPECIFICATION DOCUMENT SELECTOR, JMS MRGSETUP / 'MERGE' AND 'ODG' MERGE RELATED PARAMATER SETUP JMS SRWORKING / OUTPUT TO THE SCREEN: 'WORKING' / INITIALIZE SOME FLAGS DCA FLAG40 AC7777 DCA GETFIF / COPY THE CONTENTS OF PROGRAM LOCATIONS: / SOTFL, SLSTFL, ORDER, MMRETURN, DSKID, AND FTYPE / from the EDITOR FIELD into the same named locations of THIS FIELD CDFEDT TAD I (SOTFL) DCA SOTFL TAD I (SLSTFL) DCA SLSTFL TAD I (ORDER) DCA ORDER TAD I (MMRETURN) DCA MMRETURN TAD I (DSKID) DCA DSKID TAD I (FTYPE) DCA FTYPE CDFMYF AC7777 /AC = -1 BECAUSE (SDFNBUFFER) IS THE TAD SDFNBUFFER / ADDRESS OF THE SDFN BUFFER ADDRESS DCA SDFN /\ JMP .+1 /LOOK OUT CAUSE WE DROPPED HERE FROM ABOVE / ....... ... .. ... ... . .. . . .. ... . .... .. . . . . . . . . . .. / .. .. .. .. ... ... . . ... . . . . . . . . ..... .. . .... . / . . .. ...... ..... ...... . . . . .. .... . . . . .. . .... . ... /. .. . ... . ... ...... . . .. . . . . . . . . . . . . . .. . . ... / THIS PROGRAM IS CODED SO THAT MULTI-KEY SORT [UP TO 12 KEYS] IS TRANSPARENT / [ ACHIEVEING THAT TRANSPARENCY IS BY SCANNING THE CONTENTS OF THE SDFN BUFFER ] / [ FOR THE TERMINATORS [0] AND [-1] ] DCA SORTKEY / START WITH (SORTKEY)=0, THEN: / TOTALING THE NUMBER OF TERMINATORS FOUND WITHIN THE SDFN BUFFER / RESULTS IN DEFINING [TO THIS PROGRAM] THE MAXIMUM KEY SORT [12 KEYS] TSTSDFN,JMS TADISDFN / POP A CHARACTER FROM THE SDFN BUFFER /m0011 SPA JMP TSTOK / [-1] SDFN BUFFER TERMINATOR DETECTED SZA CLA JMP TSTSDFN / FOR MORE POPS UNTIL A [-1] TERMINATOR ISZ SORTKEY / [0] KEY TERMINATOR FOUND /*E11 - MEANS THE VALUE WITHIN 'SORTKEY' / IS GREATER THAN THE VALUE THAT 'MAXKEY' IS EQUATED TO / [ 'MAXKEY' IS THE MAXIMUM NUMBER OF KEY S ] / [ ALLOWED BY THIS PROGRAM TO SORT ON ] TAD (-MAXKEY) / THE MAX # OF KEY PERMITTED TO SORT ON TAD SORTKEY / THE # OF KEY DEFINED IN SPEC DOC SMA SZA CLA / SKIP NEXT IF (SORTKEY) <= #MAXKEY JMP E11 / E 11 /*-MEANS SPEC DOC DEFINED TO MANY KEYS TO SORT ON JMP TSTSDFN / UNTIL [-1] TERMINATOR FOUND / THE ABSOLUTE NUMBER OF KEY / DEFINED WITHIN THE SPECIFICATION DOCUMENT / TO SORT ON IN ASCENDING OR DESCENDING ORDER / NOW RESIDES WITHIN PROGRAM LOCATION 'SORTKEY' TSTOK, CLA /CLA CAUSE ENTRY WITH (AC) = [-1] SDFN TERMINATOR TAD SLSTFL / 'LIST' DRIVE AND DOCUMENT NUMBER JMS RDINIT / % RANDRD INITIALIZATION DCA RECNUM / RECORD NUMBER [ INTERNAL ATTRIBUTE ] DCA KEYFNTOTAL / KEY TOTALATOR [0 MEANS NONE] / COMPUTE THE VOLUME OF 'SLUSH' / (THAT NO MANS LAND BETWEEN THE FNVAR TABLE AND FNV BUFFER) / FOR OPTIMUM DYNAMIC MEMORY UTILIZATION TAD SORTKEY / 1; 12(10) CIA DCA SLUSH / TEMP FOR COUNTING TAD (4+1+2+3)/ 4 / 0; 0; 0; 0 (merge), / +1 / [-1] FNVAR term, / +2 / algorithm /a015 / +3 / (insurance) /a015 TAD (KCCVALUE%2+4) / NUMBER OF SLOTS PER KEY WITHIN FNV BUFFER ISZ SLUSH JMP .-2 / UNTIL (SLUSH)=0 DCA SLUSH / THIS IS THE REAL 'SLUSH' NEXTPACKET, TAD (FNVBUFFER-1) / ADDRESS-1 OF VALUE BUFFER DCA FNV TAD (FNVARBUFFER+1) / ADDRESS+1 OF VALUE ADDRESS PER RECORD BUFFER DCA FNVAR / !!!!!!!! PARSE A RECORD WITHIN THE LIST DOCUMENT !!!!!!!! NEXTRECORD, TAD (KEY01FNTOTAL-1) DCA X0 TAD SORTKEY / # OF KEYS TO SORT ON DEFINED WITHIN SPEC DOC CIA / MAKE ITS NEGATIVE VALUE DCA T2 / [ T2 GETS 'ISZ'D TO ZERO ] / CLEAR PROGRAM LOCATIONS:: KEY01FNTOTAL THRU KEYNNFNTOTAL / PRIOR TO PROCESSING EACH RECORD OF THE LIST DOCUMENT DCA I X0 / CLEAR KEY01FNTOTAL, THEN KEY02..., THRU KEYNN... ISZ T2 JMP .-2 / UNTIL (T2)=0 AC7777 DCA I X0 / [-1] FLOATING TERM [MEANS END OF 'KEY--FN..' ADDRESSES TAD FNV JMS DCAVAR AC0003 /\ 'CLL' ALSO TAD FNV DCA HHH1ST / IF THE FNVAR BUFFER HAS FILLED UP / THEN SORT THE 'VALUE' FIELDS / SELECTED THUS FAR / AND COME BACK HERE WHEN THAT SORT IS DONE / CLL /\ FROM 'AC0003' ABOVE TAD FNV / THIS ADDRESS --INCREMENTS-- TAD SLUSH SZL JMP .+5 CLL CIA TAD FNVAR / THIS ADDRESS --DECREMENTS-- SZL CLA / SKIP NEXT IF FNV/FNVAR BUFFERS FULL JMP FNVARNOTFULL / THE FNVAR BUFFER IS NOT FULL NOT FULL AC7777 JMS DCAVAR JMS SPDPRS / DISPLAY ON SCREEN THE # OF RECORDS SELECTED JMS SORT / ORDER THE CONTENTS OF THE FNVAR TABLE JMS MERGE / COMBINE THE FNV BUFFER WITH ANY FNV PACKET JMP NEXTPACKET / SLUSH, ZBLOCK 1 FNVARNOTFULL, / .............................................................................. CIFSYS JSWAP / LET OTHER JOBS HAVE THE SPOT LIGHT / .............................................................................. TAD (-KCCRECORD-1) DCA CCRECORD / 2500 PRINTABLE CHARACTERS ALLOWED PER RECORD DCA BORFLAG / 'BOR' FLAG = 0 MEANS WAITING FOR FIRST < OF RECORD TAD RECNUM AND (7) SNA CLA JMS SRWORKING / OUTPUT THE TEXT: 'WORKING' JMP PARSE / SUBROUTNE TO OUTPUT TO THE SCREEN THE NUMBER OF RECORDS SELECTED / WHICH IS THE NUMBER OF RECORDS WITHIN THE LIST DOCUMENT / THAT CONTAINED THE KEY / DEFINED WITHIN THE SPEC DOC TO SORT ON / ALL TEXT OUTPUT:: WILL NOT BE ABOVE LINE #4, NOT BE ABOVE LINE #4 / SO NOT TO WRITE OVER THE INFORMATION LEFT THERE BY THE SPEC DOC PARSER SPDPRS, XX CIFIOA / -IOA- JMS I IOACAL 0 / MSUMMARY / CONTROL AND TEXT STRING 0605 / ^P - LINE / COLUMN KEYFNTOTAL / !D RECNUM / !D 1600 / ^P JMP I SPDPRS / EXIT PAGE PARSE, / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!! !!!!! / !!!!! PARSE A WITHIN THE CURRENT RECORD !!!!! / !!!!! !!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! NEXTFN, LABSDFN,MQL / (MQ) <= (AC) <= ZERO [OR MMMMM0111100]; THEN CLA TAD (-KCCFNSIZE-1) / SIZE DCA CCFNSIZE TAD (-KCCVALUE-1) / 'VALUE' FIELD SIZE DCA CCVALUE TAD (FNBUFFER-1) / ADDRESS-1 OF HOLDING BUFFER DCA FN CLA MQA / (AC) = (MQ) PARSFN, DCA LABFLG / 0 MEANS WAITING FOR LAB; XXX MEANS LAB FOUND UNTILAB, / UNTIL < LEFT ANGLE BRACKET UNTILRAB, / UNTIL > RIGHT ANGLE BRACKET NPCFN, AC0000 /AC FLAG = 0 JMS RD1FNCHAR / READ 1 12-BIT CHAR FROM LIST DOC JMP DISKEOF / ...LIST DOCUMENT DISK END OF FILE [NO MORE DATA] JMP .+3 / ...THE CHARACTER READ IS NON-PRINTING JMP LAB / ...THE CHARACTER READ IS A < LEFT ANGLE BRACKET JMP RAB / ...THE CHARACTER READ IS A > RIGHT ANGLE BRACKET / ... (AC) = THE CHARACTER READ / THE 12-BIT CONTENTS OF THE AC IS (PROBABLY) A CHAR OF THE / OR TEXT PRIOR TO THE FIRST '<' OF THE FIRST AND P177 / MAKE 7-BIT ASCII STRIPPING MODE BITS DCA T3 / ...PROBABLY PART OF THE ; TEMP SAVE IT / GET 'PARAMATERS' AT THE TIME THE FIRST 'REAL' CHARACTER FROM THE / LIST DOCUMENT IS DETECTED FOR USE IN THE 'ERROR' ROUTINE WHEN AN ERROR / IS DETECTED PRIOR TO THE FIRST LEFT '<' ANGLE BRACKET EVER. ISZ GETFIF / SKIP NEXT IF 1ST 'REAL' CHAR EVER FROM DOC JMP .+3 / 1ST CHAR 'PARAMATERS' ALREADY GOTTEN AC7777 JMS GETBNO / get block #, char. offset, header block offset DCA GETFIF / set flag = 0 (next time through don't GETBNO) /\ JMP .+1 / TEXT MAY PRECEED THE FIRST < OF THE FIRST / OF THE FIRST RECORD +++ONLY+++ [THE RECORD NUMBER MUST = 1] TAD LABFLG /WAS A < FOUND EARLIER ? SZA CLA / SKIP NEXT MEANS WAITING FOR A < JMP ISZCCFNSIZE / JMP WITH CHAR STILL IN T3 / ............................................................................. /*E2 - MEANS THERE IS TEXT (PRINTABLE CHARS.) BETWEEN RECORDS / OR THE OF RECORD # GREATER THAN 1 IS MISSING A < TAD T3 / IS IT A NONPRINTING CHARACTER? TAD (-41) SMA CLA / SKIP IF IT IS; WE DON'T CARE ABOUT NON- / PRINTING CHARACTERS BETWEEN RECORDS / (INCLUDING 'SPACES') TAD RECNUM / IF RECNUM > 0 - THIS TEXT IS BETWEEN RECORDS SZA CLA JMP E2 / E 2 /*E2 JMP UNTILAB / IGNORE ALL CHARACTERS UNTIL A < IS FOUND / ............................................................................. /*E4 - MEANS THE EXCEEDED 30 PRINTABLE CHARACTERS ISZCCFNSIZE, TAD DEADKEY / Check the dead key status /a017 SNA CLA / Is a dead key sequence current? /a017 ISZ CCFNSIZE / No, INCREMENT CHARACTER COUNT SKP JMP E4 / E 4 /*ERROR / ............................................................................. / THE CHARACTER +++IS+++ PART OF THE TAD T3 /GET BACK CHARACTER HELD IN T3 DCAFNB / SAVE IT IN THE HOLDING BUFFER JMP UNTILRAB / JMP TO GET ANOTHER CHAR OF THE UNTIL > GETFIF, 0 / GETFIrst character Flag 0 = get parameters / 1 = don't get parameters BORFLAG,0 /BEGINNING OF RECORD FLAG: / 0 MEANS WAITING FOR FIRST < OF THAT RECORD / 1 MEANS FOUND IT / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . / . . A LEFT ANGLE BRACKET MEANING THE START OF A WAS DETECTED . . / . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . /*E3 - MEANS (LABFLG) NOT = 0 BECAUSE TWO < WERE FOUND BEFORE A > LAB, CLA /VECTORED WITH (AC)=CHAR FROM FNBUFFER TAD LABFLG / (LABFLG) = 0 IF THIS IS THE < OF THE SZA CLA / SKIP NEXT MEANS THIS < IS OK JMP E3 / E 3 /* CONTAINED AN EXTRA < / IF THIS < MEANS THE BEGINNING OF A RECORD (BOR) / NOT THE START OF A WITHIN THE RECORD / THEN GET THE BLOCK # WHERE THE < WAS FOUND / AND THE MODE BITS AT THE DETECTION OF THE < / AND THE CHARACTER OFFSET OF THE < WITHIN THAT BLOCK # / ELSE JUST PARSE THE / BECAUSE THIS IS NOT THE FIRST OF THE RECORD TAD BORFLAG /DOES THE < FOUND MEAN BOR OR JUST A ? SZA CLA / SKIP NEXT IF < MEANS BEGINNING OF RECORD JMP TAD1 / JMP MEANS IT'S JUST A '<' OF A ISZ BORFLAG / TICKLE BORFLG SO WE DON'T DO THIS FOR EVERY < / GET: 'BLOCK #', 'CHARACTER OFFSET OF LAB <' AND 'PERFORMANCE ATTRIBUTES' AC7777 JMS GETBNO DCA GETFIF / [0] TAD1, AC0001 / MEANS '<' FOUND JMP PARSFN / JMP TO PARSE THE WHOSE < WAS JUST FOUND / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . A RIGHT ANGLE BRACKET WAS FOUND WHILE EXPECTING CHAR'S OF THE . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / IF NO CHARACTERS WERE DETECTED AFTER THE < AND BEFORE THE > / THEN THIS > IS A LIST DOC EOR DELIMITER <> NOT A DELIMITER RAB, CLA /CLA BECAUSE VECTORED WITH (AC)=CHAR FROM FNBUFFER TAD CCFNSIZE / TEST THE NUMBER OF CHAR PARSED TAD (KCCFNSIZE+1) SZA CLA / SKIP NEXT MEANS THE > FOUND IS <> DELIMITER JMP TST4KEY / JMP MEANS DELIMITER > DETECTED /*E2 - MEANS > DETECTED BEFORE < TAD LABFLG SNA CLA JMP E2 / E 2 /* A > WAS FOUND BEFORE A < / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . A LIST DOCUMENT END OF RECORD DIAMOND <> HAS BEEN DETECTED . . . . . / . . . . WHILE EXPECTING CHARACTERS OF THE . . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . ISZ RECNUM /UPDATE TOTAL RECORDS PROCESSED [1 TO NNNN] SKP ISZ RECNUM / IF THIS RECORD CONTAINED ANY NON EXISTANT KEY S / THEN FLAG IT (THEM) AS SUCH / OTHERWISE THE KEY 'VALUE' FIELD / HAS BEEN PARSED [SEE 'TST4KEY'] / AND STORED WITHIN THE VALUE BUFFER 'FNVBUFFER' / (EVEN IF THE KEY WAS BLANK) TAD (KEY01FNTOTAL-1) DCA X0 TAD SORTKEY CIA DCA T3 / FOR COUNTING TAD I X0 / K 1 / PRIMARY KEY INDICATOR SNA CLA / SKIP NEXT IF PRIMARY KEY 'EXISTANT' JMP .+7 / PRIMARY KEY NON EXISTANT ISZ KEYFNTOTAL SKP ISZ KEYFNTOTAL JMP .+4 TAD I X0 SNA CLA JMS NOKEYFIELD ISZ T3 JMP .-4 /\ JMP .+1 / IF THE RECORD CROSSED BLOCK BOUNDRIES / THEN MODIFY THE 'PERFORMANCE' ATTRIBUTE (BIT 0(R) FROM 0 TO 1) / (WHICH WAS PREVIOUSLY PUSHED INTO THE FNV BUFFER) / (BUT WHOSE ADDRESS POINTER -- THE POSITION WITHIN THE FNVBUFFER) / (IS BEING HELD WITHIN PROGRAM LOCATION 'HHH1ST') JMS NEWHHH / --UPDATE-- 'PERFORMANCE' ATTRIBUTE / CLEAR THE 'MKSBIT' WITHIN THE 'VAT' MEANS END OF MKS (MULTI-KEY SORT) RECORD TAD (-MKSBIT-1) CDFFNV AND I MKSVAT / [VAT] DCA I MKSVAT / [VAT] CDFMYF JMP NEXTRECORD / JMP TO PARSE THE NEXT RECORD OF THE LIST DOCUMENT / ............................................................................. / THE KEY FOR THIS RECORD IS NON EXISTANT / ............................................................................. NOKEYFIELD, XX JMS PSH3V TAD (-KEY01FNTOTAL+1) TAD X0 TAD (4000+MKSBIT) DCAFNV JMP I NOKEYFIELD /a021 The following code moved here from RD1CHR page to make room /a021 /a021 for recognition of dead keys in field names. /a021 / get a character from the 'xxsdfnbuffer' (located in field 4) /a0011 /a0011 TADISDFN, XX / /a0011 CDFSDFN / CHANGE DATA FIELD TO FIELD #4 /a0011 TAD I SDFN / GET THE CHARACTER FROM THE 'XXSDFNBUFFER' /a0011 CDFMYF / CHANGE DATA FIELD BACK TO THIS FIELD /a0011 JMP I TADISDFN/ AND EXIT /a0011 /a021 -------------- End of moved code ----------------- /a021 PAGE / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!! !!!! / !!!! THE FOLLOWING IS A PSEUDO IMAGE OF THE 'SDFNBUFFER' AND 'FNBUFFER' !!!! / !!!! !!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / ASCII REPRE- ASCII REPRE- / SENTATION OF SENTATION OF / KEY S A / DEFINED WITHIN USED WITHIN / THE SPEC DOC: THE LIST DOC: /SDFNBUFFER, F FNBUFFER, F / I I / E E / L L / D D / N N / A A / M M / E E / [0]: SORTKEY=1 [0] / F / . / . / [0]: SORTKEY=2 / . / [0]: SORTKEY=NN / [-1]: SDFN BUFFER TERMINATOR / A FROM THE LIST DOCUMENT AFTER BEING PARSED / IS HELD WITHIN THE BUFFER 'FNBUFFER' / THE KEY S TO SORT ON IN ASCENDING OR DESCENDING ORDER / AS DEFINED WITHIN THE SORT SPECIFICATION DOCUMENT / HAVE BEEN PARSED BEFORE ENTRY INTO THIS PROGRAM / AND RESIDE WITHIN THE SDFN BUFFER / IN THE ORDER IN WHICH THEY WERE DEFINED WITHIN THE SPEC DOC / A FROM THE LIST DOCUMENT [THE DOCUMENT TO BE SORTED] / HAS BEEN PARSED AND IS BEING HELD WITHIN THE 'FNBUFFER' / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!! !!!!! / !!!!! TEST FOR A KEY !!!!! / !!!!! !!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / IF THE USED IN THE LIST DOCUMENT / IS A KEY DEFINED BY THE SPEC DOC / THEN INPUT [VIA JMS RD1VALUECHAR] THE 'VALUE' / AND HOLD IT WITHIN THE VALUE BUFFER [FNVBUFFER] / ELSE IGNORE ALL CHARACTERS UNTIL THE NEXT LEFT ANGLE BRACKET TST4KEY,DCAFNB /[0] IS THE 'FNBUFFER' TERMINATOR AC7777 TAD SDFNBUFFER DCA SDFN TAD (KEY01FNTOTAL-1) DCA T1 TSTNEXTFN, ISZ T1 / POINTER TO: KEY01FNTOTAL, THEN KEY02..., THRU KEYNN... TAD (FNBUFFER-1) DCA FN TSTNUFNCHAR, JMS TADISDFN /POP A CHAR DEFINED WITHIN THE SPEC DOC /M0011 SZA / SKIP NEXT IF [0] SDFN BUFFER TERMINATOR JMP TSTSMA / JMP TO TEST FOR THE [-1] SDFN BUFFER TERMINATOR TADFNB /POP A CHAR USED WITHIN THE LIST DOC SZA CLA JMP TSTNEXTFN / [0] OF SDFN, [NN] OF FN JMP FNKEYFOUND / [0] OF SDFN, [0] OF FN MEANS THIS IS A KEY / THE CHARACTER JUST POPPED FROM THE SDFN BUFFER / IS +++NOT+++ THE [0] TERMINATOR / IT MAY BE A CHARACTER / OR IT MAY BE THE [-1] TERMINATOR TSTSMA, SMA /SKIP NEXT IF [-1] FROM SDFN JMP DOCIA / JMP TO DO A CIA CAUSE IT'S A CHAR / A CHARACTER OF THE DEFINED WITHIN THE SPEC DOC / DID +++NOT+++ COMPARE WITH A CHAR OF THE USED WITHIN THE LIST DOC / THEREFORE IGNORE ALL CHAR'S RELATED TO THAT 'VALUE' /*E7 - MEANS A DISK EOF DETECTED AFTER > BUT BEFORE < OR <> NOTKEYFN, AC0000 JMS RD1FNCHAR /READ ONE 12-BIT CHARACTER FROM THE LIST DOCUMENT JMP E7 / E 7 / ... (AC)=0; LIST DOCUMENT END OF FILE [NO MORE DATA] JMP .-3 / ...THE 'VALUE' CHARACTER IS NON-PRINTING [SO WHAT] JMP LABSDFN / ...THE 'VALUE' CHARACTER IS A < [START OF A ] JMP .-5 / ...THE 'VALUE' CHARACTER IS A > [NOT LOOKING FOR THAT] JMP .-6 / ...THE 'VALUE' CHARACTER IS PRINTABLE [WHO CARES] / THE CHARACTER POPPED FROM THE SDFN BUFFER / IS NOT THE [0] OR [-1] TERMINATORS / THEREFORE IT IS A CHARACTER OF THE DOCIA, CIA /NEGATE IT FOR COMPARISON LATER DCA T2 / TEMP SAVE TADFNB /POP A CHARACTER USED IN THE LIST DOC SNA JMP NEXTSDFN / [0] OF FN BUFFER, [NN] OF SFDN / MATCHED 1 CHARACTER [POPPED FROM THE SDFN BUFFER] / WITH 1 CHARACTER [POPPED FROM THE FN BUFFER] / THEREFORE COMPARE A NEW CHARACTER TAD T2 /2'S COMP ADD SDFN CHAR WITH CHAR SNA CLA JMP TSTNUFNCHAR / COMPARE A NEW CHARACTER / CHARACTERS DID NOT MATCH / MOVE DOWN TO THE NEXT [0] TERMINATOR WITHIN SDFN BUFFER / RESET TO THE TOP OF THE FN BUFFER NEXTSDFN, JMS TADISDFN / /m0011 SPA JMP NOTKEYFN / [-1] SDFN TERMINATOR FOUND, NOT A KEY SZA CLA JMP NEXTSDFN JMP TSTNEXTFN / [0] OF SDFN MEANS THIS IS >NOT< A KEY / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!! !!!! / !!!! THE FOLLOWING IS A PSEUDO IMAGE OF THE: !!!! / !!!! 'FNVBUFFER', AND 'FNVARBUFFER' BUFFERS. !!!! / !!!! !!!! / !!!! ---- NOTE THAT THEY OCCUPY THE SAME FIELD ---- !!!! / !!!! !!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / PACKED 6-BIT ASCII REPRESENTATION OF THE 'VALUE' FIELD / FOR THE KEY FOUND IN THE LIST (INPUT) DOCUMENT / (FNV) / \/ BUFFER, BLOCKNO :: APPLICABLE IF 1ST ENTRY FOR RECORD / \/ LABOFFSET :: APPLICABLE IF 1ST ENTRY FOR RECORD / \/ PERFORMANCE :: APPLICABLE IF 1ST ENTRY FOR RECORD / \/ VAT :: ALWAYS APPLICABLE / \/ V A / \/ L U / \/ E F / \/ I E / \/ FNV +A, L D / \/ BLOCKNO :: NOT APPLICABLE IF MULTI-KEY RECORD / \/ LABOFFSET :: NOT APPLICABLE IF MULTI-KEY RECORD / \/ PERFORMANCE :: NOT APPLICABLE IF MULTI-KEY RECORD / \/ FNV +B, #4000 :: ALWAYS APPLICABLE / \/ BLOCKNO / \/ LABOFFSET / \/ PERFORMANCE / \/ FNV +C, #40KK / \/ \\\\//// / \/ (DUMMY), 0 / \/ 0 / \/ 0 / \/ 0 / MERGE FILLS-OUT THE 4 WORDS (THE 'DUMMY' ENTRY WITHIN 'FNVAR') / AFTER THE PREVIOUS (LAST VALAD) ENTRY WITH THE VALUE OF 0000 / BECAUSE THE MERGE AND THE OUTPUT DOCUMENT GENERATOR / NEED TO KNOW THE END / ? ? ? ? ? ? ? ? ? ?? ? ? ??? ? ? ? ?? ?? ?? ? ? ? ???? ? ?? ? ? ? ? / ???? ? ? ? ? ? ? ? ? ??? ? ? ? ? ? ??? ? ? ? ? ? ? ? ?? ? ? ? ??? / THE PC-1 FOR EACH 'VALUE' FIELD ENTRY WITHIN THE 'FNV' BUFFER / /\ [-1] / /\ (DUMMY) / /\ FNV+ / /\ FNV +E / /\ FNV +D / /\ FNV +C / /\ FNV +B / /\ (FNVAR) FNV +A / /\ BUFFER, FNVBUFFER-1 / BLOCKNO:: 0 1 2 3 4 5 6 7 8 9 10 11 / M1 M2 B B B B B B B B B B / / OFFSET:: 0 1 2 3 4 5 6 7 8 9 10 11 / M3 M4 M5 CO CO CO CO CO CO CO CO CO / / PERFORMANCE:: 0 1 2 3 4 5 6 7 8 9 10 11 / R - HO HO HO HO HO HO HO HO HO HO / / R = 0 MEANS SINGLE BLOCK READ / R = 1 MEANS MULTIPLE BLOCK READ / ------------------------------------------- / VAT MEANS: ! 0 1 2 ! 3 4 5 ! 6 7 8 ! 9 10 11 ! / (VALUE ATTRIBUTE) ! X V V V V V ! S M K K K K ! / ------------------------------------------- / / IF X = 0 THEN: VVVVV = THE NUMBER OF 'VALUE' LOCATIONS USED WITHIN FNV BUFFER / AND: S = 0 MEANS EVEN NUMBER OF 'VVVVV' CHARACTERS / = 1 MEANS ODD NUMBER OF 'VVVVV' CHARACTERS / AND: KKKKK = THE NUMBER OF THE KEY / / IF X = 4000 THEN: / THE #4000 MEANS: THE RECORD OF THE LIST DOCUMENT / DID +++NOT+++ CONTAIN ANY KEY S / AS DEFINED WITHIN THE SPECIFICATION DOCUMENT / / THE #40KK MEANS: THE RECORD OF THE LIST DOCUMENT / CONTAINED A +++BLANK+++ 'VALUE' FIELD / FOR KEY NUMBER KK / DEFINED WITHIN THE SPECIFICATION DOCUMENT XBIT= 4000 VVVVV= 37 SBIT= 40 MKSBIT= 20 KKKK= 17 / . . . . . . . . . . . . . . . . . . . . . . . . . . . . / A DEFINED WITHIN THE SPECIFICATION DOCUMENT / [ BEING HELD WITHIN THE SDFN BUFFER ] / +++ IS THE SAME AS +++ / A USED WITHIN THE LIST DOCUMENT / [ AND BEING HELD WITHIN THE FN BUFFER ] / . . . . . . . . . . . . . . . . . . . . . . . . . . . . /*E6 - MEANS THAT THIS IS DUPLICATED WITHIN THE SAME RECORD FNKEYFOUND, TAD I T1 /SAME AS 'TAD KEY01FNTOTAL' THRU 'KEY--FNTOTAL' SZA CLA / SKIP NEXT OF NO PREVIOUS OF THIS NAME JMP E6 / E 6 /* RECORD CONTAINS A DUPLICATE ISZ I T1 /+1 TO THE TOTAL # OF OF THIS NAME / A DEFINED WITHIN THE SPECIFICATION DOCUMENT / IS THE SAME AS A USED WITHIN THE LIST DOCUMENT / THEREFORE THE USED WITHIN THE LIST DOCUMENT / IS A +++KEY+++ JMS PSH3V /PUSH INTO THE FNV BUFFER THE:: / BLOCK#, OFFSET, PERFORMANCE ATTRIBUTES OF THIS TAD (-KEY01FNTOTAL+1) TAD T1 DCA KEYNO / SAVE IT FOR USE WITHIN 'NVFPROCESSOR' TAD KEYNO DCAFNV / [VAT] / THE ABSOLUTE # OF THIS KEY WITHIN SDFN BUFFER /\ JMP .+1 / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!! !!!!! / !!!!! GET THE 'VALUE' FIELD OF THE KEY SELECTED !!!!! / !!!!! !!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / GET THE 'VALUE' FIELD FOR THIS / AND PUSH IT INTO THE VALUE BUFFER 'FNVBUFFER' / THE 1ST 60 PRINTABLE CHARACTERS UP TO A < OF THE NEXT OR <> / ARE PART OF A 'VALUE' FIELD GETFNVALUE, AC7776 DCA VALCOUNT / TWO 6-BIT ASCII 'VALUE' CHAR PER FNV SLOT DCAPACK6BIT, BSW / AND PUT INTO HIGH ORDER BYTE OF THE WORD: CC00 DCA PACK6BIT / START WITH (PACK6BIT) CLEAR; IT'S MUCH CLEANER JMS XRD1VALUECHAR / READ 1 'VALUE' FIELD CHARACTER / CONVERT (AC): MMMMMCCCCCCC 'LOWER CASE' CHARACTERS TO 'UPPER CASE' AND P177 / STRIP MODE BITS MAKING 7-BIT ASCII CHAR TAD (-140) / MAKE 'LOWER CASE' SPA / 'UPPER CASE' TAD (140) / WHOOPS - NOT AN ALPHA CHARACTER / ONLY THE 1ST 60 CHARACTERS OF THE 'VALUE' FIELD ARE SORTED ON / ALL EXCESSIVE 'VALUE' FIELD CHARACTERS ARE IGNORED ISZ CCVALUE JMP ANDP77 / 'VALUE' FIELD OVERFLOW / THE 'VALUE' FIELD EXCEEDED 60 PRINTABLE CHARACTERS / WHICH IS NOT AN ERROR BUT MEANS ALL EXCESSIVE CHAR'S MUST BE IGNORED / BECAUSE THIS PROGRAM IS DESIGNED TO SORT ON ONLY THE 1ST 60 CHARS JMS XRD1VALUECHAR / READ 1 'VALUE' FIELD CHARACTER JMP .-1 / IGNORE THIS 'OVER 60' CHARACTER / THE CONTENTS OF THE AC IS A 12-BIT 'VALUE' CHARACTER: MMMMMCCCCCCC ANDP77, AND P77 /MAKE THE 12-BIT CHARACTER 6-BIT JMS NVFPROCESSOR / IF <:FN> THEN 'NVFPROCESSOR' CAPTURES MAIN-LINE IFNDEF ITALIAN < TAD (SBIT) /ADD 40 TO CHAR (SET FROM ASCII TO 6 BIT SEQ) /A016 AND P77 /MASK OUT L/O 6 BITS /A016 > ISZ VALCOUNT / +1 FROM 7776 TO 7777 TO 0 JMP DCAPACK6BIT / JMP TO GET ANOTHER CHARACTER / (VALCOUNT) WENT TO 0 MEANS GOT 2 PACKED 6-BIT 'VALUE' FIELD CHARACTERS TAD PACK6BIT / CC00 DCAFNV / PUSH THE TW0 6-BIT CHAR'S WITHIN THE FNV BUFFER JMP GETFNVALUE / JMP TO GET MORE OF THE 'VALUE' TIL THE NEXT < VALSTATUS, / 0 MEANS EVEN # OF 'VVVVV', 40 MEANS ODD VALCOUNT, -2 / TWO 6-BIT 'VALUE' CHARACTERS PER 1 FNV BUFFER SLOT PACK6BIT, 0 / LOCAL TEMP WORK / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . / . . A LEFT ANGLE BRACKET WAS DETECTED . . / . . WHILE EXPECTING CHARACTERS OF THE 'VALUE' FIELD FOR THAT . . / . . WHICH MEANS THIS MUST BE THE END OF THE 'VALUE' FIELD . . / . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . GOTALL, CLA /CLA CAUSE VECTOR HERE WITH (AC) = 12-BIT CHAR TAD PACK6BIT / 0000 IF (VALCOUNT) = 7776; ELSE CC00 CAUSE = 7777 ISZ VALCOUNT JMP .+3 DCAFNV / PUSH CC00 INTO THE FNV BUFFER TAD (SBIT) DCA VALSTATUS / IF THERE WERE NO 'VALUE' CHARACTERS BETWEEN THE LAST > AND THIS < / THEN THIS KEY HAS A +++BLANK+++ 'VALUE' FIELD AC0004 TAD FNVKEY / (AC) = ADDRESS OF THE [VAT] CIA / NEGATE FOR COMPARISON TAD FNV / CURRENT ADRS OF FNV SNA JMP FNVBLANK / THE 'VALUE' FIELD FOR THIS KEY IS NOT BLANK / / THE CONTENTS OF THE AC = THE NUMBER OF FNV BUFFER SLOTS / USED TO STORE THE VALUE FIELD BSW /MOVE INTO HIGH BYTE: 0VVVVV 000000 TAD VALSTATUS / 0VVVVV S00000 JMP FNVOK / THE FIELD NAME IS OK / THE 'VALUE' FIELD FOR THIS IS +++BLANK+++ / PUSH THE #40KK INTO THE FNV BUFFER SLOT / PREVIOUSLY RESERVED FOR THE 'VALUE ATTRIBUTE' ELEMENT (VAT)' FNVBLANK, AC4000 / XBIT / THE 'VALUE' FIELD FOR THIS IS +++NOT+++ BLANK / PUSH THE #0V00 INTO THE FNV BUFFER SLOT / RESERVED FOR THE 'VALUE ATTRIBUTE' ELEMENT (VAT) FNVOK, CDFFNV TAD I MKSVAT / [VAT] / (AC) = 40KK OR 0VKK TAD (MKSBIT)/ MKSBIT DCA I MKSVAT / [VAT] / PUT BACK INTO THE FNV BUFFER CDFMYF AC0001 / MEANS '<' FOUND JMP NEXTFN / JMP TO PARSE THE NEXT OF THE LIST DOC FNVKEY, FNVBUFFER-1 / PUSH INTO THE 'FNVBUFFER' THE ATTRIBUTES FOR THIS KEY ; (OR NO KEY RECORD) / ....BLOCK #...., ....CHARACTER BYTE OFFSET...., ....PERFORMANCE.... PSH3V, XX TAD FNV / GET THE ADDRESS OF THE FNV BUFFER DCA FNVKEY / FNVKEY TAD BLOCKNO / GET BLOCK # WHEN THE < WAS DETECTED [AT 'LAB'] DCAFNV / PUSH IT INTO THE FNV BUFFER TAD LABOFFSET / GET CHAR OFFSET OF THE '<' WHEN IT WAS DETECTED DCAFNV / PUSH IT INTO THE FNV BUFFER TOO TAD PERFORMANCE DCAFNV TAD FNV / ADDRESS-1 OF [VAT] IAC DCA MKSVAT / MKSVAT/ ADDRESS OF [VAT] WITHIN FNV TABLE JMP I PSH3V PAGE / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . . . . . / . . . . A DISK END OF FILE [EOF] HAS BEEN DETECTED . . . . / . . . . WHILE EXPECTING CHAR'S OF THE . . . . / . . . . . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . /*E9 - MEANS NO RECORDS PROCESSED [INPUT DOC PROBABLY HAD ONLY TEXT] DISKEOF,TAD RECNUM SNA CLA JMP E9 / E 9 /*NO RECORDS PROCESSED /*E7 - MEANS THIS DISK EOF DETECTED AFTER < BUT BEFORE > TAD LABFLG SZA CLA JMP E7 / E 7 /*DISK EOF DETECTED AFTER < BUT BEFORE > OR <> /*E10- MEANS NO RECORDS SELECTED [LIST DOC HAD NO KEY 'S] TAD KEYFNTOTAL SNA CLA JMP E10 / E 10 /*E10 - NO RECORDS SELECTED FOR SORT / SET A [-1] TERMINATOR INTO THE FNVAR BUFFER AC7777; JMS DCAVAR / DISPLAY ON THE SCREEN THE # OF RECORDS SELECTED OUT OF # PARSED JMS SPDPRS / RECORDS SELECTED: S OUT OF X JMS SORT / SORT THE 'FNVAR' TABLE VIA THE 'FNV' TABLE JMS MERGE / MERGE THAT TABLE WITH ANY FNV PACKETS JMS ODG / TO THE OUTPUT DOCUMENT GENERATOR / IF WE GOT TO HERE / THEN WE ARE FINISHED: / SELECTING, SORTING, MERGING AND PRODUCING THE OUTPUT DOCUMENT / THEREFORE OUTPUT TO THE SCREEN THE MESSAGE: 'DONE' CIFIOA / -IOA- JMS I IOACAL 0 / MSRDONE / 'DONE' 1205 / ^P JMP NOERRORS / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!! !!!! / !!!! REPORT AN EXPLICIT ERROR CONDITION !!!! / !!!! !!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! E5CLA, CLA; JMP E5 / E 5 / THE CONTENTS OF THE AC AT ENTRY TO 'E-' MUST = 0 FOR THE IAC'S TO WORK E13A, IAC / OUTPUT VOLUME FULL /A018 E13, IAC / output diskette full (no more blocks to alloc) /a0014 E12P, /IAC / EXTRA RADIX POINT ('.') FOUND E12N, /IAC / ILLEGAL PLACEMENT OF ('$') CURRENCY SYMBOL E12M, /IAC / EXTRA ('$') CURRENCY SYMBOL FOUND E12L, /IAC / EXTRA SIGN BUT FOUND E12K, /IAC / ILLEGAL PLACEMENT OF ('+') PLUS SIGN E12J, /IAC / EXTRA RIGHT ')' PAREN FOUND E12I, /IAC / '()' FOUND -- BACK TO BACK PARENS E12H, /IAC / NO '(' BEFORE ')' E12G, /IAC / SIGN '+' OR '-' PRECEEDED RIGHT ')' PAREN E12F, /IAC / ILLEGAL PLACEMENT OF LEFT '(' PAREN E12E, /IAC / '(' BUT NO ')' DETECTED BEFORE E12D, /IAC / UNKNOWN CHARACTER -- NOT 0 THRU 9 OR 'NATURAL' E12C, /IAC / TO MANY CHAR'S -- 'KWHOLE' OR 'KFRACTION' OVFL E12B, /IAC / ILLEGAL PLACEMENT OF MINUS '-' SIGN E12A, /IAC / ILLEGAL PLACEMENT OF RIGHT ')' PAREN IAC / (INVALAD NUMERIC VALUE FIELD SYNTAX) E11, IAC / SPEC DOC DEFINED TO MANY KEYS TO SORT ON E10, IAC / LIST DOC HAD NO KEY S E9, IAC / LIST DOC HAD NO RECORDS TO PROCESS E8, IAC /*ODG: UNEXPECTED DISK EOF E7, IAC / A DISK EOF DETECTED AFTER < BUT BEFORE > OR <> E6, IAC / DUPLICATE WITHIN SAME RECORD E5, IAC / > DETECTED WITHIN VALUE E4, IAC / EXCEEDED 30 DECIMAL CHARACTERS E3, IAC / < DETECTED WITHIN A E2, IAC / HAS TEXT PRECEEDING THE /E1, IAC / E0, TAD (EMESTABLE) / RECORD EXCEEDED 2500 PRINTABLE CHARACTERS DCA ERMEADRS JMS SPDPRS / OUTPUT TO THE SCREEN: 'KEY RECORDS: X OF Y CIFIOA / -IOA- JMS I IOACAL 0 / MERROR / ^S - CONTROL AND TEXT ADDRESS 1200 / ^P 1300 / ^P ERMEADRS, (EMESTABLE) / !S - ADDRESS OF ADDRESS OF TEXT 1400 / ^P 1600 / ^P /\ JMP .+1 /DROP FROM ABOVE AND / OUTPUT TO THE SCREEN THE FIRST >7< LINES / OF THE RECORD BEING PROCESSED / WHEN THE ERROR WAS DETECTED TAD BLOCKNO / BLOCK # OF INPUT DOC AT TIME OF ERROR DCA EBNO TAD LABOFFSET / OFFSET OF > AT TIME OF ERROR DCA EOFF TAD PERFORMANCE / HHH AT TIME OF ERROR CLL RAL STL RAR / FORCE 'MULTIPLE READ' MODE DCA EHHH JMS PUTBNO / 'PUT' THE NEXT 3 PARAMATERS INTO % RANDRD EBNO, ZBLOCK 1 EOFF, ZBLOCK 1 EHHH, ZBLOCK 1 JMP NO7LINES / CAN'T TYPE -7- LINES; JUST ERRORED TRYING TO GET THEM TAD (-7) DCA SRBUGSWITCH / >>7<< LINES / OUTPUT UP TO >>7<< LINES / OF THE RECORD BEING PROCESSED / AT THE TIME OF THE ERROR SRLOOPE,AC0002 /'+2' FLAG FOR 'EORD1CHAR' JMS ERORD1CHAR / READ 1 CHAR FROM THE LIST DOCUMENT JMP SRERROR / ...RETURN TO HERE AT DISK EOF... (AC)=0 / ......(A DISK EOF COULD OCCUR) / ......(BECAUSE 7 LINES OF DATA TO READ) JMP ERRCR / ...NON-PRINTING RETURNS HERE / ......(IF IT IS A 'LF' THEN STUFF A 'CR') NOP / ... < RETURNS HERE; (TYPE IT) NOP / ... > RETURNS HERE; (TYPE IT) JMS TYPERD / ... 12-BIT CHAR DATA RETURNS HERE; (TYPE IT) JMP SRLOOPE / GET NEXT CHARACTER / IF THE CHARACTER JUST READ FROM THE LIST DOCUMENT / (WHICH IS PART OF THE >7< LINES FOR OUTPUT / IS A 'LINE FEED' THEN OUTPUT A 'CARRIAGE RETURN' ERRCR, JMS TYPERD / type nonprinting character TAD CHR177 / was character just typed a ? TAD (-LF) SNA CLA TAD (CR) / yes - type a JMS TYPERD / no - type a null character ISZ SRBUGSWITCH / UPDATE TYPED LINE COUNT JMP SRLOOPE / UNTIL UP TO >>7<< LINES ARE ECHOED TO THE VT NO7LINES, SRERROR,DCA SRBUGSWITCH / ZERO 'SRBUGSWITCH' /\ JMP .+1 NOERRORS, / IF WE DROPPED FROM ABOVE / THEN THE ODG SHOULD HAVE DEALLOCATED ALL MERGE SCRATCH BLOCKS (NATURALLY) / BUT BECAUSE THE MERGE CAN WRITE 'PARTIAL' BLOCKS (WITHIN THE CHAIN) / AND THE ODG IS DONE WHEN A '0' VAT IS FOUND / (NOT WHEN ALL BLOCKS ARE READ) / 'JMS MRGEFRALL' ANYWAY TO BE SURE ALL BLOCKS ARE DEALLOCATED / ELSE RUNNING 'MC::VERIFY' COMMAND (FROM MAIN MENU) / WILL DETECT ALLOCATION ERRORS JMS MRGEFRALL / DEALLOCATE ALL BLOCKS ALLOCATED BY:: MERGE / OUTPUT THE MESSAGE:: GOLD M TO THE SCREEN CIFIOA / -IOA- JMS I IOACAL 0 / MGOLD / 2703 / ^P AOK1, JMS WAITM / WAIT FOR KEY 'GOLD M' /C017 AOK, JMP AOK1 / RETURN HERE IF NOT GOLD M /C017 / RETURN HERE IF GOLD M / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - /SRABORT,CDIMNU / CDF CIF TO THE MENU FIELD SRABORT,CDF CIF 20 / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - JMP I MMRETURN / BACK TO THE 'MAIN' MENU / SUBROUTINE TO OUTPUT TO THE SCREEN THE TEXT: 'SR: WORKING' SRWORKING, XX JMS TIMEOUT CIFIOA / -IOA- JMS I IOACAL 0 MPROCESSING / ^S - CONTROL AND TEXT ADDRESS 1205 / ^P - LINE / COLUMN 1600 / ^P - LINE / COLUMN JMP I SRWORKING XRD1VALUECHAR, XX /*E7 - MEANS A DISK EOF DETECTED AFTER > BUT BEFORE < OR <> /*E5 - MEANS A > WAS DETECTED WITHIN THE 'VALUE' FIELD /*E0 - MEANS RECORD EXCEEDED 2500 PRINTABLE CHARACTERS AC7777 / '-1' FLAG FOR 'RD1VALUECHAR' JMS RD1VALUECHAR / READ 1 'VALUE' 12-BIT CHARACTER FROM THE LIST DOCUMENT JMP E7 / E 7 /* (AC)=0; LIST DOCUMENT END OF FILE [NO MORE DATA] JMP .-3 / THIS 'VALUE' CHAR IS NON-PRINTING [NO BIG DEAL] JMP GOTALL / THIS 'VALUE' CHAR IS '<' MEANS END OF VALUE FIELD JMP E5CLA / E 5 /* > DETECTED WITHIN THE VALUE JMP I XRD1VALUECHAR / 12-BIT CHARACTER IS IN THE AC PAGE / AC???? /AC AT ENTRY IS A FLAG:: -1, 0, 1, 2 / JMS $$$$$$ /JMS IS THE CALL, (AC) AT EXIT = 12-BIT CHAR / JMP A / RETURN TO HERE WHEN A DISK EOF / JMP B / RETURN TO HERE WHEN A NON-PRINTING CHAR / JMP C / RETURN TO HERE WHEN A < LEFT ANGLE BRACKET / JMP D / RETURN TO HERE WHEN A > RIGHT ANGLE BRACKET / JMP E / RETURN TO HERE WHEN A CHAR / SUBROUTINE TO READ 1 CHARACTER FROM THE LIST DOCUMENT FOR ERROR TYPEOUT. / (WITHOUT 'SCROLLING' THEM TO THE OUTPUT DOCUMENT ERORD1CHAR, / ENTER HERE WITH THE AC = 0002 / ---------------------------------------------------------------------------- / SUBROUTINE TO READ 1 CHARACTER FROM THE LIST DOCUMENT / (FOR 'SCROLL'ING TO THE OUTPUT DOCUMENT) ODGRDCHAR, / ENTER HERE WITH THE AC = 0001 MEANS IGNORE NOTHING / ---------------------------------------------------------------------------- / SUBROUTINE TO READ 1 'VALUE' FIELD CHARACTER / FROM THE LIST DOC RD1VALUECHAR, / ENTER HERE WITH THE AC = 7777 / ---------------------------------------------------------------------------- / SUBROUTINE TO READ 1 CHARACTER FROM THE LIST DOCUMENT RD1FNCHAR, / ENTER HERE WITH THE AC = 0000 / ---------------------------------------------------------------------------- XX JMS RD1CHR /'JMS' WITH (AC)=0000, 0001, 0002, OR 7777 JMP I RD1FNCHAR / 'JMP I' MEANS DISK EOF (OUT OF DATA) DETECTED / ENTRY TO HERE IS WITH THE AC = 7-BIT ASCII CHARACTER TAD (-40) / -40 SPA JMP NPCCHAR / THE CHARACTER IS: NON-PRINTING TAD (-34) / -74 SNA JMP LABCHAR / THE CHARACTER IS #74: A LEFT ANGLE BRACKET '<' TAD (-2) / -76 SNA CLA JMP RABCHAR / THE CHARACTER IS #76: A RIGHT ANGLE BRACKET '>' /\ JMP .+1 / DROP FROM ABOVE, AND / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / IF THE MAIN-LINE IS THE SELECTOR / SIGNIFIED BY THE CONTENTS OF PROGRAM LOCATION 'RDFLAG' = 0 OR -1 / THEN 'ISZ CCRECORD' /*E0 - MEANS RECORD EXCEEDED 2500 PRINTABLE CHARACTERS / - (EXCLUDING '<'S AND '>'S) TAD RDFLAG SMA SZA CLA JMP .+4 ISZ CCRECORD SKP JMP E0 / E 0 /*RECORD EXCEEDS 2500 CHARACTERS / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . ISZ RD1FNCHAR / THE CHAR IS PRINTABLE RABCHAR,ISZ RD1FNCHAR LABCHAR,ISZ RD1FNCHAR NPCCHAR,ISZ RD1FNCHAR / EXIT WITH (AC) = 12-BIT CHARACTER: MMMMMCCCCCCC CLA /CLA CAUSE (AC) IS GARBAGE TAD CHARIN / GET BACK THE 12-BIT CHARACTER (INCLUDING MODE BITS) JMP I RD1FNCHAR / AND EXIT WITH IT IN THE AC / SUBROUTINE TO READ A CHARACTER FROM A DOCUMENT / JMS ZRDNXCH / DISK END OF FILE RETURNS TO THIS PC WITH (AC) = 0 / ELSE RETURN TO THIS PC ZRDNXCH,XX JMS XXHLTFLG / TEST FOR THE GOLD HALT FLAG JMS RDNXCH / % RANDRD READS 1 CHAR DCA CHARIN / MMMMM CCCCCCC TAD CHARIN / GET IT BACK AND P177 / STRIP OFF MODE BITS DCA CHR177 / SAVE 00000CCCCCCC TAD CHARIN / GET IT BACK FOR EXIT SZA / SKIP NEXT IF NO MORE DATA ISZ ZRDNXCH / 'ISZ' MEANS GOT DATA FROM INPUT DOC JMP I ZRDNXCH / /SUBROUTINE TO READ ONE CHARACTER FROM THE INPUT DOCUMENT (EXIT WITH AC= 7-BIT ASCII) / AC AT ENTRY =-1: IGNORES ONLY: RULERS, JUSTIFYING SPACES AND LINE FEEDS / AC AT ENTRY = 0: IGNORE ALL BLANKS, TABS, RULERS, JUSTIFYING SPACES AND 'S / AC AT ENTRY =+1: IGNORE NOTHING AND 'JMS ODGSCROLL' (CAUSE MAIN-LINE IS ODG) / AC AT ENTRY =+2: IGNORE NOTHING SO WE CAN OUTPUT THE CHARACTER TO THE SCREEN / AS PART OF THE ERROR DETECTION AND REPORTING RDFLAG, ZBLOCK 1 / HOLDS THE CONTENTS OF THE AC:: -1, 0, 1, 2 /CALLED WITH AC=FLAG / JMS RD1CHR / DISK EOF RETURN TO THIS PC [WITH THE AC = 0] / ELSE RETURN TO THIS PC [WITH AC = THE 7-BIT CHAR: 00000CCCCCCC] RD1CHR, XX DCA RDFLAG / SAVE FLAG RDNEXT, JMS ZRDNXCH / READ 1 CHAR JMP I RD1CHR / DISK END OF FILE [EOF] CLA RDNOBUG,TAD RDFLAG / Get the read type flag. /a021 SPA CLA / Is this a field value? /a021 JMP SINGLE / Yes, CHECK FOR SINGLE ACCENTED CHARACTERS RDNOB1, TAD CHR177 / No, GET CHARACTER:: 00000CCCCCCC TAD (-41) SPA CLA / SKIP NEXT IF THE CHARACTER IS PRINTABLE JMP NPC RD1EXIT,CLA DCA FLAG40 / PRINTABLE CHARACTERS RESET 'FLAG40' NPCEXIT,TAD CHR177 / GET CHARACTER TO RETURN WITH ISZ RD1CHR / +1 TO RETURN ADDRESS RD1EOF, JMP I RD1CHR / NON PRINTING [SPECIAL] CHARACTER NPC, TAD RDFLAG SMA SZA CLA / SKIP IF AC<= 0 JMP ODGSKP / 'JMP' BECAUSE MAINLINE IS 'ODG' TAD CHR177 / GET CHARACTER:: 00000CCCCCCC /\ JMP NOTODG / THE CHARACTER IS NON-PRINTING / AND THE MAINLINE IS --NOT-- THE OUTPUT DOCUMENT GENERATOR (ODG) NOTODG, TAD (-10) / CHECK FOR 'BEGIN DEAD' SZA / Is it a begin sequence introducer? /m021 JMP NOTDEAD / No, deal with others /a021 CMA / Yes, set the dead flag. /a021 DCA DEADKEY / /a021 TAD RDFLAG / Test the read type. /a021 SMA / Is it a field value read? /a021 JMP RD1EXIT / No, exit with character as is. /a021 JMP DEAD / Yes, JMP TO DEAD KEY SEQUENCE PROCESSOR NOTDEAD,TAD (10-40) / /A021 SNA JMP SPHANDLER / THE CHARACTER IS A:: SPACE (40) OR (2040) TAD (40-12) SZA JMP NOTLF / NOT A LINE FEED TAD CHARIN / THE CHARACTER IS A:: LINE FEED (12) AND (3000) / IS IT A WRAPPED LINE OR END OF PARAGRAPH? SZA CLA / SKIP IF: REGULAR LINE FEED JMP WRAPHANDLER / IT'S WRAPPED OR E.O.P. - HANDLE IN SAME MANNER JMP LFHANDLER / REGULAR LINE FEED / LOOKING FOR -1014 [START OF PRINTER CONTROL] / OR -1414 [END OF PRINTER CONTROL] LPTCTRL,TAD CHARIN / TEST FOR 'START OF PRINTER CONTROL' TAD (-1014) SNA CLA JMP SOPC / JMP BECAUSE 'START OF PRINTER CONTROL' TAD RDFLAG SMA CLA JMP ODGTST JMP RD1EXIT SOPC, TILEND, JMS FLGTST JMS ZRDNXCH / READ 1 CHARACTER FROM THE PROPER DOCUMENT JMP I RD1CHR / THIS 'JMP I' IF DISK EOF TAD (-1414) / 'END OF PRINTER CONTROL' YET ? SZA CLA JMP TILEND / KEEP LOOKING FOR 'END OF PRINTER CONTROL' /\ JMP ODGTST / IF THE CONTENTS OF PROGRAM LOCATION 'RDFLAG' = +1 / THEN THE OUTPUT DOCUMENT GENETATOR (ODG) IS IN CONTROL / THEREFORE 'SCROLL' THE CHARACTER TO THE OUTPUT DOCUMENT / ELSE JUST EXIT ODGTST, JMS FLGTST / TEST THE CONTENTS OF 'RDFLAG' JMP RDNEXT / 'JMP' TO READ THE NEXT CHARACTER / SUBROUTINE TO TEST THE CONTENTS OF PROGRAM LOCATION 'RDFLAG' / IF (RDFLAG) = +1 THEN 'SCROLL' THE CHARACTER TO THE OUTPUT DOCUMENT / IF (RDFLAG) = +2 THEN 'JMP NPCEXIT' FLGTST, XX TAD RDFLAG SPA CLA / /m021 JMP I FLGTST / 'JMP I' BECAUSE AC IS MINUS AC7777 / CHECK - IGNORE NOTHING EXCEPT RULERS IN/m021 / SPKRUL ROUTINE FOR ERROR TYPEOUT TAD RDFLAG SZA CLA / /m021 JMP NPCEXIT / THE (RDFLAG) = +2 / THE CONTENTS OF PROGRAM LOCATION 'RDFLAG' = +1 / THEREFORE 'SCROLL' THE CHARACTER TO THE OUTPUT DOCUMENT TAD CHARIN JMS ODGSCROLL JMP I FLGTST /d021/ get a character from the 'xxsdfnbuffer' (located in field 4) /a0011 /d021 /a0011 /d021TADISDFN, XX / /a0011 /d021 CDFSDFN / CHANGE DATA FIELD TO FIELD #4 /a0011 /d021 TAD I SDFN / GET THE CHARACTER FROM THE 'XXSDFNBUFFER' /a0011 /d021 CDFMYF / CHANGE DATA FIELD BACK TO THIS FIELD /a0011 /d021 JMP I TADISDFN/ AND EXIT /a0011 PAGE NOTLF, IAC SNA CLA JMP TABHANDLER / THE CHARACTER IS:: TAB (11) ODGSKP, TAD CHR177 TAD (-16) / -16 / Check for a start of ruler (16) /m021 SNA JMP SKPRULER / THE CHARACTER IS:: START OF RULER (16)/m021 IAC / Test for an End Dead character /a021 SNA / Is it End Dead (CR=15)? /a021 DCA DEADKEY / Yes, zero the dead key sequence flag /a021 IAC / -14 / Check for Form Feed (14) /m021 SNA CLA JMP LPTCTRL / THE CHARACTER IS:: FORM FEED (14) /m021 JMP ODGTST END40, IAC / +1 WRAPHANDLER, IAC / +1 LFHANDLER, IAC / +1 JMP IAC4 / THE CONTENTS OF PROGRAM LOCATION 'CHARIN' = 11 WHICH IS A TAB / CONVERT THIS TAB TO A (2040) FOR OUTPUT VISUAL CONTINUITY TABHANDLER, TAD SFTSPC DCA CHARIN IAC4, CMA DCA FLAG40 / -1, -2, -3, -4 JMP NPCEXIT / EXIT WITH THE CHARACTER IN THE AC FLAG40, ZBLOCK 1 SPHANDLER, / THE CHARACTER IS A SPACE (40) OR (2040) AC2000 / TEST FOR THE SPACE TO BE (2040) 'JUSTIFYING' AND CHARIN SNA CLA / SKIP NEXT IF A 'JUSTIFYING' SPACE (2040) JMP NPCEXIT / EXIT 'RD1--CHAR' WITH THE AC=40 / THE SPACE IS DEFINATELY A 'JUSTIFYING' (2040) SPACE / ... IS IT A [TAB] 'JUSTIFYING' SPACE ? TAD FLAG40 IAC SNA / SKIP NEXT IF (FLAG40) = '-1' JMP NPCEXIT / EXIT 'RD1--CHAR' WITH THE AC=40 / ... IS IT A 'JUSTIFYING SPACE' THAT FOLLOWS A NORMAL LINE FEED ? IAC SNA / SKIP NEXT IF (FLAG40) = '-2' JMP SPHAN1 / JUST IGNORE LEFT MARGIN JUSTIFY SPACES / ... IS IT A [WORD WRAP] OR [SOFT RETURN] IAC SNA / SKIP NEXT IF (FLAG40) = '-3' JMP RDNEXT / IGNORE THE CHAR AND READ THE NEXT ONE / ... IS IT A [CENTERING] 'JUSTIFYING' SPACE ? IAC SNA CLA / SKIP NEXT IF (FLAG40) = '-4' JMP NPCEXIT / EXIT 'RD1--CHAR' WITH THE AC=40 / WE GOT HERE BECAUSE THE CONTENTS OF PROGRAM LOCATION (FLAG40) = 0 SPHAN1, TAD TOCTALJUSTIFY / JUSTIFYING SPACE COUNT SNA JMP NPCEXIT / THE COUNT = 0 MEANS NO JUSTIFYING SPACES TO SKIP CIA / NEGATE IT DCA T3 SPHAN2, JMS ZRDNXCH / READ NEXT CHARACTER JMP RD1EOF TAD (-2040) / IS IT A SOFT SPACE? SZA CLA / SKIP NEXT IF A SOFT SPACE JMP RDNOBUG / WE'VE FINISHED JUSTIFYING SPACES / SO SEND THIS CHAR THROUGH REGULAR PROCESSING ISZ T3 / SOFT SPACE, COUNT OVERFLOW? JMP SPHAN2 / NO - GET THE NEXT CHARACTER UNTIL (T3) = 0 JMP END40 / GO SETUP FLAG40 FOR NORMAL WORDWRAP SEQENCE /++ /FUNCTIONAL DESCRIPTION: SKPRUL - SKiP RULer / / This routine will exam each ruler of the input document as it is / being read and calculate the proper number of left justify spaces to / ignore (due to the current left margin setting) while reading each / field name or value of a record. It will save the left margin / justification value of the ruler just preceding the first record / in the list as this ruler is the default ruler for our output / document. This routine also serves the purpose of ignoring all / rulers encounted during the typeout of an error message since the / characters that make up a ruler would appear as simply garbage to / the user. / / SKPRUL PSUEDO CODE: / / skprul: repeat /10) if [not ignoring ruler for error typeout] / go check for scrolling of character / read ruler character /15) if [character = "@ (forward ruler follows)] /20) if [already entered record list] /25) if [not in ODG] / flag user - more than one ruler in list / else /30) clear octal value computed from previous ruler / set flag (RULSEPDET) - ruler separator detected ("@) / else /40) if ["@ has been previously detected] /45) get character / if [left margin value character] /55) compute it's octal value / else /60) reset ruler separator detected flag / TOCTALJUSTIFY = TOCTALJUSTIFY - 1 / end if / if [first record in list not yet detected] / set default OCTALJUSTIFY for ODG = TOCTALJUSTIFY /65) get character /70) until [character = end of ruler marker] /75) if [ignore ruler for error typeout] / exit SKPRUL via RDNEXT (go read next character) / else / exit SKPRUL via ODGTST (see if e.o.r. needs to be scrolled) / /CALLING SEQUENCE: JMP SKPRUL /INPUT PARAMETERS: none /IMPLICIT INPUTS: CHARIN, RULSEPDET, T2, OCTALJUSTIFY, TOCTALJUSTIFY, / SRBUGSWITCH, BORFLAG, RECNUM, P7700 /OUTPUT PARAMETERS: none /IMPLICIT OUTPUT: RULSEPDET, OCTALJUSTIFY, T2, TOCTALJUSTIFY /COMPLETION CODE: none /SIDE EFFECTS: none /-- SKPRUL, TAD SRBUGSWITCH / [10] / ignore ruler for error typeout? SNA CLA / skip: if so JMS FLGTST / 'FLGTST' also 'SCROLLS' the (CHARIN) JMS ZRDNXCH / read NEXT ruler character JMP RD1EOF / 'JMP' CAUSE DISK EOF TAD P7700 / [15] / (-100)is char. @ ? SZA CLA / skip if so JMP SKPRU4 / no it's not TAD BORFLAG / [20] TAD RECNUM SNA CLA / SKIP NEXT IF 1ST '<' EVER DETECTED JMP SKPRU3 TAD RDFLAG / [25] SMA SZA CLA / skip if: not in ODG JMP SKPRU7 CIFIOA / -IOA- JMS I IOACAL 0 / MULTIRULERERR / 0705 / ^P IFDEF CANADA <141> / IFDEF / ^Z ................................ /A004 SKPRU3, DCA TOCTALJUSTIFY / [30] / clear for new value ISZ RULSEPDET / flag ruler forward/reverse separator detected JMP SKPRU7 SKPRU4, TAD RULSEPDET / [40] / has @ been detected already? SNA CLA / skip if so JMP SKPRU7 TAD CHARIN / [45] / get character back (IS IT AN ALPHA ?) TAD P7700 / (-100)is it a left margin value character? SMA CLA / skip if so JMP SKPRU6 / no - go reset RULSEPDET TAD TOCTALJUSTIFY / [55] CLL RTL RTL DCA TOCTALJUSTIFY TAD CHARIN AND (17) / MAKE BCD JMP SKPRU8 SKPRU6, DCA RULSEPDET / [60] / clear ruler separator detected flag AC7777 SKPRU8, TAD TOCTALJUSTIFY DCA TOCTALJUSTIFY STL / LINK = 1 TAD BORFLAG / have we hit the first record yet? TAD RECNUM SZA SNL CLA / skip: if not [SKIP IF EITHER OR AC=0, L=1] JMP SKPRU7 / yes - we've already got our default for ODG TAD TOCTALJUSTIFY / save this left margin value for ODG default DCA OCTALJUSTIFY SKPRU7, TAD CHARIN / [70] TAD (-17) / end of ruler? SZA CLA / skip if so JMP SKPRUL / go get next ruler character TAD SRBUGSWITCH / [75] / ignore end of ruler for error typeout? SZA CLA / skip: if not JMP RDNEXT / ignore e.o.r. for error typeout. get next char. JMP ODGTST / back to normal processing RULSEPDET, / 'RULER SEPERATOR DETECTOR' ZBLOCK 1 / if <> 0 then the char. which separates forwrd / and reverse ruler has been detected OCTALJUSTIFY, ZBLOCK 1 / holds octal number of justifying spaces that / must be inserted pervious to the OUTPUT DOC- / UMENT GENERATOR writing the first line of a / record to the output document. TOCTALJUSTIFY, ZBLOCK 1 / holds octal number of justifying spaces that / must be ignored as text while reading input / document while in selector. PAGE / SUBROUTINE TO OUTPUT THE TIME TO THE SCREEN TIMEOUT,XX CIFMNU JMS I TIMCAL JMP I TIMEOUT / RETURN THIS PC IF NO CHANGE / RETURN THIS PC IF TIME CHANGED (NEXT SECOND) / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . CNT27=INSERTJUST / NOTE THAT PROGRAM LOCATION 'INSERTJUST' / IS USED AS A LOCAL COUNTER / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . TAD (-27) DCA CNT27 CDFMNU AC7777 TAD I (DATESP) CDFMYF DCA X0 TAD (DATEST-1) DCA X1 LOOP27, CDFMNU TAD I X0 CDFMYF DCA I X1 ISZ CNT27 JMP LOOP27 CIFIOA / -IOA- JMS I IOACAL 0 / TDIO / 0072 / ^P DATEST / ^A 1600 / ^P JMP I TIMEOUT / 0072 / 1600 TDIO, TEXT '^P^A!L^P' DATEST, ZBLOCK 27 /++ / /FUNCTIONAL DESCRIPTION: INSERTJUST - INSERT JUSTification spaces / / This routine will insert into the output document a given number of / justification spaces (as per OCTALJUSTIFY). / / INSERTJUST PSEUDO CODE: / / if [justification needed (OCTALJUSTIFY > 0)] / set count to (1-OCTALJUSTIFY) / repeat / scroll justify-space to output document / increment count / until [count = 0] / return to caller / /CALLING SEQUENCE: JMS INSERTJUST /INPUT PARAMETERS: none /IMPLICIT INPUTS: OCTALJUSTIFY /OUTPUT PARAMETERS: none /IMPLICIT OUTPUT: T1 /COMPLETION CODE: none /SIDE EFFECTS: none / /-- INSERTJUST, XX AC7776 DCA T2 JUSTAGAIN, TAD (LF) JMS ODGSCROLL TAD OCTALJUSTIFY SNA JMP NOJUSTIFY CIA DCA T1 TAD (2040) JMS ODGSCROLL ISZ T1 JMP .-3 NOJUSTIFY, ISZ T2 JMP JUSTAGAIN / .............................................................................. CIFSYS JSWAP / LET OTHER JOBS HAVE THE SPOT LIGHT / .............................................................................. JMP I INSERTJUST /.... .... .... .... .... .... .... .... .... .... / .... .... .... .... .... .... .... .... .... /.... .... .... .... .... .... .... .... .... .... / .... .... .... .... .... .... .... .... .... / DONE / THE OUTPUT DOCUMENT GENERATOR / HAS TRANSFERRED THE ENTIRE CONTENTS / OF THE INPUT DOCUMENT TO THE OUTPUT DOCUMENT ODGFINI,TAD (207) / 'RULER' MODIFIED FLAG JMS ODGSCROLL CIFFIO /M0006 FILEIO /M0006 XDSKCL / CLOSES THE FILE OPENED BY XDSKIN / JMP I ODG / EXIT THE OUTPUT DOCUMENT GENERATOR TAD ODG DCA .+2 JMP I .+1 ZBLOCK 1 /.... .... .... .... .... .... .... .... .... .... / .... .... .... .... .... .... .... .... .... /.... .... .... .... .... .... .... .... .... .... / .... .... .... .... .... .... .... .... .... DCAVAR, XX DCA VARTMP AC7777 TAD FNVAR DCA FNVAR TAD VARTMP CDFFNV DCA I FNVAR CDFMYF JMP I DCAVAR VARTMP, ZBLOCK 1 / SUBROUTINE TO PUSH 1 ELEMENT INTO THE FNV BUFFER XFNVPSH,XX CDFFNV /CHANGE DF TO THE 'EDITOR' FIELD DCA I FNV / PUSH THE CONTENTS OF THE AC INTO THE FNV BUF CDFMYF / CHANGE DF BACK TO 'MY' FIELD JMP I XFNVPSH / EXIT WITH THE AC = 0 / --UPDATE-- THE 'PERFORMANCE' ATTRIBUTE WITHIN THE FNV BUFFER NEWHHH, XX / AC0000 JMS GETBNO TAD PERFORMANCE CDFFNV DCA I HHH1ST / REPLACE UPDATED 'PERFORMANCE' ATTRIBUTE CDFMYF JMP I NEWHHH HHH1ST, FNVBUFFER+2 / HOLDS ADDRESS POINTER INTO THE FNV TABLE / FOR THE 1ST 'PERFORMANCE' ATTRIBUTE / OF THE CURRENT RECORD / SUBROUTINE TO WAIT FOR THE USER TO TYPE A CHARACTER AT THE KEYBOARD /A008 / THIS ROUTINE IS ON THIS PAGE BECAUSE OF SPACE LIMITATIONS /A008 GETCHR, XX / GET CHARACTER FROM USER KEYBOARD /A008 UNTILC, CIFSYS / CHANGE TO SYS FIELD /A008 JSWAP / LET OTHER JOBS GET A CHANCE TO RUN /A008 JMS TIMEOUT / OUTPUT THE TIME TO THE SCREEN /A008 CIFSYS / CHANGE TO SYS FIELD /A008 XLTIN / GO LOOK FOR A CHARACTER /A008 JMP UNTILC / NONE STRUCK, GO WAIT SOME MORE /A008 JMP I GETCHR / GOT IT, RETURN TO CALLER /A008 PAGE / SUBROUTINE TO TEST FOR THE 'GOLD' HALT FLAG / / CALL: JMS XXHLTFLG; RETURN PC (if no gold halt) / / NOTE THAT THIS SUBROUTINE / IS CALLED FROM WITHIN 'ZRDNXCH' / WHICH IS USED BY EVERYONE ---EXCEPT--- THE MERGE / K E E P I T T H A T W A Y / and from within 'WT1SCRATCH' / used --ONLY-- by the MERGE XXHLTFLG, XX / + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + / THE FOLLOWING 3 INSTRUCTIONS HAVE NOTHING FUNCTIONAL TO DO WITH THE SORT / THEY ARE REQUIRED BECAUSE OF THE SYSTEM SHORT COMMINGS / AS A VECHICLE BY WHICH PRINTER ERRORS ARE REPORTED TO THE OPERATOR CIFPRT / TO THE 'PRINTER' FIELD JMS I (FLABUZ) / FLASH AND BUZZ CLA / + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + CDFSYS TAD I HLTFLG CDFMYF SNA CLA JMP I XXHLTFLG / IF THE MAIN-LINE CODE IS 'THE MERGE' / THEN OUTPUT THE MESSAGE ' - PLEASE WAIT' / BECAUSE WE'D HAVE A HELLUVA TIME TRYING TO CLEAN-UP / ANY SCRATCH BLOCKS ALLOCATED WITHIN THE MERGE TAD MBUSY SNA CLA JMP NOTMERGE CIFIOA / -IOA- JMS I IOACAL 0 / MSRWAIT / 1220 / ^P 1600 / ^P JMP I XXHLTFLG / THE USER AFTER TYPING 'GOLD HALT' HAS THE OPTION TO: / PRESS 'RETURN' TO CONTINUE THE SR PACKAGE, OR / TYPE 'GOLD M' TO ABORT THE SR AND RETURN TO THE MAIN MENU NOTMERGE, CIFIOA / -IOA- JMS I IOACAL 0 MSRPAUSED 1205 / ^P 2603 / ^P 2703 / ^P JMS SPDPRS WAITMLOOP, JMS WAITM / JMS TO WAIT FOR KEY 'GOLD M' JMP TSTEDNWLN / RETURN TO THIS PC IF >not< GOLD M /\ CIFIOA / -IOA- / /D009 /\ JMS I IOACAL / /D009 /\ 0 / /D009 /\ MSRABORTED / /D009 /\ 1205 / ^P /D009 /\ IFDEF FRENCH <153> / ^Z ................................ /A002 /D009 /\ JMS MRGEFRALL / DEALLOCATE ALL MERGE 'WORK' BLOCKS /D009 JMP SRABORT / RETURN TO THIS PC IF 'GOLD M' / TEST FOR THE KEYBOARD INPUT 'NEW LINE' ALSO KNOWN AS KEY 'RETURN' TSTEDNWLN, TAD XLTINN / GET KEYBOARD INPUT TAD (-EDNWLN) SZA CLA /DEBUG JMS ODTIOA JMP WAITMLOOP / REQUIRED WHEN 'JMS ODTIOA' IS COMMENTED OUT JMS SRWORKING JMP I XXHLTFLG / SUBROUTINE TO WAIT FOR A KEYBOARD INPUT:: GOLD M / CALL: JMS WAITM; RETURN HERE IF >NOT< GOLD M; RETURN HERE IF GOLD M WAITM, XX JMS GETCHR / GO GET A CHARACTER FROM THE USER /A008 DCA XLTINN / SAVE CHARACTER FOR RETURN TEST /M008 TAD XLTINN / RETRIEVE CHARACTER FOR GOLD MENU TEST /M008 TAD (-EDMENU) / SUBTRACT VALUE FOR GOLD MENU /M008 SZA CLA / SKIP NEXT IF 'GOLD M' JMP BEEP / BEEP IF NOT GOLD MENU /C017 / if the return pc is the address 'AOK' /A009 / then do not output the message 'aborted' /A009 / (or execute the 'jms mrgefrall') /A009 / because the 'jms' was already executed at address 'NOERRORS' /A009 /A009 TAD (-AOK) / /A009 TAD WAITM / /A009 SNA CLA / SKIP NEXT IF RETURN PC IS not AOK /A009 JMP CHKDSK / /A009 /A009 CIFIOA / -IOA- / /A009 JMS I IOACAL / /A009 0 / /A009 MSRABORTED / /A009 1205 / ^P /A009 IFDEF FRENCH <153> / ^Z ................................ /A002/A009 JMS MRGEFRALL / DEALLOCATE ALL MERGE 'WORK' BLOCKS /A009 JMP CHKDSK / /A017 BEEP, CIFIOA /A017 JMS I IOACAL /A017 0 /A017 ASCS / ASCII STRING /A017 BELASC / BELL ASCII STRING /A017 JMP I WAITM / RETURN /A017 ASCS, TEXT '^A' / ASCII SUBSTRING /A017 BELASC, 7;0 / BELL CODE WITH ZERO TERMINATOR /A017 CHKDSK, DCA QDRV / 0 / THE 'SYSTEM' IS ALWAYS DRIVE # 0 TAD (RXEDN) / 'GET DENSITY' COMMAND /a0013 DCA QFNC / BECOMES FUNCTION CODE FOR QURX /a0013 JMS QURX / AND EXECUTE THE 'GET DENSITY' COMMAND /a0013 / ----------------------------------------------------------------------------- / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / THIS IS THE ONLY (AND SHOULD BE THE ONLY) / REFERENCE WHERE DATA IS READ 'INTO' / THE 'OUTBLOCK' BUFFER AC0002 / 'HOME' BLOCK DESIGNATION JMS RD1BLOCK / READ THE HOME BLOCK OF THE SYSTEM DISKETTE OUTBLOCK / INTO THE 'EDITOR' FIELD BUF ADDRESS 'OUTBLOCK' / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / ----------------------------------------------------------------------------- /d0013 JMS MGQDRV / RESET 'QDRV' TO THE OUTPUT DOCUMENT DRIVE # TAD DSKID / 0YY NNN NNN NNN CDFEDT TAD OUTBLOCK+5 / SYSTEM DISKETTE ID WITHIN 'HOME' BLOCK CDFMYF AND (777) SNA CLA JMP GOLDM / JMP BECAUSE THE SYSTEM DISKETTE IS IN DRV #0 CIFIOA / -IOA- / JMS I IOACAL / 0 / MREPLACE / 2603 / ^P CIFIOA / -ioa- / /a0013 JMS I IOACAL / /a0013 0 / /a0013 MGOLD / /a0013 2703 / ^P /a0013 UNTILM, JMS GETCHR / GET A CHARACTER FROM THE USER /A008 TAD (-EDMENU) / SUBTRACT VALUE FOR GOLD MENU /A008 SZA CLA / SKIP NEXT IF 'GOLD M' /A008 JMP UNTILM / NOT GOLD MENU, GO GET NEXT CHARACTER /A008 JMP CHKDSK / GO CHECK FOR THE CORRECT SYSTEM DISK /A008 GOLDM, ISZ WAITM / POINT TO GOLD MENU RETURN LOCATION /M008 JMP I WAITM / RETURN TO CALLER /M008 XLTINN, ZBLOCK 1 / HOLDS THE KEYBOARD CHARACTER / SUBROUTINE TO OUTPUT 1 CHARACTER TO THE SCREEN / (enter with the ac = character) TYPERD, XX / AND P177 / STRIP MODE BITS DCA VTCHAR / save it for output via IOA CIFIOA / -IOA- / JMS I IOACAL / 0 / CA / VTCHAR / ^A - ADDRESS OF STRING JMP I TYPERD / / VTCHAR, ZBLOCK 1 / holds the ascii character for display 0 / this 0 is the ascii string terminator CA, TEXT \^A\ / this is the control string for IOA /D011 / SUBROUTINE TO REPLACE THE 'CDF...' AND 'CIF...' [JMS] MAINLINE CODE /D011 / WITH THE ACTUAL '6FFN' IOT /D011 /D011 / THIS SUBROUTINE IS REQUIRED FOR MULTI-USER WPS-8 SYSTEMS /D011 /D011 CDFCIF, XX /D011 DCA TAC / TEMPORARILY SAVE THE CONTENTS OF THE AC /D011 RAL /D011 DCA TLINK / AND THE LINK /D011 RIF / 00F0: RIF GETS THE INSTRUCTION FIELD OF THIS PGM /D011 TAD CDF0 / 'TAD (CDF 0)' /D011 DCA CNNCNN /D011 CNNCNN, .-. / 'CDF' SAME AS 'IF' OF THIS PROGRAM /D011 AC7776 /D011 TAD CDFCIF / TO GET THE ADRS OF THE ADRS OF THE MAIN LINE CALLER /D011 DCA CNNCNN /D011 AC7777 /D011 TAD I CNNCNN / ADDRESS OF THE MAIN LINE CALLER /D011 DCA CNNCNN /D011 RIF / 00F0: /D011 TAD I CDFCIF / 'IF' 'ORED WITH CNN+USRFLX FOLLOWING JMS CIFCIF /D011 DCA I CNNCNN / REPLACES THE MAINLINE JMS WITH THE IOT /D011 TAD TLINK /D011 CLL RAR /D011 TAD TAC /D011 JMP I CNNCNN / JMP TO EXECUTE THAT IOT /D011 TAC, ZBLOCK 1 / HOLDS THE AC FOR THE SUBROUTINE CDFCIF /D011 TLINK, ZBLOCK 1 / HOLDS THE LINK FOR THE SUBROUTINE CDFCIF PAGE /***************************************************************************** / / The Field Name Buffer has been moved to field 4 and /a021 / has been enlarged to enable it to accomodate up to 30 /a021 / multinational and/or technical characters. /a021 / /***************************************************************************** / THE CONTENTS OF THE FN BUFFER [LOADED VIA JMS RD1CHR] / REPRESENT AN ASCII FROM A RECORD OF THE LIST DOCUMENT / / ONE ASCII CHARACTER PER 12-BITS / / FNBUFFER, F / I / E / L / D / N / A / M / E / [0] FNBUFFER TERMINATOR /d021 FNBUFFER, ZBLOCK KCCFNSIZE+1 / ----------------------------------------- / --THE FOLLOWING CODE IS ORDER IMPORTANT-- / ----------------------------------------- / 'KEY--FNTOTAL' COUNTERS ARE ORDER IMPORTANT / REPRESENTING 1 KEY WITHIN A RECORD / SINGLE KEY SORT: 1 'KEY--FNTOTAL' COUNTER IS NEEDED: KEY01FNTOTAL / 3 KEY SORT: 3 'KEY--FNTOTAL' COUNTERS ARE NEEDED: KEY01FNTOTAL / KEY02FNTOTAL / KEY03FNTOTAL / N KEY SORT: ETC. KEY01FNTOTAL, ZBLOCK 1 KEY02FNTOTAL, ZBLOCK 1 KEY03FNTOTAL, ZBLOCK 1 KEY04FNTOTAL, ZBLOCK 1 KEY05FNTOTAL, ZBLOCK 1 KEY06FNTOTAL, ZBLOCK 1 KEY07FNTOTAL, ZBLOCK 1 KEY08FNTOTAL, ZBLOCK 1 KEY09FNTOTAL, ZBLOCK 1 KEY10FNTOTAL, ZBLOCK 1 KEY11FNTOTAL, ZBLOCK 1 KEY12FNTOTAL, ZBLOCK 1 /KEY13FNTOTAL, ZBLOCK 1/ MUST EXPAND THE WORDS 'ORDER' AND 'FTYPE' /KEY14FNTOTAL, ZBLOCK 1 /KEY15FNTOTAL, ZBLOCK 1/ MUST REDEFINE DATA STRUCTURE AND 'KKKK' WITHIN [VAT] //////// KEEP GOING (REALISTICALLY NOW) UNTIL YOUR LITTLE HEART DESIRES //////// MAXKEY=.-KEY01FNTOTAL / MAX # OF KEY S TO SORT ON / PERMITTED BY THIS PROGRAM -1 / [-1] TERMINATOR /m0013 / MAKING MULTI-KEY SORT [ UP TO NN KEYS ] / INVISIBLE TO THIS PROGRAM / ----------------------------------------- / --THE PREVIOUS CODE WAS ORDER IMPORTANT-- / ----------------------------------------- / / ACCENTED CHARACTER PROCESSORS / / / THIS SERIES OF ROUTINES IS CURRENTLY USED TO CONVERT THE SINGLE AND / MULTI STROKE ACCENTED CHARACTERS PRESENT IN FOREIGN LANGUAGE SYSTEMS / TO A SINGLE CHARACTER TO BE USED IN THE SORT. / / AT PRESENT, ANY ACCENTED CHARACTER IS TREATED AS IF IT HAD APPEARED / WITH NO ACCENT. FOR EXAMPLE, AN ACCENT AGU 'A' WILL BE SORTED AS AN / 'A' WITH NO ACCENT. THIS SCHEME MAY OR MAY NOT BE MODIFIED FOR FUTURE / RELEASES OF THE SOFTWARE. / / / / / DEAD KEY SEQUENCE PROCESSOR DEAD, JMS ZRDNXCH / DEAL WITH DEAD KEY CHARACTERS IN THE /A021 JMP RD1EOF / SORT COLLATING SEQUENCE. /A021 AND P177 / GET THE FIRST CHARACTER OF THE DEAD /A021 TAD NEGSPC / SEQUENCE, MINUS MODE BITS, AND TEST /A021 SZA / IS IT A SPACE? /A021 JMP DEDNRM / NO, IT IS A USER DEAD KEY SEQUENCE /A021 JMS ZRDNXCH / YES, GET THE NEXT CHARACTER TO SEE /A021 JMP RD1EOF / WHICH CHARACTER SET IT COMES FROM OR /A021 / IF IT IS A HARD SPACE. /A021 AND P177 / GET THE CHARACTER WITHOUT MODE BITS /A021 TAD NEGSPC / TEST FOR A HARD SPACE /A021 SNA / IS IT A HARD SPACE? /A021 JMP DEDNRM / YES, OUTPUT SPACE /A021 TAD DEDSPC / NO, GET CHARACTER BACK /A021 RAR / GET THE LSB INTO THE LINK /A021 SZL CLA / IS THIS A TECH OR LINE CHARACTER? /A021 JMP DEADTL / YES, DEAL WITH IT /A021 JMS ZRDNXCH / NO, GET THE MULTINATIONAL CHARACTER /A021 JMP RD1EOF / CODE /A021 AND P177 / GET THE CODE SANS MODE BITS /A021 /D023 RAL / DOUBLE IT /A021 TAD (EQUTB) / ADD THE BASE ADDRESS OF THE EQUIVELENC/A021 DCA EQUTBA / TABLE IN PANEL AND SAVE IN THE PR3 /A021 PR3 / MAKE THE PANEL REQUEST TO GET THE /A021 5054 / EQUIVELENCE CHARACTER /M023 /A021 EQUTBA, XX / ADDRESS IN EQUIVALENCE TABLE /A021 DCHAR1 / THE EQUIVALENCE CHARACTER STORE /A021 -2 / THE MINIMUM NO OF WORDS YOU CAN XFER /A021 -1 / PR TERMINATOR /A021 JMP DEDOUT / RETURN CHARACTER TO MAIN LOOP /A021 DEADTL, JMS ZRDNXCH / GET THE TECHNICAL OR LINE DRAWING /A021 JMP RD1EOF / CHARACTER /A021 DCA DCHAR1 / SAVE IT WHILE LOOKING FOR END DEAD /A021 JMP DEDOUT DEDNRM, TAD DEDSPC / RECONSTITUTE FIRST CHARACTER OF USER /A021 DCA DCHAR1 / DEAD KEY SEQUENCE /A021 DEDOUT, JMS ZRDNXCH / GET A CHARACTER UNTIL END DEAD IS /A021 JMP RD1EOF / SEEN. /A021 TAD (-15) / /A021 SZA CLA / /A021 JMP DEDOUT / /A021 DCA DEADKEY / ZERO THE DEAD KEY FLAG, AS END FOUND /A022 SNGLXT, TAD DCHAR1 / COPY THE CHARACTER TO THE RETURN /A021 DCA CHARIN / RETURN VARIABLE /A021 TAD DCHAR1 / ALSO COPY INTO THE CHR177 VARIABLE /A021 AND P177 / AS THE MASKED VERSION /A021 DCA CHR177 / /A021 JMP RD1EXIT /A021 //\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/ / SINGLE ACCENTED CHARACTER PROCESSOR SINGLE, TAD RDFLAG / CHECK MAINLINE CODE SMA SZA CLA / AC>0 MEANS 'ODG' JMP RDNOB1 / NO PROCESSING IF 'ODG' TAD CHARIN / GET CHARACTER AND (7600) / MASK OFF CHARACTER DCA DCHAR1 / SAVE MODE BITS TAD CHARIN / GET CHARACTERS AND P177 / MASK OFF MODE BITS DCA DCHAR2 / SAVE CHARACTERS TAD (TBL2) / GET TABLE ADDRESS DCA DADDR1 / SAVE IN TEMP POINTER SNGLP1, TAD I DADDR1 / GET TABLE ENTRY ISZ DADDR1 / INCREMENT POINTER SNA / CHECK FOR END OF TABLE JMP RDNOB1 / END OF TABLE DETECTED TAD DCHAR2 / CHECK FOR MATCH SNA CLA JMP SINGL2 / WE HAVE A MATCH ISZ DADDR1 / NO MATCH. INCREMENT ADDRESS. JMP SNGLP1 / CONTINUE SEARCH SINGL2, TAD I DADDR1 / GET SUBSTITUTE CHARACTER /D021 TAD DCHAR1 / RETRIEVE MODE BITS /D021 DCA CHARIN / SAVE NEW CHARACTER /D021 JMP RDNOB1 / RETURN TO MAIN PROCESSING JMP SNGLXT / EXIT VIA ROUTINE TO SAVE CHARS /A021 //\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/ / / / TEMPORARY STORAGE / / DCHAR1, 0 / TEMP CHARACTER STORAGE DCHAR2, 0 / TEMP CHARACTER STORAGE DADDR1, 0 / TEMP ADDRESS POINTER DEDSPC, 40 / ASCII VALUE OF A SPACE /A021 NEGSPC, -40 / NEGATIVE ASCII VALUE OF A SPACE /A021 EQUTB=SORTBL / COLLATING SEQUENCE EQUIVALENCE TABLE //\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/ / / / ACCENTED CHARACTER TABLES / / TBL1, IFDEF ENGCAN < -140 / ACCENT GRAVE -136 / CIRCUMFLEX -176 / UMLAUT > IFDEF CANADA < -140 / ACCENT GRAVE -136 / CIRCUMFLEX -176 / UMLAUT > IFDEF FRENCH < -136 / ACCENT AGU -176 / UMLAUT > 0 TBL2, IFDEF ENGCAN < -173; 141 / AGU E > IFDEF CANADA < -173; 141 / AGU E > IFDEF FRENCH < -100; 141 / GRAVE A -173; 145 / AGU E -174; 165 / GRAVE U -175; 145 / GRAVE E > 0 PAGE ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// MERGE .PA - MULTI-KEY MERGE \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ / MERGE SUBROUTINE / TO 'SET-UP' PARAMATERS FOR THE MERGE MRGSETUP, XX TAD (7401) / WPS-8 DOCUMENT BLOCK IDENTIFIER CDFEDT DCA I (OUTBLOCK) / 7401 DCA I (OUTBLOCK+1) / 0 CDFMYF DCA FIRSTBLOCK / [0] MEANS NO SCRATCH CHAIN, YET JMP I MRGSETUP / MERGE SUBROUTINE / TO SET THE DRIVE NUMBER WITHIN QURX:: 'QDRV' / IDENTICAL TO THE OUTPUT DOCUMENT DRIVE MGQDRV, XX TAD SOTFL / DDDDNNNNNNNN AND (7400) BSW CLL RTR DCA QDRV JMP I MGQDRV / EXIT QUQDRV / ALLOCATE (SETUP) THE 1ST BLOCK OF THE SCRATCH CHAIN; AND 'WTQBLK' SETFIRSTBLOCK, XX JMS QUXEAL /ALLOCATE 1 SCRATCH BLOCK DCA FIRSTBLOCK / TO BECOME THE 1ST IN A CHAIN OF SCRATCH BLOCKS TAD FIRSTBLOCK DCA WTQBLK / SETTING UP 'WTQBLK' WITH NEXT BLOCK # TO BE 'WRITTEN' JMP I SETFIRSTBLOCK FIRSTBLOCK, ZBLOCK 1 / 1ST BLOCK # OF THE SCRATCH CHAIN SETINVLENGTH, XX TAD INVVAT / /m0013 BSW AND (VVVVV) CIA DCA INVLENGTH TAD (-4) TAD INVLENGTH DCA INLENGTH JMP I SETINVLENGTH / ........................................ /THIS IS THE START OF THE MERGE; THEREFORE / ........................................ / ENTRY TO HERE AFTER SORT HAS ORDERED THE FNVAR TABLE / BECAUSE THE FNV BUFFER - FNVAR TABLE VOLUME HAS FILLED-UP / OR AN INPUT DOCUMENT EOF OCCURED MERGE, XX / MERGE ENTRY PORT ISZ MBUSY / [1] MEANS 'MERGE' IS THE MAIN-LINE TAD (OUTBLOCK+HEADER) /m0013 DCA OUTTOP / MAKES THE 'OUTBLOCK' BUFFER LOOK EMPTY TAD (FNVARBUFFER+1) DCA FNVAR / SET TO THE TOP OF THE (SORTED) RECORD POINTER LIST TAD (INBLOCK) DCA INFLADR / 'FLOATING' TOP ADDRESS OF 'INBLOCK' BUFF (SEE 'NEXTIN') JMS MGQDRV / SET THE DRIVE # SAME AS OUTPUT DOC DRIVE # / FILL-OUT THE NEXT 4 WORDS WITHIN THE FNV BUFFER / BECAUSE 'ODG' LOOKS FOR THE CONTENTS OF 'VAT' = 0000 / WHICH IS THE INTERNAL SIGNAL MEANING THE END OF THE FNV BUFFER DCAFNV / [0] DCAFNV / [0] DCAFNV / [0] DCAFNV / [0] / IF DISKETTE SCRATCH BLOCKS HAVE BEEN PREVIOUSLY ALLOCATED / (WHICH CONTAIN SORTED FNV BUFFER PACKETS) / THEN MERGE THE PRESENT CONTENTS OF THE FNV BUFFER / WITH THE SORTED FNV BUFFER PACKETS TAD FIRSTBLOCK / 1ST BLOCK OF THE SCRATCH CHAIN SZA / SKIP NEXT MEANS [0] NO SCRATCH CHAIN YET JMP MERGE2 / MERGE THE FNV BUFFER WITH THE FNV PACKETS / WRITE-OUT THE CONTENTS / OF THE FNV BUFFER (AS PER THE SORTED ORDER OF THE FNVAR BUFFER) / INTO THE DISKETTE SCRATCH BLOCKS / WHICH WILL BE ALLOCATED AS NEEDED WITHIN 'WT1SCRATCH' JMS SETFIRSTBLOCK / SET THE 1ST BLOCK OF THE SCRATCH CHAIN (AND 'WTQBLK') /\ JMP WTFNV / WRITE ALL (RECORDS) WITHIN THE FNV BUFFER / ---------------- / --END OF MERGE-- THE LOGICAL END OF THE INPUT BUFFER HAS BEEN FOUND / ---------------- / WRITE-OUT THE CONTENTS OF THE FNV BUFFER IN THE SORTED ORDER OF THE FNVAR TABLE / THE DATA IS MOVED FROM THE FNVAR BUFFER TO THE OUTPUT BLOCK BUFFER / 1 WORD AT A TIME VIA 'FXOUT' WTFNV, JMS TADVAR / VTOP / GET A RECORD ADDRESS POINTER ENDI, JMS WT1FNV JMP .-2 / UNTIL A 0 VAT FOUND JMS FXOUT / 4-0'S ISZ LENGTH JMP .-2 JMP WTLASTOUT / WRITE THE FINAL (NOT NECESSARILY LAST) BLOCK / TRANSFER 1 RECORD'S WORTH OF DATA FROM THE FNV BUFFER TO THE OUTPUT BUFFER / (NOTE THAT THE POINTER TO THAT RECORD'S WORTH OF DATA WITHIN THE FNV BUFFER) / (WAS ALREADY POPPED FROM THE FNVAR TABLE WHICH MEANS THAT A 'JMS TADVAR') / (WAS EXECUTED SOME TIME PRIOR TO ENTERING 'WT1FNV') / JMS WT1FNV; RETURN HERE; BUT VAT=0 RETURNS HERE WT1FNV, XX UNTIL0, AC0003 TAD VTOP DCA VVTOP JMS GETVV / [VAT] DCA WT1TMP / TEMP TAD WT1TMP BSW AND (VVVVV) CIA TAD (-4) DCA LENGTH / -VVVVV-4 TAD WT1TMP SNA CLA JMP VAT0 / VAT=0 / EXIT IS TO RETURN+1 JMS FXOUT /'QUXEAL'/ MOVE THE DATA FOR THIS RECORD ISZ LENGTH / FROM THE FNV BUFFER TO THE OUTPUT BUFFER JMP .-2 / UNTIL ALL ELEMENTS MOVED TAD WT1TMP AND (MKSBIT) SZA CLA JMP UNTIL0 SKP VAT0, ISZ WT1FNV /RETURN+1 JMP I WT1FNV WT1TMP, ZBLOCK 1 LENGTH, ZBLOCK 1 / ---------------- / --END OF MERGE-- THE LOGICAL END OF THE FNV BUFFER HAS BEEN FOUND / ---------------- IXOLOOP,JMS INXOUT ENDFNV, TAD INTOP TAD PEIBLOCK / (-INBLOCK-400) SPA CLA / SKIP NEXT IF 'INPUT' BUFFER HAS BEEN EMPTIED JMP IXOLOOP TAD RDQBLK / GET NEXT BLOCK # TO BE 'READ' /\ JMP WTLASTOUT / AC = BLOCK # (NOT ZERO) / WRITE THE LAST SCRATCH BLOCK (COULD BE A PARTIAL BLOCK WITHIN THE CHAIN) / (NOTE THAT ENTRY WITH THE CONTENTS OF THE AC=0 MEANS AT THE END OF THE CHAIN) / (AND THAT WHEN THE AC IS NOT ZERO THAN WITHIN THE CHAIN) WTLASTOUT, JMS WT1SCRATCH / 'JMS' WITH (AC) = 0 MEANS --END OF CHAIN-- DCA MBUSY / [0] / CLEAR JMP I MERGE MBUSY, ZBLOCK 1 / =1 MEANS THE MAIN-LINE IS 'THE MERGE' PAGE / SCRATCH BLOCKS HAVE BEEN ALLOCATED / ON THE OUTPUT DOCUMENT DRIVE / THEREFORE [MERGE] THE CONTENTS OF THE FNV BUFFER / WITH THE CONTENTS OF THOSE SCRATCH BLOCKS / AS PER THE ORDER OF THE 'FNVAR' BUFFER / ............................................................................. / 'NEXTIN' MUST BE THE ONLY GUY TO READ SCRATCH BLOCKS / ............................................................................. MERGE2, DCA RDQBLK / ENTERED WITH (AC) = 1ST BLOCK OF SCRATCH CHAIN JMS SETFIRSTBLOCK /'WTQBLK'/ 'JMS' MAKES A NEW ('1ST' BLOCK) SCRATCH CHAIN / TAD (INBLOCK) / 'FYI' / (FOR YOUR INFORMATION) / DCA INFLADR / TAD (INBLOCK) DCA INTOP DCA PEIOFFSET/ [0] / /m0013 JMS NEXTIN /'RDQBLK' / NEWFNV, JMS TADVAR / SET 'VTOP' / FNVAR=FNVAR-1 NEWIN, TAD SORTKEY CIA DCA XSORTKEY DCA KEYID / 0 TAD ORDER JMP .+3 NEWKEY, TAD SORTORDER CLL RAL DCA SORTORDER ISZ KEYID / 1; 14 / ............................................................................. / TO INCREASE THE PERFORMANCE OF A SINGLE KEY SORT ONLY:: / IF THIS IS A SINGLE KEY SORT (THE CONTENTS OF 'SORTKEY' = 1) / THEN WE KNOW THE 'VAT' ADDRESS ALREADY / NO NEED TO 'KEYSEARCH' TAD SORTKEY / 1; 14 CLL RAR SZA CLA JMP .+4 / 'JMP' MEANS THIS IS A MULTI KEY SORT AC0003 / [3] TAD VTOP / (VTOP) PREVIOUSLY SET WITHIN 'TADVAR' JMP .+3 / 'JMP' TO 'DCA VVTOP' TAD FNVAR JMS KEYSEARCH / SEARCH FOR THE 'VAT' ADDRESS DCA VVTOP / SAVE THE [VAT] SLOT ADDRESS WITHIN THE FNV FOR THIS KEY / ............................................................................. JMS GETVV / [VAT] SNA JMP ENDFNV / [0] / ZERO [VAT] FOUND MEANS END IF FNV BUFFER BSW AND (VVVVV) CIA DCA VLENGTH / -VVVVV /\ JMP .+1 TAD INTOP DCA INVTOP SEARCH, TAD (3) TAD INVTOP DCA INVTOP JMS GETINV / [VAT] SNA JMP ENDI / END OF THE INPUT BUFFER FOUND [0 VAT] DCA INVVAT / /m0013 TAD INVVAT / /m0013 AND (KKKK) CIA TAD KEYID SNA CLA JMP FOUND / KEY FOUND TAD INVVAT / /m0013 BSW AND (VVVVV) SNA JMP SEARCH / VVVVV=0 CIA DCA INVVAT / /m0013 JMS GETINV CLA ISZ INVVAT / /m0013 JMP .-3 JMP SEARCH INVVAT, ZBLOCK 1 / /m0013 FOUND, JMS SETINVLENGTH / SETUP 'INVLENGTH' (AND 'INLENGTH') TAD VLENGTH TAD INVLENGTH SNA CLA JMP BOTH0 / BOTH 'VVVVV'ALUES ARE NULL TAD VLENGTH SNA CLA JMP FNVWINS TAD INVLENGTH SNA CLA JMP INWINS /\ JMP VALCOMP / THE FNV VAT ELEMENT AND THE SCRATCH VAT ARE BOTH (+) / THEREFORE COMPARE THE 6-BIT VALUE CHARACTERS 2X2 / AS 12-BIT WORDS / AND PUT THE WINNER TO THE 'OUT' BLOCK BUFFER VALCOMP,JMS GETVV / GET 1 ELEMENT FROM THE FNV BUFFER DCA GETVV / SAVE IT USING 'GETV' AS TEMP STORAGE JMS GETINV / [IN] / GET 1 ELEMENT FROM THE INPUT BUFFER CLL CIA TAD GETVV / [FNV] SNA CLA JMP .+4 / BOTH 2X2 CHARACTERS ARE THE SAME SZL JMP FNVWINS / 'FNV' BIGGER JMP INWINS / 'IN' BIGGER ISZ INVLENGTH / +1 TO THE INPUT 'V'ALUE COUNTER JMP ISZVLENGTH / / IN VALUE COUNTER OVERFLOW ISZ VLENGTH / +1 TO THE FNV 'V'ALUE COUNTER JMP FNVWINS / FNV HAS MORE TO GO SO IT'S THE WINNER BOTH0, ISZ XSORTKEY JMP NEWKEY JMP INWINS / IN VALUE COUNTER DID NOT OVERFLOW ISZVLENGTH, ISZ VLENGTH / +1 TO THE FNV 'V'ALUE COUNTER JMP VALCOMP / GET MORE 2X2 CHARACTERS / FNV VALUE COUNTER OVERFLOW JMP INWINS / 'IN' HAS MORE DATA TO GO SO IT'S THE WINNER VLENGTH, ZBLOCK 1 INVLENGTH, ZBLOCK 1 XSORTKEY, ZBLOCK 1 / THE NEGATIVE FROM 'SORTKEY' PAGE / TRANSFER THE RECORD ELEMENT WINNER / RESIDING WITHIN THE INPUT BUFFER / TO THE OUTPUT BUFFER INWINS, TAD SORTORDER SMA CLA JMP FNV2OUT IN2OUT, AC0003 TAD INTOP DCA INVTOP JMS GETINV / [VAT] DCA INVVAT / m0013 JMS SETINVLENGTH / SETUP 'INLENGTH' (AND 'INVLENGTH') IOLOOP, TAD INTOP TAD PEIBLOCK SPA CLA JMP JMSINXOUT TAD (INBLOCK) DCA INFLADR TAD (INBLOCK) DCA INTOP DCA PEIOFFSET/ [0] / /m0013 JMS NEXTIN JMSINXOUT,JMS INXOUT / INTOP+1/ POP INPUT/PUSH OUTPUT ISZ INLENGTH/-100;-4/ UNTIL (INLENGTH)=0 JMP IOLOOP / MEANS ALL KEYS FOR THAT RECORD MOVED TAD INVVAT / /m0013 AND (MKSBIT) SNA CLA JMP NEWIN JMP IN2OUT / UNTIL 'VAT' MKS-BIT = 0 INLENGTH, ZBLOCK 1 / TRANSFER THE RECORD ELEMENT WINNER / RESIDING WITHIN THE FNV BUFFER / TO THE OUTPUT BUFFER FNVWINS,TAD SORTORDER SMA CLA JMP IN2OUT FNV2OUT,JMS WT1FNV /'FXOUT'/ (IMBEDDED 'JMP ENDFNV' WITHIN 'WT1FNV' IF VAT=0) JMP NEWFNV / NORMAL RETURN FROM 'WT1FNV' JMP ENDFNV / VAT=0 / RETURN HERE WHEN THE VAT IS ZERO / POP AN ELEMENT FROM THE FNV BUFFER / AND PUSH IT INTO THE OUTPUT BLOCK BUFFER FXOUT, XX TAD FXOUT DCA INXOUT CDFFNV TAD I VTOP ISZ VTOP NOP JMP XXXOUT VTOP, FNVBUFFER / POP AN ELEMENT FROM OF THE INPUT BLOCK BUFFER / AND PUSH IT INTO THE OUTPUT BLOCK BUFFER INXOUT, XX TAD INTOP CIA TAD INFLADR SZA CLA JMP INXCDFEDT TAD (HEADER) / /m0013 TAD INTOP DCA INTOP AC7777 TAD INLENGTH DCA INLENGTH JMP I INXOUT INXCDFEDT, CDFEDT TAD I INTOP ISZ INTOP SKP / 'SKP' IS FASTER THAN AN 'IOT' XXXOUT, CDFEDT DCA I OUTTOP ISZ OUTTOP CDFMYF TAD OUTTOP TAD (-OUTBLOCK-400) SPA CLA / SKIP NEXT IF 'OUTPUT' BUFFER FULL JMP I INXOUT JMS QUXEAL / ALLOCATE 1 DISK BLOCK JMS WT1SCRATCH / OUTPUT BLOCK FILLED-UP JMP I INXOUT INTOP, INBLOCK+HEADER / /m0013 OUTTOP, OUTBLOCK+HEADER / /m0013 / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / INBLOCK, 7401 OUTBLOCK, 7401 / 0 0 / NEXT BNO --CARRY-IT-OVER--> NEXT BNO / ALWAYS THE NEXT / / BLOCK # TO READ / [RESERVED] [RESERVED] / / DATA FROM READ DATA FOR WRITE / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . GETI2, XX CDFEDT TAD I (INBLOCK+2) CDFMYF JMP I GETI2 GETI3, XX CDFEDT TAD I (INBLOCK+3) CDFMYF JMP I GETI3 GETO2, XX CDFEDT TAD I (OUTBLOCK+2) CDFMYF JMP I GETO2 PUTO2, XX CDFEDT DCA I (OUTBLOCK+2) CDFMYF JMP I PUTO2 TADVAR, XX AC7777 TAD FNVAR DCA FNVAR / FNVARBUFFER, ..-1, ..-2, ..-3, ..ETC CDFFNV TAD I FNVAR CDFMYF IAC DCA VTOP JMP I TADVAR PAGE PEIBLOCK,-INBLOCK-400 / (-#) FLOATING PHYSICAL END ADRS OF 'INBLOCK' BUFFER SLOP= KCCVALUE%2+4^MAXKEY&400 IFZERO SLOP OUTBLOCK= 6400 / OF THE 'EDITOR' FIELD INBLOCK= OUTBLOCK-400-SLOP/ OF THE 'EDITOR' FIELD RDQBLK, ZBLOCK 1 /NEXT # TO BE READ / WE RAN OUT OF CHARACTERS FROM THE 'INBLOCK' BUFFER NEXTIN, XX TAD RDQBLK /GET THE BLOCK # TO BE READ JMS RD1BLOCK / READ 1 SCRATCH BLOCK INFLADR, INBLOCK / FLOATS/ INTO MEMORY STARTING AT THE ADDRESS WITHIN 'INFLAD' TAD RDQBLK JMS QUXEFR / DEALLOCATE THE BLOCK JUST READ AC0002 TAD INFLADR DCA T3 / (INFLADR)+2 CDFEDT TAD I T3 / 'NEXT' BLOCK # TO BE 'READ' DCA RDQBLK / '--CARRY--IT--OVER-->' ISZ T3 / (INFLADR)+3 TAD I T3 /-400;-4/ NEGATIVE # OF 'VALAD' WORDS JUST READ CDFMYF TAD PEIOFFSET/-400;0/ NEGATIVE OFFSET; ELSE 0; REMEMBER ? /m0013 TAD (-INBLOCK) DCA PEIBLOCK / '-INBLOCK-400-X' JMP I NEXTIN PUSHUP, XX CDFEDT UPLOOP, TAD T1 TAD PEIBLOCK SMA CLA JMP .+6 TAD I T1 DCA I INFLADR ISZ T1 ISZ INFLADR JMP UPLOOP CDFMYF JMP I PUSHUP / GET 1 ELEMENT FROM THE FNV BUFFER GETVV, XX CDFFNV TAD I VVTOP CDFMYF ISZ VVTOP NOP JMP I GETVV VVTOP, FNVBUFFER+3 / GET 1 ELEMENT FROM THE INPUT BUFFER GETINV, XX INVLOOP,TAD PEIBLOCK / (-INBLOCK-400) TAD INVTOP SPA CLA JMP TADINVTOP / THERE IS NO MORE DATA IN THE INPUT BUFFER TO GET VIA 'GETINV' / THEREFORE 'PUSHUP' ALL DATA BETWEEN (INTOP) AND (INVTOP) TAD INTOP CIA TAD INFLADR / (COULD BE '#INBLOCK') SNA JMP MOVUP4 / (INTOP) IS SAME AS (INFLADR) SPA CLA JMP MOVTOP / (INTOP) IS GREATER THAN (INFLADR) / (INTOP) IS LESS THAN (INFLADR) TAD INFLADR TAD (HEADER)/ [4] / /m0013 DCA T1 JMS PUSHUP / ... USING 'T1' ... TAD (HEADER)/ [4] / /m0013 TAD PEIBLOCK DCA PEIBLOCK TAD (-HEADER) / /m0013 TAD INVTOP DCA INVTOP SKP MOVUP4, TAD (HEADER) / /m0013 MOVTOP, TAD INTOP DCA T1 TAD T1 CIA TAD INVTOP TAD (INBLOCK) DCA INVTOP TAD T1 TAD PEIBLOCK DCA PEIOFFSET / /m0013 TAD (INBLOCK) DCA INFLADR TAD (INBLOCK) DCA INTOP JMS PUSHUP / ... USING 'T1' ... JMS NEXTIN / JMP INVLOOP / BECAUSE (INVTOP) MAY STILL BE PAST (PEIBLOCK) PEIOFFSET, ZBLOCK 1 / /a0013 TADINVTOP, TAD INVTOP CIA TAD INFLADR SMA SZA JMP INVCLA / (INVTOP) IS LESS THAN (INFLADR) SMA JMP INVAC4 / (INVTOP) IS SAME AS (INFLADR) TAD (HEADER) / /m0013 SPA SNA CLA JMP INVCLA / (INVTOP) IS SAME AS (INFLADR) OR IS BETWEEN (INFLADR THRU INFLADR+header) INVAC4, TAD (HEADER)/ [4] / /m0013 TAD INVTOP DCA INVTOP JMP INVLOOP INVCLA, CLA CDFEDT TAD I INVTOP CDFMYF ISZ INVTOP NOP JMP I GETINV INVTOP, INBLOCK+HEADER+3 / THE SAME AS (INTOP)+3 /m0013 /***************************************************************************** / / Code here is inserted to access the new FNBUFFER, which now /a021 / resides in FIELD 4. This has been moved to provide enough /a021 / room for upto 30 multinational or technical characters in the /a021 / field name. /a021 / /**************************************************************************** XFNBPSH,XX / Routine to put a character in FNBUFFER/a021 / at the address given in FN /a021 CDFFNB / Change to the FNBUFFER field /a021 DCA I FN / Save the value via FN /a021 CDFMYF / Change back to my field /a021 JMP I XFNBPSH / Return /a021 XFNBGET,XX / Routine to get a character from the /a021 / FNBUFFER at the address given in FN /a021 CDFFNB / Change to the FNBUFFER field /a021 TAD I FN / Add the value pointed to by FN to AC /a021 CDFMYF / Change back to my field /a021 JMP I XFNBGET / Return /a021 PAGE HEADER= 4 /m0013 / ........................................................................... /0 OUTBLOCK, 7401 /1 0 /2 NEXT BLOCK # /3 -# ('VALAD' VOLUME) /4 DATA /5 DATA /THRU 255 WORDS / ........................................................................... / WRITE 1 SCRATCH BLOCK / CALL:: AC????; JMS WT1SCRATCH / ENTER WITH THE CONTENTS OF THE (AC) = NEXT BLOCK # OF CHAIN, WHILE / THE CONTENTS OF PROGRAM LOCATION 'WTQBLK' = 'THIS' BLOCK # TO BE WRITTEN WT1SCRATCH, XX JMS PUTO2 / NEW NEXT BLOCK (OF THE CHAIN) / CALCULATE THE USED VOLUME OF THE OUTPUT BUFFER / (INCLUDING THE 4 HEADER WORDS) / AND PLACE THAT N-E-G-A-T-E-D VALUE INTO 'OUTBLOCK+3' TAD OUTTOP CIA TAD (OUTBLOCK) CDFEDT DCA I (OUTBLOCK+3) TAD .-2 / 'CDFEDT' CDFMYF DCA QBFD / THE DATA ('EDITOR') FIELD OF THE DATA TAD (OUTBLOCK) DCA QBAD / TOP ADDRESS WITHIN THAT ('EDITOR') FIELD TAD WTQBLK DCA QBLK / THE BLOCK # TO BE WRITTEN WITH THAT DATA JMS QUXEWT TAD (OUTBLOCK+HEADER) /m0013 DCA OUTTOP / (MAKES THE OUTPUT BLOCK BUFFER LOOK EMPTY) JMS GETO2 DCA WTQBLK / THE NEXT BLOCK # TO BE WRITTEN / . . . . . . . . . . . . . . . . . . . . . . . . . . JMS TIMEOUT / OUTPUT THE TIME TO THE SCREEN JMS XXHLTFLG / TEST FOR 'GOLD HALT' / . . . . . . . . . . . . . . . . . . . . . . . . . . JMP I WT1SCRATCH WTQBLK, ZBLOCK 1 / PRESERVES THE BLOCK # TO BE WRITTEN 'NEXT' / MERGE SUBROUTINE / TO DEALLOCATE ALL BLOCKS ALLOCATED / ... THE DRIVE # MUST ALREADY BE SET WITHIN QDRV MRGEFRALL, XX FREEALL,TAD FIRSTBLOCK / FIRST TIME EVER IS FIRST BLOCK OF THE SCRATCH CHAIN SNA JMP I MRGEFRALL / 0 MEANS ALREADY FREED-UP THE LAST BLOCK ALLOCATED JMS FREE1 JMP FREEALL / UNTIL ALL BLOCKS ALLOCATED HAVE BEEN FREED-UP / SUBROUTINE TO DEALLOCATE (FREE-UP) 1 DISKETTE SCRATCH BLOCK / ENTER WITH THE (AC) = BLOCK # TO DEALLOCATE AFTER THE READ IS COMPLETE FREE1, XX JMS RD1BLOCK / 'READ' THE BLOCK (TO GET NEXT BLOCK # OF CHAIN) INBLOCK / INTO A BUFFER CALLED 'INBLOCK' (OF 'EDITOR' FIELD) TAD QBLK JMS QUXEFR / 'OFFICALLY' DEALLOCATE VIA 'QURX::' JMS GETI2 / GET NEXT BLOCK # WITHIN CHAIN (0 MEANS NO MORE) SNA JMS QUXERT / REWRITE' ALLOCATION BLOCK DCA FIRSTBLOCK / AND MAKE IT THE NEW FIRST BLOCK OF THE CHAIN JMP I FREE1 ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// QURX .PA - SUBROUTINES TO QUEUE RXHAN \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!! !!!!!!!! / !!!!!!!! QURX !!!!!!!! / !!!!!!!! !!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! QURX, XX CIFSYS ENQUE QUBLK QURXJWAIT, CIFSYS JWAIT CLA TAD QUQBLK+RXQCOD SNA CLA / CHANGE 'SNA CLA' TO 'SNA' WHEN DOING 'FNC+4000' JMP QURXJWAIT / EXIT WITH THE (AC) MINUS MEANS A DISK ERROR WAS DETECTED BY THE DISK HARDWARE / [EXITING WITH THE (AC) MINUS WAS MADE POSSIBLE BY THE FUNCTION+4000] / EXIT WITH THE (AC) POS MEANS THE QURX COMPLETED SUCCESSFULLY JMP I QURX / ------------------------------------ / -------- ORDER IMPORTANT -------- / ------------------------------------ QUBLK, DSKQUE; 0; 0 QUQBLK, QCOD, 0 / R ECCCCCCCCCCC: COMPLETETION CODE QFNC, 0 / W FFFFFFFFFFFF: FUNCTION TO DO:: / +2000 WITH A PHYSICAL OR / +4000 WITH ANY FUNCTION / LOGICAL WRITE / MEANS THAT RXHAN WILL / MEANS THAT AFTER THE / RETURN PROGRAM CONTROL / FUNCTION IS COMPLETED / TO THE CALLING PROGRAM / RXHAN WILL ISSUE A / INSTEAD OF THE OPERATING SYSTEM / HARDWARE READ OF THE / UPON THE DETECTION / BLOCK JUST WRITTEN. / OF A DISK ERROR. / / / THE DATA OF THAT / THE CALLING PROGRAM WILL / BLOCK WILL BE READ / PROCESS THE ERROR. / INTO THE HARDWARE / / SCRATCH PAD MEMORY. / / RXERT= 0 / :: RESET DIR AND ALLOC MEMORY BLOCK / RXEPR= RXERT+1 / :: PHYSICAL READ / RXEPW= RXEPR+1 / :: PHYSICAL WRITE / RXERD= RXEPW+1 / :: LOGICAL READ / RXEWT= RXERD+1 / :: LOGICAL WRITE / RXEAL= RXEWT+1 / :: ALLOCATE A BLOCK / RXEFR= RXEAL+1 / :: DEALLOCATE A BLOCK / RXEGF= RXEFR+1 / :: GET BLOCK # OF THE FIRST BLOCK [THE HDR] / FOR THE FILE # WITHIN QFNO / RXESF= RXEGF+1 / :: SET BLOCKNO TO FIRST BLOCK / RXESP= RXESF+1 / :: GET # OF FREE BLOCKS ON DISKETTE QDN1, 0 / DRIVE NAME WORD #1 QDN2, 0 / DRIVE NAME WORD #2 QFNO, 0 / R/W 0000NNNNNNNN: FILE # QID1, 0 / PLASTIC ID QSPC, 0 / R 00##########: # FREE BLOCKS ON DISKETTE QCTL, 0 / CONTROLLER BITS FOR PATCHING COMMANDS QDRV, 0 / W MMMMMMMMDDDD: MODE BITS FOR LCD; DRIVE # QBLK, 0 / R/W BLOCK # QRS1, 0 /* RESERVED QBAD, 0 / W AAAAAAAAAAAA: ADDRESS OF READ/WRITE BUFFER QBFD, 0 / W 62F1: CDF TO THE FIELD / OF THE ADDRESS / OF THE READ/WRITE BUFFER / WITHIN QBAD QTRK, 0 / TRACK # QSEC, 0 / SECTOR # / ------------------------------------- / -------- END ORDER IMPORTANT -------- / ------------------------------------- / QURX SUBROUTINE TO RESET ALLOCATION OR DIRECTORY BLOCK / ...THE DRIVE # MUST ALREADY BE SET WITHIN QDRV / EXIT WITH AC = 0 QUXERT, XX / TAD KRXERT DCA QFNC / 0 JMS QURX JMP I QUXERT / QURX SUBROUTINE TO GET THE # OF FREE BLOCKS REMAINING ON THE DISKETTE / ...THE DRIVE # MUST ALREADY BE SET WITHIN QDRV / EXIT WITH THE CONTENTS OF THE AC = THE NUMBER OF FREE BLOCK REMAINING / - HARDWARE ERROR WHILE TRYING TO GET AVAILABLE DISKETTE SPACE COULD OCCUR QUXESP, XX TAD KRXESP / FUNCTION DCA QFNC / INTO QUBLK JMS QURX / JMS TO EXECUTE THE FUNCTION TAD QSPC / GET THE # OF FREE BLOCK REMAINING JMP I QUXESP / EXIT QUXESP / QURX SUBROUTINE TO DEALLOCATE 1 DISKETTE BLOCK / ENTERED WITH THE CONTENTS OF THE AC = THE BLOCK # TO BE DEALLOCATED / ...THE DRIVE # MUST BE ALREADY SET WITHIN QDRV / - HARDWARE ERROR WHILE TRYING TO DEALLOCATE 1 BLOCK COULD OCCUR QUXEFR, XX DCA QBLK / TAD KRXEFR AC0006 DCA QFNC JMS QURX / JMS TO EXECUTE THE FUNCTION JMP I QUXEFR / EXIT QUXEFR / QURX SUBROUTINE TO ALLOCATE 1 DISKETTE BLOCK / ...THE DRIVE # MUST BE ALREADY SET WITHIN QDRV / EXIT WITH THE CONTENTS OF THE AC = BLOCK # ALLOCATED / - HARDWARE ERROR WHILE TRYING TO ALLOCATE 1 BLOCK COULD OCCUR QUXEAL, XX TAD KRXEAL DCA QFNC JMS QURX TAD QBLK / BLOCK # ALLOCATED SNA / /a0014 JMP E13CKW / OUTPUT DISK/VOL FULL - CK WHICH ONE /A018 /D018 JMP E13 /error / OUTPUT DISKETTE FULL (no more blocks) /a0014 JMP I QUXEAL / EXIT / QURX SUBROUTINE TO EXECUTE A LOGICAL READ OF 1 BLOCK / ...THE BLOCK # MUST ALREADY BE SET WITHIN QBLK / ...THE READ BUFFER ADDRESS MUST ALREADY BE SET WITHIN QBAD / ...THE DATA FIELD OF THAT READ BUFFER MUST ALREADY BE SET WITHIN QBFD / ...THE DRIVE # MUST BE ALREADY SET WITHIN QDRV QUXERD, XX TAD QUXERD DCA QUXEWT / TAD KRXERD / LOGICAL READ FUNCTION AC0003 JMP QURDWT / QURX SUBROUTINE TO EXECUTE A LOGICAL WRITE OF 1 DISKETTE BLOCK / ...THE BLOCK # MUST ALREADY BE SET WITHIN QBLK / ...THE WRITE BUFFER ADDRESS MUST ALREADY BE SET WITHIN QBAD / ...THE DATA FIELD OF THAT WRITE BUFFER MUST ALREADY BE SET WITHIN QBFD / ...THE DRIVE # MUST BE ALREADY SET WITHIN QDRV / * - HARDWARE ERRORS COULD OCCUR ON THE DISK READ OR WRITE QUXEWT, XX TAD KRXEWT / LOGICAL WRITE FUNCTION + 2000 QURDWT, DCA QFNC JMS QURX / EXECUTE THE FUNCTION: KRXEWT(2004); KRXERD(3) JMP I QUXEWT / EXIT QUEWT OR QUERD /KRXERT, RXERT / 0 KRXESP, RXESP /KRXEFR, RXEFR / 6 KRXEAL, RXEAL /KRXERD, RXERD / 3 KRXEWT, RXEWT+2000 / SUBROUTINE TO READ 1 DISKETTE BLOCK / TAD (BLOCK#); JMS RD1BLOCK; BUFFER; RETURN PC RD1BLOCK, XX / ENTER WITH THE CONTENTS OF THE AC = TO THE BLOCK # TO BE READ /*THE DRIVE NUMBER MUST ALREADY BE WITHIN QDRV / PC+1 IS THE BUFFER ADDRESS (ALWAYS IN THE 'EDITOR' FIELD) / PC+2 IS THE RETURN ADDRESS DCA QBLK / BLOCK # TAD I RD1BLOCK ISZ RD1BLOCK DCA QBAD / BUFFER ADDRESS CDFEDT TAD .-1 CDFMYF DCA QBFD / BUFFER DATA FIELD (ALWAYS 'EDITOR' FIELD) JMS QUXERD JMP I RD1BLOCK PAGE ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// ODG .PA - OUTPUT DOCUMENT GENERATOR \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ / ********************************************************************** / * * / * NOTES: 1) INSERTJUST routine resides in SELECTOR due to lack of * / * space IN ODG. * / ********************************************************************** / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!! !!!!!!!! / !!!!!!!! OUTPUT DOCUMENT GENERATOR !!!!!!!! / !!!!!!!! !!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / LOGICAL READ ONE FNV BUFFER PACKET BLOCK / AND DEALLOCATE THAT BLOCK / THEN RANDOM READ THE INPUT DOCUMENT / STARTING AT THE BLOCK # AND CHARACTER OFFSET / SPECIFIED WITHIN THAT FNV BUFFER PACKET BLOCK CONTROL WORDS / OPEN THE OUTPUT DOCUMENT # DEFINED WITHIN PROGRAM LOCATION 'SOTFL' / FOR [TOP], [BOTTOM], OR [OVERWRITE] 'SCROLL'ING ODG, XX /-- DCA ODGCOUNT / 'OUTPUT' RECORD COUNTER TAD FIRSTBLOCK / 1ST BLOCK OF A CHAIN OF SCRATCH BLOCKS JMS FREE1 / READ THE 1ST SCRATCH BLOCK OF THE CHAIN TAD (INBLOCK+HEADER) /m0013 DCA T1ODG TAD SOTFL / OUTPUT DOCUMENT NAME & DRIVE MQL / INTO THE MQL FOR 'XDSKIN' TAD DSKID / 0QQ DNN NNN NNN AND K7000 / QQ = (0) TOP, (1) BOT, (11) OVERWRITE CLL RAL / QQ0 000 000 000 SNA JMP .+4 / 'TOP' SMA CLA AC7776 / 'BOT' CMA / 'OVR' CIFFIO /M0006 FILEIO /M0006 XDSKIN / WANTS MQ; THEN AC (0) TOP, (1) BOT, (-1) OVERWRITE / OPEN THE INPUT DOCUMENT # DEFINED WITHIN PROGRAM LOCATION 'SLSTFL' TAD SLSTFL / INPUT DOCUMENT NAME & DRIVE JMS RDINIT / % RANDRD INITIALIZATION / TRANSFER ALL CHARACTERS TO THE OUTPUT DOCUMENT / FROM THE BEGINNING OF THE INPUT DOCUMENT / UNTIL THE FIRST '<' OF THE FIRST IS DETECTED ODGRD1, AC0001 JMS ODGRDCHAR / READ 1 CHARACTER FROM THE INPUT DOCUMENT JMP E8 /*...UNEXPECTED DISK EOF SKP / ...NON-PRINTING CHAR RETURNS HERE JMP ODGLAB / ... < RETURNS HERE K7000, NOP / ... > RETURNS HERE / ...12-BIT CHARACTER RETURNS HERE / BLINDLY 'SCROLL' ALL 12-BIT DATA / FROM THE BEGINNING OF THE INPUT DOCUMENT / UNTIL THE FIRST '<' IS DETECTED JMS ODGSCROLL JMP ODGRD1 / ODG SUBROUTINE TO TRANSFER THE: / BLOCK #, CHARACTER OFFSET, PERFORMANCE (HHH), AND VAT / FROM THE 'INBLOCK' BUFFER TO INDIVIDUAL HOLDING LOCATIONS / FOR 'PUTBNO' ODGPOP, XX JMS ODGFNV DCA ODGBNO / SAVE THE BLOCK # JMS ODGFNV DCA ODGOFF / SAVE THE CHARACTER BYTE OFFSET JMS ODGFNV DCA ODGHHH / SAVE THE PERFORMANCE ACCELERATOR ATTRIBUTE JMS ODGFNV / GET THE 'VAT' WHICH SHOULD NEVER = 0000 SNA / XVV VVV SMK KKK JMP ODGFINI / VAT=0000 MEANS AT END OF FNV TABLE / MOVE THE POINTER T1ODG OVER THE 'VALUE' CHARACTERS / WHICH WERE BROUGHT ALONG WITH THE READING OF THE BLOCK / BUT WHICH ARE NOT NEEDED HERE / [THEY WERE NEEDED ONLY FOR THE SORT AND EARLY PACKET MERGES] DCA ODGVAT / TEMP SAVE THE WHOLE 'VAT' TAD ODGVAT BSW / SMKKKK XVVVVV AND (VVVVV) / 000000 0VVVVV SNA JMP ODGV0 CIA DCA T1 JMS ODGFNV CLA ISZ T1 JMP .-3 /*E8 - MEANS ERROR FROM WITHIN 'PUTBNO' ROUTINE ODGV0, JMS PUTBNO / SETUP RANDOM READ ATTRIBUTES: ODGBNO, ZBLOCK 1 / ...BLOCK # ODGOFF, ZBLOCK 1 / ...CHARACTER BYTE OFFSET ODGHHH, ZBLOCK 1 / ...PERFORMANCE ATTRIBUTE JMP E8 / SHOW ANY ERROR AS UNEXPECTED END OF FILE JMP I ODGPOP ODGVAT, ZBLOCK 1 / HOLDS THE WHOLE 'VAT': XVV VVV SMK KKK / A LEFT ANGLE BRACKET HAS BEEN FOUND / SIGNIFYING THE FIRST OF THE FIRST RECORD / WHILE BLINDLY 'SCROLL'ING ALL 12-BIT DATA / FROM THE INPUT DOCUMENT TO THE OUTPUT DOCUMENT ODGLAB, CLA / CLA BECAUSE AC = '<' ASCII CODE ODGNEXT,JMS ODGPOP / GET THE:: BLOCK #, C-OFFSET, HHH, AND VAT / TRANSFER THE CONTENTS OF ONE RECORD / BETWEEN THE '<' AND THE '<>' / FROM THE INPUT DOCUMENT TO THE OUTPUT DOCUMENT /*E8 - MEANS UNEXPECTED DISK END OF FILE (OUT OF DATA) ODGRDNXCH, AC0001 JMS ODGRDCHAR JMP E8 /*...UNEXPECTED DISK EOF JMP .+3 / ...NON-PRINTING CHAR RETURNS HERE JMP .+4 / ... < RETURNS HERE JMP ODGRAB / ... > RETURNS HERE JMS ODGSCROLL / ... 12-BIT DATA: MMMMMCCCCCCC RETURNS HERE JMP .+3 / EACH CHAR (EXCEPT '<') CLEARS ODGFLAG JMS ODGSCROLL / SCROLL THE '<' LEFT ANGLE BRACKET AC7777 DCA ODGFLAG / 0-MEANS WAITING FOR '<'; -1 MEANS FOUND IT JMP ODGRDNXCH / UNTIL '<>' DETECTED / RIGHT ANGLE BRACKET '>' FOUND / IF THE CONTENTS OF PROGRAM LOCATION ODGFLAG = -1 / THEN THIS '>' MEANS AN END OF RECORD DIAMOND '<>' / ELSE IT IS JUST A DELIMITER ODGRAB, JMS ODGSCROLL / SCROLL THE '>' TO THE OUTPUT DOCUMENT ISZ ODGFLAG / SKIP NEXT IF (ODGFLAG) GOES TO 0 JMP ODGRDNXCH / JUST DELIMITER; MORE DATA IN RECORD TO MOVE JMS INSERTJUST / INSERT 'RULER JUSTIFYING' SPACES / 'JMS TIMEOUT' DOESN'T EXECUTE WHEN 'ODGCOUNT' GOES TO ZERO - THAT'S O.K. ISZ ODGCOUNT / OUTPUT TO THE SCREEN: 'RECORDS REPRODUCED: X' JMS TIMEOUT / OUTPUT THE TIME TO THE SCREEN CIFIOA JMS I IOACAL 0 MODG 1005 / ^P ODGCOUNT,ZBLOCK 1 / ^D 1600 / ^P /\ JMP .+1 / WHEN THE RECORD HAS MULTIPLE KEYS (AND MULTIPLE ATTRIBUTES) / THE OUTPUT DOCUMENT GENERATOR TRANSFERS THE ENTIRE RECORD / USING THE FIRST BLOCK #, C-OFFSET, HHH, AND VAT ONLY (SKIPPING THE OTHERS) TAD ODGVAT / GET THE WHOLE 'VAT': XVVVVVSMKKKK AND (MKSBIT) / TEST THE MULTI-KEY SORT BIT (MKSBIT) SNA CLA / SKIP NEXT IF PART OF MULTI-KEY ATTRIBUTES JMP ODGNEXT / JMP MEANS AT END OF MULTI-KEY RECORD JMS ODGPOP / UNTIL A 'VAT' WITH 'MKSBIT' = 0 IS FOUND JMP .-5 / UNTIL 'MKSBIT' WITHIN THE 'VAT' = 0 ODGFLAG,ZBLOCK 1 / 0 MEANS WAITING FOR >; -1 FOUND IT T1ODG, INBLOCK / / ODG SUBROUTINE / TO GET THE NEXT VALUE FROM THE ELEMENT TABLE / POINTED TO BY THE ADDRESS WITHIN T1ODG / IF A 'TAD I T1ODG' EXAUSTS THE DATA WITHIN THE BUFFER / THEN READ AND DEALLOCATE (FREE-UP) ANOTHER SCRATCH BLOCK OF THE CHAIN ODGFNV, XX JMS GETI3 TAD (-INBLOCK) TAD T1ODG /GET ADDRESS POINTER INTO THE FNV BUFFER SPA CLA / SKIP NEXT IF AT END OF 'INBLOCK' BUFFER LIMIT JMP .+6 / JMP CAUSE STILL WITHIN BUFFER ADDRESS LIMITS TAD (INBLOCK+HEADER) /m0013 DCA T1ODG / RESET WITH TOP OF 'INBLOCK' PHYSICAL ADDRESS JMS GETI2 JMS FREE1 / 'READ' 1 SCRATCH BLOCK THEN FREE IT UP JMP ODGFNV+1 CDFEDT TAD I T1ODG /EXIT 'ODGFNV' WITH THE (AC) = TO THE VALUE OF: CDFMYF / ....... ISZ T1ODG / ....... JMP I ODGFNV / 'BLOCK #', 'OFFSET', 'PERFORMANCE', OR 'VAT' /-- / DONE /-- /-- / THE OUTPUT DOCUMENT GENERATOR /-- / HAS TRANSFERRED THE ENTIRE CONTENTS /-- / OF THE INPUT DOCUMENT TO THE OUTPUT DOCUMENT /-- /-- ODGFINI,TAD (207) / 'RULER' MODIFIED FLAG /-- JMS ODGSCROLL /-- CIFFIO /-- FILEIO /-- XDSKCL / CLOSES THE FILE OPENED BY XDSKIN /-- JMP I ODG / EXIT THE OUTPUT DOCUMENT GENERATOR /-- / ODG SUBROUTINE / TO OUTPUT 1 CHARACTER TO THE OUTPUT DOCUMENT / VIA 'SCROLL' CROSS FIELD SYSTEM CALL ODGSCROLL, XX CIFFIO /M0006 FILEIO /M0006 XPUTST JMP I ODGSCROLL PAGE /RANDR2.PA - RANDOM ACCESS DISKETTE READ / /++ /TITLE: RANDR2.PA / /FACILITY: WPS - 8 / /ABSTRACT: RANDR2 is used to random access read a WPS diskette / by the WPS SORT routine. It is a modified copy of RDFILP.PA. / /ENVIRONMENT: WPS278 / /AUTHOR: Joe Famularo WPD, CREATION DATE: 12/15/80 / Pete Smith WPD / /-- / /Definitions: / SCHCNT= 774 / BYTES PER BLOCK BOFSET= 2 / BYTE OFFSET IN BLOCK / SCBKOF= 52 / OFFSET TO FIRST BLOCK PTR IN HEADER 1 / GETBY1=T1RR / FOR USE IN RDGTBY ROUTINE / HO1354=1354 / HEADER OFFSET OF EXTENTION HEADER 3 /A012 / / The following buffers reside in USER FIELD 1 (physical field 3) / RDBUF=7000 / read data buffer / HEADBF=RDBUF+400 / header block buffer /M017 HDBLEN=400 / length of header block buffer (HEADBF) /M017 / in words / / /***************************************************************************** / DESCRIPTION: RDINIT / / OPENS A FILE FOR READING. / / INPUTS: AC CONTAINS THE FILENAME / / OUTPUTS: / / RDINIT, XX DCA T1RR / SAVE THE FILE NAME TAD T1RR / RECOVER IT AND P377 / GET THE FILE NUMBER DCA RDFQBK+RXQFNO / WRITE THE FILE NUMBER / TAD T1RR / RECOVER THE FILE NAME BSW RTR AND (17) / GET THE DRIVE NUMBER DCA RDFQBK+RXQDRV / WRITE THE DRIVE NUMBER / / THIS CALL WILL DEPOSIT THE BLOCK NUMBER OF OUR FILE'S HEADER BLOCK / INTO RDFQBK+RXQBLK / JMS RDFIO RXEGF+4000 HEADBF /M017 / SMA CLA / A NEGATIVE RETURN INDICATES AN ERROR TAD RDFQBK+RXQBLK / GET THE HEADER BLOCK NUMBER RDINI2, JMS RDINI1 / INITITIALIZE SOME VARIABLES / JMS RDGETR / GET THE FIRST HEADER EXTENSION DCA RDHDRB+1 / SAVE ITS BLOCK NUMBER / AC0001 JMS RDGETR / GET THE SECOND HEADER EXTENSION DCA RDHDRB+2 / SAVE ITS BLOCK NUMBER / JMS GETHDREXT / GET 3RD & 4TH HEADER EXTENTIONS /A012 / JMP I RDINIT / AND RETURN /***************************************************************************** / DESCRIPTION: RDINI1 / / INITIALIZES A FEW VARIABLES FOR READING A FILE. / / INPUTS: AC = BLK # OF THE FILE'S HDR CTRL BLK, OR 0 IF NOT FOUND / OUTPUTS: / RDINI1, XX DCA RDHDRB / SET HEADER BLOCK NUMBER AC7777 DCA RDCHNO / INITIALIZE THE COUNT OF NUMBER OF CHARACTERS LEFT / IN THE BUFFER AC7777 DCA HDRTNO / INITIALIZE THE COUNT OF NUMBER OF BLOCK NUMBERS / LEFT IN HEADER BLOCK BUFFER (HEADBF) /M017 TAD (SCBKOF) / INITIALIZE THE OFFSET OF THE FIRST BLOCK NUMBER / IN THE HEADER BLOCK DCA HDROFF DCA RDMOD / CLEAR THE MODE VALUES (USED IN SIX BIT TRANSLATION) DCA RDMOD+1 DCA RDHDBN / SHOW HEADBF EMPTY OF A HEADER BLOCK /M017 DCA LBLKLD / INIT LAST BLOCK LOADED LOCATION JMP I RDINI1 / AND RETURN / / / / /***************************************************************************** / DESCRIPTION: RDNXCB / / RETURNS THE NEXT BYTE FROM THE FILE / / INPUTS: / / OUTPUTS: / RDNXCB, XX /*** THIS IS AN EXTERNALLY DEFINED ENTRY POINT / RDNXC1, CLA ISZ RDCHNO / INCREMENT THE NEGATIVE CHARACTER COUNT JMP RDNXC3 / JUMP IF THERE ARE ANY CHARACTERS LEFT IN THE BUFFER / ISZ HDROFF / INCREMENT THE OFFSET INTO HEADER BLOCK SKP JMP I RDNXCB / TO SIMULATE EOF FOR SINGLE BLOCK READ / TAD HDROFF / HAS THE OFFSET BEEN INCREMENTED INTO /A012 / HEADER EXTENTION POINTERS IN /A012 / EXTENTION HEADER BLOCK 2? /A012 TAD (-HO1354 /A012 SZA CLA / SKIP IF: SO /A012 JMP RDNXC4 /A012 TAD (HO1354+16 / OFFSET HDROFF OVER THE POINTERS TO /A012 / THE FIRST DATA BLOCK POINTER IN /A012 / HEADER EXTENTION BLOCK 3. /A012 DCA HDROFF /A012 JMP RDNXC5 /A012 / RDNXC4, ISZ HDRTNO / ANY BLOCK NUMBERS LEFT IN HEADBF? /M017 JMP RDNXC2 / SKIP IF SOME ARE LEFT / / THERE ARE NO BLOCK NUMBERS IN HEADBF. FILL THE BUFFER UP. /M017 / RDNXC5, JMS LDHDRB / LOAD HEADER BLOCK BUFFER /M012 JMP I RDNXCB / ERROR RETURN AC = 0 / / THERE ARE NO CHARACTERS. READ THE NEXT BLOCK INTO THE BUFFER. / RDNXC2, TAD (-SCHCNT) / RESET THE CHARACTER COUNT DCA RDCHNO JMS RDFBUF / FILL THE BUFFER JMP I RDNXCB / ERROR OR EOF RETURN / / NOW, READ THE NEXT BYTE FROM THE BUFFER / RDNXC3, TAD RDCHNO / GET THE CHARACTER COUNT TAD (SCHCNT) / SUBTRACT FROM THE END OF THE BUFFER JMS RDGTBY / GET THE NEXT BYTE FROM THE BUFFER RDBUF+BOFSET / SNA / IS THE VALUE A NULL? JMP RDNXC1 / JUMP TO GET A NEW ONE IF SO JMP I RDNXCB / ELSE, RETURN THE VALUE /***************************************************************************** / DESCRIPTION: RDFBUF / / READS THE NEXT BLOCK INTO RDBUF / / INPUTS: IMPLICIT: HDRPTR = BLK # TO BE READ / / OUTPUTS: AC = NEGATIVE IF AN ERROR WAS ENCOUNTERED / AC = POSITIVE IF OK / / AT EOF / AC = 0, RDCHNO = 0 RDFBUF, XX ISZ HDRPTR / INCREMENT THE POINTER INTO HEADER BLOCK BUFFER TAD LBLKLD / GET NEGATIVE NUMBER OF THE LAST BLOCK LOADED CDFEDT / change df to user field 1 (physical field 3) TAD I HDRPTR / GET THE NUMBER OF THE BLOCK WE WANT TO LOAD SNA CLA / ARE THEY THE SAME? JMP RDFBL3 / YES - DON'T BOTHER TO LOAD IT AGAIN TAD I HDRPTR / RECOVER THE NEXT BLOCK NUMBER SNA / IS THERE ANOTHER BLOCK NUMBER? JMP RDFBL1 / JUMP IF THERE ARE NO MORE / CDFMYF / change df back to my field JMS RDFIO / READ THE NEXT BLOCK INTO RDBUF RXERD+4000 RDBUF / SPA CLA / WAS THERE AN ERROR? JMP RDFBL2 / JUMP IF SO CDFEDT / change df to user field 1 (physical field 3) TAD I HDRPTR / GET BLOCK NUMBER OF THE BLOCK WE JUST LOADED CIA / MAKE IT NEGATIVE DCA LBLKLD / SAVE IT RDFBL3, ISZ RDFBUF / MAKE A SKIP RETURN TO SHOW ALL IS WELL SKP RDFBL1, DCA RDCHNO / CLEAR CHARACTER COUNT TO SIGNAL EOF CDFMYF / change df back to my field JMP I RDFBUF / AND RETURN / / THERE WAS AN ERROR READING A BLOCK. / RDFBL2, JMS RDINI1 / REINITIALIZE TO PREVENT READS JMP I RDFBUF / LBLKLD, 0 / NEGATIVE BLOCK NUMBER OF LAST BLOCK LOADED INTO RDBUFD / / HDRPTR, 0 / POINTER INTO THE HEADER BLOCK BUFFER HDROFF, 0 / OFFSET INTO HEADER BLOCK OF NEXT BLOCK NUMBER HDRTNO, 0 / NUMBER OF ENTRIES LEFT IN HEADBF /M017 RDMOD, 0 / MODES FOR DECODING 6-BIT 0 / MODE SHIFT (40)/UNSHIFT (0) RDCHNO, 0 / CHARACTER COUNT FOR RDBUF / / PAGE / /***************************************************************************** / DESCRIPTION: RDNXC / / RETURNS THE NEXT CHARACTER FROM THE FILE IN 6-BIT / / INPUTS: / OUTPUTS: / RDNXC, XX JMS RDNXCB / GET THE NEXT BYTE FROM THE FILE TAD (-77) / IS IT AN ESCAPE? SNA JMP RDNXCX / JUMP IF SO TAD P77 / ELSE RESTORE THE CHARACTER JMP I RDNXC / AND RETURN IT RDNXCX, JMS RDNXCB / GET ANOTHER BYTE SMA SZA TAD P7700 / SHOW IT IS AN ESCAPE CHARACTER JMP I RDNXC / AND RETURN IT / / / / /++ / GETHDREXT /A012 / /FUNTIONAL DESCRIPTION: GET_HEADER_EXTENTIONS / / THIS ROUTINE WILL LOAD THE ADDITIONAL HEADER BLOCK EXTENTION ADDRESSES / WHICH ARE USED BY A DOCUMENT THAT EXCEEDS 704 BLOCKS WHEN OPERATING IN / RX02 DOUBLE DENSITY, INTO THE RDHDRB BUFFER. IT IS IMPORTANT TO NOTE / THAT AT THIS TIME GETHDREXT IS SET UP TO GO NO FURTHER THAN THE 4TH / HEADER EXTENTION SINCE THIS PROVIDES THE MAXIMUM NUMBER OF BLOCKS / POSSIBLE FOR RX02 DOUBLE DENSITY DOCUMENT FLOPPY. IF RL BASED SYSTEM / IS DEVELOPED THAN THIS WILL NECESSITATE SLIGHT CHANGES TO GETHDREXT AS / WELL AS FURTHER MODIFICATIONS TO RANDR2. / /CALLING SEQUENCE: JMS GETHDREXT / /INPUT PARAMETERS: AC = 0 / /IMPLICIT INPUT: RDHDRB+2, GETHD1 / /OUTPUT PARAMETERS: AC = 0 / /IMPLICIT OUTPUT: GETHD4, GETHD1, GETHD2 / /COMPLETION CODE: NONE /SIDE EFFECTS: NONE / /-- / GETHDREXT, / ROUTINE TO GET HEADER BLOCK EXTENSIONS XX TAD RDHDRB+2 / IS THERE A 2ND HEADER EXTENTION? SNA CLA / SKIP IF: SO JMP GETHD6 / ELSE RETURN / TAD (RDHDRB+3 / GET PTR TO 3RD HDR EXT IN RANDRD CTL BLK DCA GETHD4 / SAVE FOR AUTOINDEXING / TAD (HO1354 / GET HEADER OFFSET OF EXT HEADER 3 POINTER / (EXT HDR 2 [362]) DCA GETHD1 / / / /*************************************************************************** /********************** YOUR ATTENTION PLEASE ****************************** /*************************************************************************** / NUMBER OF POSSIBLE HEADERS MUST BE CHANGED FOR RL'S. LOOP CONTROL IS / SET FOR -3 SO IF HEADER THAT IS BEYOND THE LIMITS OF AN RX02 (DOUBLE / DENSITY) DISKETTE IS CALLED WE'LL TERMINATE RDHDRB BUFFER AND RETURN. / THE MAXIMUM NUMBER OF BLOCKS ON A DOUBLE DENSITY FLOPPY IS 983. THIS MEANS / THAT THE MAXIMUM NUMBER OF HEADER BLOCKS NEEDED FOR A SINGLE DOCUMENT / WOULD BE THE MAIN HEADER BLOCK + 4 EXTENTION HEADERS. RANDR2 ROUTINE WILL / NEED MODIFIICATION TO HANDLE ADDITIONAL HEADER BLOCKS BEYOND THE 4TH / EXTENTION HEADER WHICH MAY BE NEEDED FOR VERY LARGE DOCUMENTS ON AN RL. /*************************************************************************** /*************************************************************************** /*************************************************************************** AC7775 / GET ITERATION COUNT FOR EXT HDRS 3 & 4 DCA GETHD2 / SAVE THE COUNT /************************************************************************** /************************************************************************** /************************************************************************** / GETHD3, TAD GETHD1 / GET 3RD & 4TH EXT HDR BLK NUMS JMS RDGETR SNA / SKIP IF: BLOCK NUMBER PRESENT JMP GETHD5 / ELSE ALL DONE DCA I GETHD4 / PUT BLK NBR INTO RDHDRB+X / ISZ GETHD1 / POINT TO NEXT HDR BLK NBR ISZ GETHD4 / INC POINTER INTO RDHDRB BUFFER ISZ GETHD2 / EXCEEDED RX02 DOUBLE DENSITY EXTENTION / HEADER LIMIT? JMP GETHD3 / NO- GO GET IT IF ITS THERE / GETHD5, DCA I GETHD4 / TERMINATE RDHDRB BUFFER GETHD6, JMP I GETHDREXT / RETURN / GETHD1, 0 / POINTER TO HDR BLK NBRS IN HEADER EXT 2 GETHD2, 0 / COUNTER FOR LOOP CONTROL GETHD4, 0 / POINTER INTO RDHDRB BUFFER / / / / /**************************************************************************** / DESCRIPTION: RDGTBY / / Returns either the upper or lower byte / in RDBUF for conversion to seven bit ASCII. / / INPUT: AC = character count of RDBUF / / OUTPUT: 6 bit COS-310 character / RDGTBY, XX CLL RAR / IF LINK = 0 GET UPPER BYTE / IF LINK = 1 GET LOWER BYTE / TAD I RDGTBY / GET RDBUF+OFFSET DCA GETBY1 ISZ RDGTBY / BUMP RETURN CDFEDT / change df to user field 1 (physical field 3) TAD I GETBY1 CDFMYF / change df back to my field SNL BSW / SWAP BYTES IF UPPER BYTE NEEDED AND P77 JMP I RDGTBY / PAGE / / MOVED RDGTBY /M012 /*************************************************************************** /DESCRIPTION: RDFIO / / Submits diskette read to queue. / RDFIO, XX DCA RDFQBK+RXQBLK / STORE BLOCK NUMBER TAD I RDFIO / GET FUNCTION CODE FROM CALLER DCA RDFQBK+RXQFNC / DEPOSIT IN QUEUE BLOCK ISZ RDFIO / BUMP TO RETURN ADDRESS TAD I RDFIO / GET WHICH BUFFER ARE TO READ DATA INTO DCA RDFQBK+RXQBAD / DEPOSIT IN QUEUE BLOCK ISZ RDFIO CDFEDT / change df to user field 1 (physical field 3) TAD .-1 / get cdf instruction CDFMYF / change df back to my field DCA RDFQBK+RXQBFD / DEPOSIT IN QUEUE BLOCK CIFSYS / ENQUE / SUBMIT TO QUEUE RDFQB / PASSED PARAMETER RDFIO1, CIFSYS / NOW JWAIT / WAIT TIL DONE TAD RDFQBK+RXQCOD / DONE YET? SNA / YES JMP RDFIO1 / NO JMP I RDFIO / RETURN STATUS (AC = MINUS ON ERROR) / /***************************************************************************** / QUEUE REQUEST BLOCK / RDFQB, DSKQUE 0 0 / QUEUE HEADER RDFQBK, 0 / +RXQCOD HANDLER STATUS (0 = NOT DONE) 0 / +RXQFNC RX FUNCTION REQUEST 0 / + 0 / +RXQFNO FILE NUMBER 0 0 0 0 0 / +RXQDRV DRIVE NUMBER 0 / +RXQBLK BLK # BEING RETURNED 0 0 / +RXQBAD ADDRESS OF LOCAL BUFFER 0 / +RXQBFD "CDF" TO BUFFER FIELD 0 0 / / /***************************************************************************** / DESCRIPTION: RDGETR / / RETURNS THE BLOCK NUMBER ADDRESSED BY THE OFFSET WHICH IS / IN THE AC UPON CALL. / / INPUTS: AC = OFFSET IN RANDRD CTRL BLK CONTAINING REQUESTED BLK # / / OUTPUTS: AC = PHYSICAL BLOCK NUMBER / AC = 0 - NO HEADER BLOCK IN HEADBF /M017 / RDGETR, XX DCA .+2 / SAVE THE OFFSET IN THE CALL BELOW RDGETA, JMS SCOFST / THIS ROUTINE RETURNS: / 1) THE ADDRESS IN HEADBF WHICH /M017 / CONTAINS A BLOCK NUMBER. SKIP RETURN / 2) IF HEADER BLOCK IS PRESENTLY NOT IN / "HEADBF", "RDHDBN" POINTS TO "RDHDRB" /M017 / OR AN OFFSET WHERE THE BLOCK # IS STORED. / RETURN AND READ THAT BLK 0 / THE DESIRED OFFSET RDBFCB / THE HEADER CONTROL BLOCK / JMP RDGTXR / NORMAL RETURN MADE--JUMP TO HANDLE IT / DCA T1RR / SAVE THE BLOCK NUMBER ADDRESS TO INDIRECT THROUGH CDFEDT / change df to user field 1 (physical field 3) TAD I T1RR / GET THE BLOCK NUMBER CDFMYF / change df back to my field JMP I RDGETR / RETURN IT / / WE MUST LOAD THE HEADER BLOCK INTO THE BUFFER AND TRY AGAIN / RDGTXR, TAD I RDHDBN / GET THE BLOCK NUMBER OF THE HEADER BLOCK SNA JMP RDGTXZ / JUMP IF NO HEADER BLOCK WAS SPECIFIED / JMS RDFIO / READ THE HEADER BLOCK RXERD+4000 HEADBF /M017 / SMA CLA / WAS THERE AN ERROR IN READING? JMP RDGETA / NO--LOOP TO GET THE BLOCK NUMBER DCA I RDHDBN / YES--CLEAR THE BLOCK NUMBER OF THE HEADER BLOCK / RDGTXZ, DCA RDHDBN / CLEAR TO INDICATE NO HEADER BLOCK IS IN THE BUFFER JMP I RDGETR / AND RETURN /***************************************************************************** / DESCRIPTION: SCOFST / / INPUTS: CALL+1 = DESIRED OFFSET / CALL+2 = ADDR OF RANDRD CONTROL BLOCK / RDHDBN (IMPLICIT) = 0 IF BUFFER EMPTY OR HDR BLK / / OUTPUTS: RDHDBN (IMPLICIT) = ADDRESS CONTAINING EITHER HDR, EXT1, EXT2 / SCOFST, XX DCA SCOFS1 / INIT REL BLK # TAD I SCOFST / GET DESIRED OFFSET INTO HEADER BLOCKS / UNTIL (OFFSET IS WITHIN A HEADER BLOCK'S BOUNDARY) TAD (-376) / COMPUTE REL BLK # ISZ SCOFS1 / INC OFFSET INTO RDHDRB TABLE SMA / JMP .-3 / END UNTIL DCA SCOFS2 / SAVE OFFSET-400 ISZ SCOFST / BUMP RETURN TAD I SCOFST / BUFCB PTR DCA SCOFS3 / STORE ADDRESS OF HEADER CONTROL BLOCK AC0001 TAD SCOFS3 / CUR BLK PTR PTR DCA SCOFS4 ISZ SCOFST / BUMP RETURN TAD I SCOFS4 SNA JMP SCOFSA / READ IF CURR BLK 0 (BUFFER EMPTY OF HEADER BLOCK) CIA / ELSE COMPARE WITH NEEDED PTR TAD SCOFS1 TAD SCOFS4 SNA CLA JMP SCOFSB / JUMP IF SAME (BLOCK ALREADY LOADED IN / HEADBF AREA) /M017 SCOFSA, TAD SCOFS1 TAD SCOFS4 / SET NEW BLK PTR DCA I SCOFS4 JMP I SCOFST / RETURN FOR READ SCOFSB, TAD SCOFS2 / GET WORD OFFSET TAD (400) TAD I SCOFS3 / +BUFFER PTR ISZ SCOFST / BUMP FOR NORMAL RETURN JMP I SCOFST / RETURN WORD PTR / SCOFS1, .-. / OFFSET INTO RDHDRB TABLE 1 --> RDHDRB / 2 --> RDHDRB+1 / 3 --> RDHDRB+2 / ETC. SCOFS2, .-. / WORD OFFSET - 400 SCOFS3, .-. / POINTS TO 1ST ENTRY IN RDFIL HDR CTRL BLK (RDBFCB) SCOFS4, .-. / POINTS TO RDHDRB / / / RANDRD CONTROL BLOCK / RDBFCB, HEADBF / HEADER BLOCK BUFFER ADDRESS /M017 RDHDBN, 0 / POINTER TO CURRENT HEADER BLOCK NUMBER RDHDRB, 0 / MAIN HEADER BLOCK NUMBER 0 / 1ST HEADER BLOCK EXTENTION 0 / 2ND HEADER BLOCK EXTENTION 0 / 3RD HEADER BLOCK EXTENTION /A012 0 / 4TH HEADER BLOCK EXTENTION /A012 0 / 5TH HEADER BLOCK EXTENTION /A012 0 / 6TH HEADER BLOCK EXTENTION /A012 0 / 7TH HEADER BLOCK EXTENTION /A012 0 / 8TH HEADER BLOCK EXTENTION /A012 0 / 9TH HEADER BLOCK EXTENTION /A012 0 / 10TH HEADER BLOCK EXTENTION /A012 0 / 11TH HEADER BLOCK EXTENTION /A012 0 / 12TH HEADER BLOCK EXTENTION /A012 0 / 13TH HEADER BLOCK EXTENTION /A012 0 / 14TH HEADER BLOCK EXTENTION /A012 0 / 15TH HEADER BLOCK EXTENTION /A012 0 / 16TH HEADER BLOCK EXTENTION /A012 0 / HEADER BLOCK NUMBERS ENDED BY ZERO / / PAGE /++ / TNOPRT / /FUNTIONAL DESCRIPTION: TNOPRT / / Calculate and save count of header block entries (HDRTNO) that will / be found in the header block buffer (HEADBF). Also calculate /M017 / and save header buffer pointer (HDRPTR). / / TNOPRT PSEUDO CODE: / / calculate count of header block entries / save it / calculate header buffer pointer / save it / return to caller / /CALLING SEQUENCE: JMS TNOPRT / /INPUT PARAMETERS: AC = header block offset value / /IMPLICIT INPUTS: HDRTNO / /OUTPUT PARAMETERS: none / /IMPLICIT OUTPUT: HDRTNO, HDRPTR / /COMPLETION CODE: none / /SIDE EFFECTS: none / /-- / TNOPRT, XX / TAD (-376) / calculate count of header block entries SMA JMP .-2 DCA HDRTNO / save it / TAD HDRTNO / calculate header buffer pointer TAD (HDBLEN+HEADBF-1) / add header buffer length + value /M017 / of first address of header buffer - 1 DCA HDRPTR / save result in header buffer pointer / JMP I TNOPRT / / /***************************************************************************** / DESCRIPTION: RDNXCH / / Reads the next character from the file and returns it in / seven bit ASCII along with it's mode bits. / / INPUTS: / / OUTPUTS: AC = mode bits and seven bit ASCII character / RDNXCH, XX TAD RDCHNO / IS THE COUNT CLEAR? SMA CLA JMP I RDNXCH / YES--EOF HAS BEEN REACHED. RETURN / / RDNXH1, JMS RDNXC SNA JMP I RDNXCH / RETURN IF NONE JMS XLTASC JMS GETMOD RDMOD SNA JMP RDNXH1 / DON'T RETURN NULLS JMP I RDNXCH / XLTASC, XX / XLAT 6-BIT TO ASCII / 1-73: NORMAL / 74: SHIFT / 76: UNSHIFT / 7702-7777: ESCAPE / / OUTPUT: -(1-6): MODE CHANGE (L=1 IF ON) / 0-200: ASCII CHAR (L=1 IF ALPHA) / SPA SNA JMP XLTAS1 / ESCAPE TAD (-74) SMA JMP XLTAS2 / SHIFT-UNSHIFT TAD (74-41) XLTAS4, CLL CML / SET LINK FOR ALPHA TAD (41+37) / CLEAR LINK IF NOT ALPHA JMP I XLTASC XLTAS1, TAD (100-MAXESC) SMA CLA / CHECK FOR OK TAD (MAXESC+ESCTAB) DCA T1RR TAD I T1RR SPA JMP XLTAS3 TAD (-100) / ADJUST FOR ALPHA TEST JMP XLTAS4 / XLTAS2, SNA CLA IAC CMA XLTAS3, CLL CML RAR JMP I XLTASC / ESCTAB, 0 0 -3 -4 -5 -6 11 10 15 -13 -14 12 14 -7 -10 -11 -12 0 133 / [ - SHIFT 134 / \ - RESERVED 135 / ] - UNSHIFT 136 / ^ - START OF 2 CHARACTER SPECIAL CODE 137 0 / NORMALLY 7 FOR NEED-WRAP CODE 16 17 MAXESC=.-ESCTAB -16 / ERROR / / GETMOD, XX / XLAT ESCAPES, ADD MODES TO ASCII MQL / TEMP HOLD CHAR. IN MQ TAD I GETMOD / GET ADDRESS OF RDMOD DCA T1RR ISZ GETMOD / BUMP RETURN MQA / GET CHAR. BACK FROM MQ SMA SZA JMP GETMD1 / NORMAL ASCII SNA / NULL CHARACTER ? JMP I GETMOD / YES - RETURN IAC SNA ISZ T1RR / ADJUST T1RR IF SHIFT-UNSHIFT CHANGE TAD (MODTAB) DCA T2RR / GET PTR TAD I T2RR SPA JMP I GETMOD / RETURN QUICK IF ERROR CMA AND I T1RR SNL TAD I T2RR DCA I T1RR / SET NEW MODE JMP I GETMOD GETMD1, TAD I T1RR / ADD MODE FLAGS ISZ T1RR SZL TAD I T1RR / AND UNSHIFT JMP I GETMOD / -1 / ERROR 2000 / JUSTIFY 1400 / SUPERSCRIPT 1000 / SUBSCRIPT 400 / UNDERSCORE 200 / BOLD MODTAB=. 40 / PAGE /++ / LDHDRB / /FUNTIONAL DESCRIPTION: LDHDRB / / Fills header block buffer with proper header block based on the header / offset value. Then calculate and save count of header block entries / (HDRTNO) as well as the header buffer pointer (HDRPTR). / / LDHDRB PSEUDO CODE: / / get header offset value / load in corresponding header block / if [no error] / get header offset / calculate and save count of header block entries (HDRTNO) and header buffer pointer (HDRPTR) / increment return pointer / return to caller / /CALLING SEQUENCE: CALLER, JMS LDHDRB / CALLER+1, error return / /INPUT PARAMETERS: none / /IMPLICIT INPUTS: HDROFF / /OUTPUT PARAMETERS: none / /IMPLICIT OUTPUT: HDRTNO, HDRPTR / /COMPLETION CODE: none / /SIDE EFFECTS: If we error when loading header block into header / buffer then we return immediately to caller+1. / /-- / LDHDRB, XX TAD HDROFF / get the offset JMS RDGETR / load proper header block into HEADBF /M017 SNA CLA / error ? JMP I LDHDRB / yes - return ISZ LDHDRB / no - bump return TAD HDROFF JMS TNOPRT / calculate and save count of header block entries (HDRTNO) / calculate and save header buffer pointer (HDRPTR) JMP I LDHDRB / return / / /++ / GETBNO / /FUNCTIONAL DESCRIPTION: GETBNO / / Get mode, blocknumber, and offsets for WPSORT. The GETBNO routine / takes current mode bit information, breaks it up and then combines / it in part with the address of the current block read as well as / with the offset character pointer for RDBUF as shown below. Also / the offset into the header block which contained the physical block / number is aquired along with a flag which shows whether we did a / single or multiple block read during the reading of a record. All / three parameters are held in buffer locations. They are restored / to RANDR2 through the use of the PUTBNO routine. / / GETBNO PSEUDO CODE: / /10) save input parameter /20) get block no. of current block read / if (called to get parameters of current record) /40) scheme mode bits for 1st word / merge mode bits / save word in BLOCKNO / / scheme mode bits for 2nd word / get offset character pointer for RDBUF / mask 3 m.s.b. / merge mode bits / save word at LABOFFSET / /140) get offset into header block / save word at PERFORMANCE /160) else (e.o.r. call) / if (block number neq to block number at first call to routine) / set m.s.b. of LABOFFSET /190) return to caller / / 0 /1 /2 /3 /4 /5 /6 /7 /8 /9 /10/11/12 / ---------------------------------------- / BLOCKNO, |m1|m2| block number | / ---------------------------------------- / LABOFFSET, |m3|m4|m5|offset char. pointer for RDBUF | / ---------------------------------------- / PERFORMANCE, |sm| offset into header block | / ---------------------------------------- / / mode bits m1 = shift/unshift / m2 = justify / m3 = super & subscript / m4 = underscore / m5 = bold / / block read - This bit is operated on if GETBNO called with AC = 0 / sm = 0 single block read / 1 multiple block read / /CALLING SEQUENCE: Aquire parameters of the record being read. / / 1) **** Use this call when beginning of record [<] is detected. **** / / AC7777 / JMS GETBNO / / / 2) We must check if the record being read was contained / within a single block or if more than one block had / to be read into RDBUF before reaching EOR. This must / be recorded in order to read the complete record properly / by using the PUTBNO routine. This is done by setting / bit 0 in PERFORMANCE if block numbers have changed / from the start of the record being read to its end. / When PERFORMANCE parameter is passed to PUTBNO routine / it is flagged whether a single or multiple block read / is necessary. / ****Use this call after detecting e.o.r. or e.o.f.**** / / CLA / JMS GETBNO / /INPUT PARAMETERS: AC = -1 Get all three parameters / AC = 0 Check if block number being read now is / different from block read at beginning of / record. If so set m.s.b. in PERFORMANCE. / /IMPLICIT INPUTS: RDFQBK+RXQBLK, RDCHNO, RDMOD, RDMOD+1, HDROFF, BLOCKNO, / PERFORMANCE, GPTEMP / /OUPUT PARAMETERS: AC = 0 / /IMPLICIT OUTPUT: CALLER+1, CALLER+2, CALLER +3, BLOCKNO, LABOFFSET, / PERFORMANCE, GPTEMP / /COMPLETION CODE: none / /SIDE EFFECTS: 1) In order to make room for the mode bits (3,4 & 5) / in the second word, the 3 m.s.b. are masked from / the offset char. pointer (RDCHNO). Since RDCHNO's / limits are 7004 to 7777 the 3 m.s.b. must be reset / by the routine using this parameter before restor- / ing it to RDCHNO. / /-- / GETBNO, XX / /..10.. DCA GPTEMP / save pass number flag / /..20.. TAD RDFQBK+RXQBLK / get no. of current block ISZ GPTEMP / get record's parameters? JMP CHKPAS / no - do check e.o.r. for multi block read DCA GPTEMP / hold block number while do mode bits TAD RDMOD+1 / get shift/unshift mode bit BSW / bit 0 gets bit 6 MQL / hold result in MQ AC2000 / GET JUSTIFY BIT /M012 AND RDMOD /M012 MQA / MERGE WITH SHIFT/UNSHIFT /M012 MQL / HOLD IN MQ /M012 TAD GPTEMP / merge block number with 2 mode bits MQA DCA BLOCKNO / save word / /..40.. TAD RDMOD / get mode bits m3,m4, and m5 RTL / bits 0,1,2 get 2,3,4 AND (7000) MQL / hold result in MQ AC7777 / offset = offset - 1 TAD RDCHNO AND (777) / mask to set mode bits MQA / merge mode bits DCA LABOFFSET / save word / /..140.. TAD HDROFF / get offset into header block DCA PERFORMANCE / save word JMP I GETBNO / return to caller / /..160.. CHKPAS, CIA / compare blk no. e.o.r. with blk no. beginning of record DCA GPTEMP / hold -block number TAD BLOCKNO / get block number beginning of record AND (1777) / mask mode bits TAD GPTEMP SZA CLA / are they same? AC4000 / no - set flag showing multiple block read TAD PERFORMANCE DCA PERFORMANCE / /..190.. JMP I GETBNO / return to caller / / /++ / PUTBNO / /FUNCTIONAL DESCRIPTION: PUTBNO / / Insert mode, blocknumber, and offsets into RANDR2 for WPSORT. / The PUTBNO routine restores mode bits into RANDR2 and then / reads the proper header block into HEADBF. The block specified / by BLOCKNO is read into the read buffer and the offset character / pointer (RDCHNO) is loaded so we can start reading characters from / that point on. Thus we're able to accomplish random access reads / for use in sorting. / / PUTBNO PSEUDO CODE: / /10)putbno: get parameters and save them /20) restore mode bits /30) if [single block read] /40) calculate and save count of header block entries (HDRTNO) / calculate and save header buffer pointer (HDRPTR) / reset count of header block entries to -2 (HDRTNO) / set header block offset to -1 (HDROFF) / save value pointed to by header block buffer pointer / place physical block number we want to read (BLOCKNO) in header buffer / offset header block buffer pointer by -1 / read block just placed in header buffer into read buffer (RDBUF) / escape putbno if (error) / restore value saved to header buffer / else /150) set header block offset / load header block, calculate and save count of header block entries (HDRTNO) and header buffer pointer (HDRPTR) / escape putbno if (error) / read block pointed to by header buffer pointer / escape putbno if (error) /200) set offset character pointer (RDCHNO) / bump return pointer (no errors) /220) end putbno / / return to caller / / /CALLING SEQUENCE: JMS PUTBNO / ---------------------------------------- / |m1|m2| block number | / ---------------------------------------- / |m3|m4|m5|offset char. pointer for RDBUF | / ---------------------------------------- / |sm| offset into header block | / ---------------------------------------- / errror return / normal return / / / mode bits m1 = shift/unshift / m2 = justify / m3 = super & subscript / m4 = underscore / m5 = bold / / block read sm = 0 - single block read / 1 - multiple block read / /INPUT PARAMETERS: none / /IMPLICIT INPUTS: CALLER+1, CALLER+2, LABOFFSET, BLOCKNO, HDROFF, HDBUFP / /OUTPUT PARAMETERS: AC = 0 / /IMPLICIT OUTPUT: BLOCKNO, LABOFFSET, PERFORMANCE, RDMOD, RDMOD+1, RDCHNO, / HDROFF, HDBUFP / /COMPLETION CODE: none / /SIDE EFFECTS: Errors could occur (highly unlikely but nevertheless / possible) during execution of PUTBNO. Upon detection / of any error we return to caller+4. / /-- / PUTBNO, XX / /..10.. CLA CLL TAD I PUTBNO / get mode & block no. from call + 1 DCA BLOCKNO / save it ISZ PUTBNO / bump return TAD I PUTBNO / get mode & char. offset pointer DCA LABOFFSET / save it ISZ PUTBNO / bump return TAD I PUTBNO / get offset into header block DCA PERFORMANCE / save it / /..20.. ISZ PUTBNO / bump return TAD LABOFFSET / get 3 mode bits in char, offset pointer AND (7000) RTR / place in proper bit position MQL / hold here until get justify bit AC2000 / GET JUSTIFY BIT /M012 AND BLOCKNO /M012 MQA / merge with 3 other mode bits DCA RDMOD / restore mode bits AC4000 / GET SHIFT/UNSHIFT MODE BIT /M012 AND BLOCKNO /M012 BSW / place in proper bit position (bit 6) DCA RDMOD+1 / restore mode bit / /..30.. TAD PERFORMANCE / single block read? SPA / JMP PUTBN1 / no - set up for multiple block read / /..40.. JMS TNOPRT / calculate and save header buffer pointer (HDRPTR) / AC7776 DCA HDRTNO / reset count of header block entries to -2 / AC7777 / set header block offset = -1 to simulate / eof if we read beyond end of the block. DCA HDROFF / TAD HDRPTR / get address pointed to by header pointer DCA HDBUFP / save it CDFEDT / change df to user field 1 (physical field 3) TAD I HDBUFP / get value in HEADBF /M017 DCA GPTEMP / temp. save it / TAD BLOCKNO / get block number we want to read AND (1777) / mask mode bits DCA I HDBUFP / place in header buffer CDFMYF / change df back to my field / AC7777 / offset header buffer pointer by -1 TAD HDRPTR DCA HDRPTR / JMS RDFBUF / read in block JMP I PUTBNO / error or end of file return / TAD GPTEMP / restore value we saved to header buffer CDFEDT / change df to user field 1 (physical field 3) DCA I HDBUFP CDFMYF / change df back to my field / JMP PUTBN2 / /..150.. PUTBN1, AND P3777 / mask multi/single block read flag DCA HDROFF / set header block offset (HDROFF) / JMS LDHDRB / load header block buffer with header block / that corresponds to this offset. JMP I PUTBNO / error return - error caused in RDGETR / JMS RDFBUF / read block pointed to by HDRPTR JMP I PUTBNO / error or end of file return / /..200.. PUTBN2, TAD LABOFFSET / setup and save RDBUF character counter AND (777) / mask mode bits TAD (7000) DCA RDCHNO ISZ PUTBNO / bump return / /..220.. JMP I PUTBNO / return to caller / HDBUFP, 0 / temporary pointer into header block buffer / / /Symbols shared by BOTH GETBNO and PUTBNO routines / BLOCKNO, 0 / mode bits and block number LABOFFSET, 0 / mode bits and offset character pointer PERFORMANCE, 0 / multi/single block read flag & offset / into header buffer / GPTEMP, 0 / temp for GETBNO and PUTBNO routine / / PAGE / ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// SHLSRT.PA - MULTI KEY SHELL SORT ALGORITHM \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ SUBKEY, ZBLOCK 1 /2; 14 / THE 'SECONDARY' KEY(S) SORTORDER, ZBLOCK 1 / FROM 'ORDER' FOR 'RAL'S LATER BREAKADDRESS, ZBLOCK 1 / adrs 'KEY01FNTOTAL' - 'KEY12FNTOTAL' BOTADR, ZBLOCK 1 / BOTTOM (LOGICAL ADDRESS) OF FNVAR LIST TOPADR, ZBLOCK 1 / TOP (LOGICAL ADDRESS) OF FNVAR LIST / MULTI-KEY SORT PROCESSOR SORT, XX AC0002 / 2 / (because of '-1' and 'DUMMY' in list) TAD FNVAR / PHYSICAL 'END' (BOTTOM) OF LIST DCA BOTADR TAD (FNVARBUFFER+1) / PHYSICAL 'START' (TOP) OF LIST + 1 DCA TOPADR TAD (FNVARBUFFER+1) / DCA KEY01FNTOTAL / TAD (KEY01FNTOTAL) / DCA BREAKADDRESS / TAD ORDER / XXX XXX XXX XXX; (0/1 ASCENDING/ DESC) DCA SORTORDER / FOR 'RAL'(S) LATER (IN 'XSORT') / ORDER (SORT) THE SEQUENCE OF THE 'FNVARTABLE' / AS PER THE 'VVVVVALUE' WITHIN THE 'FNVBUFFER' / for the 'PRIMARY' KEY (key #1) / USING SHELL'S SORTING METHOD AC0001 / # 1 / SORT THE 'PRIMARY' (#1) KEY JMS XSORT / (INITIALZES 'KEYID' TO KEY #1) TAD SORTKEY / / CLL RAR / SNA CLA / JMP I SORT /EXIT / SINGLE KEY SORT COMPLETED / PARTITION (RECALCULATE) THE SIZE OF THE 'LSTADR' / TO THAT OF THE PRIMARY KEY ('THISKEY') / AND SORT ON KEY #2; ETC / (THEN ITERATIONS THRU KEY #MAXKEY) AC0002 / 2 / (because of '-1' and 'DUMMY' in list) TAD FNVAR / PHYSICAL 'END' (BOTTOM) OF LIST DCA BOTADR TAD BOTADR / THE PHYSICAL (THEN LOGICAL) BOTTOM DCA TOPADR / BECOMES THE 'LOGICAL' TOP BREAKPRIMARY, JMS TSTTOPADR / 'ISZ TOPADR' JMP I SORT / DONE / ONLY 1 MULTIKEY RECORD IN 'FNVARTABLE' /\ JMP .+1 / TAD ORDER / DCA SORTORDER / AC0001 / / CONTINUE SORTING KEYS #2 THRU #14 DCA SUBKEY /SUBKEY=/ (BECAUSE PRIMARY KEY ALREADY SORTED) BREAKSUB, TAD SUBKEY / / the PRIMARY key identification (#1) JMS ADVANCE / ADVANCE TO A BREAK FOR THIS KEY CDFMYF /--------------------//CDF / / THE 'VVVVV'ALUES ARE DIFFERENT (LOGICAL BREAK), OR / THE 'VAT'S ARE DIFFERENT (LOGICAL BREAK); OR / AT THE PHYSICAL TOP OF THE 'FNVARTABLE' TAD TOPADR /TOPADR / CONTAINS THE BREAK ADDRESS ISZ BREAKADDRESS / SAVE IT INTO DCA I BREAKADDRESS / 'KEY02FNTOTAL THRU KEY12FNTOTAL' TAD SORTORDER / GET THE SORTING 'ORDER' CLL RAL / FOR THE NEXT KEY (2 THRU 14) DCA SORTORDER / (MAKING A WORKING MASTER) SZL / DON'T LOOSE THE LINK ISZ SORTORDER / (BIT 0 IS HELD IN BIT 12--ETC.) ISZ SUBKEY / +1 / TAD SUBKEY / 1; 14 / SORT THE LIST ON SECONDARY KEYS (2-14) JMS XSORT /'SORT' / (UPDATING 'KEYID' TO THE NEXT KEY #) TAD SORTKEY /MAX# / CIA / TAD SUBKEY / # OF CURRENT SUBKEY IN PROCESS SNA CLA / JMP NOMORESUBKEYS / TAD BOTADR / / RESET 'TOPADR' WITH THE ADDRESS OF THE DCA TOPADR / 'BOTTOM' OF THE LIST (DIDN'T MOVE YET) JMSTSTTOPADR, JMS TSTTOPADR / JMP NOMORESUBKEYS / JUMP / IF DONE WITH THIS KEY (OR 1 KEY REC) JMP BREAKSUB / NOMORESUBKEYS, TAD I BREAKADDRESS / RESET 'TOPADR' WITH 'BREAK' ADDRESS DCA TOPADR / OF THE SUB KEY (FROM A 'TOPADR') TAD TOPADR / and M O V E the bottom address DCA BOTADR / TO BECOME THE 'NEW' LOGICAL BOTTOM AC7777 / -1 / TAD BREAKADDRESS / DCA BREAKADDRESS / TAD BREAKADDRESS / TAD (-KEY01FNTOTAL) / SNA CLA / JMP BREAKPRIMARY / CONTINUE FORWARD SORT OF SUB KEYS / ALL SECONDARY KEYS IN THE FORWARD DIRECTION HAVE BEEN SORTED / BACKUP 1 SECONDARY KEY TO CONTINUS SORTING IN THE FORWARD DIRECTION / WHEN ALL SECONDARY KEYS HAVE BEEN SORTED TO THEIR RESPECTIVE / PRECEEDING SECONDARY KEYS FOR THIS PRIMARY KEY BREAK / (WHEN THE CONTENTS OF PROGRAM LOCATION 'BREAKADDRESS') / (EQUILS THE VALUE FOR THE ADDRESS 'KEY01FNTOTAL) / THEN FIND THE NEXT PRIMARY KEY BREAK / AND DO IT ALL OVER AGAIN AC7777 / -1 / TAD SUBKEY / DCA SUBKEY / TAD SORTORDER / CLL RAR / SZL / TAD (4000) / BIT 0 / DCA SORTORDER / JMP JMSTSTTOPADR / TSTTOPADR, XX TAD I BREAKADDRESS / CIA ISZ TOPADR TAD TOPADR SPA CLA ISZ TSTTOPADR JMP I TSTTOPADR /****************************************************************************** / / OUTPUT DISKETTE/VOLUME FULL - CK WHICH ONE IS IN USE AND USE CORRECT / TEXT STRING / / CK FOR WINCHESTER DRIVE INSTALLED / /****************************************************************************** E13CKW, CLA / CLEAR AC /A018 CDFMNU / MENU FIELD /A018 TAD MUBUF+MNOPTN / FETCH OPTION WORD /A018 CDFMYF / BACK TO THIS FIELD /A018 DCA SROPTN / SAVE VALUE /A018 AC0004 / MASK VALUE FOR WINCHESTER DRIVE /A018 AND SROPTN / IS WINNIE BIT SET ? /A018 SNA CLA / YES - SKIP AND CONTINUE /A018 JMP E13 / NO - USE "DISKETTE /A018 / /****** - SYSTEM HAS WINCHESTER, CK WHICH DRIVE HAS THE OUTPUT DOC. /A018 / TAD SOTFL / FETCH DRIVE # /A018 AND (7400) / MASK FOR DRIVE # /A018 BSW / SWAP /A018 CLL RTR / DRIVE # INTO LOW 4 BITS /A018 DCA SRDRVN / SAVE VALUE /A018 TAD SRDRVN / CK FOR DRIVE 0 /A018 SNA / NO - SKIP AND CONTINUE /A018 JMP E13 / YES - USE "DISKETTE /A018 TAD (-1 / IS IT 1 ? /A018 SZA CLA / YES - SKIP AND CONTINUE /A018 JMP E13A / NO - USE "VOLUME /A018 AC0010 / MASK - VOLUME ASSIGNED TO DEVICE 1 /A018 AND SROPTN / IS VOLUME ASSIGNED ? /A018 SNA CLA / YES - SKIP AND USE "VOLUME /A018 JMP E13 / NO - USE "DISKETTE /A018 JMP E13A / USE "VOLUME /A018 SROPTN, 0 SRDRVN, 0 PAGE / MORE THAN 1 MULTI-KEY RECORD IS IN THE 'FNVARTABLE' ADVANCE,XX / / ENTER WITH THE CONTENTS OF THE ACCUMULATOR EQUIVALENT KEY # DCA KEYID / RESET / (UPDATE) 'KEYID' USED BY 'KEYSEARCH' TAD BOTADR JMS KEYSEARCH / (KEYID) DCA BOTVATADR / 'PREVIOUS' KEY'S [VAT] ADDRESS LOOP, TAD TOPADR JMS KEYSEARCH / (KEYID) DCA TOPVATADR / 'THIS' KEY'S [VAT] ADDRESS CDFFNV /--------------------//CDF / TAD I BOTVATADR / [VAT] AND (-MKSBIT-1) / 7757 / X VVVVV S [0=M] KKKK DCA T1 TAD I TOPVATADR / [VAT] AND (-MKSBIT-1) CIA TAD T1 SZA CLA JMP I ADVANCE / EXIT - DIFFERENT 'VAT'S TAD BOTVATADR DCA T1 / 'T1' GETS 'ISZ'D TAD I T1 / [VAT] AND (VVVVV^100) SNA JMP NOVVVVV / 'VVVVV' = 0 MEANS NON-EXISTANT KEY BSW CIA DCA T2 /-VVVVV NEXTV, ISZ T1 ISZ TOPVATADR TAD I T1 / V V CIA TAD I TOPVATADR / V V SZA CLA JMP I ADVANCE / EXIT - DIFFERENT 'VVVVV'S ISZ T2 JMP NEXTV NOVVVVV, CDFMYF /--------------------//CDF / / THE 'VVVVV'ALUES ARE STILL EQUAL / MOVE DOWN THE 'FNVARTABLE' UNTIL THE 'VVVVV'ALUES CHANGE / WHICH MEANS AT A PRIMARY KEY BREAK JMS TSTTOPADR / 'ISZ TOPADR' JMP I ADVANCE / EXIT - AT 'TOPADR' OF LIST JMP LOOP BOTVATADR, ZBLOCK 1 / 'VAT' ADDRESS FOR THE 'BOTTOM' ELEMENT TOPVATADR, ZBLOCK 1 / 'VAT' ADDRESS FOR THE 'TOP' ELEMENT / MULTI-KEY SORT SUBROUTINE TO / SEARCH FOR THE KEY # (WITHIN PROGRAM LOCATION 'KEYID') / WITHIN THE FNVAR LIST / STARTING AT THE LOGICAL ADDRESS WITHIN THE AC AT ENTRY / UNTIL THE KEY # IS FOUND, OR / UNTIL 'VAT' MKS-BIT = 0 KEYSEARCH, XX DCA T1 / WORK / SEARCH STARTING ADDRESS FROM AC CDFFNV /--------------------//CDF / TAD I T1 / FNVAR / GET THE 'VAT' ADDRESS FOR THIS RECORD KEYLOOP,TAD (4) /OFFSET / 'VAT' ADDRESS OFFSET DCA T1 TAD I T1 / [VAT] DCA T2 / XVV VVV SMK KKK TAD T2 AND (KKKK) CIA TAD KEYID SZA CLA JMP .+4 KEYEND, CDFMYF /--------------------//CDF / TAD T1 JMP I KEYSEARCH / EXIT / WITH (AC) = 'VAT' ADDRESS OF KEY # TAD T2 AND (MKSBIT) / M SNA CLA JMP KEYEND / EXIT / BECAUSE MKS-BIT = 0 TAD T2 / [VAT] BSW AND (VVVVV) TAD T1 JMP KEYLOOP / UNTIL KEY IS FOUND; OR M-BIT = 0 KEYID, ZBLOCK 1 / 1; 15 PAGE / ** DESCIPTION / / THIS PAGE CONTAINS THE SHELL SORT ALOGRITHM. GIVEN THE / NUMBER OF ELEMENTS IN THE LSTADR TO BE SORTED, AN OPTIMUM / DISTANCE BETWEEN ELEMENTS IS CALCULATED. ALL ELEMENTS / WHICH ARE SEPERATED BY THE CALCULATED "DISTANCE" MAKE UP / A PARTITION. THE ELEMENTS IN THE PARTITION ARE SORTED. / AFTER A PARTITION IS SORTED THE DISTANCE IS RECOMPUTED, / AND NEW PARTITIONS ARE DEFINED USING THIS DISTANCE. WHEN / VALUE OF DISTANCE EQUALS "1", THE SORT IS COMPLETED. / / ** INPUT - IMPLICIT - / / COUNT -Autoindex Register (FNVAR) contains the last address / in which FNV pointers are stored / / LSTADR -The starting address (-1) of the LSTADR to be sorted / Assumed to be FNVARBUFFER-1 / / ** OUTPUT / / LSTADR -The Input LSTADR in sorted order / / ** LOCAL VARIABLES (TO THIS PAGE) / DISTNC, 0 / The distance between elements in a partition BOTINX, 0 / An index to the botINXtom element in a partition TOPINX, 0 / An index to the topINX element in a partition FREINX, 0 / An index to the free element in a partition BOTPTR, ZBLOCK 1 / Pointer (address) to the botINXtom element in a partition TOPPTR, ZBLOCK 1 / Pointer (address) to the topINX element in a partition FREPTR, ZBLOCK 1 / Pointer (address) to the free element in a partition TOPTMP, 0 / TOPTMPorary storage for the TOPINX element in a partition EXCHNG, 0 / A boolean, 0=FALSE, 1=TRUE NUMELM, 0 / Number of elements to be sorted (computed) LSTADR, ZBLOCK 1 / The address (-1) of the LSTADR to be sorted / FIND INITIAL DISTANCE FOR SHELL's SORT / .............................................................................. / IF NUMELM<=1 (No need to sort if there / THEN EXIT (are "1" or less elements / / DISTNC=1 / WHILE DISTNC0 / BOTINX=1 / TOPINX=BOTINX+DISTNC / / WHILE TOPINX<=NUMELM / DO "ORDER THE PARTITION" / BOTINX=BOTINX+1 / TOPINX=BOTINX+DISTNC / / DISTNC=DISTNC+1 / DO "FIND HIBBARD VALUE" / ..... ( SORT EXIT ) ................... SHLSORT,TAD DISTNC / IS DISTNC > 0 SPA SNA CLA / 7750 / YES, SKIP IF AC > 0 JMP I XSORT / NO, DONE AC0001 DCA BOTINX / BOTINX=1 TAD BOTINX TAD DISTNC DCA TOPINX / TOPINX=BOTINX+DISTNC PARTSRT,TAD TOPINX / IS TOPINX <= NUMELM CIA TAD NUMELM SPA CLA / YES, SKIP IF AC >= 0 JMP NXTDIS / NO, EXIT THE WHILE LOOP /-- JMS ORDPART / DO "ORDER THE PARTITION" / ..............ORDER THE PARTITION........................ / TOPTMP=LSTADR(TOPINX) / FREINX=TOPINX / DO "COMPARE ELEMENTS" / WHILE BOTINX>DISTNC AND EXCHNG=TRUE (Defined for an ascending sort) / BOTINX=BOTINX-DISTNC / DO "COMPARE ELEMENTS" / BOTINX=TOPINX-DISTNC (Need to restore BOTINX since it may have) / (changed by 'secondary' compares) / ...... (RETURN TO "SORT THE PARTITIONS") ..... /--ORDPART,XX TAD LSTADR TAD TOPINX DCA TOPPTR / CREATE "LSTADR(TOPINX)" POINTER CDFFNV /--------------------//CDF / TAD I TOPPTR CDFMYF /--------------------//CDF / DCA TOPTMP / TOPTMP=LSTADR(TOPINX) TAD TOPINX DCA FREINX / FREINX=TOPINX JMS CMPELMT / DO "COMPARE ELEMENTS" SCNDRY, TAD BOTINX / IS BOTINX > DISTNC CIA TAD DISTNC SMA CLA / YES, SKIP IF AC < 0 JMP DONEORD / NO TAD EXCHNG / IS EXCHNG TRUE SPA SNA CLA / YES JMP DONEORD / NO TAD DISTNC CIA TAD BOTINX DCA BOTINX / BOTINX=BOTINX-DISTNC JMS CMPELMT / DO "COMPARE ELEMENTS" JMP SCNDRY / STAY IN WHILE LOOP DONEORD,TAD DISTNC CIA TAD TOPINX DCA BOTINX / BOTINX=TOPINX-DISTNC /-- JMP I ORDPART ISZ BOTINX / BOTINX+1 NOP TAD BOTINX TAD DISTNC DCA TOPINX / TOPINX=BOTINX+DISTNC JMP PARTSRT / STAY IN INNER WHILE LOOP NXTDIS, ISZ DISTNC / DISTNC+1 NOP JMS FNDHIB / DO "FIND HIBBARD VALUE" JMP SHLSORT / STAY IN OUTER WHILE LOOP / .. COMPARE THE ELEMENTS ........................ / EXCHNG=FALSE / DO EVALUATION / IF EXCHNG=TRUE / THEN / LSTADR(FREINX)=LSTADR(BOTINX) / LSTADR(BOTINX)=TOPTMP / FREINX=BOTINX / ...... (RETURN TO "ORDER THE PARTITION") ....... CMPELMT,XX DCA EXCHNG / EXCHNG=FALSE (0) TAD LSTADR TAD BOTINX DCA BOTPTR / CREATE "LSTADR(BOTINX)" POINTER TAD LSTADR TAD FREINX DCA FREPTR / CREATE "LSTADR(FREINX)" POINTER JMS EVAL / COMPARE THE SORT FIELDS DCA EXCHNG / SAVE EXCHANGE INDICATOR TAD EXCHNG / IS EXCHNG=TRUE SNA CLA / YES, SKIP IF AC <> 0 JMP I CMPELMT / NO CDFFNV /--------------------//CDF / TAD I BOTPTR DCA I FREPTR / LSTADR(FREINX)=LSTADR(BOTINX) TAD TOPTMP DCA I BOTPTR / LSTADR(BOTINX)=TOPTMP CDFMYF /--------------------//CDF / TAD BOTINX DCA FREINX / FREINX=BOTINX JMP I CMPELMT PAGE BOTDAT, 0 / AN ADDRESS POINTER TO THE BOTINX DATA ELEMENT FREDAT, 0 / AN ADDRESS POINTER TO THE FREE DATA ELEMENT BINVALID,0 / A BOOLEAN (0=F, 1=T), TRUE = INVALID FIELD (BOTINX) FINVALID,0 / A BOOLEAN (0=F, 1=T), TRUE = INVALID FIELD (FREINX) BOTCNT, 0 / A COUNT OF THE NUMBER OF CHARACTERS IN BOTINX FIELD FRECNT, 0 / A COUNT OF THE NUMBER OF CHARACTERS IN FREE FIELD CHARCT, 0 / THE NUMBER OF CHARACTERS TO BE COMPARED / EQUALS THE LESSER OF BOTCHR/FRECHR / ** INTEROGATE VAT ** / SET INVALID FIELD INDICATORS & DETERMINE SORT FIELD LENGHTS / INVLD=FALSE / BOTDAT=(BOTPTR)+4 (ADDR = (ADDR OF REC] - 1) / FREDAT=(FREPTR)+4 (ADDR = (ADDR OF REC] - 1) / IF (BOTDAT) IS INVALID / THEN / DO INVALD / BINVALID = TRUE / BOTCNT=(BOTDAT IS THE CHARACTER COUNT) / / IF (FREDAT) IS INVALID / THEN / DO INVALD / FINVALID = TRUE / FRECNT=(FREDAT IS THE CHARACTER COUNT) / / (FALL THROUGH TO "RESOLVE INVALID FIELD CONDITIONS") EVAL, XX / ENTRY POINT TO EVALUATION LOGIC TAD SORTKEY CLL RAR SZA CLA JMP EVALMKS / MULTI-KEY SORT TAD BOTPTR DCA BOTDAT TAD FREPTR DCA FREDAT CDFFNV /--------------------//CDF / AC0004 / ADDR = (ADDR OF REC) - 1 TAD I BOTDAT DCA BOTDAT / BOTDAT=(BOTPTR)+4 AC0004 / ADDR = (ADDR OF REC) - 1 TAD I FREDAT CDFMYF /--------------------//CDF / JMP .+6 / FREDAT=(FREPTR)+4 EVALMKS,TAD BOTPTR JMS KEYSEARCH DCA BOTDAT / 'VAT' ADDRESS OF RECORD ENTRY IN FNVTABLE TAD FREPTR JMS KEYSEARCH DCA FREDAT CDFFNV /--------------------//CDF / TAD I BOTDAT / [VAT] BSW AND (VVVVV) DCA BOTCNT / BOTCNT=(BOTDAT -CHARACTER COUNT-) TAD I FREDAT / [VAT] BSW AND (VVVVV) DCA FRECNT / FRECNT=(FREDAT -CHARACTER COUNT-) CDFMYF /--------------------//CDF / TAD BOTCNT / VVVVV SNA CLA AC0001 / [1] / MEANS 'BOTINX' DATA FIELD IS INVALID DCA BINVALID TAD FRECNT / VVVVV SNA CLA AC0001 / [1] / MEANS 'FRE' DATA FIELD IS INVALID DCA FINVALID /\ JMP CKINVL / ** RESOLVE INVALID FIELD CONDITIONS ** / IF THE "INVLD" FLAG WAS SET, CHECK WHICH FIELDS / WERE INVALID. INVALID FIELDS ARE TREATED AS IF THEY / CONTAINED HIGH VALUES. THEY GO TO THE BOTINX IN / ASCENDING SORTS, AND ON THE TOPINX IN DESCENDING SORTS. / THE COMPARISON ROUTINE WILL TAKE THE PROPER EXIT IF ONLY / ONE OF THE FIELDS WAS INVALID, AND IT WILL RETURN / IF BOTINXH WERE INVALID. IN THIS CASE THE ELEMENTS ARE / IN ORDER, AND THE ROUTINE IS EXITED. / IF INVLD=TRUE / THEN / DO COMPARISON (OF 'BINVALID' VS 'FINVALID') / EXIT (BOTINXH FIELDS WERE INVALID) / / (FALL THROUGH TO "SET UP COMPARE LOOP COUNTER") CKINVL, TAD BINVALID / IF INVLD=TRUE TAD FINVALID SNA CLA / THEN JMP SETLC / ELSE TAD BINVALID CLL CIA TAD FINVALID JMS VALCMP / DO COMPARISON JMP I EVAL / BOTH FIELS WERE INVALID / ** SET UP COMPARE LOOP COUNTER ** / FIND THE LESSER OF FRECNT, BOTCNT. THAT WILL BE THE NUMBER / OF CHARACTERS TO BE COMPARED. / CHARCT=FRECNT / IF BOTCNT0 / BOTCHR="UNPACK CHARACTER"(BOTINX) / FRECHR="UNPACK CHARACTER"(FRE) / DO COMPARISON (OF BOTCHR VS FRECHR / CHARCT=CHARCT-1 (CHARACTERS WERE EQUAL) / IF CHRPTR=0 / THEN / CHRPTR=1 / ELSE / RESET (CHRPTR, BOTDAT, FREDAT) / (FALL THROUGH TO "COMMON EVALUATION EXITS") CMPLOP, ISZ BOTDAT / V V NOP ISZ FREDAT / V V NOP TAD CHARCT / IF CHARCT > 0 SPA SNA CLA / THEN, SKIP IF AC > 0 JMP CKEXCH / ELSE CDFFNV /--------------------//CDF / TAD I BOTDAT / BOTCHR="UNPACK CHARACTER"(BOTINX) CLL CIA TAD I FREDAT / FRECHR="UNPACK CHARACTER"(FRE) CDFMYF /--------------------//CDF / JMS VALCMP / DO COMPARISON OF BOTCHR VS FRECHR AC7777 / -1 TAD CHARCT DCA CHARCT / CHARCT = CHARCT-1 JMP CMPLOP / COMPARE 2 VALUES / THIS ROUTINE IS USED FOR ALL COMPARISONS RELATING TO ORDER. / ............................................................................. / FOR ASCENDING:: ASCDSC, SZL / ............................................................................. / / FOR INVLD FLD FOR STRING LGTH FOR CHARACTER / COMPARISON COMPARISON COMPARISON / RELATION (VLD=0, INVLD=1) /----------------------------------------------------------------------------- / A > B | EXCHG ELEMENTS | EXCHG ELEMENTS | EXCHG ELEMENTS / | | | / A = B | RETURN TO RTN | RETURN TO RTN | RETURN TO RTN / | | | / A < B | ORDER IS OK | ORDER IS OK | ORDER IS OK /----------------------------------------------------------------------------- / / / / / / / / ............................................................................. / FOR DESCENDING:: ASCDSC, SNL / ............................................................................. / / FOR INVLD FLD FOR STRING LGTH FOR CHARACTER / COMPARISON COMPARISON COMPARISON / RELATION (VLD=0, INVLD=1) /----------------------------------------------------------------------------- / A < B | EXCHG ELEMENTS | EXCHG ELEMENTS | EXCHG ELEMENTS / | | | / A = B | RETURN TO RTN | RETURN TO RTN | RETURN TO RTN / | | | / A > B | ORDER IS OK | ORDER IS OK | ORDER IS OK /----------------------------------------------------------------------------- / A:: IS 'BOT...' / B:: IS 'FRE...' VALCMP, XX SNA CLA JMP I VALCMP / THE ELEMENTS ARE EQUAL /............................................................................... ASCDSC, ZBLOCK 1 / [ASC]ENDING = 'SZL' (7430); [DES]CENDING = 'SNL' (7420) /............................................................................... JMP EXCH / EXCHANGE THE ELEMENTS JMP I EVAL / ELEMENTS ARE ORDERED / ** COMMON EVALUATION EXITS ** / CKEXCH- IF THE FIELDS WERE EQUAL IN VALUE, THIS EXIT ROUTINE WILL / CHECK TO SEE IF THEY WERE EQUAL IN LENGTH. DIFFERENCES IN / FIELD LENGTH DETERMINES ORDER. / CKEXCH, TAD BOTCNT / IF BOTCNT > FRECNT CIA; CLL TAD FRECNT JMS VALCMP / DO COMPARISON OF BOTCNT VS FRECNT SKP EXCH, AC0001 / EXCHANGE THE ELEMENTS JMP I EVAL / COUNTS WERE EQUAL / ........ FIND HIBBARD VALUE ........ / DISTNC=DISTNC/2 / DISTNC=DISTNC-1 FNDHIB, XX TAD DISTNC CLL RAR / DISTNC=DISTNC/2 TAD (-1) DCA DISTNC / DISTNC=DISTNC-1 JMP I FNDHIB PAGE ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// NVFP .PA - NUMERIC VALUE FIELD PARSER \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ / Numeric Value Field (NV) Parser / Subroutine to parse the <:FIELD NAME> 'value' field of a record / to determine its numeric (decimal) significence (and alignment) / IF the SELECTOR set (NVFFLAG)=7777 / (means <:FIELD NAME> not was found) / THEN capture program control and / parse the 'value' field of the record / for its numeric (decimal) significence / aligning [Kwhole] places to the left / of the decimal point and [KFraction] / places to the right of the point / ELSE exit with (AC) unchanged = 6-bit character at entry / Entry with the contents of the AC = the 6-bit character: 000000cccccc / FROM THE 'VALUE' FIELD OF THE RECORD / / Exit from the nvfprocessor with a 'jmp i nvfprocessor' / (if no numeric fields specified in the specification doc) / / else exit is with a 'jmp gotall' / / JMS NVFPROCESSOR; return pc (if no numeric fields defined) NVFPROCESSOR, XX / DCA T1NVF / Temporarily save the 6-bit char / IF THERE IS NO NUMERIC <:FN> / THAT MEANS THE CONTENTS OF 'FTYPE' = 0 / THEN NO NEED TO EXECUTE THIS TEST / BUT IF THERE IS AT LEAST ONE <:FN> / THAT MEANS THE CONTENTS OF 'FTYPE' ARE NOT ZERO / THEN WE MUST EXECUTE THIS TEST LOOP / BECAUSE THE KEY # DON'T COME FROM THE INPUT DOC IN ORDER TAD KEYNO CIA DCA T2NVF TAD FTYPE / TTT TTT TTT TTT SNA JMP FTYPE0 CLL RAL ISZ T2NVF JMP .-2 SZL CLA JMP NVFPARSE FTYPE0, TAD T1NVF / Get back the AC at entry JMP I NVFPROCESSOR / EXIT / <:FIELD NAME> was detected by the SELECTOR and (NVFFLAG) = 7777 / therefore this 'value' field will be parsed for its decimal significence NVFPARSE, TAD (NVFBUFFER-1) / Holding buffer for ASCII character string DCA X0 / Auto-index register #1 TAD (-KWHOLE-1) DCA NLCOUNT / left justification total (for ISZ) DCA NVFJUSTIFICATION/ combined left and right justification DCA NVFVAT / 'NVF' VALUE ATTRIBUTE JMP NVF1ST / Capture MAIN-LINE control to parse the 'value' field / Start the process then the first ascii character with / the code between 60 and 71 inclusive is detected / End the process when the first non-numeric character / is detected (except natural language characters) IGNORE, NEXTNVF,AC7777 JMS RD1VALUECHAR / Get a character of the 'value' field JMP E7 /* Disk EOF should not have happened here JMP .-3 / ignore this non-printing character JMP NVFLAB / JMP means '<' or start of '<>' detected JMP E5CLA /* found '>' within value field AND P177 / AC=mmmmmccccccc (mask mmmmmODE bits) DCA T1NVF / temporarily save the 7-bit character NVF1ST, TAD T1NVF / TAD (-71) / minus ASCII numeric 9 SMA SZA / JMP TSTNATURALS / JMP means character greater than ascii 9 TAD (11) / AC=-60 SPA CLA / JMP TSTNATURALS / JMP means character NOT between 60-71 / IF THE ASCII CHARACTER IS 61 THRU 71 / THEN SET THE 'X' BIT IN THE 'NVFVAT' TAD (-60) / TAD T1NVF / SNA CLA / SKIP NEXT BECAUSE ASCII 1 THRU 9 JMP SAVENVF / JMP CAUSE ASCII 0 TAD NVFVAT / AND (-10-1) / TAD (10) / SETS THE 'X' BIT DCA NVFVAT / / This particular character from the 'value' field / is between the ASCII codes 60-71 (0-9) inclusive / therefore save it within the holding buffer / for alignment (padding within the FNV table) later SAVENVF,AC0004 / cannot have numbers following a ')' /A0010 AND NVFVAT / do we have a ')' already? /A0010 SZA CLA /A0010 JMP E12A / yes, means illegal placement of ')' /A0010 TAD (1000) / cannot have numbers after trailing '-'/A0010 AND NVFVAT / is there a trailing '-'? /A0010 SZA CLA /A0010 JMP E12B / yes, no numbers may follow... /A0010 TAD T1NVF DCA I X0 / 'I' into the holding buffer ISZ NVFJUSTIFICATION/ 0-77 (will never overflow) ISZ NVFCOUNT / +1 to the 'V'alue JUSTIFICATION total JMP NEXTNVF JMP E12C /* JMP means to many 'value' characters / This particular character from the 'value' field / is NOT between the ASCII codes 60-71 (0-9) inclusive / therefore test for imbedded Natural language characters: / - decimal point / - decimal comma / - plus sign / - minus sign (LEADING or TRAILING) / - left paren (implied minus sign) / - right paren / - space (LEADing's are ignored but IMBEDDED's are kept) / - decimal colon / - asterisk TSTNATURALS, CLA / clean-up the AC TAD (NATURALS-2) DCA X1 NATLOOP,ISZ X1 TAD I X1 SNA JMP E12D /* - MEANS [0] TABLE TERMINATOR TAD T1NVF SNA CLA JMP I X1 JMP NATLOOP NATURALS, -55; JMP AMINUS / minus sign -50; JMP ALPAREN / left paren -51; JMP ARPAREN / right paren -40; JMP ASPACE / space -53; JMP APLUS / plus sign -54; JMP IGNORE / (ignore ALPHA) comma -52; JMP IGNORE / (ignore ALPHA) asterisk / ........................................................................ / CONDITIONALIZE the RADIX POINT and CURRENCY SYMBOL for NATURAL LANGUAGES -56; JMP APERIOD / period -44; JMP SPECIE / (ignore ALPHA) dollar sign -43; JMP SPECIE / (ignore ALPHA) pound sign / A20 / ........................................................................ 0 / TABLE TERMINATOR PAGE / A LEFT ANGLE BRACKET '<' HAS BEEN DETECTED / THEREFORE, ALIGN THE NUMERIC VALUE CHARACTERS / (BEING HELD WITHIN THE 'NVFBUFFER') / FOR DECIMAL SIGNIFICENCE / (PACK AS 6-BIT) INCLUDING LEADING AND TRAILING ZEROS IF APPLICABLE NVFLAB, AC6000 / CHECK FOR ')' FOLLOWING A '(' /A0010 AND NVFVAT / DO WE HAVE A '('? /A0010 TAD (-6000) /A0010 SZA CLA /A0010 JMP NVFL1 / NO... /A0010 AC0004 / YES, DO WE HAVE A MATCHING ')' ? /A0010 AND NVFVAT /A0010 SNA CLA /A0010 JMP E12E / NO, UNMATCHED PARENS. /A0010 NVFL1, AC7776 / COUNT OF -2 DCA VALCOUNT / USED FOR 6-BIT PACKING TAD (NVFBUFFER-1) / ADDRESS-1 OF THE NVFBUFFER DCA X0 / AUTO-INDEX REGISTER TAD NVFJUSTIFICATION/ LLLLLLRRRRRR SNA CLA / SKIP NEXT IF NO DIGITS 'LEFT OF' OR 'RIGHT OF' JMP GOTALL / EXIT BECAUSE A 'BLANK' VALUE FIELD AC0001 AND NVFVAT SZA CLA JMP .+4 TAD NVFJUSTIFICATION BSW DCA NVFJUSTIFICATION TAD NVFVAT / (N)UMERIC (V)ALUE (F)IELD (AT)TRIBUTE SPA CLA / SKIP NEXT IF + SIGN AC7776 / THE DECIMAL SIGNIFICENCE IS NEGATIVE /M0010 TAD (53) / THE DECIMAL SIGNIFICENCE IS POSITIVE JMS NVFPACK / STUFF SIGN (- OR +) INTO (FNV)TABLE TAD NVFJUSTIFICATION/ LLLLLLRRRRRR (L-LEFT OF, R-RIGHT OF) BSW / RRRRRRLLLLLL AND P77 / ACTUAL # DIGITS 'LEFT OF DECIMAL POINT' TAD (-KWHOLE) / MAXIMUM # PLACES ALLOWED TO THE LEFT SZA / (AC) = DIFFERENCE BETWEEN ACTUAL AND MAXIMUM JMS NVFPADZEROS / PAD LEADING 0'S (CAUSE ACTUAL LESS THAN MAX) TAD NVFJUSTIFICATION/ LLLLLLRRRRRR BSW / RRRRRRLLLLLL AND P77 CIA / 2'S COMP OF ACTUAL # DIGITS 'LEFT OF' SZA / SKIP NEXT IF NO DIGITS LEFT OF DECIMAL POINT JMS NVFFILL / STUFF THOSE DIGITS INTO THE (FNV)TABLE /-- TAD (KPERIOD) /------ /-- JMS NVFPACK /------ TAD NVFJUSTIFICATION/ LLLLLLRRRRRR AND P77 / ACTUAL # DIGITS 'RIGHT OF DECIMAL POINT' CIA / 2'S COMP OF THAT NUMBER SZA / SKIP NEXT IF NO DIGITS 'RIGHT OF' JMS NVFFILL / STUFF THOSE DIGITS INTO THE (FNV)TABLE TAD NVFJUSTIFICATION/ LLLLLLRRRRRR AND P77 / ACTUAL # 'RIGHT OF' TAD (-KFRACTION) / MAXIMUM # PLACES ALLOWED TO THE RIGHT SZA / SKIP NEXT IF ACTUAL=MAXIMUM JMS NVFPADZEROS / PAD TRAILING 0'S (CAUSE ACTUAL LESS THAN MAX) JMP GOTALL / EXIT / NVF SUBROUTINE to 'FIX' (correct by 9's complementing) /A011 / THE VALUE OF THE NUMERIC FIELD /A011 / (IF THE DECIMAL SIGNIFICENCE IS negative) /A011 / enabling negative value fields to sort algebraically /A011 / /A011 / -9999.99 /A011 / - 999.99 /A011 / - 99.99 /A011 / - 9.99 /A011 / - .99 /A011 / - .9 /A011 / + .99 /A011 / /A011 / BUT if the 'X' bit (within the NVFVAT = 0) is 0 /A011 / then the nvf (numeric value field) is all zeros /A011 / so don't fix /A011 / /A011 NVFFIX, XX / /A011 / /A011 / ENTER WITH THE AC = 6-BIT ASCII CHARACTER /A011 / IN THE RANGE OF 60 TO 71 /A011 / /A011 DCA T1FIX / save the character (temporarily) /A011 TAD NVFVAT / get the value attributes /A011 AND (10) / mask the 'X' bit /a011 SNA CLA / skip next if 'X' bit set /a011 JMP NVFNOFIX / jmp cause the nvf=00000000.000 /a011 TAD NVFVAT / get the attributes again /a011 SMA CLA / skip next if negative value /a011 JMP NVFNOFIX / jmp cause the nvf is positive /a011 TAD T1FIX / get back the 6-bit ascii at entry /a011 TAD (-71) / -9 / ... 9'S /A011 CIA / ... COMPLE- /A011 TAD (60) / 0 / ... MENT /A011 JMP I NVFFIX / EXIT with the ac=1's compliment value /a011 NVFNOFIX, TAD T1FIX / get back the character at entry /a011 JMP I NVFFIX / EXIT without complimenting /a011 T1FIX, ZBLOCK 1 / holds the 6-bit temporarily /a011 / NVF SUBROUTINE TO PRECEED OR POSTCEED / (PAD) THE DECIMAL VALUE WITH LEADING OR TRAILING 0'S NVFPADZEROS, XX / ENTER WITH (AC) = 2'S COMP # OF PLACES TO PAD DCA T1NVF / SAVE THAT 2'S COMP # FOR 'ISZ T1NVF' LATER TAD (60) / ASCII ZERO (0) JMS NVFFIX / FIX THE VALUE FOR NEGATIVE nvf's /a011 JMS NVFPACK / 6-BIT PACK IT ISZ T1NVF / UPDATE THE COUNT JMP .-4 / UNTIL (T1NVF) = 0 JMP I NVFPADZEROS / EXIT (PADDING COMPLETE) / NVF SUBROUTINE TO / TRANSFER THE 'LLLLLL' DIGITS TO THE LEFT OF THE DECIMAL POINT / (UNTIL THE CONTENTS OF PROGRAM LOCATION 'T1NVF'=0) / OR TO TRANSFER THE 'RRRRRR' DIGITS TO THE RIGHT OF THE DECIMAL POINT / (UNTIL THE CONTENTS OF PROGRAM LOCATION 'T1NVF'=0) NVFFILL, XX / ENTER WITH (AC) = 2'S COMP # OF DIGITS TO FILL DCA T1NVF / SAVE FOR 'ISZ T1NVF' LATER TAD I X0 / 'LEFT' OR 'RIGHT' PLACED DIGITS JMS NVFFIX / FIX THE VALUE FOR NEGATIVE nvf's /a011 JMS NVFPACK / 6-BIT PACK EM ISZ T1NVF / UPDATE THE COUNT JMP .-4 / UNTIL (T1NVF)=0 JMP I NVFFILL / DONE / NVF SUBROUTINE TO / STUFF THE CONTENTS OF THE AC (000000CCCCCC) / INTO THE (FNV)TABLE AS 6-BIT 'TEXT' NVFPACK,XX / ENTER WITH THE (AC) = 6-BIT CHAR TO PACK ISZ VALCOUNT / SKIP NEXT WHEN 2 CHAR'S READY FOR PACKING JMP .+5 / JMP MEANS POSITION 1ST OF 2 CHAR'S FOR PACKING TAD PACK6BIT / PACK THIS 2ND CHAR WITH THE 1ST DCAFNV / STUFF INTO THE (FNV)TABLE AC7776 / -2 DCA VALCOUNT / RESET THE COUNTER BSW / BSW MEANS POSITION THIS 1ST CHAR FOR PACKING DCA PACK6BIT JMP I NVFPACK PAGE / The character is a LEFT PAREN '(' ALPAREN,TAD NVFJUSTIFICATION SZA CLA JMP E12F /* - means ILLEGAL PLACEMENT of '(' AC6000 AND NVFVAT SZA CLA JMP E12G /* - means a '+' or '-' PRECEEDED '(' AC6000 JMP SETNVF / The character is a RIGHT PAREN ')' ARPAREN,AC6000 AND NVFVAT TAD (-6000) SZA CLA JMP E12H /* - means no '(' before ')' TAD NVFJUSTIFICATION SNA CLA JMP E12I /* - means '()' AC0004 AND NVFVAT SZA CLA JMP E12J /* - means extra ')' AC0004 JMP SETNVF / The character is a PLUS SIGN /*E12 - means syntax error for extra (or illegal placement of) '+' APLUS, TAD NVFJUSTIFICATION /A0010 SZA CLA /A0010 JMP E12K /* - means illegal placement of '+' /A0010 AC0002 /A0010 AND NVFVAT /A0010 SZA CLA /A0010 JMP E12K /* - means illegal placement of '+' /A0010 AC2000 JMP MINUS2 /M0010 / The character is a MINUS SIGN /*E12 - means syntax error for extra (or illegal placement of) '-' AMINUS, TAD NVFJUSTIFICATION/ |if NOT the first character /A0010 SZA CLA / |then /A0010 JMP MINUS1 / | go set trailing '-' bit /A0010 AC0002 / |else /A0010 AND NVFVAT / | |if previous '$' /A0010 SZA CLA / | |then /A0010 JMP E12B / | | illegal placement of '-' /A0010 / | |else /A0010 AC4000 / | | set '-' sign bit /A0010 SKP / /A0010 MINUS1, TAD (5000) / set trailing '-' bit /A0010 / .......................................................................... MINUS2, MQL / .......................................................................... CLA /A0010 TAD (7000) / check for previous SIGN /M0010 AND NVFVAT SZA CLA JMP E12L /* - means extra SIGN found / .......................................................................... CLA MQA / 2000; or 4000 / .......................................................................... SETNVF, TAD NVFVAT DCA NVFVAT JMP NEXTNVF / The character is a CURRENCY SYMBOL / [conditionalized for natural languages] SPECIE, AC0002 AND NVFVAT SZA CLA JMP E12M /* - means extra currency (money) symbol TAD NVFJUSTIFICATION /A0010 SZA CLA /A0010 JMP E12N /* - means illegal placement of '$' /A0010 / AC6000 /D0010 / AND NVFVAT /D0010 / SNA CLA /D0010 / JMP E12 /* - means no 'sign' before symbol /D0010 AC0002 JMP SETNVF / The character is a SPACE ' ' ASPACE, TAD NVFJUSTIFICATION SNA CLA JMP IGNORE / LEADING SPACE /\ JMP NVFEND / IMBEDDED SPACE TERMINATES NUMBER / This is the END of the numeric value field parse / IGNORE all characters until the next left angle bracket '<' NVFEND, AC7777 JMS RD1VALUECHAR / Get a character of the 'value' field JMP E7 /* Disk EOF should not have happened here JMP .-3 / ignore this non-printing character JMP NVFLAB / JMP means '<' or start of '<>' detected JMP E5CLA /* found '>' within value field JMP .-6 / ignore this printable character / The character is a DECIMAL POINT '.' [RADIX SEPERATOR] /*E12 - means syntax error for extra '.' (or illegal placement) APERIOD,AC0001 AND NVFVAT SZA CLA JMP E12P /* - means extra '.' found ISZ NVFVAT / set decimal point found indicator TAD (-KWHOLE) TAD NVFJUSTIFICATION TAD (KFRACTION) SPA CLA TAD (-KFRACTION-1) DCA NRCOUNT TAD NVFJUSTIFICATION BSW DCA NVFJUSTIFICATION JMP NEXTNVF T1NVF, ZBLOCK 1 / TEMPorary holding register / ............................................................................. KWHOLE= 15 / UP TO 13(10) places LEFT of DECIMAL KFRACTION= 06 / UP TO places RIGHT of DECIMAL / ............................................................................. / HOLDing buffer for NUMERIC VALUE characters / SIGN, LLLLLL, RRRRRR, (-1) SLUSH NVFBUFFER,ZBLOCK 1+KWHOLE+KFRACTION+1 / / / / / T2NVF, NLCOUNT, NRCOUNT, NVFCOUNT, -KWHOLE-1 / then -KFRACTION-1 NVFJUSTIFICATION, 0 / LLLLLL RRRRRR NVFVAT, ZBLOCK 1 / S S S - - - - - X R C D /______________________________ / 0 0 0 - (IMPLIED+)\ | | | | / 0 1 0 - PLUS sign \ | | | 1 - DECIMAL POINT found / 1 0 0 - MINUS sign\ | | 1 - CURRENCY SYMBOL found / | 1 - RIGHT PAREN found / 0 - nvf=000.000 / 1 1 0 - LEFT PAREN\ / (implied MINUS)\ / 1 0 1 - trailing \ /A0010 / MINUS\ /A0010 PAGE ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// WPSRTX.PA - TEXT \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ / THE SCREEN SIZE IS 24 LINES X 80 COLUMNS / * COLUMNS 0 THRU 79: / * / *0 10 20 30 40 50 60 70 / *! ! ! ! ! ! ! ! / LINES *01234567890*********01234567890*********0*********0*********0*********0********* / 0-23:0 DATE/TIME / 1 X - INFORMATION LEFT BY SORT PARSER AND MENUS / 2 X - INFORMATION LEFT BY SORT PARSER AND MENUS / 3 X - INFORMATION LEFT BY SORT PARSER AND MENUS / 4 X - INFORMATION LEFT BY SORT PARSER AND MENUS / 5 BLANK LINE / 6 Primary Key Records: X OUT OF Y / 7 Multiple ruler warning / 8 Records output: Z / 9 BLANK LINE / 10 --------- OR, WORKING, PAUSED, ABORTED, DONE / 11 --ERROR-- M1, THRU... / 12 --------- / 13 BLANK LINE / * ???????? LINES #14 THRU #21 / * ???????? CONTAINS UP TO 7 LINES / * ???????? OF INFORMATION / * ???????? FROM THE LIST DOCUMENT / * ???????? IF AN ERROR WAS DETECTED / * ???????? WITHIN THE SELECTOR / * ???????? OR THE OUTPUT DOCUMENT GENERATOR / 21 BLANK LINE / 22 Press RETURN to continue, or / 23 Press Gold MENU to return to MAIN MENU / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!! !!!!!!!! / !!!!!!!! TEXT FOR OUTPUT !!!!!!!! / !!!!!!!! TO THE SCREEN !!!!!!!! / !!!!!!!! !!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / 1205 1600 MPROCESSING, IFDEF ENGLSH < TEXT '^P^E&WORKING^P' /M002 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /^P^E&IN &CORSO/ > IFDEF V30NOR < TEXT '^P^E&AKTIV^P'> IFDEF V30SWE < TEXT '^P^E&BEARBETAR^P'> IFDEF DUTCH < TEXT '^P^E&BEZIG...^P'> IFDEF SPANISH < TEXT '^P^E&TRABAJANDO^P'> / 1220 (OCTAL) 1600 MSRWAIT, IFDEF ENGLSH < TEXT '^P - &PLEASE WAIT^P' /M002 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /^P - &PREGO ATTENDERE.../ > IFDEF V30NOR < TEXT '^P - &VENT'> IFDEF V30SWE < TEXT '^P - V\DNTA EN STUND^P'> IFDEF DUTCH < TEXT '^P - &EVEN GEDULD.^P'> IFDEF SPANISH < TEXT '^P - &ESPERE^P'> / 0605 1600 MSUMMARY, IFDEF ENGLSH < TEXT '^P&PRIMARY &KEY &RECORDS: ^L!D OUT OF !D^P' /M002-MJS >/END ENGLSH IFDEF ITALIAN < TEXT /^P &CHIAVI &PRIMARIE: ^L!D DI !D^P/ > IFDEF V30NOR < TEXT '^PPOSTER UTVALGT ETTER PRIM\FRN\XKKEL: ^L!D AV !D^P'> IFDEF V30SWE < TEXT '^P&PRIM\DRA F\DLT MED SORTERINGSNYCKLAR: ^L!D AV !D'> IFDEF DUTCH < TEXT '^P&GESELECTEERDE GEGEVENSGROEPEN: ^L!D UIT !D^P'> IFDEF SPANISH < TEXT '^P®ISTROS &TECLA &PRIMARIA: ^L!D FUERA DE !D^P'> / 1005 1600 MODG, IFDEF ENGLSH < TEXT '^P&RECORDS &REPRODUCED: ^L^D^P' /M002 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /^P&RECORDS &COPIATI: ^L^D^P/ > IFDEF V30NOR < TEXT '^P&RECORD &REPRODUCED: ^L^D^P'> IFDEF V30SWE < TEXT '^P&ANV\DNDA POSTER: ^L^D^P'> IFDEF DUTCH < TEXT '^P&VERWERKTE GEGEVENSGROEPEN: ^L^D^P'> IFDEF SPANISH / 2603 MREPLACE, IFDEF ENGLSH < TEXT '^P^L-&REPLACE SYSTEM DISKETTE, THEN' /M002 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /^P^L-&INSERIRE IL DISCO SISTEMA,/ > IFDEF V30NOR < TEXT '^P^L-&SETT SYSTEMDISKETTEN TILBAKE OG'> IFDEF V30SWE < TEXT '^P^L-&S\DTT TILLBAKA SYSTEMDISETTEN OCH'> IFDEF DUTCH < TEXT '^P^L-&ZET SYSTEEMDISKETTE TERUG.'> IFDEF SPANISH / 1205 MSRDONE, IFDEF ENGLSH < TEXT '^P^E&DONE' /M002 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /^P^E&FINE/ > IFDEF V30NOR < TEXT '^P^E&UTF\XRT'> IFDEF V30SWE < TEXT '^P^E&F\DRDIGT'> IFDEF DUTCH < TEXT '^P^E&KLAAR!!'> IFDEF SPANISH / 1205 MSRABORTED, IFDEF ENGLSH < TEXT '^P^E&ABORTED' /M002 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /^P^E&INTERRUZIONE/ > IFDEF V30NOR < TEXT '^P^E&AVBRUTT'> IFDEF V30SWE < TEXT '^P^E&AVBRUTEN'> IFDEF DUTCH < TEXT '^P^EAFGEBROKEN'> IFDEF SPANISH IFDEF ENGLSH < /A002 / 1205 MSRPAUSED, TEXT '^P^L&PAUSED ' *.-1 / 2603 TEXT '^P-&PRESS &R&E&T&U&R&N TO CONTINUE, OR ' *.-1 / 2703 MGOLD, TEXT '^P-&PRESS &GOLD &M&E&N&U TO RECALL THE &MAIN &MENU.' >/END ENGLSH /A002 IFDEF ITALIAN < MSRPAUSED, TEXT '^P^L&SOSPENSIONE ' *.-1 / 2603 TEXT '^P-&PREMERE !&RITORNO PER CONTINUARE ' *.-1 / 2703 MGOLD, TEXT '^P-&PREMERE &ORO !&MENU PER RICHIAMARE IL &MENU &PRINCIPALE.' > IFDEF V30NOR < /A002 / 1205 MSRPAUSED, TEXT '^P^L&MIDLERTIDIG STANS' *.-1 / 2603 TEXT '^P-&TRYKK P\E !&RETUR FOR \E FORTSETTE EL.' *.-1 / 2703 MGOLD, TEXT '^P-&TRYKK P\E &GULL !&MENY FOR \E F\E &HOVEDMENYEN.' >/END V30NOR /A002 IFDEF V30SWE < MSRPAUSED, TEXT '^P^L&PAUS ' *.-1 / 2603 TEXT '^P-&TRYCK P\E RETUR F\VR ATT FORTS\DTTA ' *.-1 / 2703 MGOLD, TEXT '^P-&TILLBAKA TILL HUVUDMENYN: ANV\DND GULD MENY' >/END V30SWE /A002 IFDEF DUTCH < MSRPAUSED, TEXT '^P^L&ONDERBROKEN' *.-1 / 2603 TEXT '^P-&DRUK OP !&RETURN OM VERDER TE GAAN. ' *.-1 / 2703 MGOLD, TEXT '^P-&DRUK OP &GOUD !&MENU OM TERUG TE GAAN NAAR HET &HOOFDMENU.' > IFDEF SPANISH < MSRPAUSED, TEXT '^P^L&PAUSA' *.-1 / 2603 TEXT '^P-&PULSE !& RETORNO PARA CONTINUAR, O' *.-1 / 2703 MGOLD, TEXT '^P-&PULSE &DORADA !&MENU PARA VOLVER AL &MEN\Z &PRINCIPAL.' > / 0705 MULTIRULERERR, IFDEF ENGLSH < TEXT '^P^L&WARNING - &LIST CONTAINS MULTIPLE RULERS' >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /^P^L&ATTENZIONE - &PI\Y DI UN DESCRITTORE RIGA/ > IFDEF V30NOR < TEXT '^P^L&ADVARSEL - &LISTEN INNEHOLDER FLERE FORMATERINGSLINJER'> IFDEF V30SWE < TEXT '^P^L!&VARNING! - ®ISTRET INNEH\ELLER FLERA LINJALER'> IFDEF DUTCH < TEXT '^P^L!&OPGELET - &BESTAND HEEFT MEER DAN EEN REGELINDELING'> IFDEF SPANISH < TEXT '^P^L!&ADVERTENCIA - &LA LISTA CONTIENE REGLAS M\ZLTIPLES'> / --------- / --ERROR-- THE TEXT OF A SPECIFIC ERROR HERE. / --------- IFDEF ENGLSH < /A002 /1200 1300 1400 1600 MERROR, TEXT '^P^E---------^P--&E&R&R&O&R--&!S^P---------^P' >/END ENGLSH IFDEF ITALIAN < /A002 /1200 1300 1400 1600 MERROR, TEXT '^P^E----------^P--!&ERRORE--&!S^P----------^P' > IFDEF V30NOR < MERROR, TEXT '^P^E----------^P--!&FEIL--&!S^P------------^P' > IFDEF V30SWE < MERROR, TEXT '^P^E----------^P--!&FEL--&!S^P-------------^P' > IFDEF DUTCH < /A002 /1200 1300 1400 1600 MERROR, TEXT '^P^E^P!&FOUT:&!S^P^P.' >/END ENGLSH IFDEF SPANISH < /A002 /1200 1300 1400 1600 MERROR, TEXT '^P^E---------^P--!&ERROR--&!S^P---------^P' >/END ENGLSH EMESTABLE, ME0 / RECORD EXCEEDS 2500 CHARACTERS /\ ME1 / NONE ME2 / FIELD NAME MISSING '<' OR TEXT BETWEEN RECORDS ME3 / FIELD NAME CONTAINS EXTRA '<' ME4 / FIELD NAME EXCEEDS 30 CHARACTERS ME5 / KEY VALUE FIELD CONTAINS '>' ME6 / RECORD CONTAINS DUPLICATE KEY ME7 / LIST NOT TERMINATED WITH '<>' ME8 / UNEXPECTED END OF FILE ME9 / LIST CONTAINS ONLY TEXT ME10 / PRIMARY KEY NOT FOUND ME11 / TO MANY KEYS DEFINED / (THIS IS A DEVELOPMENT ERROR MESSAGE) / (WHICH THE END USER SHOULD NEVER SEE) ME12 / INVALID NUMERIC SYNTAX / ME12A / INCORRECT PLACEMENT OF RIGHT PAREN ')' / ME12B / INCORRECT PLACEMT OF MINUS SIGN '-' / ME12C / TO MANY NUMERIC VALUE FIELD CHARACTERS / ME12D / UNKNOWN CHARACTER / ME12E / NO ')' AFTER '(' / ME12F / INCORRECT PLACEMENT OF LEFT PAREN '(' / ME12G / '+' OR '-' PRECEEDED '(' / ME12H / NO '(' BEFORE ')' / ME12I / '()' DETECTED / ME12J / 'EXTRA ')' FOUND / ME12K / INCORRECT PLACEMENT OF PLUS SIGN '+' / ME12L / EXTRA SIGN (+ OR - OR IMPLIED MINUS) FOUND / ME12M / EXTRA CURRENCY SYMBOL FOUND / ME12N / INCORRECT PLACEMENT OF CURRENCY SYMBOL / ME12P / EXTRA RADIX POINT '.' FOUND ME13 / output document diskette full /a0014 ME13A / OUTPUT DOCUMENT VOLUME FULL /A018 ME0, IFDEF ENGLSH < /A002 TEXT \RECORD EXCEEDS 2500 CHARACTERS\ >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /RECORD SUPERA 2500 CARATTERI/ > IFDEF V30NOR < TEXT 'POST OVER 2500 TEGN'> IFDEF V30SWE < TEXT '&POSTEN BEST\ER AV MER \DN 2500 TECKEN'> IFDEF DUTCH < /A002 TEXT \MEER DAN 2500 TEKENS IN GEGEVENSGROEP\ >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT 'REGISTRO CON M\AS DE 2500 CARACTERES\ >/END SPANISH /A002 ME2, IFDEF ENGLSH < /A002 TEXT "FIELD NAME MISSING '" *.-1 /A001 7447 /OPEN BRACKET,QUOTE /A001 TEXT \ OR TEXT BETWEEN RECORDS\ /A001 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /MANCA CAMPO NOME '/ *.-1 7447 TEXT / O TESTO TRA RECORDS/ > IFDEF V30NOR < /A002 TEXT \FELTNAVN MANGLER '\ /M001 *.-1 /A001 7447 /OPEN BRACKET,QUOTE /A001 TEXT \ EL. TEKST MELLOM POSTER\ /A001 >/END V30NOR /A002 IFDEF V30SWE < /A002 TEXT "&ETT F\DLTNAMN SAKNAS '" /M001 *.-1 /A001 7447 /OPEN BRACKET,QUOTE /A001 TEXT ' ELLER OCKS\E HAR DU SKRIVIT TEXT MELLAN POSTERNA' /A001 >/END V30SWE /A002 IFDEF DUTCH < TEXT \ONTBREKENDE \ /M001 *.-1 4774 TEXT /' OF TEKST TUSSEN GEGEVENSGROEPEN/ > IFDEF SPANISH < /A002 TEXT "FALTA NOMBRE DE CAMPO '" *.-1 /A001 7447 /OPEN BRACKET,QUOTE /A001 TEXT \ O TEXTO ENTRE REGISTROS\ /A001 >/END SPANISH /A002 ME3, IFDEF ENGLSH < /A002 TEXT \FIELD NAME CONTAINS EXTRA \ /A001 *.-1 /A001 4774 /QUOTE,OPEN BRACKET /A001 TEXT \'\ /A001 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /CAMPO NOME CONTIENE / *.-1 4774 TEXT /'/ > IFDEF V30NOR < /A002 TEXT \FELTNAVN INNEHOLDER EKSTRA \ /A001 *.-1 /A001 4774 /QUOTE,OPEN BRACKET /A001 TEXT \'\ /A001 >/END V30NOR /A002 IFDEF V30SWE < /A002 TEXT \&ETT F\DLTNAMN INNEH\ELLER EXTRA \ /A001 *.-1 /A001 4774 /QUOTE,OPEN BRACKET /A001 TEXT \'\ /A001 >/END V30SWE /A002 IFDEF DUTCH < /A002 TEXT \OVERBODIGE '\ /A001 *.-1 /A001 7447 /QUOTE,OPEN BRACKET /A001 TEXT \ IN VELDNAAM\ /A001 >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT \NOMBRE DE CAMPO CONTIENE EXTRA \ /A001 *.-1 /A001 4774 /QUOTE,OPEN BRACKET /A001 TEXT \'\ /A001 >/END SPANISH /A002 ME4, IFDEF ENGLSH < /A002 TEXT \FIELD NAME EXCEEDS 30 CHARACTERS\ >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /CAMPO NOME SUPERA 30 CARATTERI/ > IFDEF V30NOR < /A002 TEXT \FELTNAVN OVER 30 TEGN \ >/END V30NOR /A002 IFDEF V30SWE < TEXT '&F\DLTNAMNET BEST\ER AV MER \DN 30 TECKEN'> IFDEF DUTCH < /A002 TEXT \MEER DAN 30 TEKENS IN VELDNAAM\ >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT \NOMBRE DE CAMPO EXCEDE 30 CARACTERES\ >/END SPANISH /A002 ME5, IFDEF ENGLSH < /A002 TEXT \KEY VALUE FIELD CONTAINS '\ /M001 *.-1 /A001 7647 /CLOSE BRACKET,QUOTE /A001 0000 /ZERO WORD TO END TEXT /A001 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /CHIAVE CAMPO VALORE CONTIENE / *.-1 7647 0000 > IFDEF V30NOR < /A002 TEXT "N\XKKELFELTET INNEHOLDER '" /M001 *.-1 /A001 7647 /CLOSE BRACKET,QUOTE /A001 0000 /ZERO WORD TO END TEXT /A001 >/END V30NOR /A002 IFDEF V30SWE < /A002 TEXT "&F\DLTET MED V\DRDEN F\VR SORTERINGSNYCKEL INNEH\ELLER '" /M001 *.-1 /A001 7647 /CLOSE BRACKET,QUOTE /A001 0000 /ZERO WORD TO END TEXT /A001 >/END V30SWE /A002 IFDEF DUTCH < /A002 TEXT \OVERBODIGE '\ /M001 *.-1 /A001 7647 /CLOSE BRACKET,QUOTE /A001 0000 /ZERO WORD TO END TEXT /A001 >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT \CLAVE VALOR CAMPO CONTIENE '\ /M001 *.-1 /A001 7647 /CLOSE BRACKET,QUOTE /A001 0000 /ZERO WORD TO END TEXT /A001 >/END SPANISH /A002 ME6, IFDEF ENGLSH < /A002 TEXT \RECORD CONTAINS DUPLICATE KEY\ >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /RECORD CONTIENE CHIAVE DUPLICATA/ > IFDEF V30NOR < /A002 TEXT "POST HAR TO N\XKKELFELTER" >/END V30NOR /A002 IFDEF V30SWE < TEXT '&POSTERN INNEH\ELLER IDENTISKA SORTRINGSNYCKLAR'> IFDEF DUTCH < /A002 TEXT \DUBBELE VELDNAAM IN GEGEVENSGROEP\ >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT \REGISTRO CONTIENE CLAVE DUPLICADA\ >/END SPANISH /A002 ME7, IFDEF ENGLSH < /A002 TEXT \LIST NOT TERMINATED WITH '\ /A001 *.-1 /A001 7476 /OPEN BRACKET,CLOSE BRACKET /A001 TEXT \'\ /A001 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /LISTA NON TERMINA CON '/ *.-1 7476 TEXT /'/ > IFDEF V30NOR < /A002 TEXT "LISTE ER IKKE AVSLUTTET MED '" /A001 *.-1 /A001 7476 /OPEN BRACKET,CLOSE BRACKET /A001 TEXT \'\ /A001 >/END V30NOR /A002 IFDEF V30SWE < TEXT \®ISTERDOKUMENTET SLUTAR INTE MED '\ /A001 *.-1 /A001 7476 /OPEN BRACKET,CLOSE BRACKET /A001 TEXT \'\ /A001 >/END V30SWE /A002 IFDEF DUTCH < /A002 TEXT \BESTAND NIET AFGESLOTEN MET '\ /A001 *.-1 /A001 4774 /OPEN BRACKET,CLOSE BRACKET /A001 7647 0000 >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT \LISTA NO TERMINA CON '\ /A001 *.-1 /A001 7476 /OPEN BRACKET,CLOSE BRACKET /A001 TEXT \'\ /A001 >/END SPANISH /A002 ME8, IFDEF ENGLSH < /A002 TEXT \UNEXPECTED END OF FILE\ >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /FINE DEL DOCUMENTO INATTESA/ > IFDEF V30NOR < /A002 TEXT 'UVENTET SLUTT P\E FIL' >/END V30NOR /A002 IFDEF V30SWE < TEXT '&DOKUMENTET HAR FELAKTIGT "!&SLUT"-KOMMANDO'> IFDEF DUTCH < TEXT \ONVERWACHT EINDE VAN BESTAND\ >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT 'T\IRMINO DE FICHERO INESPERADO' >/END SPANISH /A002 ME9, IFDEF ENGLSH < /A002 TEXT \LIST CONTAINS ONLY TEXT\ >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /LISTA CONTIENE SOLO TESTO/ > IFDEF V30NOR < /A002 TEXT \LISTE INNEHOLDER BARE TEKST\ >/END V30NOR /A002 IFDEF V30SWE < TEXT 'REGISTERDOKUMENTET INNEH\ELLER ENBART TEXT'> IFDEF DUTCH < /A002 TEXT \BESTAND BEVAT SLECHTS TEKST\ >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT 'LISTA CONTIENE S\SLO TEXTO' >/END SPANISH /A002 ME10, IFDEF ENGLSH < /A002 TEXT \PRIMARY KEY NOT FOUND\ >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /CHIAVE PRIMARIA INESISTENTE/ > IFDEF V30NOR < TEXT 'PRIM\FRN\XKKEL IKKE FUNNET'> IFDEF V30SWE < TEXT '&F\VRSTA SORTERINGSNYCKELN KAN INTE HITTAS'> IFDEF DUTCH < /A002 TEXT \ONJUISTE SORTEERSPECIFICATIE\ >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT \NO SE ENCUENTRA CLAVE PRIMARIA\ >/END SPANISH /A002 ME11, IFDEF ENGLSH < /A002 TEXT \TO MANY KEYS DEFINED\ >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /TROPPE CHIAVI DEFINITE/ > IFDEF V30NOR < TEXT 'FOR MANGE SORTERINGSN\XKLER'> IFDEF V30SWE < TEXT '&F\VR M\ENGA SORTERINGSNYCKLAR \DR DEFINIERADE'> IFDEF DUTCH < /A002 TEXT \TE UITGEBREIDE SORTEERSPECIFICATIE\ >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT 'SE DEFINEN MUCHAS CLAVES' >/END SPANISH /A002 ME12, IFDEF ENGLSH < TEXT \INVALID NUMERIC SYNTAX\> IFDEF ITALIAN < TEXT /NUMERO NON VALIDO/ > IFDEF V30NOR < TEXT 'UGYLDIG TALLANGIVELSE'> IFDEF V30SWE < TEXT '&FELAKTIG NUMERISK SYNTAX'> IFDEF DUTCH < TEXT 'ONJUISTE GEGEVENS IN NUMERIEK VELD'> IFDEF SPANISH < TEXT '\SINTAXIS NUM\IRICA INV\ALIDA'> ME13, /a0014 IFDEF ENGLSH < TEXT \OUTPUT DISKETTE FULL\> /a0014 IFDEF ITALIAN < TEXT /ARCHIVIO DOCUMENTI USCITA PIENO/ > IFDEF V30NOR < TEXT 'DISKETT FOR UTDATA ER FULL'> IFDEF V30SWE < TEXT '&DISKETTEN D\DR DU VILL HA SLUTDOKUMENTET \DR FULL'> IFDEF DUTCH < TEXT '&BESTEMMINGSDISKETTE VOL'> IFDEF SPANISH < TEXT '&DISKETTE DE SALIDA LLENO'> ME13A, IFDEF ENGLSH < TEXT \OUTPUT VOLUME FULL\> /A018 IFDEF ITALIAN < TEXT /ARCHIVIO DOCUMENTI USCITA PIENO/ > IFDEF V30NOR < TEXT 'OMR\EDE FOR UTDATA ER FULLT'> IFDEF V30SWE < TEXT '&VOLYMEN D\DR DU VILL HA SLUTDOKUMENTET \DR FULL'> IFDEF DUTCH < TEXT '&BESTEMMINGSGEBIED VOL'> IFDEF SPANISH < TEXT '&VOLUMEN DE SALIDA LLENO'> / END WPSRTX.PA / --------------------------------------------------------------------- / ! ! I M P O R T A N T N O T I C E ! ! / --------------------------------------------------------------------- / / THE 'XXSDFNBUFFER' IS LOCATED IN FIELD #4 / / THE 'XXSDFNBUFFER' IS FILLED BY THE SORT PARSER / / THE BUFFER MAY BE MOVED ALMOST ANYWHERE IN THE FIELD / W/O ANY REDEFINITIONS IN THE SORT PARSER / HOWEVER, IF THIS BUFFER IS MOVED OUT OF THE FIELD / THEN THE APPROPRIATE 'CDFs' WITHIN THE PARSER MUST REFLECT THAT / / --------------------------------------------------------------------- / / THE 'XXSDFNBUFFER' HOLDS THE TO BE SORTED / AS DEFINED WITHIN THE SPECIFICATION DOCUMENT XXSDFNBUFFER=0 / of FIELD #4 /M011 / F / I / E / L / D / N / A / M / E / [0] / SEPARATOR / F / I / . / . / [0] / SEPARATOR / . / . / [0] / [-1] / XXSDFNBUFFER TERMINATOR / / / MAX # OF 'VVVVV'ALUE CHARS, TIMES 2, +1 [0 TERM], TIMES #MAXKEY, +1 [-1 TERM] / /D011 *KCCVALUE%2+1^MAXKEY+1+XXSDFNBUFFER PAGE