/ WPFILS -- FILE I-O ROUTINES / / 048 MART 30-APRL-85 ADDED FIELD 7 BLASTR HOOK / / --------- Following edits V2.0 and earlier / / 047 WCE 25-MAY-84 Removed old STATLN definitions / 046 WCE 23-JAN-84 Move RPTEM1 to page where used / 045 WJY 17-NOV-83 Read first header block back into core / after getting all the extensions. / 044 WJY 29-OCT-83 Added logic to check if the correct / header block is already in core before / requesting it to be read from disk. / This request occurs in a RESTORE FILE / POINTERS call and caused problems for / GOTO-RULER. / 043 WCE 31-AUG-83 Add conditionals for status line in the / editor to only get one block when / needed so that block count will go up / by one instead of three so that users / will not complain about counting. / 042 DMB 29-AUG-83 Added function calls for GOTO-RULER / (also useful for GOTO-PAGE) / 041 WCE 19-JUL-83 Modify symbol names for new prefix file / 040 EH 06-JUL-83 Ignore GTP extensions on read only file / 039 WCE 11-MAY-83 Make OPEN for OVERWRITE free up space / 038 EH 18-JAN-83 Clear RPSPLT between each block / 037 EH 16-DEC-82 Clear RPMODE prior to building desc. / word if writing thru ETX buffer / 036 GJP/EH 09-DEC-82 Set hdr ptr to 1 on read-file re-init. / 035 WJD 09-DEC-82 remove 034 attempt at power-lost fixes / code was altogether deleted / 034 WJD 19-NOV-82 1200 baud & power-lost fixes / 033 WJD 19-NOV-82 Writeout alloc. block during close / for SORT bugfix / 032 EH 30-JUL-82 Modify parallel GTP structure / 031 EH 24-JUN-82 Write alloc. blk. after alloc. req. / 030 WJD/EH 30-MAR-82 Process print controls / 029 WJD 23-MAR-82 G-T-P link verification / 028 GDH 18-MAR-82 "SQUISHED TEXT" bug & general cleanup. / 027 EH 16-MAR-82 Fix uppercase bug / 026 EH 22-FEB-82 OH-015 PUT page counters fix. See also / WPEDIT '144'. (DM-387) / 025 WJD 15-FEB-82 DM-316 (GOTO PAGE rel.) / 024 WJD 10-FEB-82 Extn. blks. erroneously deallocated during OPEN / 023 WJD 08-FEB-82 GOTO-PAGE header deallocation / 022 GJP 04-FEB-82 Correct header deallocation problem / 021 EH 27-JAN-82 Correct mode in descriptor word / 020 EH 27-JAN-82 Fix relative paging around end of ext. / 019 WJD 15-JAN-82 OPEN was corrupting descriptor block / 018 WJD 07-JAN-82 STX/ETX buffer page-counters installed for REL GOTO PAGE / 017 EH 31-DEC-81 Save mode when writing through STX / Fixed problem assoc.with backup through / hdr blocks ptrs. / 016 WJD 21-DEC-81 REMOVED GOTO PAGE MATH RECOGNTION / 015 GJP 15-DEC-81 WPFILS BUG DEALOCATING ASSIGNED BLOCKS / 014 WJD 14-DEC-81 GOTO structure support of >2 extensions / 013 EH/WJD 14-DEC-81 Inform editor of new block just read into ETX buffer / 012 EH 11-DEC-81 Save mode of first char. in a block / 0011 GDH/DFB 09-DEC-81 Fix to initialize block pntr(go to page) / 010 JRF 08-DEC-81 Removed temporary CMD 9 equate in / ESCTAB table. / 009 WJD 04-DEC-81 Support offset PAGE positioning / 008 WJD 03-DEC-81 Fix GOTO PAGE extension blocks problem / 007 JRF 23-NOV-81 Modify ESCTAB and SPCTAB tables for / handling of MATH area start and / end characters. / 0006 GDH 12-NOV-81 Bug fix to TBO overwrite 0 length files. / 0004 GDH 2-OCT-81 RPG to ignore GET DENSITY function. / 002 WJD 25-OCT-81 Added V2 GOTO PAGE support routines / 0001 GDH 26-AUG-81 Moved WPFILS to field 7. / X3.5 JLZ 26-JUN-80 MODIFIED PRINTER'S FILE READER TO / SUPPORT ENHANCED HEADERS/FOOTERS / TT 07-JUL-81 Removed superfluous conditionals / III.B MB 1-APR-78 PUT IN SYSTEM OPTIONS / III-1 KEE 2/27/78 ADD WT'S 'TD' COMMAND / 2.7A-1 LDB 1/6/78 MODIFY FOR WT-78 7-BIT / 2.5-1 LDB 11/11/77 MAKE IT HARDER TO CLOSE UNOPENED FILES / 2.4D+ RTL 10/17/77 FILE SIZE BUG IN ALOC / 2.Q-1 RLT 9/24/77 BUG IN R2OPEN FOR WT78 / 2.P LDB 9/19/77 PUT IN SIXBIT CALLS FOR MAIN'S VERIFY / 2.N RLT 9/14/77 ADD UDKPRT STUFF / 2.J KEE 8/26/77 ADD 4-FLOPPY SUPPORT / 2.G-1 MSB 8/9/77 GET IT FROM THE 78 PACK / / USE "PAL WPFILS PTR. TO ETX OR STX MODE WORD ISZ GETMOD MQA SMA SZA / ++++ JMP GETMD1 / NORMAL ASCII SNA / ++++ JMP I GETMOD IAC SNA / ++++ ISZ T1 / ADJUST T1 IF SHIFT-UNSHIFT CHANGE TAD (MODTAB) / ++++ DCA T2 / GET PTR TAD I T2 SPA / ++++ JMP I GETMOD / RETURN QUICK IF ERROR CMA AND I T1 SNL / ++++ TAD I T2 DCA I T1 / SET NEW MODE JMP I GETMOD GETMD1, TAD I T1 / ADD MODE FLAGS ISZ T1 /BUMP TO SHIFT MODE SZL / ++++ TAD I T1 / AND UNSHIFT /PAGE-MARKERS LEAVING SCROLL BUFFER(GET) GOING INTO THE EDIT BUFFER /A018 DCA T2 /SAVE THE CURRENT 12-BIT CHAR. /A018 TAD T2 /REFRESH THE AC /A018 TAD NWPAGE / IS IT A NEW-PAGE MARKER? /M032 SZA / SKIP IF: NEW-PAGE MARKER /M032 TAD PAGEMK / IS IT A PAGE-MARKER? /M032 SZA CLA / SKIP IF: PAGE-MARKER /A018 JMP RPCTEX / JUMP IF: NEITHER /A018 ISZ T1 / BUMP TO APPRO. PAGE-COUNTER /A018 AC7777 / PAGE-MARKER LEAVING SCROLL BUFFER /A018 TAD I T1 / DECR. PAGE-COUNTER ACCORDINGLY /A018 DCA I T1 / UPDATE THE PAGE-COUNTER /A018 RPCTEX, TAD T2 / RETURN THE CURRENT 12-BIT CHAR. /A018 JMP I GETMOD -1 / ERROR 2000 1400 1000 400 200 MODTAB=. 40 /--------------- PAGE PUTSTX, XX / PUT 12-BIT TO STX /D039 JMS RPSAV12 /GO SAVE CURRENT 12 BIT CHAR. /A026 /Save the current 12-bit char. going into either the ETX or /M039 /STX scroll buffer for later (PUTBYT) PAGE-MARK counting... /M039 DCA CUR12BIT /MAKE A COPY OF 12-BIT CHAR. /M039 TAD CUR12BIT /TO BE USED AFTER XLATION /M039 NXTSTX, JMS SAVSTX / SAVE THE CURRENT STX MODE. /A028 JMS PUTMOD / ++++ STXMOD JMS XLTCOS DCA STXSV1 /PASS THE CHAR. /A002 JMS PUTSTC TAD CHRHLD / RESCAN OR DONE (0) SZA / SKIP IF BOTH BYTES DONE JMP NXTSTX /DO LAST BYTE OF WORD /A026 JMP I PUTSTX CUR12BIT, 0 /CURRENT "12-BIT" CHAR. /A026 PUTETX, XX / PUT 12-BIT TO ETX /D039 JMS RPSAV12 /GO SAVE CURRENT 12 BIT CHAR. /A026 /Save the current 12-bit char. going into either the ETX or /M039 /STX scroll buffer for later (PUTBYT) PAGE-MARK counting... /M039 DCA CUR12BIT /MAKE A COPY OF 12-BIT CHAR. /M039 TAD CUR12BIT /TO BE USED AFTER XLATION /M039 /SECONDARY ENTRY FOR NEXT BYTE /A026 NXTETX, JMS SAVETX / SAVE CURRENT ETX MODE SETTINGS. /A028 JMS PUTMOD / ++++ ETXMOD CML / ++++ JMS XLTCOS DCA STXSV1 /PASS THE CHAR. /A002 JMS PUTETC TAD CHRHLD / ++++ SZA / ++++ JMP NXTETX /DO LAST BYTE OF WORD /A026 JMP I PUTETX PUTMOD, XX / CHECK FOR MODE CHANGES MQL / CURRENT 12-BIT CHAR. INTO MQ MQA / BACK INTO AC DCA CHRHLD / SAVE FOR RESCAN TAD I PUTMOD / ADDR. OF CURRENT MODE WORD DCA T1 / T1 = PTR TO MODE WORD ISZ PUTMOD /BUMP TO RETURN ADDR MQA / AC = CURRENT 12 BIT CHAR AND (3600) / ISOLATE MODE BITS CIA / ++++ TAD I T1 / CHECK FOR ANY CHANGES SNA / SKIP IF MODE CHANGE JMP PUTMD1 / IF NONE, CHECK CASE DCA T2 / SAVE DIFFERENCE TAD (MSKTAB-1) / ++++ DCA T3 / GET SEARCH PTR TAD T2 / ++++ BSW / GET DIFFERENCE RTR / ++++ ISZ T3 / ++++ SMA SNL / ++++ JMP .-3 / FIND FIRST CHANGE CLA CLL CML TAD I T1 / ++++ AND I T3 / NEED TO CLEAR MODE? SZA / ++++ JMP PUTMD2 / JUMP IF SO MQA / ++++ AND I T3 / MUST NEED TO SET, THEN CML PUTMD2, MQL / ++++ MQA CMA / ++++ AND I T1 / ++++ SNL / ++++ MQA / SET-CLEAR DCA I T1 / STORE NEW MODE TAD (TAB-1) / ++++ DCA X1 / GET TAB PTR MQA TAD I X1 / ++++ SZA / ++++ JMP .-2 / FIND CHANGE PATTERN TAD X1 / ++++ TAD (-TABND-1) / COMPTE CHANGE NUMBER JMP I PUTMOD PUTMD1, MQA / ++++ AND P100 SNA CLA / ++++ JMP PUTMD3 / JUMP IF NOT ALPHA ISZ T1 / GET PTR TO UNSHIFT CODE MQA / ++++ AND (40) / GET UNSHIFT BIT CIA / ++++ TAD I T1 / COMPARE WITH STORED VAL CLL SNA CLA / ++++ JMP PUTMD4 / JUMP IF SAME MQA / ++++ AND (40) / GET NEW BIT SZA / ++++ CML / SET LINK ACCORDINGLY DCA I T1 / STORE NEW BIT CMA / RETURN -1 CODE JMP I PUTMOD PUTMD3, CLL CML PUTMD4, DCA CHRHLD / ++++ MQA / CLEAR RESCAN, RETURN CHAR JMP I PUTMOD CHRHLD, .-. TAB, -2000 2000-1400 1400-1000 1000-400 400-200 TABND=. MSKTAB, 200 1400 2000 RDINI2, XX BSW / ++++ RTR AND T17 / ISOLATE AND SAVE DRIVE NUMBER DCA RDFQBK+RXQDRV TAD (CDFBUF) / get cdf to buffer field. /A028 DCA RDFQBK+RXQBFD / AND BUFFER FIELD JMP I RDINI2 /--------------- PAGE XLTCOS, XX SPA / ++++ JMP XLTCO1 / JUMP IF MODE CHANGE AND P177 TAD M100 / CHECK ALPHA SMA / ++++ JMP XLTCO2 / JUMP IF ALPHA TAD (100-37) / ADJUST FOR COS SZA SMA / ++++ JMP I XLTCOS / RETURN IF OK TAD (37-17) / ++++ SMA SZA / ++++ JMP XLTCO3 / JUMP IF ILLEGAL TAD (17-7) / ++++ /D002/A016 SPA / ++++ JMP XLTCO3 TAD (SPCTAB) / ELSE GET XLAT PTR JMP XLTCO4 / AND XLATE XLTCO3, CLA JMP I XLTCOS XLTCO1, CMA RAL TAD (-MAXCOS) / ++++ SMA / ++++ CLA TAD (MAXCOS+COSTAB) XLTCO4, DCA T1 / CONVERT TO PTR TAD I T1 JMP I XLTCOS XLTCO2, AND (37) / ++++ TAD (-33) SMA / ++++ TAD (7722-133+37) / XLAT RESERVED CHARS TAD (133-37) / ADJUST JMP I XLTCOS / make sure that there is room in this block for a 2-char. / ESC seq; it is no longer acceptable to split an ESC seq. / between 2 blocks because of the random access used by V2 / GOTO PAGE. / if this is an ESC seq. and there is only 1 byte available in / the text buffer, send a null to fill up the buffer and cause / a write to disk. then put the 2-char. ESC seq. in the next / block. in this way, GOTO PAGE will never access a block con- / taining 1/2 of an ESC seq. PUTETC, XX /ENTER W/CHAR. IN STXSV1 TAD SCEPTR /GET THE ETX-BUFFER-CHAR. PTR. /A002 SZA CLA /SKIP IF THIS WILL BE THE LAST BYTE /A002 JMP RPETCX /ROOM FOR 2-CHAR. ESC SEQ. /A002 TAD STXSV1 /GET THE CURRENT 12-BIT WORD /A002 AND P7700 /GET SET FOR /A002 TAD M7700 /COMPARE TO ESC SEQ. CHAR. /A002 SNA CLA /SKIP IF NOT ESC SEQ /M007 JMS PUTET1 /GO SEND NULL AS LAST BYTE /A002 RPETCX, /A002 JMS SAVETX / SET EXTSAV TO CURRENT MODE SETTINGS. /A028 TAD STXSV1 AND P77 / ++++ SZA / ++++ JMS PUTET1 TAD STXSV1 / ++++ BSW / ++++ AND P77 / ++++ SZA / ++++ JMS PUTET1 JMP I PUTETC PUTSTC, XX /ENTER W/CHAR. IN STXSV1 TAD STXSAV / ++++ SZA / ++++ JMS PUTST1 / same 2-char. ESC seq. check done here... AC0001 /AC => 1 /A002 TAD SCTPTR /ADVANCE STX BUFFER CHAR. POINTER /A002 TAD (-SCHCNT /COMPARE TO MAX. # OF BYTES /A002 SZA CLA /SKIP IF THIS CHAR. WILL FILL BUFFER /A002 JMP RPSTCX /ROOM FOR A 2-CHAR. ESC SEQ. /A002 TAD STXSV1 /GET THE CURRENT 12-BIT WORD /A002 AND P7700 /GET SET FOR /A002 TAD M7700 /COMPARE TO ESC SEQ. CHAR. /A002 SNA CLA /SKIP IF NOT ESC SEQ /M007 JMS PUTST1 /GO SEND NULL AS LAST BYTE /A002 RPSTCX, TAD STXSV1 /A002 BSW / ++++ AND P77 / ++++ SZA / ++++ JMS PUTST1 TAD STXSV1 / ++++ AND P77 / ++++ DCA STXSAV JMP I PUTSTC GETETC, XX JMS GETET1 TAD (-77) / ++++ SZA / ++++ JMP GETETA JMS GETET1 TAD P7700 SKP GETETA, TAD P77 JMP I GETETC GETSTC, XX TAD STXSAV / ++++ SNA / ++++ JMS GETST1 DCA STXSV1 JMS GETST1 TAD (-77) / ++++ SNA / ++++ JMP GETSA1 TAD P77 / ++++ DCA STXSAV JMP GETSA2 GETSA1, DCA STXSAV TAD P7700 GETSA2, TAD STXSV1 JMP I GETSTC STXSAV, 0 STXSV1, .-. STXMOD, 0 / STX MODES 0 /SHIFT FLAG 0 /STX BUFFER PAGE-COUNTER /A018 STXDES, 0 /DESCRIPTOR WORD FOR BLK BEING WRITTEN /A030 /OUT THROUGH STX BUFFER /A030 /--------------- PAGE / SCINI - INIT FOR FILENO IN AC SCHCNT=774 / #CHARS IN DATA BLOCK / 774 = 508 DEC. / DECIMAL: 254 12-BIT CHARS = 508 6-BIT CHARS. BOFSET= 2 / OFFSET TO FIRST CHAR. WORD IN BLOCK SCBKOF=52 / OFFSET TO BLOCK PTRS IN 1ST HEADER SCINI, XX DCA T1 TAD T1 AND P377 / ISOLATE DOCUMENT NUMBER DCA SCQBLK+RXQFNO / STORE FILE # TAD T1 BSW / ++++ RTR / POSITION DRIVE NUMBER AND T17 /(17) GETS DRIVE FLAGS /M025 DCA SCQBLK+RXQDRV / SET DRIVE FLAGS JMS SCQRX / GO GET DENSITY TO ESTAB DENSITY OF DRIVE RXEDN+4000 0 JMS SCQRX RXEGF / ++++ 0 TAD SCQBLK+RXQBLK / PICK UP BLOCK NUMBER SNA / ++++ JMP SCIER1 / WE DID GET ONE? DCA SCHDRB / SAVE AS HEADER BLOCK NUMBER TAD (SCHDRB) / ++++ DCA SCHDBN / READ FIRST HEADER JMS SCGTWR CDFBUF / GET FILE SIZE TAD I (SCHDR+5) DCA SCFILZ TAD SCFILZ / ++++ TAD M310 /GREATER THAN 210 PTRS.? /A025 SMA CLA / ++++ TAD I (SCHDR+2) CDFMYF DCA SCHDRB+1 CDFBUF TAD I (SCHDR+3) CDFMYF DCA SCHDRB+2 JMS SCFLZB / GO SET UP TOP AND BOTTOM POINTERS /A003 CDFBUF TAD I (SCHDR+1) MQL / ++++ AC2000 / ++++ MQA / OPEN FOR UPDATE DCA I (SCHDR+1) AC0001 TAD I (SCHDR+12) / INCR TIME EDITED SMA / ++++ DCA I (SCHDR+12) / DON'T INCR PAST 2047 CLA DCA I (SCHDR+SCBKOF+2) / CLEAR "DATA BLK 0" PTR CDFMYF AC0001 / ++++ JMS SCGTWR / WRITE OUT HEADER JMS GTHDRS / GO GET HEADER EXTENSIONS INTO MEMEORY /A003 SCBFCB / POINT TO THE HDR CONTROL BLOCK /A003 JMP SCINX / TAKE OK RETURN SCIER1, IAC SCINX, JMP I SCINI / DONE / SCWEB - WRITE END BLOCK SCWEB, 0 JMS SCTPBT / GO SEE IF BOTTOM = TOP +1 /A003 JMS SCALOC / YES - ALLOCATE A BLOCK BETWEEN THEM JMS SCBUFI / GO INITIATE BUFFER AREA FOR COS 310 COMPATIBILITY SCEB / INIT BUF HDR FOR COS JMS SCBOTP / GO DECREMENT BOTTOM /A003 -1 / BY 1 /A003 JMS SCGETR / GET BLOCK NUMBER SCBOT - 1 POINTS TO SCBTH / BOTTOM HEADER POINTER /A003 SCBOT / BOTTOM HEADER WORD POINTER /A003 JMS SCQRX / WRITE END BUFFER TO THAT BLOCK RXEWT+2000 / ++++ SCEB CLA / MAKE SURE OF CLEAR AC /A037 DCA RPMODE / CLEAR MODE WORD /A037 JMS TORPDSBD / WRITE GTP TEXT BLK /A032 DCA PAGLIM / CLEAR PAGE LIMIT FLAG /A032 JMP I SCWEB / RETURN / SCWTB - WRITE TOP BLOCK SCWTB, 0 JMS SCTPBT / CHECK IF A BLOCK IS 'TWEEN TOP AND BOTTOM/A003 JMS SCALOC / NO - SO ALLOC ONE TO GO THERE JMS SCBUFI / GO INIT BUFFER AREA FOR COS 310 COMPATIBILITY SCTB / INIT BUF HDR FOR COS JMS SCTOPP / GO INCREMENT TOP POINTERS /A003 1 / UP BY 1 /A003 JMS SCGETR / GET THAT BLOCKNO SCTPH / TOP HEADER POINTER /A003 SCTOP / TOP HEADER WORD POINTER /A003 JMS SCQRX / WRITE TOP BUFFER THERE RXEWT+2000 / ++++ SCTB JMS TORPDSBD / WRITE GTP TEXT BLK /A032 DCA PAGLIM / CLEAR PAGE LIMIT FLAG /A032 JMP I SCWTB / DONE SCBUFI, XX / INTIALIZE 1ST TWO WORDS IN BUFFER /A003 AC7777 / MINUS 1 TO AC /A003 TAD I SCBUFI / GET BUFFER ADDRESS - 1 (FOR INDEXING) /A003 DCA X0 / PUT ADDRESS INTO AUTO INDEXING AREA /A003 TAD (COSCNT) / GET COS COMPATIBLE CHARACTER /A003 CDFBUF / CHANGE TO BUFFER FIELD /A003 DCA I X0 / STUFF COS 310 STUFF IN BUFFER /A003 DCA I X0 / ZERO SECOND BYTE OF BUFFER /A003 CDFMYF / BACK TO THIS FIELD /A003 ISZ SCBUFI / BUMP UP TO RETURN /A003 JMP I SCBUFI / RETURN /A003 /--------------- PAGE /D047 IFNDEF STATLN < /A043 /D047 / SCALOC - ALLOCATE 3 BLOCKS BETWEEN TOP AND BOTTOM /D047 SCALOC, XX /D047 AC7775 / GET MINUS THREE FOR LOOP CONTROL /D047 DCA SCALCT / SET TO ALLOC 3 /D047 > / END IFNDEF STATLN /A043 /D047 IFDEF STATLN < /A043 / SCALOC - ALLOCATE 1 BLOCK BETWEEN TOP AND BOTTOM /A043 SCALOC, XX /A043 AC7777 / GET MINUS ONE FOR LOOP CONTROL /A043 DCA SCALCT / SET TO ALLOC 1 /A043 /D047 > / END IFDEF STATLN /A043 TAD SCBTH / GET BOTTOM HEADER POINTER /A003 DCA SCBTHS / SAVE BOTTOM HEADER POINTER /A003 TAD SCBOT / GET BOTTOM /A003 DCA SCBOTS / SAVE BOTTOM HEADER WORD POINTER /A003 DCA SCALC / INIT COUNT /A003 JMP SCALCD / GO INCREMENT AND GET BLOCK NBR /A003 SCALC1, JMS SCBOTP / GO INCREMENT BOTTOM POINTERS /A003 1 / BY ONE /A003 SCALCD, ISZ SCALC / INREMENT THE COUNTER /A003 JMS SCGETR / GET BLOCK NUMBER SCBTH SCBOT SZA CLA / IS IT END OF FILE? JMP SCALC1 / NO - LOOK AT NEXT ONE TAD SCALC / GET COUNT OF HOW MANY BLOCKS 'TILL END CIA / MAKE NEGATIVE FOR ISZ LOOP DCA SCALC / SAVE /D047 IFDEF STATLN < /A043 AC0001 / SET UP TO BUMP FILE BY ONE BLOCK /A043 /D047 > / END IFDEF STATLN /A043 /D047 IFNDEF STATLN < /A043 /D047 AC0003 / SET UP TO BUMP FILE BY THREE BLOCKS /D047 > / END IFNDEF STATLN /A043 TAD SCFILZ / COMPUTE NEW FILE SIZE DCA SCFILZ JMS SCALC2 / GO MOVE TAIL END OF FILE 1 BLOCKS OVER/M047 TAD SCBTHS / GET BOTTOM HDR PTR UPON ENTRY /A003 DCA SCBTH / PUT IT BACK INTO BOT HDR PTR /A003 TAD SCBOTS / GET BOTTOM HDR WORD PTR /A003 DCA SCBOT / BACK INTO BOT HDR WORD PTR /A003 SCALC3, JMS RPALLOCATE / SUBROUTINE TO ALOC A BLOCK /A030 JMS SCPUTR / SAVE IN B SCBTH / BOTOM HDR POINTER /A003 SCBOT / BOTTOM HEADER WORD POINTER /A003 JMS SCBOTP / INCR BOTTOM 1 / BY 1 /A003 ISZ SCALCT / ++++ JMP SCALC3 / LOOP FOR ALL JMP I SCALOC / DONE SCBTHS, 0 / TO SAVE HEADER POINTER /A003 SCBOTS, 0 / TO SAVE HEADER WORD POINTER /A003 SCALC, 0 SCALB, 0 SCALCT, .-. DSKINI, 0 / DSKINI - TOP LEVEL INIT ROUTINE - FILENO IN AC DCA SCOPTN DCA RPMODE /GOTO-PAGE-BUILT TEXT BLOCK MODE /M019 JMS CLPTRS /CLEAR BOTH HDR-BLK-PTR TABLES /A024 MQA JMS SCINI / DO INIT OF HDR BLOCK SZA / ++++ JMP DSKIN1 / JUMP IF ERROR DCA SCTPTR TAD (SCHCNT-1) DCA SCEPTR JMS SCQRX / GET # FREE BLOCKS RXESP / ++++ SCHDR JMS SCSPC / PUT IN HDR FOR CALLER DCA STXSAV / INIT LOOK-AHEAD DCA STXMOD / ++++ DCA STXMOD+1 DCA ETXMOD / ++++ DCA ETXMOD+1 / INIT MODES DCA HLDMOD / INIT AT OPEN /A030 DCA RPPCTLFL / INIT AT OPEN TIME /A030 DSKIN1, JMP I DSKINI / DONE SCFNO, 0 SCIST=10 / SCSPC MOVED HERE FOR SPACE, EDIT # 045 /A045 SCSPC, 0 / PUT # FREE BLOCKS IN HDR TAD SCQBLK+RXQSPC / FROM Q BLOCK DCA SCFSPC JMP I SCSPC / SCREB - READ END BLOCK SCREB, 0 JMS SCGETR / GET BLOCK NUMBER BOTTOM POINTS TO SCBTH / BOTTOM HEADER POINTER /A003 SCBOT / BOTTOM HEADER WORD POINTER /A003 SNA / IS BLOCK ZERO? JMP I SCREB / YES - EOF - NON-SKIP RETURN JMS SCQRX / DO A READ OF IT RXERD / ++++ SCEB JMS RPRD1 / GO READ GTP TEXT BLOCK /A032 JMS SCBOTP / GO INCREMENT BOTTOM POINTERS /A003 1 / BY 1 /A003 ISZ SCREB / SKIP RETURN JMP I SCREB JMP I SCRTB / NON-SKIP RETURN / SCRTB - READ TOP BLOCK SCRTB, 0 DCA GTFLG / ON ENTRY AC = (-) /A030 / SET FLAG TO MINUS TO INDICATE A GETSTX/A030 JMS SCGETR / GET BLOCK NUMBER SCTPH / TOP HEADER POINTER /A003 SCTOP / TOP HEADER WORD POINTER /A003 SNA / ZERO BLOCK IS EOF JMP NOBLK / MUST NOW CLEAR GTFLG WHEN NO MORE TOP /A030 / BLK. ELSE A GETETX WOULD TRIGGER A /A030 / SET-UP OF HLDMOD /A030 JMS SCQRX / READ INTO TOP BLOCK BUFFER RXERD / ++++ SCTB JMS RPRD1 / GO READ GTP TEXT BLOCK /A032 JMS SCTOPP / DECR TOP POINTER -1 / AMOUNT TO DECREMENT BY /A003 ISZ SCRTB / SKIP RETURN NOBLK, DCA GTFLG / CLEAR FLAG SO GETETX WON'T SET-UP /A030 / AND CORRUPT HLDMOD /A030 JMP I SCRTB /--------------- PAGE / SOME UTILITIES SCGETR, XX / GET A WORD FROM OUT OF THE HEADERS /A003 CLA TAD SCGETR / GET ADDR OF ADDRESS OF HEADER PTRS /A003 JMS SCGETX / GO GET THE WORD OUT OF THE HEADERS /A003 JMS RPGETR / GET WORD OUT OF RPPGDS ALSO /A002 CDFBUF / CHANGE TO THE BUFFER FIELD (WHERE HEADER IS) /A003 TAD I SCGTR1 / GET THE WORD FROM THE HEADER /A003 CDFMYF / BACK TO THIS FIELD /A003 ISZ SCGETR / BUMP PAST THE HDR PTR ADR /A003 ISZ SCGETR / BUMP UP TO THE RETURN ADDR /A003 JMP I SCGETR / GO BACK TO CALLER /A003 SCPUTR, XX / ROUTINE TO PUT A WORD INTO THE HEADERS /A003 DCA SCPTR1 / SAVE THE WORD TO PUT INTO THE HEADER /A003 TAD SCPUTR / GET ADDR OF THE HDR PTR ADDR'S /A003 JMS SCGETX / GO GET THE HEADER /A003 TAD SCPTR1 / GET THE WORD TO PUT INTO THE HEADER /A003 CDFBUF / CHANGE TO BUF FIELD (WHERE HEADER IS) /A003 DCA I SCGTR1 / PUT THE WORD INTO THE HEADER /A003 CDFMYF / BACK TO THIS FIELD /A003 JMS RPPUTR /PUT WORD INTO RPPGDS ALSO /A002 ISZ SCPUTR / BUMP PAST PARAMS PASSED /A003 ISZ SCPUTR / BUMP PAST PARAMS PASSED /A003 AC0001 / SIGNAL THAT HEADER IS MODIFIED /A003 DCA SCHDMD / PUT SIGNAL INTO HDR CTL BLOCK /A003 JMP I SCPUTR / GO BACK /A003 SCGETX, XX / ROUTINE TO SET UP FOR HEADER READ /A003 DCA SCGTR1 / SAVE ADDR OF PTR ADDRESSES /A003 TAD I SCGTR1 / GET THE HDR PTR /A003 DCA SCGTR2 / SAVE THE HDR PTR /A003 ISZ SCGTR1 / BUMP UP TO PT TO HDR WORD PTR /A003 TAD I SCGTR1 / GET HDR WORD PTR /A003 DCA SCGTR1 / SAVE IT FOR LATER USE /A003 JMS SCOFST / GO SEE IF HEADER IS IN CORE /A003 SCBFCB / HEADER CONTROL BLOCK /A003 JMP I SCGETX / RETURN /A003 SCPTR1, .-. SCGTR1, .-. / TO SAVE HDR WORD POINTER /A003 SCGTR2, 0 / TO SAVE HDR POINTER /A003 / DSKCLS - TOP LEVEL CLOSE ROUTINE DSKCLS, 0 AC0100 / FORCE STXMOD=ETXMOD TAD ETXMOD+1 / ++++ TAD ETXMOD / MODES + SHIFT JMS PUTSTX / ++++ JMS GETSTX / ++++ CLA / THE LOGIC BELOW USED TO MOVE THE ETX BUFFER TO THE STX BUFFER WITH /A028 / OVERFLOW GOING OUT TO THE DISK & THEN NULL OUT THE REMAINDER OF THE /A028 / STX BUFFER & WRITE IT OUT TOO. THIS CODE WORKS FINE BUT WILL NOT /A028 / MAINTAIN THE EXTMOD MODE SETTINGS (SINCE EVERYTHING IS DONE IN 6-BIT /A028 / RATHER THAN 12 BIT MODE COPY). AS A RESULT, THE GOTO PAGE DESCRIPTOR /A028 / WORD WOULD NOT BE CORRECT IF AND SHIFT/ESCAPE CODES MOVED FROM THE /A028 / ETX BUFFER INTO THE STX BUFFER (PROBABILITY OF > 99.9 %). THEREFORE /A028 / THE LOGIC NOW WORKS AS FOLLOWS. IF THERE IS ENOUGH ROOM IN THE STX /A028 / BUFFER TO ACCOMODATE THE TEXT IN THE ETX BUFFER, THE PRIOR LOGIC IS /A028 / INVOKED. IF NOT THEN BOTH BUFFERS AR WRITTEN OUT ESSENCIALLY AS IS /A028 / (THE BUFFER IS NULLED OUT TO THE START/END OF BUFFER AS APPROPRIATE). /A028 TAD STXSAV / SEE IF A "SAVE CHAR" EXISTS. /A028 SZA CLA / SKIP IF NO. /A028 AC0001 / YES. COUNT IT. /A028 TAD SCEPTR / ADD # OF CHARS IN STX MINUS 1. /A028 TAD SCTPTR / ADD # OF CHARS IN ETX MINUS 1. /A028 TAD (-SCHCNT+1) / COMPARE TO MAX # OF CHARS IN BLOCK PLUS/A028 SMA CLA / BAIS. AC WILL BE <0 IF ALL CHARS FIT /A028 / OR FILL BUFFER UP EXACTLY. /A028 JMP DSKCL2 / CANNOT FIT. WRITE BUFFERS AS IS. /A028 DSKCL1, / MOVE ALL CHARS IN ETX BUF TO STX BUF TAD SCEPTR / SEE IF ALL DONE TAD (-SCHCNT+1) SNA CLA JMP DSKCL2 / ALL DONE MOVING JMS GETET1 / GET 1 BYTE DCA STXSV1 /SUPPLY THE CHAR. /A002 JMS PUTSTC / AND MOVE IT (WITH OVERFLOW TO DISK) JMP DSKCL1 / TRY ANOTHER CHAR DSKCL2, TAD STXSAV / FLUSH LOOK-AHEAD, IF ANY SZA DSKCL3, JMS PUTST1 / PAD WITH NULLS TO FILL TAD SCTPTR / IS BUFFER EMPTY (MEANING ALL OUTPUT?) SZA CLA / ++++ JMP DSKCL3 / LOOP IF NOT DSKCL4, TAD SCEPTR / GET ETX COUNT OF CHARS. /A028 TAD (-SCHCNT+1) / WHEN BUFFER TOTALLY FULL WE'RE DONE. /A028 SNA CLA / SKIP IF NOT FULL YET. /A028 JMP DSKCL5 / FULL. DONE. /A028 JMS PUTET1 / NULL BALANCE OF ETX BUFFER. /A028 JMP DSKCL4 / LOOP UNTIL EXT BUFFER "MT"S /A028 DSKCL5, JMS SCCLS / CLOSE AT THE BLOCK LEVEL / SET MODIFIED DATE-TIME IN HEADER CDFSYS TAD I (CLOCK+4) / HOUR BSW / ++++ TAD I (CLOCK+3) / MINUTE CDFBUF DCA I (SCHDR+14) CDFSYS TAD I (PAKDAT) / DAY/MONTH CDFBUF DCA I (SCHDR+10) CDFSYS TAD I (YEAR) / YEAR CDFBUF DCA I (SCHDR+11) CDFMYF / BACK TO THIS FIELD AC0001 JMS SCGTWR / WRITE OUT HEADER JMS WRITEOUT / WRITE THE ALLOCATION BLOCK /A033 JMP I DSKCLS / ALL DONE - RETURN TO CALLER DSKCLC, XX / VERY, VERY TOP LEVEL CLOSE ROUTINE / CHECKS TO MAKE SURE A FILE WAS OPEN BEFORE IT / CALLS THE REAL CLOSE ROUTINE CLA TAD SCQBLK+RXQFNO / SEE IF FILE NO. IS NON-ZERO SNA CLA / IF ZERO JUST RETURN JMP I DSKCLC JMS DSKCLS / CALL REAL CLOSE DCA SCQBLK+RXQFNO / CLEAR FILE NO. JMP I DSKCLC / RETURN /--------------- PAGE / START AT BOTTOM OF STX-BUFFER AND WORK TOWARDS TOP GETST1, XX / GET 1 BYTE FROM STX AC7777 / ++++ TAD SCTPTR / BACKUP PTR SMA / ++++ JMP GETSX1 / JUMP IF STILL OK JMS SCRTB / GET A NEW TOP BLOCK JMP GETSX2 / NO MORE BLOCKS AVAILABLE TAD RPPTR1 /CURRENT V2 DESC. WORD /A018 AND (37 /SAVE # OF PAGES IN THIS BLK /A018 DCA STXMOD+2 /INIT. STX BUFFER PAGE-COUNTER /A018 TAD (SCHCNT-1) / REINIT PTR GETSX1, DCA SCTPTR TAD SCTPTR JMS GETBYT / ++++ SCTB+BOFSET SNA / ++++ JMP GETST1+1 / IGNORE NULLS GETSX2, JMP I GETST1 / RETURN / START AT TOP OF STX BUFFER AND WORK DOWN PUTST1, XX / PUT 1 BYTE TO STX PUTST2, MQL TAD (STXMOD+2 /POINTER TO STX BUFFER PAGE-COUNTER /A018 DCA T3 /IDENTIFIES PAGE-COUNTER TO PUTBYT /A018 TAD SCTPTR JMS PUTBYT / ++++ SCTB+BOFSET ISZ SCTPTR / BUMP CHAR PTR TAD SCTPTR / ++++ TAD (-SCHCNT) / STILL IN RANGE? SZA CLA / ++++ JMP PUTSX1 / JUMP IF SO JMS SCWTB / ELSE OUTPUT FULL BLOCK CLA /IO RESULT /A018 TAD STXHLD / SET HLDSTX TO BE THE MODE OF THE 1ST /A028 DCA HLDMOD / CHAR OF NEW (LAST OF OLD) BUFFER. /A028 DCA SCTPTR /CLEAR BUFFER-BYTE POINTER /A018 DCA STXMOD+2 /AND STX PAGE-COUNTER /A018 PUTSX1, TAD PAGLIM / SEE IF PAGE LIMIT FLAG IS SET /A032 SZA CLA / SKIP IF: # OF PAGES IN BLK. WITHIN /A032 / RANGE /A032 JMP PUTST2 / PAD REST OF BLK WITH NULLS /A032 JMP I PUTST1 / AND RETURN / START AT TOP OF ETX BUFFER AND WORK DOWN GETET1, XX / GET 1 BYTE FROM ETX CLA / ++++ TAD SCEPTR TAD (-SCHCNT+1) / STILL IN RANGE? SZA CLA / ++++ JMP GETEX1 / JUMP IF SO JMS SCREB / ++++ JMP GETEX2 / ELSE REFILL BUFFER TAD RPPTR1 /CURRENT DESC. WORD /A018 AND (37 /# OF PAGES ONLY /A018 DCA ETXMOD+2 /INIT. ETX BUFFER PAGE-COUNTER /A018 DCA SCEPTR / RESET PTR SKP / (SKIP ISZ INST) GETEX1, ISZ SCEPTR / BUMP CHAR PTR TAD SCEPTR JMS GETBYT / ++++ SCEB+BOFSET SNA / ++++ JMP GETET1+1 / IGNORE NULLS GETEX2, JMP I GETET1 / AND RETURN / START AT BOTTOM OF ETX BUFFER AND WORK BACK PUTET1, XX / PUT 1 BYTE TO ETX PUTET2, MQL TAD (ETXMOD+2 /ADDR. OF ETX BUFFER PAGE-COUNTER /A018 DCA T3 /IDENTIFIES PAGE-COUNTER TO PUTBYT /A018 TAD SCEPTR JMS PUTBYT / ++++ SCEB+BOFSET AC7777 / ++++ TAD SCEPTR / STILL IN RANGE? SMA / ++++ JMP PUTEX1 / JUMP IF SO JMS SCWEB / ELSE OUTPUT FULL BUFFER CLA / /A018 DCA ETXMOD+2 /INIT. ETX BUFFER PAGE-COUNTER /A018 TAD (SCHCNT-1) / AND REINIT PTR PUTEX1, DCA SCEPTR / UPDATE PTR TAD PAGLIM / SEE IF PAGE LIMIT FLAG IS SET /A032 SZA CLA / SKIP IF: # OF PAGES IN BLK. WITHIN /A032 / RANGE /A032 JMP PUTET2 / PAD REST OF BLK WITH NULLS /A032 JMP I PUTET1 / AND RETURN GETBYT, XX CLL RAR TAD I GETBYT DCA GETBY1 ISZ GETBYT CDFBUF TAD I GETBY1 CDFMYF SNL / ++++ BSW AND P77 JMP I GETBYT PUTBYT, XX CLL RAR TAD I PUTBYT DCA PUTBY1 ISZ PUTBYT CDFBUF TAD I PUTBY1 SNL / ++++ BSW AND P7700 MQA SNL / ++++ BSW DCA I PUTBY1 CDFMYF TAD CUR12BIT /CURRENT 12-BIT CHAR. /M026 SNA /SKIP IF 1ST BYTE BEING STORED /A018 JMP RPPUTX /CURRENT 12-BIT CHAR. ALREADY COUNTED /A018 JMS CHKPAG / CHECK FOR PAGE/NEW-PAGE MARKER. /M028 RPPUTX, DCA CUR12BIT /CLEAR FOR 2ND BYTE (IF ONE) /A026 JMP I PUTBYT GETBY1=PUTBYT PUTBY1=GETBYT /--------------- PAGE /******************************************************************* /A003 / / THIS ROUTINE CLOSES THE DOCUMENT AFTER AN EDIT SESSION. /A003 / IT WILL FREE UP ALL UNUSED BLOCKS THAT HAVE BEEN ALLOCATED TO IT/A003 / AND IT WILL "SQUISH" THE DOCUMENT SO THAT ALL ITS BLOCKS ARE /A003 / CONTIGUOUS IN THE "HI ORDER" POSTION OF ITS HEADER BLOCKS /A003 / IT WILL ALSO FREE UP ALL UNUSED HEADER BLOCKS AND UPDATE THE /A003 / HEADER BLOCKS THEMSELVES (THE IN-USE BIT TURNED OFF, THE DATES /A003 / AND TIMES OF THE CLOSE PUT INTO THE HEADERS, ETC) /A003 / /A003 /***********************************************************************/A003 SCCLS, 0 / SCCLS - CLOSE HEADER BLOCK JMS SCBOTP / DECREMENT BOTTOM-OF-DOCUMENT PTRS /A003 -1 / THIS POINTS TO THE LAST UNUSED BLOCK /A003 TAD SCBOT / NOW WE SAVE THE BOTTOM-OF DOC POINTERS/A003 DCA SCBTSV / SO THAT WE CAN KNOW WHEN TO STOP /A003 TAD SCBTH / FREEING UP BLOCKS /A003 DCA SCBHSV /A003 JMS SCBOTP / REPOSITION BOT-OF-DOC PTRS TO POINT TO/A003 1 / NEXT BLOCK OF DOCUMENT /A003 JMS SCREQ / GO SEE IF THERE ARE ANY BLOCKS TO FREE/A003 SMA CLA / IF YES, GO DO IT /A003 JMP SCCLS7 / IF NONE, NO FREEING, NO SQUISHING /A003 JMS SAVTOP / GO SAVE TOP POINTERS /A003 SCCLS1, JMS SCTOPP / GO INCREMENT TOP-OF-DOC POINTERS /A003 1 / POSITION TO GET BLK TO FREE OR SQUISH /A003 AC7777 / GET A MINUS 1 TO DECREMENT WITH /A003 TAD SCFILZ / DECREMENT THE FILE SIZE BY ONE /A003 DCA SCFILZ / STORE IT FOR NEXT TIME /A003 JMS SCGETR / GO GET BLOCK NUMBER TO FREE UP /A003 SCTPH /A003 SCTOP /A003 JMS SCQRX / GO FREE THE BLOCK JUST GOTTEN /A003 RXEFR /A003 0 /A003 JMS SCREQ / GO SEE IF WE'RE DONE FREEING UP BLOCKS/A003 SZA CLA / IF ZERO, WE'RE DONE /A003 JMP SCCLS1 / OF NPOT ZERO, GO FREE UP ANOTHER /A003 JMS GETTOP / GO GET TOP POINTERS PREV SAVED /A003 SCCLS2, JMS SCTOPP / GO INCREMENT TOP PTRS /A003 1 /A003 JMS SCGETR / GO GET A BLOCK TO SQUISH /A003 SCBTH /A003 SCBOT /A003 SNA / CHECK IF DONE /A003 JMP SCCLS6 / 0 BLOCK NUMBER INDICATES EOF /A003 JMS SCPUTR / GO PUT BLK NBR AT TOP-OF-DOC /A003 SCTPH / IN OREDER TO SQUISH THE FILE /A003 SCTOP /A003 JMS SCBOTP / GO INCREMENT BOTTOM-OF-DOCUMENT PTRS /A003 1 /A003 JMP SCCLS2 / GO INCREMENT TOP-OF-DOC PTRS (CONT) /A003 / ALL DONE SQUISHING/FREEING /A003 SCCLS6, AC7777 / END OF RPPGDS DESCRIPTORS /A002 DCA RPPTR1 / FOR WRITE TO RPPGDS /A002 JMS SCPUTR / GO PUT OUT THE 0-BLOCK NBR INDICATING /A003 SCTPH / END OF FILE /A003 SCTOP /A003 SCCLS7, JMS SCCLSE / GO FREE UP EXCESS HDR BLOCKS /A003 TAD SCFILZ / GET FILE SIZE TO PUT INTO HEADER /A003 JMS SCPUTR / GO PUT THE FILE SIZE INTO HEADER 1 /A003 ONE / INDICATE HEADER ONE /A003 THREE / INDICATE THE 5TH WORD OF HEADER /A003 JMS SCGETR / GO GET THE IN-USE BIT FROM 1ST HEADER /A003 ONE / INDICATE 1ST HEADER /A003 MONE / INDIC 0TH WORD (WHERE IN-USE BIT IS) /A003 AND (1777) / TURN OFF IN-USE BIT /A003 JMS SCPUTR / GO PUT THE IN-USE BIT BACK IN HDR /A003 ONE / INDICATE 1ST HEADER /A003 MONE / INDICATE 0TH WORD (WHERE IN-USE BIT IS)/A003 JMP I SCCLS / DONE /***********************************************************************/A003 / /A003 / THIS ROUTINE WILL DETERMINE IF THE TOP-OF-DOCUMENT POINTERS /A003 / ARE EQUAL TO BOTTOM-OF-DOCUMENT POINTERS THAT WERE IN EFFECT /A003 / AT THE END OF THE EDIT SESSION. THIS ENABLES THE CLOSE ROUTINES /A003 / TO DETERMINE WHEN TO STOP DEALLOCATING BLOCKS THAT HAVE BEEN /A003 / ALLOCATED TO THE DOCUMENT AND THAT ARE NOT NEEDED. A MINUS 1 /A003 / PASSED IN THE AC INDICATES 'NOT EQUAL' AND A 0 IN THE AC MEANS /A003 / THAT THEY ARE. IF EQUAL, THEN IT MEANS NO MORE BLOCKS SHOULD BE /A003 / DEALLOCATED. /A003 / /A003 /***********************************************************************/A003 SCREQ, XX /A003 TAD SCTPH / GET TOP HDR WORD PTR /A003 CIA / SET IT UP FOR COMPARE /A003 TAD SCBHSV / GET SAVED BOT HDR PTR /A003 SZA CLA / IF EQUAL, GO CHECK HDR WORD PTRS /A003 JMP SCNEQ / GO INDICATE NOT EQUAL AND RETURN /A003 TAD SCTOP / GET TOP-OF-DOC HDR WORD PTR /A003 CIA / SET IT UP TO COMPARE /A003 TAD SCBTSV / COMP TO SAVED HDR WORD PTR /A003 SNA CLA / IF NOT EQUAL, SO INDIC AND RETURN /A003 JMP I SCREQ / IF EQUAL, AC 0 AND RETURN /A003 SCNEQ, AC7777 / MINUS 1 TO SC=UNEQUAL CONDITION /A003 JMP I SCREQ / GO BACK /A003 SCBHSV, 0 / AREA TO SAVE BOT HDR PTR /A003 SCBTSV, 0 / AREA TO SAVE BOT HDR WORD PTR /A003 SCHDR=HDRBUF SCEB=ETXBUF SCTB=STXBUF SCQRX, 0 DCA SCQBLK+RXQBLK / SET BLOCK NUMBER TAD (CDFBUF) / get CDF to buffer field. /A028 DCA SCQBLK+RXQBFD / AND BUFFER FIELD TAD I SCQRX / ++++ DCA SCQBLK+RXQFNC / AND FUNCTION ISZ SCQRX TAD I SCQRX / ++++ DCA SCQBLK+RXQBAD / AND BUF PTR ISZ SCQRX CIFSYS / ++++ ENQUE / ++++ SCQUBL / QUEUE Q-BLOCK SCQRX1, CIFSYS / ++++ JWAIT / WAIT FOR EVENT TAD SCQBLK+RXQCOD / ARE WE DONE? SNA JMP SCQRX1 / NO SMA / ++++ CLA / RETURN - IF ERROR; 0 OTHERWISE JMP I SCQRX / YES SCQUBL, DSKQUE / ++++ 0 / ++++ 0 SCQBLK, 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 ETXMOD, 0 / ETX MODES 0 /SHIFT FLAG 0 /ETX BUFFER PAGE-COUNTER /A018 ETXDES, 0 /DESCRIPTOR WORD FOR BLK BEING WRITTEN /A030 /THROUGH ETX BUFFER /A030 /--------------- PAGE / RDFIL HEADER CONTROL AREA RDBFCB, PSTBUF / PASTE BUFFER RDHDBN, 0 / PTR TO BLK # IN PASTE BUFFER / THIS POINTER POINTS TO ONE OF THE FOLLOWING SEVENTEEN BLOCK NUMBERS / DEPENDING ON WHICH BLOCK NUMBER IS IN THE PASTE BUFFER RDHDRB, 0 / FIRST HEADER BLOCK NUMBER 0 / SECOND HEADER BLOCK NUMBER 0 / THIRD HEADER BLOCK NUMBER 0 / FOURTH HEADER BLOCK NUMBER 0 / FIFTH HEADER BLOCK NUMBER 0 / SIXTH HEADER BLOCK NUMBER 0 / SEVENTH HEADER BLOCK NUMBER 0 / EIGHTH HEADER BLOCK NUMBER 0 / NINTH HEADER BLOCK NUMBER 0 / TENTH HEADER BLOCK NUMBER 0 / ELEVENTH HEADER BLOCK NUMBER 0 / TWELFTH HEADER BLOCK NUMBER 0 / THIRTEENTH HEADER BLOCK NUMBER 0 / FOURTEENTH HEADER BLOCK NUMBER 0 / FIFTEENTH HEADER BLOCK NUMBER 0 / SIXTEENTH HEADER BLOCK NUMBER 0 / SEVENTEENTH HEADER BBLOCK NUMBER 0 / HEADER BLOCK #'S, THEN 0 0 / MOD FLAG (ALWAYS 0) RDGETR, XX TAD RDHDBN / CHECK TO SEE IF FIRST HEADER IN CORE /A003 SNA CLA / IF ZERO, ITS NOT IN CORE /A003 JMP RDGTHD / GO GET 1ST HEADER INTO CORE /A003 JMS TOGETR / GET ADDR OF PTR TO HDR IN CORE /A030 CIA / SWITCH IT FOR COMPARE /A003 TAD RDHDBN / IS IT THE SAME (IS HDR IN CORE?) /A003 SZA CLA / IF YES, GO GET WORD PTR /A003 JMP RDCKHD / OTHERWISE GO GET HEADER INTO CORE /A003 RDRET, ISZ RDGETR / BUMP UP TO POINT TO HDR WORD PTR /A003 TAD I RDGETR / GET ADDR OF HEADER WORD PTR /A003 DCA RDGET1 / STORE IT FOR INDIRECT USE /A003 TAD I RDGET1 / GET THE HEADER WORD POINTER /A003 TAD (PSTBUF+2) / GET ADDRESS OF BUFFER + 2 /A003 DCA RDGET1 CDFBUF TAD I RDGET1 CDFMYF JMP RDEXI2 / NEW EXIT POINT /A030 RDGET1=T1 / GET NEXT HEADER INTO CORE /A003 RDGTHD, JMS TOGETR / GET HDR POINTER, ADD IN BASE ADDR /A030 DCA RDHDBN / PUT ADDR OF HDR IN CORE /A003 RDGTXR, TAD I RDHDBN / DO IO SNA / ++++ JMP RDGTXZ JMS RDFIO RXERD+4000 SMA CLA / ++++ JMP RDRET / GOT HEADER, GO BACK /A003 DCA I RDHDBN / ELSE CLEAR BLOCK # RDGTXZ, DCA RDHDBN / AND LOADED FLAG RDEXIT, ISZ RDGETR / BUMP UP TO RETURN /A003 RDEXI2, ISZ RDGETR / EXIT FROM ABOVE ALSO /A030 JMP I RDGETR / AND RETURN 0 RDCKHD, JMS TOGETR / GET HDR PTR PLUS ADD OF HDR CTL AREA /A030 DCA RDGET1 / STORE ADDR OF HDR BLOCK NBR /A003 TAD I RDGET1 / GET HDR BLOCK NBR /A003 SNA CLA / IS THERE ONE THERE?? /A003 JMP RDEXIT / NO, GO GET OUT /A003 JMP RDGTHD / GO GET HEADER INTO CORE /A003 GTHDRS, XX / ROUTINE TO GET HEADER BLOCK EXTENSIONS TAD I GTHDRS / GET ADDRESS OF HDR CTL AREA /A003 DCA PTR1 / STORE IT TO INDIRECT THRU /A003 TAD I PTR1 / GET BUFFER ADDRESS /A003 TAD THREE / POINT TO THIRD HDR BLK AREA /A003 DCA PTR1 / STORE ADDR 3RD HDR BLK /A003 CDFBUF /A003 TAD I PTR1 / GET 3RD HDR BLOCK NBR /A003 CDFMYF /A003 SNA CLA / IF NO THIRD HDR, GO BACK /A003 JMP GTGOBK / RETURN /A003 TAD I GTHDRS / GET ADR OF HDR CONTROL AREA TAD FOUR / BUMP TO THIRD HDR BLK NBR /M014 DCA X0 / PUT ADR FOR AUTOINDEXING TAD (RPBFCB /TOP OF RPPGDS BLOCK-LIST /A014 TAD FOUR /PTR ABOVE 4TH ENTRY /A104 DCA X1 /SAVE FOR STORE LATER /A104 TAD T360 / GET WORD WHERE EXTENSIONS ARE DCA PTR1 / PUT IT IN CALLING SEQUENCE TAD M16 / GET LOOP CONTROL (NBR OF POSS HDRS) /A003 DCA PTR2 / PUT IT SOMEWHERE FOR ISZ /A003 TAD I GTHDRS / GET ADDR OF HDR CTL BLK /M045 CIA / COPLEMENT FOR COMAPRE /A003 TAD (RDBFCB) / ADD IN READ FILE HDR CTL BLK /A003 SNA CLA / IF NOT READ ONLY, DO SCROLL READ /A003 /D045 JMP RDGTHR / GO READ READ ONLY HEADERS /A003 /D045 JMS SCGETR / GO GET HEADER BLOCK NBR TAD (RDGETR-SCGETR) / GET OFFSET OF READ-ONLY FROM THE SCRL /A045 / READ ROUTINE /A045 TAD (SCGETR) / ADD ADDRESS OF SCRL READ ROUTINE /A045 DCA XGETR / & STORE THE ADDRESS OF THE APPROPRIATE/A045 / SUBROUTINE FOR LATER USE GETHDR, JMS I XGETR / GO GET HEADER BLOCK NBR /A045 THREE / THIRD HEADER WHERE BLK NBRS ARE PTR1 / POINTER TO WHERE BLK NBRS ARE GTHDCK, SNA / IF NON-ZERO, THE BLOCK NBR IS PRESENT /A003 JMP GTRESH / IF ZERO BLK NBR, THEN ALL DONE /M045 / GO GET THE FIRST HDR BACK INTO CORE/A045 DCA I X0 / PUT BLK NBR INTO HDR CTL /A003 TAD I GTHDRS / GET ADDR OF HDR CTL BLK /A040 CIA / COPLEMENT FOR COMAPRE /A040 TAD (RDBFCB) / ADD IN READ FILE HDR CTL BLK /A040 SNA CLA / SKIP IF: SCROLL READ /A040 JMP GTHDC1 / READ ONLY FILE, IGNORE GTP /A040 / TAD RPPTR1 /RPPGDS WORD READ /A014 DCA I X1 /PUT IN RPPGDS BLOCK-LIST ALSO /A014 GTHDC1, ISZ PTR1 / POINT TO NEXT HDR BLK NBR /A003 ISZ PTR2 / ARE WE ALL DONE? /A003 JMP GETHDR / NO- GO GET IT IF ITS THERE GTRESH, / READ THE FIRST HEADER BLOCK BACK INTO /A045 / CORE BEFORE EXITING /A045 JMS I XGETR / /A045 ONE / WE WANT THE 1ST HDR BLOCK /A045 ONE / ANY WORD WILL DO, ONE IS AS GOOD AS ANY/A045 CLA / JUST CLEAR THE RETURN /A045 GTGOBK, ISZ GTHDRS / BUMP TO RETURN ADDR /A003 JMP I GTHDRS / RETURN /A003 / FOLLOWING CODE NO LONGER REQUIRED /A045 /D045 / GET HEADERS FOR READ ONLY FILES /A003 /D045RDGTHR, JMS RDGETR / GO GET THE HEADERS /A003 /D045 THREE / POINT TO THIRD HEADER /A003 /D045 PTR1 / HEADER WORD POINTER /A003 /D045 JMP GTHDCK / GO SEE IF MORE TO DO /A003 PTR1, 0 / PONTER TO WHERE THE HDR BLK NBRS ARE /A003 PTR2, 0 / COUNTER FOR LOOP CONTROL /A003 XGETR=T2 / AREA TO SAVE ADDRESS OF THE APPROP. /A045 / GET ROUTINE /A045 TOGETR, XX /A030 TAD I RDGETR / GET ADDR OF THE HDR PTR /A030 DCA RDGET1 / STORE IT FOR INDIRECT USE /A030 TAD I RDGET1 / GET THE HDR POINTER /A030 TAD (RDHDBN) / GET ADDR OF PTR TO HDR IN CORE /A030 JMP I TOGETR / RETURN TO CALLER /A030 /D045SCSPC, 0 / PUT # FREE BLOCKS IN HDR /D045 TAD SCQBLK+RXQSPC / FROM Q BLOCK /D045 DCA SCFSPC /D045 JMP I SCSPC /--------------- PAGE SCOFST, XX / ROUTINE TO SEE IF HEADER IS IN CORE /A003 TAD SCGTR2 / GET HEADER POINTER /A003 DCA SCOFS4 / STORE IT FOR INDIRECT USE /A003 TAD I SCOFST / GET HEADER CONTROL BLOCK ADDR /A003 DCA SCOFS1 / SAVE IT /A003 TAD I SCOFS1 / GET BUFFER ADDR /A003 DCA SCOFS1 / SAVE BUFFER ADDR /A003 AC0001 / 1 FOR ADDING /A003 TAD I SCOFST / POINT TO IN-CORE HEADER BLOCK NUMBER /A003 DCA SCOFS2 / STORE FOR FUTURE USE /A003 TAD (24) / GET DISPL TO MOD FLAG IN HDR CTL BLOCK /A003 TAD I SCOFST / ADD IN ADDR OF HDR CTL BLOCK /A003 DCA SCOFS3 / SAVE FOR FUTURE USE /A003 ISZ SCOFST / BUMP TO RETURN ADDRESS /A003 TAD I SCOFS2 / GET ADDRESS OF IN-CORE HDR BLOCK NBR /A003 CIA / CHANGE FOR COMPARE /A003 TAD SCOFS2 / ADD IN IN-CORE ADDRESS /A003 TAD I SCOFS4 / ADD IN HDR PTR /A003 SZA CLA / IS HEADER IN CORE /A003 JMP SCCHGE / IF NOT, GO READ IN NEW ONE /A003 JMP SCEND / GO ADD IN WORD POINTER AND RETURN /A003 SCCHGE, AC7777 / MINUS 1 TO AC FOR CHECKING MOD FLAG /A003 TAD I SCOFS3 / ADD IN VALUE OF MOD FLAG (1 MEANS MODIFIED) /A003 SZA CLA / HAS IT BEEN MODIFIED? /A003 JMP SCRDIN / NO, DON'T HAVE TO WRITE IT OUT/GO READ IN /A003 AC0001 / SIGNAL A WRITE OPERATION /A003 JMS SCGTWR / GO WRITE OUT THE HEADER /A003 SCRDIN, TAD SCOFS2 / GET ADDR OF IN-CORE HDR BLOCK NBR PTR /A003 TAD I SCOFS4 / ADD IN HDR PTR (AC POINTS TO NEW HDR) /A003 DCA I SCOFS2 / PUT THIS ADDR INTO HDR CTL BLOCK /A003 JMS SCGTWR / GO READ IN NEW HEADER INTO BUFFER /A003 SCEND, TAD SCGTR1 / GET ADDR OF THE HDR WORD PTR /A003 DCA SCOFS4 / STORE IT FOR INDIRECT USE /A003 TAD I SCOFS4 / GET HDR WORD POINTER /A003 TAD (SCHDR+2) / GET BUFFER ADDR +2 PAST COS STUFF /A003 DCA SCGTR1 / PUT ADDR INTO INDIRECT FIELD /A003 JMP I SCOFST / RETURN /A003 SCOFS1, 0 / AREA TO HOLD THE BUFFER ADDRESS /A003 SCOFS2, 0 / AREA TO HOLD THE HDR BLOCK NBR ADDRESS /A003 SCOFS3, 0 / ARE TO HOLD THE MOD FLAG ADDRESS /A003 SCOFS4, 0 / AREA TO HOLD HDR POINTER /A003 / SCROLL HEADER BUFFER CONTROL AREA SCBFCB, SCHDR / SCROLL HEADER BUFFER ADDRESS SCHDBN, 0 / POINTS TO HDR BLK NBR THAT'S IN CORE / THE ABOVE POINTER IS AN ADDR TO ONE OF THE BLK NBRS BELOW SCHDRB, 0 / FIRST HEADER BLOCK NUMBER 0 / SECOND HEADER BLOCK NUMBER 0 / THIRD HEADER BLOCK NUMBER 0 / FOURTH HEADER BLOCK NUMBER 0 / FIFTH HEADER BLOCK NUMBER 0 / SIXTH HEADER BLOCK NUMBER 0 / SEVENTH HEADER BLOCK NUMBER 0 / EIGHT HEADER BLOCK NUMBER 0 / NINTH HEADER BLOCK NUMBER 0 / TENTH HEADER BLOCK NUMBER 0 / ELEVENTH HEADER BLOCK NUMBER 0 / TWELFTH HEADER BLOCK NUMBER 0 / THIRTEENTH HEADER BLOCK NUMBER 0 / FOURTEENTH HEADER BLOCK NUMBER 0 / FIFTEENTH HEADER BLOCK NUMBER 0 / SIXTEENTH HEADER BLOCK NUMBER 0 / SEVENTEENTH HEADER BLOCK NUMBER 0 / BLK #S, THEN 0 SCHDMD, 0 / MOD FLAG INDICATES HDR IN CORE'S BEEN MODIFIED SCGTWR, XX / IO ROUTINE FOR SCHDR SNA CLA / ++++ JMP SCGTRD / JUMP IF READ TAD I SCHDBN / GET BLOCK # JMS SCQRX RXEWT+2000 / ++++ SCHDR / DO WRITE JMS RPWRT / WRITE GTP HDR BLK /A032 DCA SCHDMD / CLEAR MOD FLAG JMP I SCGTWR / RETURN SCGTRD, TAD I SCHDBN / GET BLOCK # SNA / ++++ JMP SCGTAL / ALLOCATE HEADER IF ZERO JMS SCQRX RXERD / ++++ SCHDR / READ BLOCK SCGTEX, JMS RPREA1 / READ GTP BLOCK /M034 /A032 JMP I SCGTWR / RETURN SCGTAL, JMS SCQRX /ALLOC. A BLOCK FOR HDR/EXTN /M014 RXEAL / ++++ 0 / ALLOCATE BLOCK TAD SCQBLK+RXQBLK DCA I SCHDBN / STORE BLOCK # JMS SCBUFI / ++++ SCHDR / INIT FIRST WORDS / NOTE: THE ROUTINE 'SCBUFI', WHICH INITIATES BUFFER AREAS FOR /A015 / COS 310 COMPATIBILITY, ALSO SETS UP THE INDEX REGISTER 'X0" /A015 / TO POINT TO THE AREA BEING INITIALIZED. THIS INDEX REGISTER /A015 / IS ALSO USED BY THE SUBSEQUENT ROUTINE 'CLRBUF' TO CLEAR OUT /A015 / THE HEADER BUFFERS. THE ROUTINE 'CLRBUF' DEPENDS ON INDEX /A015 / REGISTER 'X0' BEING THUS INITIALIZED. /A015 TAD M376 / GET NEG OF COUNT OF CHARACTERS IN BUFFER /A015 DCA T1 / PUT IT WHERE 'CLRBUF' CAN GET AT IT /A015 JMS CLRBUF / GO CLEAR OUT REMAINDER OF HEADER BUFFER AREA /A015 JMP SCGTEX / DO SAME FOR GTP /A034 SAVTOP, XX / ROUTINE TO SAVE TOP POINTERS /A003 TAD SCTPH / GET TOP HEADER POINTER /A003 DCA SAVTPH / SAVE IT /A003 TAD SCTOP / GET TOP HEADER WORD POINTER /A003 DCA SVTOP / SAVE IT /A003 JMP I SAVTOP / GO BACK /A003 GETTOP, XX / ROUTINE TO GET BACK TOP POINTERS /A003 TAD SAVTPH / GET SAVED TOP POINTERS /A003 DCA SCTPH / RESTORE IT /A003 TAD SVTOP / GET SAVE HDR WORD PTTR /A003 DCA SCTOP / RESTORE IT /A003 JMP I GETTOP / GO BACK /A003 SAVTPH, 0 /A003 SVTOP, 0 /A003 RPEXTR, 0 /-1 => MUST ALLOC. A BLOCK FOR /A014 / RPPGDS EXTN., AFTER WRITTING OUT THE CURRENT ONE /A014 /************************************************************************* / / THIS ROUTINE CLEARS OUT THE BUFFER AREA WHEN WE ARE SETTING A015 / IT UP FOR USE AS A NEW BUFFER AREA. A015 / A015 /************************************************************************** CLRBUF, /A015 XX /A015 CDFBUF /A015 CLRBF1, DCA I X0 / X0= ADDRES OF BUFFER AREA, SET UP BY SCBUFI /A015 / AC= COS COMPATIBLE CHARACTER SET UUP BY SCBUFI/A015 ISZ T1 / T1= COUNT OF CHARCTERS (START -377 OCTAL) /A015 JMP CLRBF1 / GO CLEAR NEXT WORD OUT TIL END /A015 CDFMYF /A015 JMP I CLRBUF / RETURN, ALL DONE /A015 /--------------- PAGE /************************************************************************* / / SCAD16 WILL ADD OCTAL 16 TO THE DISPLACEMENT IF THE POINTERS / PASSED TO IT POINT TO THE HEADER EXTENSION BLOCK POINTERS / THAT EXIST ON THE THIRD HEADER. THIS ENABLES THE USER TO / PREVENT THEM FROM BEING USED AS DOCUMENT BLOCK POINTERS. / /*************************************************************************** SCAD16, XX / CHECK TO SEE IF 3RD HEADER CLA / CLEAR THE AC TAD I SCAD16 / GET ADDR OF HEADER POINTER DCA SCAD4 / STORE IT FOR INDIRECT USE ISZ SCAD16 / BUMP UP TO GET HEADER WORD PTR /A003 TAD I SCAD16 / GET HDR WORD PTR ADDR /A003 DCA SCAD7 / STORE IT FOR INDIRECT USE /A003 ISZ SCAD16 / BUMP UP TO DISPLACEMENT /A003 TAD I SCAD4 / GET HEADER POINTER TAD M3 / CHECK TO SEE IF IT'S THE 3RD SMA / IF NOT, GO SEE IF ITS THE 4TH JMP SCAD5 / GO SEE IF IT'S THE 4TH JMP SCAD1 / IF LESS, GET OUT IT'S O.K. SCAD5, SZA CLA / IF ITS THE 3RD, GO SEE IF ADD NEEDED JMP SCAD6 / GO SEE IF IT'S THE FOURTH TAD I SCAD7 / GET THE HDR WORD PTR TAD I SCAD16 / ADD DISPLACEMENT TO HDR WORD PTR TAD M360 / DOES IT POINT TO A HDR BLK NBR? SMA CLA / IF MINUS, THEN IT'S O.K. GET OUT JMP SCAD8 / GO SEE IF IT'S ZERO OR PLUS JMP SCAD1 / GO GET OUT SCAD8, / IF GREATER THAN 0 GO ADD OCTAL 16 TAD I SCAD16 / GET DISPLACEMENT TAD T16 / ADD OCTAL 16 (DECIMAL 14) DCA I SCAD16 / PUT DISPLACEMENT JMP SCAD1 / GO GET OUT SCAD6, TAD I SCAD4 / GET HEADER POINTER TAD M4 / CHECK IF IT'S THE 4TH SZA CLA / PROCESS IT IF IT IS JMP SCAD1 / GO GET OUT TAD I SCAD7 / GET HDR WORD PTR TAD I SCAD16 / GET THE DISPLACEMENT SMA CLA / DID IT GO NEGATIVE? /C017 JMP SCAD1 / GET OUT TAD I SCAD16 / GET DISPLACEMENT TAD M16 / TAKE AWAY OCTAL 16 (TO GO OVER HDR BLK NBRS) DCA I SCAD16 / PUT IT INTO CALL LIST SCAD1, ISZ SCAD16 / BUMP UP TO RETURN ADDR CLA / CLEAR AC BEFORE RETURNING /A003 JMP I SCAD16 / GO BACK SCAD4, 0 / FOR IDIRECTING TO HEADER POINTER /A003 SCAD7, 0 / FOR INDIRECTING TO HDR WORD POINTER /A003 /***************************************************************************** / / SCINC WILL INCREASE THE DOCUMENT BLOCK NUMBER POINTER BY AN AMOUNT / PASSED TO IT. THIS AMOUNT CAN BE ANY INTEGRAL VALUE EITHER NEGATIVE / OR POSITIVE. THE CALLING SEQUENCE IS: / JMS SCINC / PTR1 / HEADER POINTER / PTR2 / HEADER WORD POINTER / DISP / DISPLACEMENT (-1, 1, 2 ETC) / RETURN POINT / PTR1 IS THE HEADER POINTER. IT POINTS TO A HEADER (FROM 1 TO 17 DEC) / WHICH THE POINTER CURRENTLY POINTS TO. / PTR2 IS THE HEADER WORD POINTER WHICH POINTS TO THE PARTICULAR WORD / WITHIN THE HEADER BLOCK POINTED TO BY PTR1, AT WHICH THIS POINTER / PAIR CURRENTLY POINTS TO. / DISP IS AN INTEGER BY WHICH THE USER WISHES TO INCREMENT OR DECREMENT / THE POINTER PAIRS. /****************************************************************************** SCINC, XX / INCREMENT/DECREMENT POINTER CLA / CLEAR AC TAD I SCINC / GET ADDR OF HEADER POINTER DCA SCINC1 / STORE IT FOR INDIRECT USE ISZ SCINC / BUMP UP TO POINT TO HDRR WORD PTR TAD I SCINC / GET ADR OF HDR WORD PTR DCA SCINC2 / STORE IT FOR INDIRECT USE ISZ SCINC / BUMP UP TO DISPLACEMENT TAD I SCINC2 / GET HDDR WORD PTR TAD I SCINC / ADD IN DISPLACEMENT ISZ SCINC / BUMP UP TO RETURN ADDR SMA / IF MINUS THEN IT CROSSED HEADERS JMP SCINCX / GO CHECK FURTHER IF + TAD T376 / ADD IN LENGTH OF HEADER DCA I SCINC2 / UPDATE HDR WORD POINTER AC7777 / -1 TO AC TO DECREMENT HDR NBR TAD I SCINC1 / DECREMENT HDR POINTER DCA I SCINC1 / RETURN IT JMP I SCINC / GO BACK SCINCX, SNA / IF PLUS, THEN IT MAY HAVE CROSSED HEADERS /A017 JMP SCINCY / GO UPDATE HDR WORD POINTER ONLY IF 0 TAD M376 / SUBTRACT OUT LENGTH OF HEADER SPA / HAS IT CROSSED THE HEADER? JMP SCINCZ / NO, GO ADD BACK 376 AND GET OUT DCA I SCINC2 / YES, THEN UPDATE THE HDR WORD PTR ISZ I SCINC1 / BUMP UP HDR PTR JMP I SCINC / RETURN SCINCZ, TAD T376 / ADD BACK 376 WHEN -/0 SCINCY, DCA I SCINC2 / UPDATE HDR WORD PTR JMP I SCINC / RETURN SCINC1, 0 / WORD TO INDIRECT TO HDR POINTER SCINC2, 0 / WORD TO INDIRECT TO HDR WORD PTR /*********************************************************************/A003 / / THIS ROUTINE WILL INCREMENT OR DECREMENT THE POINTER PAIRS /A003 / FOR THE BOTTOM PAIR OF DOCUMENT POINTERS. THESE POINTER PAIRS /A003 / POINT TO DOCUMENT BLOCK NUMBERS THAT RESIDE IN THE HEADER /A003 / BLOCK(S) OF THE DOCUMENT. THE FIRST POINTER OF THE POINTER /A003 / PAIR POINTS TO THE HEADER BLOCK THAT CONTAINS THE BLOCK NUMBER /A003 / POINTED TO BY THE POINTER PAIR. THE SECOND POINTER OF THE /A003 / POINTER PAIR POINTS TO THE WORD WITHIN THE HEADER BLOCK THAT /A003 / THE POINTER PAIR IS POINTING TO. THERE ARE CURRENTLY 17 POSSIBLE/A003 / HEADER BLOCKS THAT CAN BELONG TO A DOCUMENT. THE FIRST THREE /A003 / HEADERS CAN POTENTIALLY HOLD UP TO 701 DOCUMENT BLOCK NUMBERS. /A003 / THE FIRST HEADER BLOCK CAN HOLD UP TO 211 DOCUMENT BLOCK /A003 / NUMBERS. THE SECOND HEADER BLOCK CAN CONTAIN UP TO 254 DOCUMENT /A003 / NUMBERS. THE THIRD HEADER BLOCK CAN CONTAIN UP TO 240 DOCUMENT /A003 / BLOCK NUMBERS. ALL FURTHER HEADER BLOCKS CAN CONTAIN 254 /A003 / DOCUMENT BLOCK NUMBERS. DOCUMENT BLOCK NUMBERS BEGIN AT WORD /A003 / 44 OF THE FIRST HEADER BLOCK, CONTINUE ON THE SECOND HEADER /A003 / BLOCK BEGINNING AT WORD THREE AND PROCEEDING TO THE END OF THE /A003 / BLOCK, THEN CONTINUE ONTO THE THIRD HEADER BLOCK BEGINNING ON /A003 / ITS THIRD WORD AND PROCEEDING TO THE 240TH WORD OF THE BLOCK /A003 / THEN PROCEED TO THE 3RD WORD OF THE FOURTH HEADER BLOCK. /A003 / THE FIRST 43 WORDS OF THE FIRST HEADER BLOCK CONTAIN OTHER /A003 / INFORMATION ABOUT THE DOCUMENT INCLUDING BLOCK POINTERS TO THE /A003 / SECOND AND THIRD HEADER BLOCKS. THE THIRD HEADER BLOCK HAS /A003 / BLOCK POINTERS TO THE 4TH THRU 17TH BLOCKS OF THE DOCUMENT IN /A003 / ITS 241ST THRU ITS 254TH WORD. THE FIRST 2 WORDS OF EACH BLOCK /A003 / ARE INITIALIZED FOR COS 310 COMPATIBILITY. /A003 / /***********************************************************************/A003 SCBOTP, XX /A003 CLA / CLEAR OUT AC /A003 TAD I SCBOTP / GET DIPLACEMENT /A003 DCA BDISP / PUT DISPLACEMENT INTO CALL LIST /A003 JMS SCAD16 / GO SEE IF WE MUST ADD 16(OCTAL) /A003 SCBTH / PTR TO HEADER POINTER /A003 SCBOT / PTR TO HDR WORD POINTER /A003 BDISP, 0 / SPOT TO PASS DISPLACEMENT /A003 TAD BDISP / GET NEW DISPLACEMENT /A003 DCA BDISP2 / PUT IT INTO CALL LIST /A003 JMS SCINC / GO INCREMENT PTR BY DISPLACEMENT /A003 SCBTH / HEADDER POINTER /A003 SCBOT / HEADER WORD POINTER /A003 BDISP2, 0 / DISPLACEMENT TO INCREMENT BY /A003 ISZ SCBOTP / BUMP TO RETURN ADDR /A003 JMP I SCBOTP / RETURN /A003 SCTOPP, XX / INCREMENT TOP POINTERS /A003 CLA / CLEAR AC /A003 TAD I SCTOPP / GET DISPLACEMENT /A003 DCA TDISP / PUT IT INTO CALL LIST /A003 JMS SCAD16 / GO ADD 16(OCTAL) IF NEEDED /A003 SCTPH / HEADER POINTER /A003 SCTOP / HEADER WORD POINTER /A003 TDISP, 0 / PLACE FOR DISPLACEMENT /A003 TAD TDISP / GET NEW DISPLACEMENT /A003 DCA TDISP2 / PUT IT INTO CALL LIST /A003 JMS SCINC / GO INCREMENT PTR BY DISPLACEMENT /A003 SCTPH / HEADER POINTER /A003 SCTOP / HEADER WORD POINTER /A003 TDISP2, 0 / DISPLACEMENT TO INCREMENT BY /A003 ISZ SCTOPP / BUMP UP TO RETURN ADDR /A003 JMP I SCTOPP / RETURN /A003 / during the OPEN process, clear the header block ptrs. left / from the previous document, or else hdr. blocks belonging / to a previous document may be de-allocated during the OPEN / of the current document.... /A024 CLPTRS, 0 /SAVE CALLER'S RETURN ADDR. /A024 TAD (SCBFCB /ADDR. OF START OF DOC. BLOCK-PTR TABLE /A024 DCA X1 /POINTS AT TABLE ENTRY TO CLEAR /A024 TAD (RPBFCB /ADDR. OF START OF GOTO PAGE BLOCK-PTR TABLE /A024 DCA X2 /POINTS AT TABLE ENTRY TO CLEAR /A024 BLKINT, DCA I X1 /CLEAR A HDR-BLK-PTR /A024 DCA I X2 /SAME WITH PARRELLEL GOTO PAGE STRUCTURE /A024 TAD (-SCHDMD /ADDR. AT END OF TABLE TAD X1 /COMPARE TO LOC. JUST CLEARED /A024 SZA CLA /SKIP IF BOTH TABLES CLEARED /A024 JMP BLKINT /JUMP TO CLEAR ANOTHER ENTRY /A024 JMP I CLPTRS /EXIT WITH BOTH TABLES EMPTY /--------------- PAGE SCTPBT, XX / ROUTINE TO DETERMINE IF BOTTOM = /A003 AC7777 / GET ONE INTO AC /A003 DCA SCBT3 / PUT IT INTO CALLING LIST /A003 TAD SCBOT / TOP + 1. GET BOT HDR PTR /A003 DCA SCBOTT / PUT IT IN CALL LIST /A003 TAD SCBTH / GET BOTTOM HDR PTR /A003 DCA SCBTHT / PUT IT INTO CALL LIST /A003 JMS SCAD16 / GO SEE IF NEDDS ADD 16(OCTAL) /A003 SCBT1, SCBTHT / HDR POINTER /A003 SCBT2, SCBOTT / HDR WORD POINTER /A003 SCBT3, 1 / INCREMENT BOTTOM BY 1 /A003 TAD SCBT3 / GET INCREMENTED INCRMENT AMT /A003 DCA SCBT6 / PUT INTO INCREMENT CALL LIST /A003 JMS SCINC / GO INCREMENT IT /A003 SCBT4, SCBTHT / HEADER POINTER /A003 SCBT5, SCBOTT / HEADER WORD POINTER /A003 SCBT6, 0 / INCREMENT AMOUNT /A003 TAD SCBTHT / GET INCR'TED HDR PTR /A003 CIA / COMPLEMENT AND INCREMENT IT /A003 TAD SCTPH / ARE BOTTOM AND TOP EQUAL /A003 SZA / IF YES GO SEE IF WORD PTRS EQUAL /A003 JMP SCTB2 / ELSE, NOT EQUAL, 2 ISZ'S AND RETURN /A003 TAD SCBOTT / GET HDR WORD PTR OF BOTTOM /A003 CIA / COMP AND INC IT FOR SUBTRACT /A003 TAD SCTOP / GET TOP HDR WORD PTR AND ADD IT IN /A003 SNA / IF NOT EQUAL, 2 ISZ'S AND OUT /A003 JMP SCTB1 / IF EQUAL, GO ALLOCATE 1 ISZ AND OUT /A003 SCTB2, ISZ SCTPBT / NORMAL RETURN - NO ALLOCATE /A003 SCTB1, / ALLOCATE RETURN /A003 JMP I SCTPBT / RETURN /A003 / THIS ROUTINE WILL MOVE A FILE OVER BY THREE BLOCK NUMBERS /A003 / SO THAT THE EDIT CAN CONTINUE TO ADD TEXT TO THE FILE /A003 SCALC2, XX / RETURN ADDRESS /A003 TAD SCBTH / GET HDR POINTER /A003 DCA SCBTHT / PUT HDR PTR TO NEW PTR /A003 TAD SCBOT / GET BOTTOM HDR WORD PTR /A003 DCA SCBOTT / PUT IT INTO NEW HDR WORD PTR /A003 /D047 IFDEF STATLN < /A043 JMS SCBOTP / GO BUMP UP POINTERS BY ONE /A043 1 / NUMBER TO BUMP UP BY /A043 /D047 > / END IFNDEF STATLN /A043 /D047 IFNDEF STATLN < /A043 /D047 JMS SCBOTP / GO BUMP UP POINTERS BY THREE /A003 /D047 3 / NUMBER TO BUMP UP BY /A003 /D047 > / END IFNDEF STATLN /A043 SCALCX, JMS SCGETR / GO GET BLOCK - 1 /M047 SCBTHT / HDR PTR /A003 SCBOTT / HDR WORD PTR /A003 JMS SCPUTR / GO PUT THE BLOCK GOTTEN TO BL +3 /A003 SCBTH / HDR PTR /A003 SCBOT / HDR WORD PTR /A003 JMS SCBOTP / GO DECREMENT POINTERS /A003 -1 / AMOUNT TO DECREMENT BY /A003 AC7777 / MINUS 1 TO AC /A003 DCA SCALCY / PUT DEC VALUE IN CALL LIST /A003 JMS SCAD16 / GO SEE IF WE NEED TO ADD 16(IN 3RD HDR/A003 SCBTHT / HDR PTR /A003 SCBOTT / HDR WORD PTR /A003 SCALCY, 0 TAD SCALCY / GET DISPLACEMENT /A003 DCA SCALCZ / PUT IT IN CALL LIST /A003 JMS SCINC / GO INCREMENT IT /A003 SCBTHT / HDR PTR /A003 SCBOTT / HDR WORD PTR /A003 SCALCZ, 0 / DISPLACEMENT AMOUNT /A003 ISZ SCALC / ARE WE DONE? /A003 JMP SCALCX / NO GO DO IT AGAIN /A003 JMP I SCALC2 / GO BACK /A003 /SCBTHT, 0 / TO SAVE POINTERS /D022 /SCBOTT, 0 / TO SAVE POINTERS /D022 /*********************************************************************/A003 / /A003 / THIS ROUTINE WILL FREE UP BLOCK NUMBERS THAT HAVE BEEN ASSIGNED /A003 / TO THE DOCUMENT AS HEADER EXTENSIONS. THEN IT WILL UPDATE THE /A003 / HEADERS SO THAT THEY HAVE ONLY HEADERS THAT ARE USED /A003 / /A003 /***********************************************************************/A003 SCCLSE, XX / ROUTINE TO FREE UP UNUSED HEADER BLOCKS /A003 JMS PSTBOT /GO POSITION TO BOTTON OF DOC. TAD SCHDBN / GET TO HEADER BLOCK NUMBER POINTER /A003 DCA X1 / PUT IT INTO INDEX 1 /A003 TAD SCHDBN / GET HEADER BLOCK NMBR PTR (FOR CLEARINGSCBOTT /A003 DCA X2 / PUT CLEARER INTO INDEX 2 /A003 SCCLSF, TAD I X1 / GET BLOCK NUMBER TO FREE UP /A003 SNA / IF IT ISN'T 0, THEN FREE IT /A003 JMP SCCLSG / IF ZERO, THEN GO SEE IF DONE /A003 JMS SCQRX / GO FREE UP THE BLOCK NUMBER /A003 RXEFR /A003 0 /A003 AC7777 / -1 /M032 DCA RPEXTR / SET TO INDICATE FREE-ING HDR BLK /M032 JMS RPFRBK / GO FREE GTP HDR BLOCK /A032 DCA I X2 / CLEAR OUT HDR CONTROL BLOCK /A003 SCCLSG, / SET UP TO SEE IF DONE /A003 TAD (SCHDMD-2) / GET ADDR OF LAST ENTRY IN TABLE /A003 CIA / MAKE IT ZERO /A003 TAD X1 / GET ADDR INDEX 1 POINTS TO /A003 SZA CLA / RESULT ZERO IF DONE /A003 JMP SCCLSF / LOOP AROUND TO NEXT ONE /A003 / NOW WE MUST UPDATE THE HEADERS WITH THE NEW BLOCK NUMBERS /A003 TAD (SCHDRB) / GET ADD OF HEADER BLOCK NBR TABLE /A003 DCA X1 / PUT IT INTO INDEX 1 /A003 TAD T360 / HEADER WORD POINTER FOR 3RD HDR BLOCK /M014 DCA SCCLSC / PUTIT HERE TO ISZ IT /A003 TAD M16 / NUMBER OF HEDR EXTENSION /M014 DCA SCCLST / PUT IT HERE TO ISZ THRU /A003 TAD RPHDRB+1 /RPPGDS 2ND HDR /A014 DCA RPPTR1 /SUPPLT FOR RPPGDS SCPUTR /A014 TAD I X1 / GET THE BLOCK NUMBER 2ND HDR /A003 JMS SCPUTR / GO PUT IT INTO HDR 1 /A003 ONE / INDICATE HEADER 1 /A003 ZERO / INDICATE WORD 2 OF THE HEADER /A003 TAD RPHDRB+2 /RPPGDS 3RD HDR /A014 DCA RPPTR1 /SUPPY FOR RPPGDS SCPUTR /A014 TAD I X1 / GET 3RD HDR BLOCK NBR /A003 JMS SCPUTR / GO PUT IT INTO HEADER /A003 ONE /A003 ONE /A003 TAD SCHDRB+2 / GET THE THIRD HEADER BLOCK NUMBER /A022 SNA CLA / HAS IT BEEN DEALLOCATED? /A022 JMP I SCCLSE / YES, THEN WE'RE ALL DONE /A022 SCCLSH, / LOOP TO DO 3RD HEADER EXTENSION HDR BLOCK NBRS /A003 JMS RPEXTN /GET RPPGDS EXTN. BLK # INTO RPPTR1 /A014 TAD I X1 / GET THE 4TH, 5TH, 6TH, ETC HDDR BLCK NBR /A003 JMS SCPUTR / GO PUT IT INTO THE 361TH, 362TH, 363RD /A003 THREE / ETC, WORD OF HEADER 3 /A003 SCCLSC / HDDR WORD PTR /A003 ISZ SCCLSC / INCREMENT THE HDR WORD POINTER /A003 ISZ SCCLST / INCREMENT LOOP CONTROL /A003 JMP SCCLSH / GO DO IT AGAIN AND AGAIN 'TIL DONE /A003 SCCEXT, JMP I SCCLSE / ALL DONE, RETURN /A003 SCCLST=SCBOTTS / USED FOR LOOP CONTROL /A003 SCCLSC=SCBTHT / USED AS HDR WORD PTR FOR HDR EXTENS /A003 /--------------- PAGE /***********************************************************************/A003 / / THIS ROUTINE POSITIONS THE HEADER POINTERS IN ORDER TO READ THE /A003 / FILES DURING EDITING. THESE POINTERS ARE INITIALIZED THE WAY /A003 / THE USER WANTS TO EDIT THE FILE. IF HE WANTS TO REPLACE THE /A003 / THE ENTIRE DOCUMENT HE PASSES A MINUS 1 IN SCOPTN. IN THIS CASE /A003 / THE TOP POINTERS WILL POINT TO THE FIRST BLOCK NUMBER OF THE /A003 / FILE AND THE BOTTOM POINTERS WILL POINT TO THE BOTTOM (LAST) /A003 / BLOCK NUMBER OF THE FILE. IF THE USER WISHES TO APPEND TO THE /A003 / EXISTING DOCUMENT, THEN THE TOP POINTERS WILL POINT TO THE LAST /A003 / BLOCK NUMBER OF THE FILE, AND THE BOTTOM POINTERS WILL POINT TO /A003 / THE NEXT BLOCK NUMBER (WHICH IS EMPTY). TO DO THIS, THE USER /A003 / PASSES A PLU 1 IN SCOPTN. IF SCOPTN CONTAINS A ZERO, THEN /A003 / NORMAL PRCESSING IS INDICATED, AND THE TOP POINTERS POINT TO /A003 / THE FIRST BLOCK NUMBER OF THE FILE AND THE BOTTOM POINTER POINTS/A003 / TO THE SECOND BLOCK NUMBER OF THE FILE. /A003 / /***********************************************************************/A003 SCFLZB, XX / RETURN ADDRESS /A003 TAD SCOPTN / IS THIS A NORMAL EDIT RUN? /A003 SNA CLA / IF IT IS, GO PROCESS NORMAL /A003 JMP SCFLNR / GO PROCESS NORMAL EDIT SESSION /A003 TAD SCFILZ / GET FILE SIZE /A003 SMA / HOW BIG IS IT? IS IT > 2048? /A003 JMP SCFLZ / IF < 2048, THEN DON'T SPLIT IT UP /A003 TAD P3777 / IF > 2048, TAKE OUT 2047 /A003 DCA SCFLZ2 / STORE REMAINDER FOR SEC LOOP CTL /A003 TAD P3777 / GET LOOP CONTROL FIRST LOOP /A003 DCA SCFLZ1 / STORE IT FOR LOOP CTL /A003 JMP SCFLZO / GO FIND END OF DOCUMENT /A003 SCFLNR, / PROCESS NOROMAL EDIT /A003 TAD (SCBKOF) / DIPLACEMNT TO 1ST BLOCK NBR IN 1ST HDR/A003 DCA SCTOP / PUT IT INTO TOP POINTER PAIR /A003 TAD SCTOP / GET SAME FOR BOTTOM POINTER /A003 DCA SCBOT / INITIALIZE BOTTOM POINTER /A003 IAC / GET A ONE INTO AC /A003 DCA SCTPH / TOP HDR PTR TO POINT TO 1ST HEADER /A003 IAC / 1 TO AC /A003 DCA SCBTH / BOT HDR PTR SAM AS TOP /A003 JMP SCFLOT / GO ADD ONE TO BOTTOM, AND GET OUT /A003 SCFLZ, DCA SCFLZ1 / ONLY ONE LOOP FOR SHORT FILES /A003 DCA SCFLZ2 / SECOND LOOP CTL= 0 /A003 SCFLZO, TAD (SCBKOF) / DISP TO 1ST BLK NBR IN 1ST HDR /A003 DCA SCTOP / PUT IT IN TOP POINTER /A003 IAC / GET A 1 /A003 DCA SCTPH / TO HDR POINTER /A003 TAD SCFLZ1 / GET 1ST LOOP CTL /A003 SNA / SKIP IF THERE IS A FILE SIZE. /A006 JMP SCFLX / IF FILE SIZE IS 0 THEN WE ARE DONE!!! /A006 CIA / MAKE IT MINUS /A003 DCA SCFLZ1 / STORE IT AGAIN /A003 SCFLZF, JMS SCTOPP / TOP OF 1ST LOOP, GO ADD 1 TO IT /A003 1 /A003 ISZ SCFLZ1 / 1ST LOOP CONTROL INCREMENT /A003 JMP SCFLZF / GO DO I T AGAIN /A003 TAD SCFLZ2 / GET SECOND LOOP CTL /A003 SNA / BYPASS IF ZERO /A003 JMP SCFLX / IF ZERO, BYPASS 2ND LOOP /A003 CIA / MAKE NEGATIVE FOR ISZ /A003 DCA SCFLZ2 / STORE FOR USE /A003 SCFLZT, JMS SCTOPP / TOP OF 2ND LOOP, GO ADD 1 TO TOP PTRS /A003 1 /A003 ISZ SCFLZ2 / IF ZERO, THEN WE'RE ALL DONE /A003 JMP SCFLZT / GO ADD ANOTHER 1 IF NOT ZERO /A003 SCFLX, TAD SCTOP / GET TOP HDR WORD POINTER /A003 DCA SCBOT / PUT IT INTO BOTTOM PTR /A003 TAD SCTPH / GET TOP HDR PTR /A003 DCA SCBTH / PUT IT INTO BOTTOM HDR PTR /A003 TAD SCOPTN / GET OPTIONS PASSED /A003 SMA CLA / IF NEGATIVE, THE RESET TOP /A003 JMP SCFLOT / IF NOT, GO BUMP UP BOTTOM PTRS /A003 TAD (SCBKOF) / MAKE TOP POINT TO FIRST BLK NBR /A003 DCA SCTOP / TOP HEADER WORD POINTER /A003 IAC / GET A 1 /A003 DCA SCTPH / TOP HEADER POINTER TO POINT TO 1ST /A003 SCFLOT, JMS SCBOTP / GO INCREMENT BOTTOM BY ONE /A003 1 /A003 JMP I SCFLZB / RETURN /A003 SCFLZ1, 0 / SPOT FOR ISZ LOOP CONTROL (1ST) /A003 SCFLZ2, 0 / SPOT FOR ISZ LOOP CONTROL (2ND) /A003 0 / THIS ROUTINE WILL GET ALL THE HEADERS FOR A READ ONLY FILE /A003 RDGTHS, XX /A003 JMS RDGETR / GO GET 2ND HEADER EXTENSION /A003 ONE / INDICATE 1ST HEADER /A003 ZERO / INDICATE 1ST HDR EXTENSION /A003 DCA RDHDRB+1 / PUT IT INTO HDR CTL BLOCK /A003 JMS RDGETR / GO GET 2ND HEADER EXTENSION /A003 ONE / 1ST HDR AGAIN /A003 ONE / INDCATE 2ND HDR EXT /A003 DCA RDHDRB+2 / PUT IT INTO HDR CTL BLOCK /A003 JMS RDGETR / GO GET FILE SIZE /A003 ONE / 1ST HEADER AGAIN /A003 THREE / INDICATE FILE SIZE /A003 DCA RDFSIZ / PUT IT WHERE OTHERS CAN GET IT /A003 JMS GTHDRS / GO GET REMAINING HEADERS /A003 RDBFCB / INDICATE READ-ONLY HDR CTL BLOCK /A003 JMP I RDGTHS / GOBACK /A003 / THIS ROUTINE WILL INCREMENT THE HEADER POINTERS FOR READ-ONLY /A003 RDINC, XX /A003 AC0001 / INDICATE SIZE OF INCREMNET /A003 DCA RDINC1 / PUT IT INTO CALL LIST /A003 JMS SCAD16 / GO SEE IF YOU NEED ADD 16 (OCTAL) /A003 RDHDRP / READ-ONLY HDR POINTER /A003 RDPTRS / READ-ONLY HDR WORD PTR /A003 RDINC1, 0 / AMOUNT TO INCREMENT BY /A003 TAD RDINC1 / GET AMOUNT TO INCREMENT BY /A003 DCA RDINC2 / PUT AMOUNT INTO CALL LIST /A003 JMS SCINC / GO INCREMENT THE POINTERS /A003 RDHDRP / READ-ONLY HDR PTR /A003 RDPTRS / READ-ONLY HDR WORD PTR /A003 RDINC2, 0 / AMOUNT TO INCREMENT BY /A003 JMP I RDINC / RETURN /A003 / THIS ROUTINE WILL SEARCH FOR THE BOTTOM OF THE DOCUMENT. / IT IS USED TO MAKE SURE THAT THE HEADER POINTER IN THE SCROLL / HEADER CONTROL BLOCK IS POINTING TO THE LAST HEADER BLOCK / IN THE FILE SO THAT THE DE-ALLOCATION ROUTINE WON'T DE-ALLOCATE / ANY HEADERS THAT BELONG TO THE FILE... PSTBOT, 0 /SAVE CALLER'S RETURN ADDR. AC0001 / /A032 DCA SCBTH /START WITH 1ST HEADER /A032 TAD (SCBKOF /STARTING HEADER WORD POINTER DCA SCBOT /INTO 'BOTTOM' POINTER PSTBO1, JMS SCBOTP /GO INCREMENTT THE POINTERS 1 JMS SCGETR /GO GET A BLOCK NUMBER SCBTH SCBOT SZA CLA /SKIP IF END OF BLOCK-LIST POINTERS JMP PSTBO1 /LOOP UNTIL EOF FOUND JMP I PSTBOT /EXIT:AT END OF FILE /--------------- PAGE /***********************************************************************/a048 / WARNING do not move this routine without changing WPf1 to reflect the / address change /****************************************************************** /a048 * FBHOOK /4000 /a048 /******************************************************************** / BHOOK Hook to panel page blaster /******************************************************************** /a048 BHOOK, 0 / hook return address /a048 DCA BLACSV / save accumulator /a048 RDF / read the data field /a048 TAD CDF0 / make a cdf instruction /a048 DCA BHKEXI / save for return /a048 CDFMYF / set to hooks field /a048 TAD I BHOOK / get the table entry /a048 MQL / push into MQ /a048 TAD BLACSV / get the ac /a048 ISZ BHOOK / increment the return address /a048 CIFMNU / blaster is in the menu field /a048 IOF / turn the interrupts off before.. /a048 JMS I BLASTH / Calling blaster /a048 ISZ BHOOK / skip return exit /a048 BHKEXI, 0 / CDF instruction /a048 JMP I BHOOK / return /a048 BLASTH, BLASTR / blastr address (get from WPF1) /a048 BLACSV, 0 / ac save /a048 RPPGDS=7400 /V2.0 GOTO PAGE BUFFER AREA IN FIELD 2 / if the block just allocated and initialized was the 2nd /A014 / EXTENSION block, then words 362 to 377 must be set to 0. /A014 / these words are new V2 extension block pointers, not text /A014 / block pointers..... /A014 RPCKV2, JMS RPBFIN /SET ALL BUFFER WORDS TO -1 /M031 /EXCEPT 0 (-255), 1 (70), 2&3 (0) /M031 TAD RPHDBN /PTR. TO BLOCK JUST ALLOCATED /A014 CIA /FOR COMPARE TO /A014 TAD (RPHDRB+2 /2ND EXTENSION BLOCK /A014 SZA CLA /SKIP IF SPECIAL V2 EXTENSION BLOCK /A014 JMP RPV2EX /IGNORE ALL OTHERS /A014 TAD (RPPGDS+361 /PTR. TO WORD PRIOR TO 1ST /A014 /V2 EXTN BLOCK PTR WITHIN 3RD HDR. /A014 DCA X3 /INTO AUTO-INDEX REG. /A014 RPLPV2, CDFRPB /RPPGDS BUFFER FIELD /A014 DCA I X3 /INIT. V2 EXTN. POINTER /A014 CDFMYF /BACK FROM RPPGDS FIELD /A014 TAD X3 /POINTER TO WORD JUST INIT'D. /A014 CIA /FOR COMPARE TO /A014 TAD (RPPGDS+377 /END OF RPPGDS BUFFER /A014 SZA CLA /SKIP IF INITIALIZATION DONE /A014 JMP RPLPV2 /JUMP TO INIT. ANOTHER WORD /A014 / NEW RETURN TO WITHIN RPREAD /A031 RPV2EX, JMP REEDXT /RETURN TO CALLER /A031 RPEXTN, 0 /GET RPPGDS EXTN. BLK #'S 4-16 /A012 TAD (SCHDRB /TOP OF DOC. HDR. BLOCK-LIST /A012 CIA /FOR COMPARE TO /A012 TAD X1 /PTR. TO NEXT HDR. EXTN. PTR. /A012 TAD (RPHDRB /FIND PTR TO CORRESPONDING RPPGDS PTR /A012 DCA X2 /FOR INDIRECT /A012 TAD I X2 /GET RPPGDS EXTN BLK # /A012 DCA RPPTR1 /FOR RPPGDS PART OF SCPUTR /A102 JMP I RPEXTN /RETURN FOR SCPUTR OF HDR EXTN /A012 RPALOC, 0 /CALLER'S RETURN ADDR. /A014 TAD RPALOC /CALLER'S RETURN ADDR. /A014 DCA RPREA1 /USING PREVIOUS DESIGN /A032 JMP RPRDEX /USE CURRENT LOGIC /A014 / AC = 0 ON ENTRY /A032 RPFRBK, 0 /CALLERS RETURN ADDRESSS /A022 TAD (SCHDBN /HDR BLK TO BE RELEASED /A022 CIA /MAK NEG FOR OFFSET /A022 TAD X1 /OFFSET INTO SCHDBN /A022 TAD (RPHDBN /GET SAME OFFSET INTO RPHDBN /A022 DCA RPFRB2 /SAVE /A022 TAD I RPFRB2 /SUPPLY BLOCK # TO BE FREED /A022 JMS RPDSFR /AC = BLK # (AC=0 ON RETURN) /A022 DCA I RPFRB2 /CLEAR POINTER FROM TABLE /A022 /LEAVE DEALLOCATE FLAG ON TO SIGNIFY CLOSE-OPERATION WHEN /READING 1ST GOTO-PAGE HEADER BLOCK /A023 RPFRB1, JMP I RPFRBK /RETURN /A022 RPFRB2, 0 /POINTER TO BLOCK TO BE FREED /A022 / here when writing to ETX buffer and PRINT-CONTROL char. recognized / on entry, AC = RPMODE word... CHKETX, SNA CLA /SKIP IF END-CONTROL /A030 JMP DOSTRT /GO PROCESS START-CONTROL /A030 TAD (7677 /CLEAR 'IN CONTROL-AREA' FLAG /A030 AND I T3 /IN THE CURRENT DESCRIPTOR /A030 TAD P100 /NOW SET 'IN CONTROL-AREA'FLAG /A030 DCA I T3 /WITHIN THE CURRENT DESCRIPTOR WORD /A030 JMP TODSBDEX /GO SET OUR OWN PRINT-CONTROL-FLAG /A030 /This routine is entered when it's determined that a PUT to the STX / buffer has occurred. more specifically, a print control char is / being put - 030 CHKSTX, TAD (200 /CHECK TO SEE IF THIS PRINT CONTROL /A030 AND RPMODE /IS AN END PRINT CONTROL /A030 SNA CLA /SKIP IF: END PRINT CONTROL /A030 TODSBDEX,AC0100 /PRINT CONTROL WAS A START. SET /A030 /FLAG TO INDICATE WITHIN CONTROL AREA /A030 DCA RPPCTLFL /UPDATE CONTROL AREA FLAG /A030 /Here when writing to STX buffer. check flag, if on: have already / processed a print control char in the buffer - stop / if off: process this print control char as it is the first print / control char in the STX buffer CHKST1, TAD SOMFLG / CHECK THE STATE OF FLAG /A030 SZA CLA / SKIP IF: NOT ON /A030 JMP DSBDEX / HAVE BEEN THROUGH ONCE, EXIT /A030 CHKST2, TAD I T3 /GET CURRENT DESCRIPTOR WORD /A030 AND (7677 /CLEAR 'IN CONTROL-AREA' FLAG /A030 DCA I T3 /UPDATE CURRENT DESCRIPTOR WORD /A030 /come here if writing print control char to STX buffer (and is the first / print control char in the buffer). set bit5 in the descriptor to be / the opposite state as that of the print-control area flag. CHKST3, TAD RPPCTLFL /PRINT-CONTROL AREA FLAG /A030 CMA /OPPOSITE STATE /A030 AND P100 /SAVE FLAG ONLY /A030 TAD I T3 /MERGE WITH DESC. WORD /A030 DCA I T3 /UPDATE DESC. WORD /A030 AC0001 /SET FLAG TO INDICATE THAT /A030 DCA SOMFLG /A PRINT CONTROL CHAR WAS /A030 /PROCESSED WITHIN THIS BUFFER /A030 JMP DSBDEX /RETURN /A030 /The following routine entered when writing to ETX buffer and a / start print control char is encountered DOSTRT, TAD (7677 /MASK OUT BIT 5 IN THE DESCRIPTOR /A030 AND I T3 /WORD /A030 DCA I T3 /UPDATE THE DESCRIPTOR WORD /A030 DCA RPPCTLFL /CLEAR THE PRINT CONTROL AREA FLAG /A030 /TO INDICATE NOT IN A CONTROL AREA /A030 JMP DSBDEX /RETURN /A030 / This subroutine checks to see if the character just PUT was a / Page Marker of New Page. If so, increment T3, then check to / make sure that no more than 36 Pages/New Pages are in the / buffer. Only 5 bits are designated as page counters in the / GTP descriptor word, if the number of pages overflows 5 bits, / the entire descriptor word could be ruined / CHKPAG, XX / SUBROUTINE TO CHECK FOR PAGE/NEW-PAGE /A028 TAD NWPAGE /IS IT A NEW PAGE? /A018 SZA /SKIP IF SO /A018 TAD PAGEMK /IS IT A PAGE MARKER? /A018 SNA CLA / SKIP IF: NEITHER /A032 ISZ I T3 / ACCOUNT FOR PAGE IN SCROLL BUFFER /A032 TAD I T3 / GET # OF PAGES IN SCROLL BUFFER /A032 TAD (-36 / COMPARE TO MAX. # OF ALLOWABLE PGS. /A032 SNA CLA / SKIP IF: WITHIN LIMITS /A032 AC0001 / AT MAX. SET FLAG IN ORDER TO PAD BUF /A032 DCA PAGLIM / 0 = WITHIN RANGE /A032 / 1 = AT MAXIMUM /A032 JMP I CHKPAG / RETURN TO CALLER. /A028 /--------------- PAGE / here after WPFILS requested a read io / get the "scroll" buffer address used for the read io / / IF this is not the main document header block, then go read / the parrellel 'extension' block / ELSE read the RPPGDS link word in the main document header / block / / IF the link word is empty, then this document never had a RPPGDS / block allocated to it. Go allocate one and attach it to the / main document header block / ELSE verify that the RPPGDS block linked to this document / is a valid up-to-date reflection of the text block content / /******************************************************************* /A039 /******************************************************************* /A039 /******************************************************************* /A039 /**** **** /A039 /**** NOTE **** /A039 /**** **** /A039 /**** THIS ROUTINE COUNTS ON THE FACT THAT THE DISK OPEN **** /A039 /**** COMMAND IS THE FIRST ENTRY IN THE XFLDTB TABLE **** /A039 /**** **** /A039 /******************************************************************* /A039 /******************************************************************* /A039 /******************************************************************* /A039 RPREA1, XX /SAVE CALLERS RETURN ADDRESS /A032 TAD XFILT3 /GET POINTER TO WPFILS ACTIVE FUNCTION /M039 CIA /NEGATE IT FOR FOLLOWING COMPARE /A039 TAD XFLDTB /COMPARE TO ADDRESS AT 'OPEN' COMMAND /M039 SZA CLA /SKIP IF DOING 'OPEN' /A034 JMP RPRDEX /SKIP VERIFICATION /A034 TAD SCQBLK+RXQBLK /DOC. HDR. BLOCK # JUST READ /M012 CIA /FOR COMPARISION TAD SCHDRB /BLK# OF DOC. MAIN HEADER /A034 SZA CLA /SKIP IF MAIN HEADER JMP RPRDEX /GO READ PARALLEL RPPGDS EXTN. BLOCK / (could be OPENing this document for the first time....) CDFBUF /CHANGE TO SCROLL BUFFER FIELD TAD I (SCHDR+1 /2ND WORD OF DOC. HEADER /A029 CLL RAR /TEST STATE OF BIT11 /A029 SZL CLL /SKIP IF NO G-T-P BLOCK /A029 JMP RPRDDS /GO READ THE PARELLEL RPPGDS MAIN BLOCK CML RAL /GET READY TO /A029 DCA I (SCHDR+1 /SET BIT11 (NOW HAVE A G-T-P BLOCK) /A029 / this document was never used with a V2 WPS, thus, it has no / RPPGDS block / allocate a block for the main RPPGDS descriptor block / account for this allocation in SPCSPF / link the RPPGDS block to the doc. header block by storing / the RPPGDS block # in the 43rd (dec.) word of the header block / update "main RPPGDS" block # storage word with the block # returned / from the allocation request / update "current RPPGDS" block pointer with the pointer to the / "main RPPGDS" block # storage word JMS RPALLOCATE /GO ALLOCATE A BLOCK FOR G-T-P /M029 CDFBUF /CHANGE TO BUFFER FIELD DCA I (SCHDR+53 /LINK RPPGDS TO DOC. HEADER TAD I (SCHDR+53 /GET OUR BLK# BACK CDFMYF /BACK TO THIS FIELD DCA RPHDRB /COPY IN RPPGDS BLOCK TABLE JMS WRITEOUT /WRITE OUT THE ALLOCATION BLK. /A031 RPMAIN, TAD (RPHDRB /ADDR. OF MAIN RPPGDS BLOCK RPRD2, /ENTER HERE TO SET RPHDBN /M030 DCA RPHDBN /IS NOW THE ACTIVE RPPGDS BLOCK / a block has been allocated either for the main RPPGDS block, / or one of its' extensions. / initialize the RPPGDS scroll buffer (7400) to reflect this new / block. / the content of this buffer will be written when the associated / doc. header block is written. JMP RPCKV2 /IS THIS 2ND EXTN. BLOCK? /M031 RPRDND, /END OF READ; RPPGDS CONTAINS NEW BLOCK REEDXT, JMP I RPREA1 /RETURN TO CALLER /M032 / this document has a V2.n RPPGDS linked to it; meaning that it / it has been OPENed by a V2.n WPS system... / / read the RPPGDS block into its scroll buffer (7400) and verify / that it contains up-to-date text block desciptors. / / IF AC = 0 after RPRDIT (verification) RPPGDS descriptors can be use / ELSE RPPGDS does not contain up-to-date text block descriptors. / Deallocate any RPPGDS extension blocks and initialize / the main RPPGDS block. RPRDDS, /AC = NEW MAIN DESC. BLK. # /M019 CLA /CLEAR AC HERE TO /A029 TAD I (SCHDR+53 /GET G-T-P BLOCK # /A029 JMS RPRDIT /READ/VERIFY IT MQL /SAVE VERIFY RESULT /A019 TAD NEWBLK /GET THE NEW DESC. BLK. # /A019 DCA RPHDRB /PUT IT IN BLOCK-TABLE /A019 RPEXT, /GOOD BLOCK; MAKE IT THE 'CURRENT' ONE /WRITE-BEFORE-READ FLAG IS SET TAD (RPHDRB /ADDR OF MAIN RPPGDS BLK. IN BLOCK TABLE/M011 DCA RPHDBN /MAKE MAIN RPPGDS BLOCK THE CURRENT BLOCK/M011 / OPENING..... / supply RPPGDS extension block numbers, if any... CDFRPB /RPPGDS BUFFER FIELD TAD I (RPPGDS+2 /1ST EXTN. BLOCK # OR 0 CDFMYF /BACK TO THIS FIELD DCA RPHDRB+1 /INTO OUR CONTROL TABLE CDFRPB /RPPGDS BUFFER FIELD TAD I (RPPGDS+3 /2ND EXTN. BLOCK # OR 0 CDFMYF /BACK TO THIS FIELD DCA RPHDRB+2 /INTO OUR CONTROL TABLE MQA /REPLACE RESULT OF VERIFY(RPRDIT) /A019/M031 SNA CLA /SKIP IF ITS CORRUPTED /M031 JMP REEDXT /GOOD MAIN-GTP BLK; EXIT /A032 JMS RPDSCR /DE-ALLOC. RPPGDS EXTN, IF ANY /M031 JMP RPMAIN /RE-INIT. MAIN RPPGDS BLOCK/ /M031 / a document header extension block has been read. / / identify which extension and determine if the RPPGDS block / has a parrellel extension available. / / if not, allocate a block for an extension and initialize the / the RPPGDS scroll buffer to reflect the new block. / link the new extension to the RPPGDS block table and make the / new extension the "active" block. / / if extension already present, read it into the RPPGDS scroll buffer RPRDEX, /HERE WHEN THE PARALLEL BLOCK IS AN EXTN. TAD SCHDBN /PTR. INTO DOC. HDR. BUFFER CONTROL AREA TAD (-SCHDRB /MINUS THE START OF THE CONTROL AREA TAD (RPHDRB /PLUS THE START OF THE RPPGDS CONTROL AREA DCA EXTNOF /= PTR. TO PARRELLEL RPPGDS BLOCK # TAD I EXTNOF /GET THE BLOCK # OF THE PARRELLEL RPPGDS BLOCK SNA /SKIP IF THERE IS A BLOCK # AVAILABLE JMP RPALEX /AC => 0; NO BLOCK AVAILABLE JMS RPRDIT /AC => BLK #; READ THE BLOCK SNA CLA /SKIP IF RPPGDS BLOCK CORRUPTED JMP RPXEX /EXIT:PARRELLEL RPPGDS BLOCK IN BUFFER (7400) TAD I EXTNOF /SUPPLY THE BLOCK # JMS RPDSFR /DE-ALLOCATED THE CORRUPTED BLOCK / Here to allocate a block for the RPPGDS. / Put the block # returned (allocated) into the appropriate / RPPGDS block table entry and make this block the "current" / current block. / Go and initialize our scroll buffer (7400) to reflect a new / unused block. RPALEX, JMS RPALLOCATE /GO ALLOCATE AN EXTN. BLOCK /A029 DCA I EXTNOF /PUT IT IN RPPGDS BLK TABLE AT EXTN. ENTRY / A BLOCK WAS JUST ALLOCATED, SO WRITE-OUT THE ALLOCATION BLOCK /A031 JMS WRITEOUT /WRITE-OUT THE ALLOCATION BLOCK /A031 / supply the link to the 1st and 2nd extension blocks now... JMS RPWRTH /WRITE OUT CURRENT GTP BLK /A034 RPLNK, TAD EXTNOF /POINTER TO CURRENT TABLE ENTRY /A034 JMP RPRD2 /INIT. RPPGDS EXTN. BLOCK IMAGE RPXEX, TAD EXTNOF /CONTROL TABLE ENTRY POINTER DCA RPHDBN /MAKE THIS EXTN. THE CURRENT BLOCK JMP REEDXT /EXIT:EXTN. IN BUFFER /A032 RPALLOCATE, XX /GET A BLOCK FOR THIS DOC. /A029 JMS RPQRX /INTERNAL REQ. TO ALLOC. A BLOCK /A029 RXEAL /FC5=ALOOCATE A BLOCK /A029 0 /NO BUFFER NECESSARY /A029 JMS SCSPC /UPDATE # OF FREE BLOCK ON DISKETTE /A029 /SPCSPF IN PAGE 0 TAD SCQBLK+RXQBLK /GET THE BLK# JUST ALLOC. /A029 JMP I RPALLOCATE /RETURN WITH AC = BLOCK # /A029 /--------------- PAGE / here after a block has been written. / / IF THE BLOCK JUST WRITTEN WAS THE DOC. HEADER BLOCK (CLOSE), / WRITE THE MAIN RPPGDS BLOCK AFTER INITIALIZING APPROPRIATE / IDENTIFICATION WORDS / / ASSUMPTION: IF THE DOC. HEADER BLOCK WAS IN THE SCROLL BUFFER / THEN THE PARALLEL RPPGDS BLOCK WAS CO-RESIDENT / RPWRTH, XX /A034 TAD RPWRTH /GET CALLER'S RETURN ADDR. /A034 DCA RPWRT /USE IT FOR THIS RETURN /A034 JMP RPWRTO /NOW GO WRITE BLOCK /A034 RPWRT, XX /A032 TAD SCQBLK+RXQBLK /BLK# JUST WRITTEN CIA /FOR COMPARE TO TAD I (SCHDRB /DOC. HDR. BLK. # SZA CLA /SKIP WITH MAIN HDR. BLK. JMP RPWRTO /GO DO PARALLEL EXTENSION BLK / before writting the MAIN RPPGDS block, update the identifiaction / words... CDFBUF /BUFFER FIELD TAD I (SCHDR+5 /# OF BLKS. ALLOCATED TO THIS DOC. CDFRPB /OUR BUFFER FIELD DCA I (RPPGDS+5 /UPDATE NEW DATA STRUCTURE CDFBUF TAD I (SCHDR+10 /DAY-MONTH OF LAST EDIT CDFRPB /OUR BUFFER FIELD DCA I (RPPGDS+10 /SAME HERE CDFBUF TAD I (SCHDR+11 /LAST 2 DIGITS OF YESR CDFRPB /OUR BUFFER FIELD DCA I (RPPGDS+11 /SAME HERE CDFBUF TAD I (SCHDR+12 /START TIME OF LAST EDIT CDFRPB /OUR BUFFER FIELD DCA I (RPPGDS+12 /SAME HERE CDFMYF /BACK TO OUR FIELD / now write out the buffer to update the RPPGDS MAIN block... / write the "current" block to disk after clearing its' modified bit RPWRTO, /WRITE THE RPPGDS BLOCK TO DISK TAD I RPHDBN /GET THE RPPGDS BLOCK # JMS RPQRX /WRITE OUT A RPPGDS BLOCK RXEWT+2000 /FC 4 = WRITE/VERIFY RPPGDS /BLOCK IMAGE FROM THIS BUFFER JMP I RPWRT /EXIT:PARALLEL RPPGDS BLK WRITTEN /A032 / a descriptor word has been built (RPDSBD) depicting the / positioning information contained within the text block / just written to disk... / if the scroll buffer just used was the STX buffer, then / use SCTOP for offset into RPPGDS for descriptor word location / else use SCBOT for offset RPDSWD, /UPDATE RPPGDS 0 /SAVE CALLERS RETURN ADDR. TAD SCQBLK+RXQBAD /BUFFER JUST USED FOR IO TAD (-SCTB /COMPARE TO TOP (STX) SZA CLA /SKIP IF STX TO USE SCTOP AC0001 /WANT SCBOT FOR BOTTOM (ETX) TAD (SCTOP-1 /POINT TO BLOCK OFFSET DCA X3 /INIT. TO BLOCK OFFSET JMS RPDSW1 /GET MODE OF CHARACTER /A017 TAD I X3 /GET THE CURRENT BLOCK OFFSET A1, TAD M376 /MINUS # OF WORDS IN A BLOCK (254) SMA /SKIP WITH DESCRIPTOR PTR -400 JMP A1 /BIG DOC., REPEAT TAD T400 /CONVERT TO POSITIVE WORD OFFSET /AC = OFFSET TO BLOCK JUST WRITTEN TAD (RPPGDS /PLUS START OF OUR SCROLL BUFFER DCA DESCOF /DESCOF => PTR TO APPRO. DESCRIPTOR TAD I T3 /GET CURRENT DESCRIPTOR WORD /A030 CDFRPB /GET TO OUR BUFFER FIELD DCA I DESCOF /UPDATE DESCRIPTOR WORD IN SCROLL BUFFER CDFMYF /BACK TO OUR FIELD DCA I T3 /CLEAR DESC. SAVE AREA FOR NEXT /A030 JMP I RPDSWD /EXIT: BUFFER UPDATED; WRITE OUT / OUR BUFFER WHEN PARELLEL DOC. HDR. BLK. GET'S WRITTEN OUT DESCOF, 0 /RPPGDS BUFFER DESCRIPTOR WORD OFFSET /RPPGDS SCROLL HEADER BUFFER CONTROL AREA: RPBFCB, RPPGDS /SCROLL BUFFER ADDRESS IN FIELD 2 RPHDBN, 0 /POINTER TO CURRENT RPPGDS BLOCK IN THE BUFFER : /THE POINTER IS ADDR. OF ONE OF THE FOLLOWING RPHDRB, 0 /FIRST HEADER BLOCK NUMBER 0 /SECOND 0 /THIRD 0 /SO ON TO THE 17TH 0 0 0 0 0 0 0 0 0 0 0 0 0 0 RPHMD, 0 /TERMINATOR /M007 WRITEOUT, XX /SAVE CALLERS RETURN ADDRESS /A031 JMS RPQRX /WRITE THE ALLOCATION BLOCK /A031 RXERT /FC 0 /A031 0 /DUMMY BUFFER ADDRESS /A031 JMP I WRITEOUT /RETURN TO CALLER /A031 CKSAME, XX /ROUTINE TO CHECK TO SEE IF THE DOCUMENT/A044 /HEADER BLOCK TO BE RESTORED DURING A /A044 /RESTORE SYSTEM FILE POINTERS CALL IS /A044 /ALREADY IN CORE /A044 DCA T1 /SAVE THE ONE WE WANT /A044 TAD T1 /GET IT BACK AND /A044 CIA /NEGATE IT /A044 TAD SCHDBN /ADD IN THE ONE WE HAVE ALREADY /A044 SNA CLA /SKIP IF THEY ARE DIFFERENT /A044 ISZ CKSAME /ELSE TAKE THE SKIP RETURN TO BYPASS /A044 / ..THE UNNECESSARY READ /A044 TAD T1 /GET THE HDR BLK # WE WANT BACK /A044 DCA SCHDBN /& PUT IT IN AS THE CURRENT /A044 JMP I CKSAME /RETURN TO CALLER /A044 /--------------- PAGE / here to make a request for IO... / RPQRX, 0 /INTERNAL CALLER'S RETURN ADDR. CDFMYF /HERE FOR ROOM /A029 DCA SCQBLK+RXQBLK /BLOCK #, IF THERE IS ONE TAD (CDFRPB) / GET RPPGDS BUFFER FIELD. /M028 DCA SCQBLK+RXQBFD /SUPPLY FIELD TAD I RPQRX /GET FUNCTION CODE DCA SCQBLK+RXQFNC /SUPPLY FUNCTION CODE ISZ RPQRX /BUMP TO GET BUFFER ADDR. TAD I RPQRX /GET RPPGDS BUFFER ADDR. DCA SCQBLK+RXQBAD /SUPPLY BUFFER ADDR. ISZ RPQRX /BUMP TO RETURN ADDR. CIFSYS ENQUE SCQUBL RPQRX1, CIFSYS JWAIT TAD SCQBLK+RXQCOD SNA JMP RPQRX1 SMA CLA JMP I RPQRX /EXIT:IO COMPLETED / here only after a block has been allocated to RPPGDS / initialize the RPPGDS "scroll" buffer (7400) words to -1 / initialize the first two words to imitate a standard WPS / "fixed" block. / word 0 = -255 entries in this block / word 1 = 0070 (ID code ) / / clear the extension block pointers (words 2&3) RPBFIN, 0 /RETURN ADDR TO CALLER TAD (RPPGDS-1 /START ADDR. -1 DCA X3 /INIT. AUTO INDEX REG. TO RPPGDS BUFFER TAD (COSCNT /-255 VALUE FOR 1ST WORD CDFRPB /GET TO OUR BUFFER FIELD DCA I X3 /SET 1ST WORD TO -255 TAD (0070 /OUR UNIQUE ID CODE DCA I X3 /INTO 2ND WORD DCA I X3 /AND CLEAR THE EXTENSION BLOCK DCA I X3 /POINTERS TAD (7404 /NEG. 252 WORD COUNTER DCA RPTEM1 /RPTEM1 => NEG. WORD COUNTER B, AC7777 /AC => -1 DCA I X3 /ADVANCE PTR. AND THEN SET A WORD TO -1 ISZ RPTEM1 /SKIP IF ALL RPPGDS BUFFER WORDS INIT'D. JMP B /NOT DONE, SO LOOP... CDFMYF /BACK TO THIS FIELD JMP I RPBFIN /EXIT: RPPGDS SCROLL BUFFER INIT'D TO -1 /EXCEPT WORD 0 (-255) AND WORD 1 (0070) /AND 2&3 (0) RPTEM1, 0 /TEMP. MUST BE ON THIS PAGE /M046 / here to free a block pertaining to a corrupted RPPGDS / ON ENTRY: AC = BLOCK # TO FREE RPDSFR, 0 /SAVE RETURN TO CALLER JMS RPQRX /INTERNAL REQ. TO FREE A BLOCK RXEFR /FC 6 = FREE A BLOCK 0 /DUMMY CLA /INSURE A CLEARED AC JMP I RPDSFR /EXIT: BLOCK HAS BEEN FREED / here to clear all extension blocks associated with a corrupted MAIN / RPPGDS... RPDSCR, 0 /RETURN ADDR. TAD (RPHDRB /START WITH THE 1ST EXTN. BLOCK DCA X3 /X3 => PTR. TO BLOCK TO BE FREED TAD X3 / DCA X4 /X4 => PTR. TO TABLE ENTRY THAT CONTAINED FREED BLK. RPFRDS, TAD I X3 /GET BLOCK # TO BE FREED SNA /SKIP IF THERE IS ONE JMP RPENDS /DO UNTIL PHYSICAL END OF TABLE JMS RPDSFR /GO FREE A BLOCK DCA I X4 /TAKE BLOCK OUT OF TABLE RPENDS, TAD X3 /NEXT ENTRY TO GET BLOCK # FROM IAC / /A007 TAD (-RPHMD /TEST PHYSICAL END AND NOT NULL /ENTRY IN CASE ENTIRE TABLE FILLED AND RPHMD /WORD NOT NULL... SZA CLA /SKIP IF ALL BLOCKS FREED JMP RPFRDS /GO DO ANOTHER ENTRY JMP I RPDSCR /EXIT:RPPGDS AND ALL EXTENSIONS FREED / during the CLOSE procedure, perform the same housekeeping / on the RPPGDS blocks that is done to the DOC. HEADER blocks... RPGETR, 0 /CALLER'S RETURN ADDR. TAD SCGTR1 /DOC. HDR. BLK. SCROLL BUFFER ADDR. AND P377 /STRIP HDR. BUFFER ADDR., LEAVING WORD OFFSET TAD (RPPGDS /ADD THIS WORD OFFSET TO OUR BUFFER ADDR. DCA RPGTR1 /RESULTING IN A POINTER TO THE PARRELLEL WORD CDFRPB /GET THE RPPGDS DATA FIELD TAD I RPGTR1 /GET OUR PARRELLEL WORD CDFMYF /BACK TO THIS FIELD DCA RPPTR1 /AND SAVE IT FOR PUT LATER... JMP I RPGETR /EXIT:RPPGDS WORD ALSO AVAILABLE RPPUTR, 0 /CALLER'S RETURN ADDR. TAD SCGTR1 /DOC. HDR. BLK. SCROLL BUFFER ADDR. AND P377 /STRIP HDR. BUFFER ADDR., LEAVING WORD OFFSET TAD (RPPGDS /ADD THIS WORD OFFSET TO OUR BUFFER ADDR. DCA RPGTR1 /RESULTING IN A POINTER TO THE PARRELLEL WORD TAD RPPTR1 /GET RPPGDS WORD SAVED DURING GET CDFRPB /RPPGDS SCROLL BUFFER FIELD DCA I RPGTR1 /PUT WORD IN PARRELLEL RPPGDS LOCATION CDFMYF /BACK TO THIS FIELD JMP I RPPUTR /EXIT:PARRELLEL RPPGDS WORD UPDATED RPGTR1, 0 /POINTER TO PARRELLEL RPPGDS WORD RPPTR1, 0 /PUT RPPGDS CHAR. HERE;GET RPPGDS CHAR. FROM HERE SPCTAB, /12 BIT SPECIALS TO 6-BIT TRANSLATION TABLE 7727 /LINE MODIFIED (CMD 6) 7707 /ENTER COMPOSITE (CMD &) 7706 /TAB (CMD %) 7713 /END OF LINE (CMD *) 7721 /A016 7714 /END OF PAGE (CMD +) 7710 /EXIT COMPOSITE (CMD ') 7730 /START OF A RULER (CMD 7) 7731 /END OF A RULER (CMD 8) COSTAB, /12-BIT MODES INTO 6-BIT TRANSLATION TABLE 74 /SHIFT 76 /UNSHIFT 7703 /EXIT BOLD (CMD ") 7702 /ENTER BOLD (CMD !) 7705 /EXIT UNDERLINE (CMD $) 7704 /ENTER UNDERLINE (CMD #) 7716 /EXIT SUPERSCRIPT (CMD -) 7715 /ENTER SUPERSCRIPT (CMD ,) 7720 /EXIT SUBSCRIPT (CMD /) 7717 /ENTER SUBSCRIPT (CMD .) 7712 /EXIT AUX. (CMD )) 7711 /ENTER AUX. (CMD () MAXCOS=.-COSTAB /# OF MODES 0 /END OF TABLE / /A042 / WPFILS FUNCTION TO SET SCTOP,SCTPH /A042 / DOES NO DISK I/O /A042 / /A042 RRSCTP, XX /A042 DCA SCTOP /A042 MQA /A042 DCA SCTPH /A042 JMP I RRSCTP /A042 /--------------- PAGE / read the RPPGDS block into our scroll buffer (7400) / then determine if the descriptor words reflect an up-to-date / text block content... / / ON ENTRY: AC => BLK # OF RPPGDS / ON EXIT : AC => 0 WHEN RPPGDS OK / AC => NOT 0 WHEN RPPGDS CORRUPTED RPRDIT, 0 /CALLER'S RETURN ADDR. CDFMYF /A032 DCA NEWBLK /SAVE BLOCK # TO BE READ /A019 TAD RPHDBN /GET PTR. TO BLOCK # THAT IS CURRENTLY ACTIVE SNA / IS IT ZERO? /A011 JMP RPDORD / YES, DON'T WRITE OUT OLD HEADER /A011 DCA TMPPTR /FOR INDIRECT THRU THIS PAGE TAD I TMPPTR /GET THE BLOCK # CIA /FOR COMPARE /A007 TAD NEWBLK /ALREADY IN BUFFER? /A007/M019 SNA CLA /SKIP IF NOT /A007 JMP I RPRDIT /RETURN IF SO /A007 TAD I TMPPTR /ACTIVE BLOCK # /A007 JMS RPQRX /GO WRITE IT TO DISK RXEWT+2000 /WRITE AND VERIFY F.C. RPPGDS /ADDR. OF BUFFER CLA RPDORD, TAD NEWBLK /REPLACE BLOCK # TO BE READ /M019 JMS RPQRX /"INTERNAL" REQUEST TO READ RPPGDS BLOCK RXERD /FC 3 = READ LOG. BLOCK RPPGDS /PTR TO OUR SCROLL BUFFER / BEGIN THE VERIFICATION PROCESS: / / if this document was OPENed by a V2.n WPS then the 2nd word / of this block should contain the unique ID code of 0070 / else this block used for other than RPPGDS descriptor words TAD (-0070 /NEG. RPPGDS ID CODE CDFRPB /SCROLL BUFFER DF TAD I (RPPGDS+1 /COMPARE TO 2ND WORD OF RPPGDS BLOCK CDFMYF /BACK TO THIS FIELD SZA /SKIP IF THIS IS THE RPPGDS BLOCK JMP I RPRDIT /AC => NOT 0 ERROR RETURN / if the # of blocks allocated to this document is the same for / both the doc. header block and the RPPGDS block, then this / RPPGDS block ok / else this document was used on a system that did not contain / V2.n GOTO PAGE software. / The RPPGDS descriptor words are not the most current / reflection of the text blocks within this document. TAD NEWBLK /GTP BLK # JUST READ /A034 CIA /FOR COMPARES /A034 TAD RPHDBN /MAIN GTP BLK# OR 0 FOR OPENING DOC. /A034 SZA /SKIP TO VERIFY MAIN GTP BLK /A034 TAD NEWBLK /SEE IF RPHDBN WAS 0 FOR OPENING /A034 SZA CLA /SKIP TO VERIFY MAIN GTP BLK /A034 JMP I RPRDIT /DON'T VERIFY EXTENSIONS CDFBUF /SCROLL BUFFER DF TAD I (SCHDR+5 /# OF BLOCK ALLOCATED TO THIS DOC. CIA /MAKE NEG. FOR COMPARE CDFRPB /OUR BUFFER FIELD TAD I (RPPGDS+5 /COMPARE TO ITS RPPGDS COUNTER-PART CDFMYF /BACK TO THIS FIELD SZA /SKIP IF # OF BLOCK THE SAME JMP I RPRDIT /ERROR EXIT: AC NOT = 0 / if the DAY-MONTH-YEAR of both the doc. header block and the / RPPGDS block match, then this document CLOSED by a V2.n / system. / else this document used by a system not containing V2.n / GOTO PAGE software. CDFBUF /SCROLL BUFFER FIELD TAD I (SCHDR+10 /DAY-MONTH CIA /MAKE NEG. FOR COMPARE CDFRPB /OUR BUFFER FIELD TAD I (RPPGDS+10 /GET COUNTERPART CDFMYF /BACK TO THIS FIELD SZA /SKIP IF A MATCH JMP I RPRDIT /ERROR EXIT:AC NOT = 0 CDFBUF /SCROLL BUFFER FIELD TAD I (SCHDR+11 /LAST 2 DIGITS OF YEAR VALUE CIA /CONVERT TO NEG. FOR COMPARE CDFRPB /OUR BUFFER FIELD TAD I (RPPGDS+11 /GET COUNTERPART CDFMYF /BACK TO THIS FIELD SZA /SKIP IF YEAR VALUES AGREE JMP I RPRDIT /ERROR EXIT: AC NOT = 0 / 4) IF THIS DOC. WAS OPENED BY A V2.0 OR LATER WPS / THEN THE START TIME OF THE LAST EDIT CYCLE SHOULD BE / THE SAME IN BOTH BLOCKS... CDFBUF /SCROLL BUFFER FIELD TAD I (SCHDR+12 /START TIME OF LAST EDIT CIA /NEG. VALUE FOR COMPARE CDFRPB /OUR BUFFER FIELD TAD I (RPPGDS+12 /GET THE COUNTERPART CDFMYF /BACK TO THIS FIELD JMP I RPRDIT /EXIT W/AC CONTAINING RESULT / here after a TEXT block has been written to diskette. / locate the scroll buffer used and read its contents, looking / for repositioning information and mode. RPSPLT, 0 /NEG. = "SPLIT" ESC SEQ. / POS. = NORMAL 2 CHAR. SEQ. /I.E., 1277 1250 7713 3377 1477 RPENDB, 0 /BUFFER CHAR. COUNTER RPDSBD, 0 /SAVE CALLERS' RETURN ADDR. AC0001 / /A030 DCA TMPPTR /FIRST-TIME THRU ETX FLAG /A030 DCA SOMFLG /CLEAR FIRST-TIME THRU STX FLAG /A030 TAD M376 /SET UP A NEG. 254 WORD COUNTER /M021 DCA RPENDB /TO END DESCRIPTOR WORD BUILD TAD T3 / DESC. BEING USED /A030 TAD (-ETXDES /IS IT ETX? /A030 SZA CLA /SKIP TO PROCESS ETX BUFFER CHARS. TAD T400 /BUMP TO PROCESS STX BUFFER CHARS. TAD (SCEB+BOFSET-1 /INIT. BUFFER WORD POINTER DCA X3 /TO WORD IMMEDIATELY BEFORE 1ST WORD DSBDST, TAD RPSPLT /GET "SPLIT" ESC SEQ. FLAG AND P7700 /GET THE ESC CHAR. TAD M7700 /COMPARE TO ESC CODE /M021 SZA CLA /SKIP TO PROCESS "SPLIT" ESC JMP DSBDWD /JUMP TO PROCESS NORMAL WORD CDFBUF /SCROLL BUFFER FIELD TAD I X3 /GET THE CURRENT BUFFER WORD CDFMYF /BACK TO OUR FIELD BSW /USE BITS 6-11 FOR "SPLIT" FLAG DCA RPSPLT /UPDATE FLAG AND MAKE A COPY OF CURRENT WORD TAD RPSPLT /GET THE CURRENT BUFFER WORD AND P77 /OUR SECOND HALF OF ESC SEQ. TAD P7700 /SUPPLY THE ESC. CHAR. /M021 JMP DOESC+1 /GO PROCESS ESC SEQ. IN AC /M021 DSBDWD, CDFBUF /SCROLL BUFFER FIELD TAD I X3 /GET THE CURRENT BUFFER WORD CDFMYF /BACK TO THIS FIELD MQL /SAVE WORD IN MQ /A021 ACL /RESTORE CHAR /A021 AND P7700 /GET THE ESC CHAR /A021 TAD M7700 /COMPARE TO ESC CODE /A021 SNA /SKIP IF NORMAL /M021 JMP DOESC /GO PROCESS ESC SEQ. IN AC ACL /RESTORE CHAR /A021 BSW /LOOKING FOR "SPLIT" ESC SEQ. DCA RPSPLT /IF ESC CHAR., FLAG IS NOW NEG. DSBDEX, ISZ RPENDB /BUMP BUFFER CHAR. COUNTER JMP DSBDST /READ ANOTHER BUFFER WORD JMS RPDSWD /PUT CURRENT DESCRIPTOR WORD IN RPPGDS DCA RPSPLT /CLEAR SPLIT FLAG FOR EACH BLOCK /A038 JMP I RPDSBD /AND EXIT: THIS TEXT BLOCK HAS A NEW DESCRIPTOR WORD TMPPTR, 0 /POINTER ON THIS PAGE TO ACCESS BLOCK CONTROL TABLE /--------------- PAGE RPMODE, 0 /BUILD OUR OWN MODE BYTE RPPCTLFL, 0 /PRINT-CONTROL STATE FLAG /A030 TORPDSBD, XX /INIT. DESC. WORD AND BIT 5 /A030 ISZ T3 /BUMP TO STX/ETX DESC. WORD /A030 TAD RPPCTLFL/CONTENTS OF PRINT-CONTROL FLAG /A030 DCA I T3 /INIT. APPROPRIATE DESC WORD /A030 JMS RPDSBD /IDENTIFY/RECORD PERTINENT ESC /A030 JMP I TORPDSBD/CONTINUE PUT PROCESS /A030 / RPDESC bit assigmnents: /M012 / / 0 1 2 3 4 5 6 7 8 9 10 11 / R J S U B C U P P P P P / A S / / when bit 'ON': / R = a RULER starts in this block / J = Justify / S = Superscript / U = Underscore / B = Bold / S & U = Subscript / CA = (Print) Control Area / US = Unshift / P = total number of PAGES in this block / / determine if this ESC sequence has to be reflected in our text / block descriptor word. / / ON ENTRY: AC contains full 2-char. ESC Sequence... DOESC, ACL /GET THE CURRENT BUFFER WORD BACK /A021 CIA /MAKE POSITIVE FOR COMPARES TAD (7730 /COMPARE TO START OF RULER SNA /SKIP IF NOT START OF RULER JMP RPSTRL /GO INDICATE THAT THIS BLOCK HAS A RULER TAD (7720-7730 /EXIT SUBSCRIPT MODE? /A016 SNA /SKIP IF NOT JMP RPEXSB /GO CLEAR SUBSCRIPT MODE /M030 TAD (7717-7720 /ENTER SUBSCRIPT MODE? SNA /SKIP IF NOT JMP RPENSB /GO SET SUBSCRIPT MODE /M030 TAD (7716-7717 /EXIT SUPERSCRIPT MODE? SNA /SKIP IF NOT JMP RPEXSU /GO CLEAR SUPERSCRIPT MODE TAD (7715-7716 /ENTER SUPERSCRIPT MODE? SNA /SKIP IF NOT JMP RPENSU /GO SET SUPERSCRIPT MODE TAD (7714-7715 /COMPARE TO END PAGE SEQUENCE SNA /SKIP IF NOT JMP RPPGMK /FLAG PAGE MARK IN DESCRIPTOR / now check for MODE.... TAD (7712-7714 /EXIT AUX. MODE? SNA /SKIP IF NOT JMP RPEXAU /GO CLEAR AUX. BIT TAD (7711-7712 /ENTER AUX. MODE? SNA CLA /SKIP IF NOT JMP RPENAU /GO SET AUX. BIT JMP DSBDEX /EXIT: / ESC. sequence was end of page. This type of sequence with MODE / equal NONE represents a NEW PAGE MARK, or, this sequence with / AUX. set represents a PAGE MARKER; any other mode is not applicable. RPPGMK, TAD (1200 /TEST SUPER/SUB SCRIPT /M030 AND RPMODE /IN CURRENT MODE /M030 SZA CLA /SKIP IF NEITHER (PAGE MARK) /M030 JMP CHCNTL /JUMP IF PRINT CONTROL INFO /M030 ISZ I T3 /REFLECT PAGE MARKER /M030 JMP DSBDEX /RETURN TO NORMAL PUT PROCESS /M030 CHCNTL, TAD TMPPTR /TEST FIRST-TIME THRU ETX FLAG /A030 SNA CLA /SKIP IF 1ST TIME THRU /A030 JMP DSBDEX /CONTINUE PUT PROCESS /A030 TAD T3 /POINTER TO CURRENT DESC. WORD /A030 TAD (-ETXDES /COMPARE TO ETX /A030 SZA CLA /SKIP IF ETX BUFFER /A030 JMP CHKSTX / PROCESS STX /A030 DCA TMPPTR /CLEAR FIRST TIME THRU FLAG /A030 AC0001 / /A030 DCA SOMFLG /FORCE ETX EXIT /A030 TAD (200 /END PRINT-CONTROL MASK /A030 AND RPMODE /TEST CURRENT MODE /A030 JMP CHKETX /CONTINUE TO PROCESS ETX OFF PAGE /A030 RPSTRL, TAD P3777 /MAKE SURE RULER PRESENT BIT OFF AND I T3 /BEFORE WE SET IT /M030 TAD (4000 /SET RULER IN THIS BLOCK BIT DCA I T3 /UPDATE DESCRIPTOR WORD /M030 JMP DSBDEX /EXIT: RETURN TO NORMAL PUT-PROCESS / ESC sequence was EXIT SUPER/SUBSCRIPT mode.... /A012 RPEXSU, TAD (6777 /CLEAR SUPER-SCRIPT (1000) /C030 AND RPMODE /SAVE OTHER MODE BITS JMP MODEXT /GO UPDATE MODE AND EXIT / ESC sequence was ENTER SUPER/SUBSCRIPT mode.... /A012 RPENSU, TAD (6777 /MAKE SURE SUPER-SCRIPT BIT OFF /C030 AND RPMODE /BEFORE WE SET IT TAD (1000 /SET SUPER/SUBSCRIPT MODE BIT JMP MODEXT / ESC sequence was EXIT AUX. mode... RPEXAU, TAD (5777 /CLEAR AUX. MODE BIT (2000) AND RPMODE /SAVE OTHER MODE BITS JMP MODEXT /GO UPDATE MODE AND EXIT / ESC sequence was ENTER AUX. mode... RPENAU, TAD (5777 /MAKE SURE AUX. MODE-ON BIT IS OFF AND RPMODE /BEFORE WE SET IT TAD (2000 /SET AUX. MODE BIT JMP MODEXT /GO UPDATE MODE AND EXIT / ESC sequence was EXIT BOLD mode... RPEXSB, TAD (7577 /CLEAR SUB-SCRIPT MODE BIT (0200) /M030 AND RPMODE /SAVE OTHER MODE BITS JMP MODEXT /GO UPDATE MODE AND EXIT / ESC sequence was ENTER BOLD mode... RPENSB, TAD (7577 /MAKE SURE SUB-SCRIPT MODE BIT OFF /M030 AND RPMODE /BEFORE WE SET IT TAD (200 /SET BOLD MODE MODEXT, DCA RPMODE /UPDATE OUR MODE WORD JMP DSBDEX /AND RETURN TO CONTINUE RPTRS1, XX DCA SCTOP /BACK FOR EDITOR TAD EDHDR /PREVIOUS ACTIVE HEADER BLOCK DCA SCTPH /INTO TOP HEADER POINTER TAD EDHDR1 /GET ORIGINAL 'BOTTOM' HDR ID DCA SCBTH /BACK FOR EDITOR TAD EDSCBK /GET HDR BLK # THAT'S IN CORE JMS CKSAME /SEE IF WE NEED TO READ (NORMAL RETURN) /A044 /OR DO WE ALREADY HAVE (SKIP) /A044 / ... THE CORRECT DOCUMENT HEADER BLOCK IN CORE /A044 /D044 DCA SCHDBN /BACK FOR EDITOR /note -- don't save and restore the current rppgds block in the buffer JMS SCGTWR JMP I RPTRS1 /RETURN EDHDR1, 0 /USED TO SAVE/RESTORE SCBTH HDR ID EDSCBK, 0 /USED TO SAVE/RESTORE HDR BLK # THAT'S IN CORE / /A042 / /A042 / SUBR RPTPDS -- Rapid Paging get ToP goto-page DeScriptor word /A042 / /A042 / Gets GOTO-PAGE descriptor word of block currently defined by /A042 / top pointers SCTOP,SCTPH. /A042 / Probably reads appropriate GOTO-PAGE header block if it's not /A042 / currently loaded in the RPPGDS buffer. /A042 / /A042 / CALL: /A042 / JMS RPTPDS / GET TOP DESCRIPTOR WORD /A042 / / AC = GOTO-PAGE DESCRIPTOR WORD (?FOR BLK IN STX BUFFER?) /A042 / /A042 / /A042 RPTPDS, XX /A042 JMS SCGETR /READ AN ENTRY FROM THE DOC. HEADER BLOCK SCTPH SCTOP AC0002 /IGNORE DOC. HEADER STUFF /AC := 2 TO GET PAST COS WORDS 1&2 TAD (RPPGDS /OUR BUFFER STARTS HERE TAD SCTOP /PLUS THE PARELLEL DOC HEADER OFFSET DCA T1 /SAVE EXTRA WORD /A007 CDFRPB /GET OUR BUFFER FIELD TAD I T1 / /A007 CDFMYF /BACK TO THIS FIELD /WITH DESCRIPTOR WORD IN AC.... JMP I RPTPDS /EXIT /A042 /--------------- PAGE / / This code was developed for the exclusive use of the V2 / GOTO PAGE enhancement; it provides for 7 seperate functions: / / 1) when AC = -1: Increment top ptrs; Get top G-T-P descriptor word / / permits the reading of successive "descriptor words" / and passes back the current descriptor word within / the AC for the caller (EDITOR). The main advantage / of employing this method is the automatic loading / of sequential doc. header extension blocks and their / parallel RPPGDS extension blocks. / / 2) when AC = -2: Save SYSTEM FILE POINTERS / / Saves FILE SYSTEM POINTERS (current position within / GOTO-PAGE header structure), then / sets current position to ---TOP--- for function AC=-1. / If file position is to restored (function AC=-4), then / do not attempt to scroll to/from disk until / after calling function AC=-4. / / Value returned to EDITOR: / / AC= the current number of pages / contained within the STX buffer. This count will / be used to calculate the current page being editted. / / 3) when AC = -3: Get original and current top pointers / / Value supplied on entry: / / MQ= Pointer to 2-word save area for current SCTOP & SCTPH / / Values returned to the EDITOR: / / AC= the original value of SCTOP (saved by func AC=-2) / (to be used to calculate the current PAGE being edited) / MQ= the original HDR. ID # (saved by func AC=-2) / CDFLP;@entry MQ = current value of SCTPH / CDFLP;@entry MQ = current value of SCTOP / / 4) when AC = -4: Restore SYSTEM FILE POINTERS / / the calculation of the total number of PAGES within / this document has been completed. Before returning / to resume the edit session, return the FILE SYSTEM POINTERS / to those values saved at the start of the total PAGE / calculation. It is possible that the HEADER scroll buffer / and the RPPGDS scroll buffer got overlaid with / successive extension blocks necessary to count all / pages within the document. Furthurmore, SCTOP and SCBOT / were bumped to read successive descriptor words. / / 5) when AC = -5: Get current bottom pointers / / Values returned to the EDITOR: / / AC= current contents of SCBOT / (so that a determination can be made as to when the / current block has been read.) / MQ= current contents of SCBTH / / 6) when AC = -6: Get top G-T-P descriptor word; Increment top ptrs / / Value supplied on entry: / / AC= signed increment for top pointers / (+- # of blocks to move; may=0) / / Value returned to EDITOR: / / AC= value of GOTO-PAGE descriptor word for block / originally pointed to by top pointers (before / they were incremented) / / 7) when AC = positive #: Random-Access OPEN for scrolling / / Values supplied on entry: / / AC= new SCBOT (header word pointer (offset into hdr blk)) / MQ= new SCBTH (header block id number) / / Initializes the TOP and BOTTOM pointer pairs / for random access of text blocks. / The entry AC&MQ together specify which document block / to open at. After this function, ADVPTR will get characters / starting at the beginning of the opened block; / BAKPTR will get characters starting at the end of the / previous block. / (This function is used for several purposes. Example: / positions the pointer pairs at the block in the / document containing the desired page to reposition / to.) / RPINIT, 0 /CALLER'S RETURN ADDRESS SPA /SKIP TO SET UP FOR RANDOM READ JMP RPDSCP /JUMP TO TEST FURTHUR / / RANDOM ACCESS OPEN / DCA SCBOT /HDR WORD PTR INTO BOTTOM WORD PTR MQA /GET THE HEADER # DCA SCBTH /PUT IN BOTTOM HEADER PTR / THE BOTTOM POINTERS ARE NOW SET FOR RANDOM READ TAD SCBOT /BOTTOM HDR WORD POINTER DCA SCTOP /NOW BECOMES THE TOP POINTER TAD SCBTH /GET THE BOTTOM HEADER POINTER DCA SCTPH /INTO TOP HEADER NUMBER JMS SCTOPP /GO DECR. TOP PTRS BY 1 -1 /DECR. FACTOR / DEPICT AN EMPTY TEXT BUFFER... DCA SCTPTR /CLEAR STX BUFFER CHAR. POINTER TAD (SCHCNT-1 /MAX. # OF BUFFER BYTES DCA SCEPTR /SET EXT BUFFER CHAR. POINTER AT MAX. / WHEN THE EDITOR REQUESTS A READ OF A CHAR. (LODCHR) FROM / AN INITIALIZED EDIT BUFFER, WPFILS WILL BE CALLED TO SUPPLY / A CHAR. FROM THE ETX BUFFER. THE POINTER SET ABOVE WILL / RESULT IN READING A BLOCK FROM DISK INTO THE ETX BUFFER. AC0001 /SET Go To page FLaG TO /A012 DCA GTFLG /INDICATE A GO-TO-PAGE REQUEST /A012 JMP RPINEX /EXIT:POINTERS ALL SET FOR RANDOM READ GTFLG, 0 /SET TO INDICATE A GO-TO-PAGE REQUEST /A012 RPDSCP, TAD ONE /SKIP TO READ DESCRIPTOR /M025 SZA / JMP RPCNT /JUMP TO TEST FURTHUR / / the AC was -1...... / JMS SCTOPP /CLEARS AC, THEN INCR. TOP POINTER 1 /BY 1 /D042 JMS SCGETR /READ AN ENTRY FROM THE DOC. HEADER BLOCK /D042 SCTPH /D042 SCTOP /D042 /D042 AC0002 /IGNORE DOC. HEADER STUFF /D042 /AC := 2 TO GET PAST COS WORDS 1&2 /D042 TAD (RPPGDS /OUR BUFFER STARTS HERE /D042 TAD SCTOP /PLUS THE PARRELLE DOC HEADER OFFSET /D042 DCA T1 /SAVE EXTRA WORD /A007 /D042 /D042 CDFRPB /GET OUR BUFFER FIELD /D042 TAD I T1 / /A007 /D042 CDFMYF /BACK TO THIS FIELD /D042 /WITH DESCRIPTOR WORD IN AC.... JMS RPTPDS /GET TOP GOTO-PAGE DESCRIPTOR WORD /A042 JMP RPINEX /EXIT RPCNT, TAD ONE /TEST FOR # OF PAGES IN STX BUFFER /M025 SZA /SKIP TO PASS THE # OF PAGES IN THE STX BUFFER JMP RPTOP /MAY BE REQUEST FOR ORIGONAL SCTOP & HDR ID# / / AC was -2..... / TAD SCTOP /SAVE POINTER TO CURRENT TOP BLOCK DCA EDTOPS /AT START OF TOTAL PAGE CALCULATION /M041 TAD SCBOT /AND CURRENT BOTTOM BLOCK POINTER DCA EDBOTS /M041 TAD SCTPH /SAVE CURRENT 'TOP' HDR ID /A020 DCA EDHDR /A020 TAD SCBTH /SAVE CURRENT 'BOTTOM' HDR ID /A020 DCA EDHDR1 /A020 TAD SCHDBN /SAVE CURRENT HDR BLK # THAT'S IN CORE /A020 DCA EDSCBK /A020 / set-up to enable read of successive descriptor words, /A009 / starting with the 1st descriptor of the 1st RPPGDS block.. /A009 TAD (52 / /A009 DCA SCTOP /INIT'D VALUE /A009 TAD (53 / /A009 DCA SCBOT /INIT'D VALUE /A009 AC0001 / /A009 DCA SCTPH /1ST HEADER BLOCK ID # /A009 TAD STXMOD+2 /SUPPLY THE # OF PAGE IN STX BUFFER /A018 JMP RPINEX /EXIT / THE FOLLOWING BLOCK IS ALL SCRAMBLED, SO I'M JUST DELETING IT /A042 / AND REWRITING IT (RATHER THAN ATTEMPTING TO MODIFY IT IN PLACE) /A042 /D042 / the EDITOR wants to know when a new block has been read; /A013 /D042 / so that it knows it has written the previous block into /A013 /D042 / the edit buffer.... /A013 /D042 / AC was - 5....... /D042 /D042 RPBOT, TAD SCBOT /AC = CURRENT SCBOT /A013 /D042 JMP RPINEX /RETURN TO CALLER /A013 /D042 /D042 RPPTRS, TAD TWO /TEST FOR SCBOT CONTENTS /A013/M025 /D042 SNA CLA /SKIP IF NOT /A013 /D042 JMP RPBOT /JUMP TO SUPPLY SCBOT /A013 /D042 /D042 /AC was -4....... /D042 /D042 TAD EDBOTS /GET ORIG. SCBOT /M041 /D042 DCA SCBOT /BACK FOR EDITOR /D042 TAD EDTOPS /SAVED SCTOP /M041 /D042 JMS RPTRS1 / /D042 /D042 RPINEX, JMP I RPINIT /EXIT: RETURN TO CALLER RPTOP, IAC /INCR. MINUS AC /A042 SZA /SKIP IF EDITOR REQUEST FOR SCTOP /A042 JMP RPPTRS /JUMP IF NOT /A042 /A042 / /A042 / AC was -3....... /A042 / /A042 / ON ENTRY: MQ = pointer to caller's save area to /A042 / pass the current SCTOP and HDR ID # /A042 / /A042 / ON EXIT: MQ = HDR ID # at START of relative page /A042 / request /A042 / /A042 / AC = SCTOP at START of relative page /A042 / request /A042 / /A042 / The CURRENT SCTOP and HDR ID # (SCTPH) /A042 / are in the caller's data field /A042 /A042 /D042 TAD SCTOP /CURRENT TOP POINTER /A042 /D042 SWP /MQ = CURRENT TOP /A042 ACL /AC = POINTER TO CALLERS SAVE AREA /A042 DCA X0 /PTR TO SAVE AREA INTO X0 /A042 TAD SCTPH /CURRENT HDR ID # /A042 CDFLP /FIELD 5 /A042 DCA I X0 /SAVE CURRENT HDR ID # /A042 /D042 ACL /RETRIEVE CURRENT TOP POINTER /A042 RRAER1, IFNZRO SCTOP&7600 < ? > /SCTOP MUST BE ON PAGE 0 /A042 /OTHERWISE A CDFMYF IS NEEDED HERE /A042 TAD SCTOP /RETRIEVE CURRENT TOP POINTER /A042 DCA I X0 /TO SAVE FOR COMPARE /A042 CDFMYF /FIELD 7 /A042 /A042 TAD EDHDR /ORIG. HEADER ID # /A042 MQL /INTO THE MQ /A042 TAD EDTOPS /ORIG. SCTOP /A042 JMP RPINEX /RETURN TO CALLER /A042 /A042 RPPTRS, TAD TWO /A042 / /A042 / AC=+1 == AC WAS -4 /A042 / AC=0 == AC WAS -5 /A042 / AC=-1 == AC WAS -6 /A042 / /A042 SNA /A042 JMP RPBOT /AC WAS = -5 /A042 SPA CLA /A042 JMP RPDSIN /AC WAS = -6 /A042 / /A042 /AC was -4....... /A042 / /A042 TAD EDBOTS /GET ORIG. SCBOT /A042 DCA SCBOT /BACK FOR EDITOR /A042 TAD EDTOPS /SAVED SCTOP /A042 JMS RPTRS1 / /A042 /A042 RPINEX, JMP I RPINIT /EXIT: RETURN TO CALLER /A042 /A042 / /A042 / AC was -5 ... /A042 / /A042 / the EDITOR wants to know when a new block has been read; /A042 / so that it knows it has written the previous block into /A042 / the edit buffer.... /A042 / /A042 RPBOT, TAD SCBTH /MQ = CURRENT SCBTH /A042 MQL /A042 TAD SCBOT /AC = CURRENT SCBOT /A042 JMP RPINEX /RETURN TO CALLER /A042 /A042 / /A042 / AC WAS = -6 ... /A042 / /A042 / READ GOTO-PAGE DESCRIPTOR WORD DEFINED BY SCTOP,SCTPH; /A042 / THEN INCREMENT SCTOP,SCTPH BY CONTENTS OF MQ AT ENTRY. /A042 / /A042 RPDSIN, ACL /GET INCREMENT FOR SCTOP,SCTPH /A042 DCA RPTPIN /SAVE POST INCREMENT FOR SCTOP,SCTPH /A042 JMS RPTPDS /GET G-T-P TOP DESCRIPTOR WORD /A042 DCA RPTPDS /SAVE DESCRIPTOR WORD /A042 JMS SCTOPP /INCREMENT TOP POINTERS (SCTOP,SCTPH) /A042 RPTPIN, .-. / AMOUNT TO INCREMENT (-1,0, OR +1) /A042 TAD RPTPDS / GET ORIGINAL G-T-P DESCRIPTOR WORD /A042 JMP RPINEX /EXIT /A042 / if Go To page request FLaG is NOT set / then / return to caller / else / reset GTFLG / get pointer to appropriate descriptor / get the descriptor / retrieve the mode of the first character in the block / save in: ETXMOD / ETXMOD+1 / STXMOD / STXMOD+1 / / RPRD1, XX TAD GTFLG /GET THE GOTO PAGE REQUEST FLAG SNA /SKIP IF G-T-P REQUEST /M030 JMP RPRDEN /EXIT SPA CLA /SKIP IF GETTING ETX /A030 JMP RPCLHLD /JUMP IF GETTING STX /A030 TAD (3600 /MASK TO EXTRACT MODE BITS AND RPPTR1 /MASK WITH CURRENT DESC WORD /M030 DCA ETXMOD /STORE FOR LATER USE TAD ETXMOD /RETRIEVE MODE DCA STXMOD /FOR USE WHEN SCROLLING UP TAD T40 /MASK TO EXTRACT SHIFT/UNSHIFT BIT AND RPPTR1 /AC = SHIFT/UNSHIFT /M030 DCA ETXMOD+1 /SAVE TAD ETXMOD+1 /RETRIEVE DCA STXMOD+1 /AND SAVE FOR SCROLL UP AC0100 /MASK FOR ACTIVE-CONTROL AREA /A030 AND RPPTR1 /TO CURRENT DESC. WORD /A030 DCA RPPCTLFL /UPDATE FLAG ACCORDING TO BLOCK READ /A030 RPCLHLD,TAD (3640 /MASK TO EXTRACT MODE /A030 AND RPPTR1 /FROM CURRENT DESC. /A030 DCA HLDMOD /FOR NEXT STX BLOCK TO BE WRITTEN /A030 DCA GTFLG /CLEAR G-T-P ACTIVE FLAG /A030 RPRDEN, JMP I RPRD1 /RETURN TO CALLER /D030 RPRD3, .-. /TEMP. /D030 RPRD4, .-. /TEMP. / THIS BLOCK IS NEEDLESSLY AND CONFUSINGLY OUT OF SEQUENCE, /A042 / AND IT ALSO WASTES WORDS, SO I'M REWRITING IT AND MOVING IT /A042 / TO WHERE IT LOGICALLY BELONGS (WHY WASN'T IT THERE TO BEGIN WITH??) /A042 /D042 RPTOP, TAD ONE /INCR. MINUS AC /M025 /D042 SZA /SKIP IF EDITOR REQUEST FOR SCTOP /D042 JMP RPPTRS /JUMP IF NOT /D042 /D042 / AC was -3....... /D042 /D042 / ON ENTRY: MQ = pointer to caller's save area to /D042 / pass the current SCTOP and HDR ID # /D042 / /D042 / ON EXIT: MQ = HDR ID # at START of relative page /D042 / request /D042 / /D042 / AC = SCTOP at START of relative page /D042 / request /D042 / /D042 / The CURRENT SCTOP and HDR ID # (SCTPH) /D042 / are in the caller's data field /D042 /D042 TAD SCTOP /CURRENT TOP POINTER /A026 /D042 SWP /MQ = CURRENT TOP /A030 /D042 /AC = POINTER TO CALLERS SAVE AREA /A030 /D042 DCA X0 /PTR TO SAVE AREA INTO X0 /D042 TAD SCTPH /CURRENT HDR ID # /A026 /D042 CDFLP /FIELD 5 /A026 /D042 DCA I X0 /SAVE CURRENT HDR ID # /A026 /D042 ACL /RETRIEVE CURRENT TOP POINTER /A026 /D042 DCA I X0 /TO SAVE FOR COMPARE /A026 /D042 CDFMYF /FIELD 7 /A026 /D042 /D042 TAD EDHDR /ORIG. HEADER ID # /A009 /D042 MQL /INTO THE MQ /A009 /D042 TAD EDTOPS /ORIG. SCTOP /M041 /D042 JMP RPINEX /RETURN TO CALLER /A009 /--------------- PAGE   /WPSYS - Standalone WPS operating system & handlers / /170 EMcD 24-Sep-85 Dutch Keyboard (conditional) /169 KMD 13-Sep-85 Spanish KB (conditional) /168 EMcD 12-Sep-85 Allow UDK key as single stroke if we / are in SETUP (allows use of DO key) /167 EMcD 26_aug-85 Add Insert-Overstrike Key and move UDK key /166 EMcD 19-Aug-85 Swedish/Norwegian Keyboard layout (conditional) /165 EMcD 13-Jul-85 FAo keyboard layout (conditional) /164 RCME 11-Jul-85 Allow 8 bit GOLD things /163 EMcD 25-Jun-85 Mask chars from Panel to 7 bit for Date on / start up /162 RCME 31-May-85 Move Print Screen job start /161 MART 04-MAY-85 Add fallback for 8 bit chars on LQP02s /160 RCME 01-FEB-85 Convert to 8 bit in and out. /--------------------------- Mods below refer to V2.0 and earlier-------- /159 TCW 05-NOV-84 Add support for EIA pin 23, speed select /158 DFB 19-SEP-84 Fix to add drives 8,9 when WPS = strtup vol /157 TCW 03-SEP-84 Extend Break Time for Integral Modem (2 sec.) /156 TCW 22-AUG-84 Add ck for Integral Modem enabled /155 GDH 2-AUG-84 Added VT52 GOLD:HALT detection. /154 TCW 16-JUL-84 Change in position of Break Time bits /153 JAC 09-JUL-84 Fix problems left over from /152 /152 AH 09-JUL-84 Change/add esc def for (hypen & columm) /151 TCW 05-JUL-84 Correct modem control bits 10 & 11 /150 AH 03-JUL-84 Change tech char from F14 to F11 key /149 JAC 02-JUL-84 Changes to U1STPT /148 JAC 02-JUL-84 100 UDK Integration /147 JFS 26-JUN-84 die if not DMII or DMIII /146 DFB 22-JUN-84 Set time if boot from hard disk /145 JFS 20-JUN-84 limit RXONLN to 2 for DMIII /144 WJY 14-MAY-84 Differentiate between XPU and APU. /143 AIB 14-MAY-84 ADD PARSING OF EDTC (FOR LABONTE) /142 HLP 25-APR-84 Add D2XONF double xon flag for printer /141 DFB 18-APR-84 Date/Time fix for WPS boot other winnie systems /140 HLP 07-APR-84 Include Joan Silverston's DM III & IV changes /139 HLP 05-APR-84 Open a hole for another page of code /138 HLP 26-MAR-84 Move PTC7R0 to printer field /137 AH 21-MAR-84 Add code for column key /136 HLP 20-MAR-84 Fix hang when change comm baud rate while / printing to DD HOST /135 HLP 08-MAR-84 Restructure Patch Code to handle small LPOBUF / Moved Printer Handler inline with WPSYS / Deleted SQWAIT from Printer Handler / Moved TSTFUL from WPRINT to WPSYS / Moved PCMWT0 from resident to patch code / Replace SQSV with X0 in SQRES /134 HLP 02-MAR-84 Fix Print Buffer Wrap Pointer Clobbered / (Famous Ford / printer drops mucho chrs prblm) /133 WJY 29-FEB-84 Fix DMI Hangup function /132 DFB 23-FEB-84 Set DSKACP drive table to WINNIE(drv1) RX50(8,9) /131 DFB 14-JAN-84 Dismount vol 0 for rx50 (firmware mounts it on boot) /130 WJY 16-FEB-84 DECmate I compatability + Discard nulls sent to / the printer. /129 DFB 04-JAN-84 Fix to allow Function Key input from Master Menu /128 BCR 28-DEC-83 Moved INITONCE to WPCU2 /127 HLP 15-DEC-83 Call which resets printer handler also sets XON /126 DFB 13-DEC-83 Fix bug in command str passed from Master Menu /125 DFB 21-NOV-83 Fix date passing from Master Menu /124 DFB 21-NOV-83 Fix APU check /123 BCR 18-NOV-83 Add H2OU code 7401 = BREAK /122 DFB 16-NOV-83 Set date or cmnd if called from Master Menu /121 DFB 03-NOV-83 Fix to finnish when no winnie on system /120 DFB 28-OCT-83 Fix to set firmware type /119 EH 25-OCT-83 Set bit 5 in RXTYPE if APU board present /118 DFB 24-OCT-83 Set firmware bit in RXTYPE (40) bit 6 /117 DFB 28-SEP-83 Fix to acp device table /116 GDH 23-SEP-83 Changed initial delay time for host initialization. /115 DFB 15-SEP-83 Initialize dskacp device table for winnie /114 HLP 13-SEP-83 Make Serial Printer Handler a fixed part of WPSYS / Delete Separtely loadable Printer Handlers / Add reset capability to printer handler / Move drive sizing routine from null handler / to buffer area since null handler deleted /113 WCE 07-SEP-83 REINSTALLED GOLD-S BECAUSE PRODUCT MANAGEMENT / WANT'S IT ENABLED /112 PMM 06-SEP-83 ADD CURSOR KEYS AND NONBREAKING SPACE /111 GDH 11-JUL-83 Changed HOST INIT to only check bit 11 of / MNXONF for XON/XOF enable. /110 DFB 07-JUL-83 Compressed to set 2 pages for dskhnd /109 EPS 09-JUN-83 FIXED GOLD-S WHICH "BROKE" IN 107 (SHOULD / NOT BE ENABLED FOR CONDOR) /108 GDH 9-MAY-83 Large Host Input buffer support. / also, EZLINK temp & MT host silo code. /107 WCE 19-APR-83 Fix CMONLN code to make Communications work /106 HLP 13-APR-83 Fix DM-II initialization problem near DM1 /105 HLP 02-MAR-83 Added JMP H2INPT near TSTHSI for non CONDOR / Restore 8 bit mask in LPOCHR /104 HLP 17-FEB-83 Change LPONLN to CMONLN (LPONLN moved to / printer field) / Deconditionalize clock iot code / (standardize on what was CONDORized) /103 HLP 16-FEB-83 Make code which handles printer input do XON/XOF / and stuff everything else into a buffer. / State parser moved to printer code /-------------19-JAN-83-------SUBMITTED TO SDC DECmate-II V1.0.0----------- / THE VERSION SUBMITTED DID NOT CONTAIN EDIT101 BUT DID CONTAIN / EDIT 102 /--------------------------------------------------------------------------- /102 HLP 14-JAN-83 Make ESC-[?10-anything be a drafter printer / so will respond to both LA50 and LA100PC /101 MJS 23-DEC-82 -only "moved code around" allowing for a / clean DECmate I or DECmate I assembly / from the same WPSYS.PA / /100 HLP 20-DEC-82 Fix LQP02 SE parser--not recognizing / E[?2xn type reports / /099 HLP 12-DEC-82 Change error code for LQPSE CANCEL to 25 / /098 HLP 10-DEC-82 Fix state parser for LQP02 status reports: / to wait until terminator is received / to check for validity of digits received / to report no error status only when / E[?20;30n is received / /097 HLP 03-DEC-82 Change TIMOUT function to be a 12 bit value / that SYS upcounts once per second. Now / anybody can use it! / /096 MJS 1-DEC-82 -forgot to close a condor conditional / /095 MJS 24-NOV-82 -fixed "U1TSTLIST" (added esc seq cnt attribute) / /094 DFB 11-DFB-82 Fixed hangup when system drive = drive 4 / Replaced init deleted ver. 77 / added sel for drives 6 & 7 / /093 EPS 28-OCT-82 FIXED HALT FLAG NOT BEING CLEARED BUG / /092 MJS 22-OCT-82 -modified the timing loop for rx sizing / within "RXPOLL" call from within "PTC7R0" / /091 MJS 18-OCT-82 -modified "u1inpt" / -and redefined the code for the "SETUP" key / from "ESC [ 1 4 ~" to "ESC [ 1 3 ~" / -and redefined the code for the "BREAK" key / from "ESC [ 1 3 ~" to "ESC [ 1 5 ~" / /090 MJS 05-OCT-82 -added "PRINT SCREEN" recog to interrupt level / parsing at "u1inpt" and rewrote "U1INPT" parser / -and deleted "PRINT SCREEN" recog from "SRCHTB" / -and changed mask "P377" to "P177" / at "lpoch1" cause only 7-bit ascii to the / printers (else the LA50 would barf) / -and added terminal characteristic init / at system initialization at "INITONCE" / (issues RST "ESC c" to terminal) / /089 MJS 7-OCT-82 -modified hanging up the modem scenerio / at "H2ORST" so it doesn't issue an "XON" / -and corrected the mask of "P77" to "(17)" / at "DOBRK" cause break time was incorrect / /088 MJS 6-OCT-82 -added "EDDO" recognition to "srchtb" / /087 MJS 28-SEP-82 -added "PRINT SCREEN" recog to "SRCHTB" / /086 MJS 23-SEP-82 -added "SETUP" recoginition to "SRCHTB", / -and properly clear comm chip after error / /085 BS/MJS 07-SEP-82 -added la150 recognition in "SQPINP" / /084 MJS 07-SEP-82 -added "ARROW" keypad functionality / /083 MJS 25-AUG-82 -fixed host (comm) irq-error handling / -fixed hyphen-push/pull broken this time / by the firmware...( "pp" redefined to 34) / -changed flavor of "DTR" (negative logic) / that means 0 sets and 1 clears / -fixed "SRCH" to beep invalid key strokes, and / ("GOLD..GOLD" treated as 1 "GOLD") / ("ESC....ESC" treated as 1 "ESC") / -redefined "NODEF" = 4400 (from 4000) / because "MENU" does an "AND 3777" to make the / value positive / (cause a neg # means a menu command) / /082 MJS 20-AUG-82 added 'find', 'insert here', and 'remove' into / "SRCH" table...added "JMS HANGUP" into "XH2INI" / /081 MJS 19-AUG-82 fixed 'hyphen-pull' broken by edit '078' / /080 HLP 18-AUG-82 ALLOW LQP02 TO RECOVER FROM ASF ERRORS / /079 MJS/HLP 12-aug-82 changed "SQREST" to make cross field callable / AND to clear the printer buffer / /078 MJS 3-AUG-82 -added code to 'hang-up' the modem / (drop DTR for approx 2 seconds)... / -and added keys to "SRCH"... / -and broke-up "XH2INI" for space. / /077 EPS 15-JUL-82 FIXED HANG AT 'NORX78' / (when sizing drives 4,5,6,7) / /076 EPS 08-JUL-82 CORRECTED CLOCK TEST WITHIN 'CONT' (patches) / /075 MJS 29-JUN-82 CONDOR communications / /075T MJS 20-may-82 Temporary delay for prototype condor at / subroutine 'rxpoll' / /074 MJS 10-MAY-82 Modified and added DECmate II clock IOT's / /073 MJS 5-MAY-82 Modified 'WPEDTB' table (cond for CONDOR) / And rewrote 'SRCH' incl cond for CONDOR / /072 MJS 25-APR-82 Modified RX50/RX02 POLLING within 'PTC7R0' / /071 MJS 20-APR-82 Programmably slowed UDK execution / (conditionalized on DEMO only) / (UDK0 contains the 'delay' value) / / THE ABOVE REVISIONS ARE FOR DECMATE II (CONDOR) / The edit history below is for DECmate I /070 GDH 29-MAR-82 Fixed secondary port error detect (and port / hang condition). /069 GDH 01-MAR-82 Fixed LP input interrupt handler to handle / incoming input when handler not loaded. /068 GDH 26-FEB-82 Re-ordered interrupt chain to put printer input / 'rupts at a higher priority than kb output. /067 GDH 25-JAN-82 LA100 "who-are-you" support. /066 GDH 20-JAN-82 Eliminate possible race conditions enabling / host interrupts. /065 GDH 20-JAN-82 Bug fix for detecting Host line errors. /064 GDH 30-DEC-81 H2INIT to clear pending input host buffer. /063 GDH 08-DEC-81 Fix LQP02 state logic to cleanly detect asf / status (30 through 39). /062 GDH 03-DEC-81 Fix LQP02 sheet feeder detect logic. /061 GDH 03-DEC-81 Ignore sheet-feeded OK status. /060 AJF 02-DEC-81 Added explanation of LPONLN values /059 GDH 01-DEC-81 Added lqp handler code to do restore at / interrupt level. /058 DFB 25-NOV-81 Clear intermittent transfer flag request / during test for number of RX devices /057 GDH 24-NOV-81 Added TIMOUT variable for printer timeout / requirements. /056 GDH 21-NOV-81 Changes to SQEOT to not start FLABUZ. / Other changes (in printer) to start FLABUZ / upon reciept of error status. /055 GDH 20-NOV-81 Changes serial handler to do status request / when it sees the EOT (4) error code. /054 AJF 18-NOV-81 MADE SQRES NOT MONITOR XOFF FLAG AND BUFFER /053 GDH 17-NOV-81 RX02 Double Density support in startup. /052 GDH 10-NOV-81 Added "warm start" enhancements. /051 GDH 10-NOV-81 RX01/RX02 detection & 2drive/4drive cleanup. /050 GDH 03-NOV-81 Bug fix to zero out 1st location of LPT buffer. /049 GDH 27-OCT-81 Moved RXHAN write-out code loader. /048 GDH 26-OCT-81 Removed RXHAN from interrupt chain. /047 GDH 26-OCT-81 Made GOLD-S another GOLD-SEARCH. /046 GDH 18-OCT-81 Bug fix. don't eat up duplicate udk keys!!! /045 GDH 18-OCT-81 Distinguishmentation between function key / escape sequences and user entered escape seqs. / Cleanup of Patch code for 278 clock interrupts. /044 GDH 16-OCT-81 Implementation of 3rd TM option (DWORD). /043 GDH 6-Oct-81 Added Host error checking. /042 GDH 2-Oct-81 Moved Host initialization to WPSYS. /041 GDH 28-Sep-81 Implemented "Break Key" recognition & / implementation. /040 GDH 21-Sep-81 Host line support for primary/secondary port. / Fixed the losing of cursor keypad mode. /039 GDH 18-Sep-81 Fine tuning of auto repeat xon/xof support. /038 AJF 10-SEP-81 Removed extraneous send restore code from / sqrest and made sqwait cross field callable /037 AJF 06-SEP-81 Set com port to data terminal ready and set / to recieve /036 AJF/RS 03-SEP-81 Removed le=8 line printer interface, added / multi printer input handler, new entry points / after SQREST /035 DIM 3-SEPT-81 Fix French Gold-Halt /034 GDH 29-Aug-81 Eliminated User 2 code. / Added Terminal auto xon/xof support for / better auto-repeat handling. /033 TT 07-JUL-81 Removed superfluous conditionals / ABOVE REVISIONS ARE FOR DECMATE I VERSION 2.0 /032 GR 11-MAY-81 Inserted missing ESCAPE seq code from 78,19 /031 JM 27-MAR-81 Conditionalized power fail stuff for / IFNDEF VT278 /030 JM 24-MAR-81 Changed SQREST for WS80 to send for status / from the SQPSE as well as send a restore /027 DSS 17-MAR-81 ADDED CALL TO NEW POWER FAIL AND RECOVERY / CODE FOR WS80 LOCATED IN PRINTER FIELD. /026 JM 20-FEB-81 Changes for WS78 /025 JM 20-FEB-81 Deleted an extra definition of X0006 /024 JM 20-FEB-81 Added missing closing bracket for WS102 conditional /023 DAO 8-FEB-81 Changed Serial Printer handler to not set the / done flag just because it was XOFFED. /022 DAO 16-JAN-81 Deleted Power low check from interupt chain of / VT278 (since hardware does not support it) and / changed order of checking interupts in 278 so / COMM line is checked before keyboard and / screen. This change improved speed of CX / transmission (still limited to 4800 to screen) /0021 reg/DAO 7-JAN-81 Modified the way comm option and SQ1 are / detected to get rid of illegal micro instr /0020 LDB 16-DEC-80 Disable printer 'rupts at start-up and change / order of U1 trans./receive test /0017 LDB 14-DEC-80 Remove U2 from system & change conditionals / to test for no. of floppies correctly. / Also check if comm. is present. /016 LDB 5-DEC-80 Turn off vectored 'rupts and other unsupported / devices (modem control & comm port 1) /015 DAO 10-DEC-10 Isolated the restore and send for status / routines for the LQPSE /014 DAO 9-DEC-80 Fixed SQRES to not conflict with printer / handler when outputing ESCAPE sequences /013 DAO 4-DEC-80 NOT USED /012 DAO 2-DEC-80 Changed SQREST to be used to send for status / from the SQPSE as well as send a restore /011 DAO 21-N0V-80 Added check for EOT as input from LQPSE in the / Case of a VT278. This check will also have to / be added in routine CHKCAN for the WS80 /0010 LDB 10-Nov-80 Fix problem with RTF instr. not turning on / interrupts /009 DA0 6-NOV-80 Add to Match Table for Editor Input definition / for GOLD CMND. (GOLD [) /008 JRF 6-NOV-80 Make corrections to Match Table for Editor / Input (SRCHTB) & Editor Command Matcher (SRCH) /007 JRF 21-OCT-80 Add call to the routine that checks for / KBD buffer full & misc. additions. /006 DAO 17-OCT-80 CONDITIONALIZED ESCAPE SEQUENCES FOR ANSI MODE /0005 DAO 5-OCT-80 Deleted disabling of LA180P for 278 during / interupt handling /0004 DIM 23-SEPT-80 Merge with x3.5 /0003 DM,JM 15-SEPT-80 MERGED SCANDI AND EUROPE/ENGLISH /0002 DSS 09-JUL-80 MODIFIED FOR ENGLISH/FRENCH-CANADIAN /0001 GLT 9-Apr-80 Fixed bug in German character map table /3.4 JLZ 6-MAY-80 FIXED #RX CODE TO SET DONE FLAG /3.3 JLZ 18-FEB-80 /FIXED # OF RX INIT CODE FOR RX02 /3XX EPS 14-AUG-79 MODIFIED FOR FOREIGN LANGUAGES /3X LDB 3-MAY-78 TRY TO FIX FLOPPY CHECK FOR WT /QA3.3 MB 13-APR-78 PUT IN KL8A MADE BY BLT TO WS202 SYSTEM /III.C-2 MB 1-APR-78 PUT IN SYSTEM OPTIONS /III.C MB 27-MAR-78 PUT IN THE DP2 HANDLER FOR WS78 ONLY /III.1-1 LDB 2/28/78 CHANGE RXONLN BACK TO 4 (DEFAULT VALUE) /2.7A-1 LDB 1/28/78 FIX RXONLN FOR WT78 /2.7A KEE 12/6/77 MAKE XON/XOF A RUNTIME OPTION /2.7-1 RLT 11/18/77 DELETE 8E CHECK FOR WS200 /2.5-2 RLT 11/9/77 CHANGE MISSED INTERRUPT CATCHER /2.5-1 RLT 11/7/77 ADD TWIN-TRACK TEST CODE TO PRINTER /2.P-3 RLT 9/23/77 ADD RXONLN CHECKING /2.P-2 RLT 9/22/77 ELIM U2/H2ONLN, ADD H2 CHECKING /2.P-1 RLT 9/21/77 ELIM INTPWR, ADD INT DISABLE INSTS /2.N-2 RLT 9/20/77 ADDED PRINTER CONFIG CHECKS /2.N-1 RLT 9/14/77 ADDED UDKPRT LOGIC /2.K-1 RLT 8/31/77 WS78 CHECKS FOR EPI /2.F-1 RLT 8/4/77 COMBINED WPS-8, VT78 SOURCES / THSFLD= 0 CDFMYF= CDF THSFLD U1DXOF= 1 / WANT XON-XOF PROCESSING H2DXOF= 1 / |---------------| / |PAGE 0 CONTENTS| / |---------------| *1 JMP I .+1 / INTERRUPT CATCHER INTRPT 0 / JOB SCAN FLAG (0=ON) TSTXXX / INTERRUPT CHAIN INTPC, INTXIT, GOJOB / INTERRUPT EXIT AND PWRFAIL SAVED PC JMP I .-1 / (USED TO SET INTXIT CONTENTS VIA JMS) PWRJMP, POWRUP / PTR TO POWER START LOCN *10 / |---------------| / |INDEX REGISTERS| / |---------------| *TTYIN&177 / |------------| / |SYSTEM CALLS| - common cross field callable / |------------| U1ICHR / "TTYIN" / get 1 character from the keyboard U1OCHR / "TTYOU" / output 1 character to the screen U1XLAT / "XLTIN" / translate 7-bit char into EDITOR values U1HLTF / "TAD I HLTFLG"/ (when "U1HLTF" not 0 means GOLD Halt) UD1OPS / "UDKOPS" / H2ICHR / "HS2IN" / get 1 character from the comm line H2OCHR / "HS2OU" / put 1 character onto the comm line LPOCHR / "LPTOU" / output 1 character to the printer XENQUE / "ENQUE" / XDEQUE / "DEQUE" / XJWAIT / "JWAIT" / XJSWAP / "JSWAP" / XJSTRT / "JSTRT" / XJEXIT / "JEXIT" / SYFORK / "FRKINT" / FRKNXT / "FRKXIT" / FRKCHN, 0 / "FRKCHN" / XH2INI / "H2INIT" / INIT HOST LINE (communications device)/A042 LPICHR / "LPTIN" / receive a character from the printer /A103 / |----------------| / |USEFUL CONSTANTS| / |----------------| *CDF0 CDF 0 / "CDF0" / CIF CDF 0/ "CIDF0" / 177 / "P177" / 377 / "P377" / 77 / "P77" / 7700 / "P7700" / 3777 / "P3777" / 0 / |-----| / |CLOCK| / |-----| *CLOCK 0 / INTERRUPT COUNTER / (used by "NULJOB" for "CLKSVC") ZBLOCK 4 / TENTHS, SECONDS, MINUTES, HOURS DAMNTH, 0 MONTH, 0 YEAR, 0 DAYEAR, 0 DAWEEK, 0 PAKDAT, 0 RANDOM, 0 / RANDOM (BY NULJOB) XGETRT /"getrtf" / / LPONLN MOVED TO PRINTER FIELD AND REDEFINED /A104 CMONLN, 0 / COMMUNICATIONS HARWARE DETECTED FLAG /A104 CMADSX, 0 / LOCK WORD FOR COMMUNICATIONS / THE VALUES ARE: 0 = FREE; 1 = AX; 2 = DX; / 3 = PRINTER; 4= CX(STANDARD); 5 = DX(MAGCARD) RXONLN, 4 / #RX UNITS (sized and on-line) INTAC, NULJSB / SAVED AC AT INTERRUPT INTLK, 200 /SAVED FIELDS, LINK AT INTERRUPT /A0010 /(START WITH 'RUPTS ENABLED - BIT 4 ON) /A0010 INTMP1, 0 / TEMP FOR INTERRUPT PROCESSING U1HLTF, 0 RXTYPE, 0 / RXTYPE = 0 FOR RX01 OR 1 FOR RX02 /A050 STTYPE, 0 / STTYPE = 0 FOR COLD START, /A051 / 1 FOR WARM START. SET BY DSKHND. /A051 TIMOUT, 0 /A051 / A VALUE WHICH IS INCREMENTED /SEC /C097 EZLNTM, 0 / SAVED MNCXTM VALUE FOR CX (EZLINK) /A108 PRT8FB, 7600 / address of routine to deal with fallback /a161 /*********************************************************************** /****** LOCATIONS ON THIS PAGE AFTER HERE ARE CURRENTLY AVAILABLE FOR /A050 /****** USE BUT SHOULD BE USED SPARINGLY. THE ABOVE LOCATIONS ARE /A050 /****** DEFINED IN "WPF1" FOR SYSTEM WIDE REFERENCES. /A050 /*********************************************************************** INTMP2, 0 / 0nn,n00,0,0 / ERROR STATUS FOR HOST LINE SET HERE. /A043 BREAKF, 0 / BREAK FLAG -- = 0 MEANS IDLE /A041 / < 0 MEANS START BREAK /A041 / > 0 MEANS DOING BREAK; WAITING FOR BT /A041 TACHAR,0 / save char here while testing for 8 bit LQP02 chr output/a161 LPTRSV, 0 / save retun address of LPTOU /a161 LPTFSV, 0 / save the return field of LPTOU /a161 SRCHCA, 0 / CHARACTER BEING SEARCHED FOR. ALSO / VALUE TO RETURN TO CALLER IF MATCH WAS / FOUND FOR COMPLETE INPUT SEQUENCE. / (for each modifier) SRCHU1, 0 / (modifier built here) TSTIMT, 0 / TEMP STORAGE FOR INTEGRAL MODEM TEST /A159 P200, 200 / a constant /a161 / Moved here on Edit 163 for space reasons /M163 / O_R_D_E_R I_M_P_O_R_T_A_N_T / Moved here in edit 155 to make room/M155 RPTON, ESC;"[&177;"?&177;"8&177;";&177;"1&177;"h&177;0 RPTOFF, ESC;"[&177;"?&177;"8&177;"l&177;0 /A040 / E_N_D O_R_D_E_R I_M_P_O_R_T_A_N_T /-------- / / N O T E ...... / / The address of STUACF below is known by WPSYS and WPSETU ,so /A168 / if you move it here , CHANGE IT IN WPF1 also !!!! /A168 STUACF, 0 / Setup active flag /A168 STUCHR, 0 / Char saved when SETUP active /A168 / |-----------------------------------------------------------------| / | CLOCK IOT differences between DECmate I and DECmate II (condor) | / |-----------------------------------------------------------------| / | D E C m a t e I | / |-----------------------------------------------------------------| / / CMOD 6130 (AC) = 0 set interupt mode "vector/ |--------------------------------------------------------- (AC) = 0 disable clock for irq's / (AC) = 1 enable clock for irq's / / CLCL 6136 CLEAR CLOCK FLAG / / CLSK 6137 SKIP ON CLOCK FLAG (clear if set) / / |-----------------------------------------------------------------| / | D E C m a t e II | / |-----------------------------------------------------------------| / / 6130 SET CLOCK FLAG / / 6131 SKIP ON CLOCK FLAG (clear if set) / / 6132 NOP / 6133 NOP / 6134 NOP / / 6135 SAME AS DECMATE I / / 6136 NOP / 6137 NOP / / NOTE: that the "interrupt mode" on DECmate II is always "normal" / because there is NO "vectored" interrupts. / |-----------------------------------------------------------------| / INPUT/OUTPUT IOT'S FOR DEVICE "H2" C O M M U N I C A T I O N S / IFNDEF CONDOR < / --------------------------------------------- /A081 WRTP0= 6362 / WRITE PORT 0 /A037 WRTP1= 6366 / WRITE PORT 1 /A040 > / END IFNDEF CONDOR ----------------------------------- /A081 RACD= 6367 / RESET COMMUNICATIONS DEVICE /A037 / / 'input' / H2KCF= IOTH2I / SET PORT 0 RECIEVE FLAG H2KSF= H2KCF+1 / SKIP ON PORT 0 RECIEVE FLAG (AND CLEAR IT) H2KCC= H2KSF+1 / clear AC H2KRS= H2KCC+2 / H2KIE= H2KRS+1 / LOAD PORT 0 RECIEVE INTERRUPT ENABLE H2KRB= H2KIE+1 / READ PORT 0 COMM DEVICE (data in) PRB0= H2KRB / READ PORT 0 COMM DEVICE (data in) /A041 / / 'output' / H2TFL= IOTH2O / SET PORT 0 TRANSMIT FLAG H2TSF= H2TFL+1 / SKIP ON PORT 0 TRANSMIT FLAG (and clear it) H2TCF= H2TSF+1 / nop H2TCP= H2TCF+2 / H2TSK= H2TCP+1 / LOAD PORT 0 TRANSMIT INTERRUPT ENABLE H2TLS= H2TSK+1 / WRITE PORT 0 COMM DEVICE (data out) PTB0= H2TLS / WRITE PORT 0 COMM DEVICE (data out) /A041 / IFNDEF CONDOR < / -------------------------------------------- /A081 OPKSF= 6341 / SKIP ON PORT 1 RECIEVE FLAG /A041 OPTSF= 6351 / SKIP ON PORT 1 TRANSMIT FLAG /A041 OPRIE= 6345 / LOAD COMM PORT (1) RECEIVE ENABLE /A016 OPSIE= 6355 / LOAD COMM PORT (1) TRANSMIT ENABLE /A016 > / END IFNDEF CONDOR ----------------------------------- /A081 MCIE= 6365 / MODEM CONTROL IRQ ENABLE (WITH AC11=1) /A016 /---------------- PAGE THSJOB, 0 / CURRENT JOB PTR / TO FOLLOW INTERRUPT CHAIN SEE LABEL INTCHAIN, /A135 DOINTR, / RETURN ADDR FROM INTERRUPT CHAIN (IF ALL FAIL) START, JMP I XJSWAP / BOOT-UP SYSTEM / DECmate I clock IOT definitions CLKENB= 6135 / CLOCK ENABLE IOT /M045 CLKCLF= 6136 / 8A CLOCK CLEAR IOT /M045 CLKSKP= 6137 / CLOCK SKIP IOT /M045 CMOD= 6130 / VECTORED INTERRUPT ENABLE IOT /A016 / DECmate II (condor) clock IOT definitions CLKENB= 6135 /ac11: / Enable (AC11:1)/disable (AC11:0) clock /\clkclf= / none CLKSK2= 6131 / Skip next if clock flag=1 (then clear it) CLKSET= 6130 / Set clock flag /\cmod= / none XCLKSKP,CLKSKP /-DECmate I IOT- / IS INTERRUPT FOR CLOCK TIC? GOINTR / NO, SO START INTERUPT CHAIN CLKCLF /NOP (DECmate II)/ YES, CLEAR FLAG IF 8A /M045 ISZ CLKINT / ++++ JMP DISMS1 / BUMP TICS/TENTH TAD CLKINT+1 / ++++ DCA CLKINT / RESET FOR A NEW TENTH AC7777 / ++++ TAD CLOCK DCA CLOCK / UPDATE CLOCK COUNTER JMP DISMIS+1 / AND EXIT / / *** ---------------------------------------- *** / *** ORDER OF NEXT FEW LOCATIONS IS IMPORTANT *** / *** ---------------------------------------- *** / JMP PWRUP2 INTMQ, 5252 / 2FULL DECKS TSTLST, SRQ / HERE ON UNKNOWN INTERRUPT JMP DISMS1 / JUST EXIT IF NO INTERRUPT REQUEST ANY MORE JMP I DOINTR / ELSE RETURN TO CALLER GOPOWR, JMP I PWRJMP / |-------------------| / |interupt entry here| / |-------------------| INTRPT, / HERE ON INTERRUPT DCA INTAC / SAVE AC GTF / ++++ DCA INTLK / AND DF,LINK, ETC. JMS DOINTR / ENTER INTERRUPT CHAIN JMS DOINTR / !!MISSED IT, TRY AGAIN!! / !!!! TWICE IS ONCE TOO MANY -- CLEAR ALL !!!! / |--------------------------------| / | entry here from an UNKNOWN irq | / |--------------------------------| PWRFL1, TAD 0 / ++++ DCA INTPC / SET UP FOR POWER UP JMP TO 0 MQA / ++++ DCA INTMQ / SAVE MQ FOR POWER FAIL / CODE WAS REMOVED HERE WHICH LOOPED UNTIL THE AC LOW FLAG CLEARED /D027 / BY ITSELF INDICATING THAT AC POWER HAS BEEN RESTORED. /D027 CAF / CLEAR ALL HARDWARE FLAGS PWRUP1, POWRUP, TAD INTPC / ++++ DCA 0 / RESTORE PC TO LOC 0 TAD INTMQ / ++++ MQL / RESTORE MQ IFNZRO INTCHN-4 AC0003 / ++++ DCA IX0 / INIT FOR INTERRUPT CHAIN CHASING / DISABLE SOME INTERRUPTS... /Modem control and comm. port1 are disabled in HOST2 power up code /cause we're out of room here - LDB /Also serial printer port is disabled in the null printer handler for the /same reason - LDB AC0001 / ++++ CLKENB / START CLOCK (AGAIN) IFNDEF CONDOR < / --------------------------------------------- /A074 AC4000 /BIT 0 TO TURN OFF VECTORED INTERRUPTS /A016 CMOD /A016 > /END IFNDEF CONDOR (DECmate II only has 'normal' interrupts) /A074 JMS INTXIT / POINT INTXIT HERE FOR TIME BEING AC7775 / ++++ TAD I IX0 / ++++ DCA IX0 / GET NEXT IN CHAIN JMP I IX0 / AND EXECUTE HIM / IF NOT TSTLST, HE'LL COME BACK VIA INTXIT / OTHERWISE, WE GET A JUMP TO PWRUP2 PWRUP2, JMS INTXIT / TO RESTORE PROPER INTXIT / AND COMPLETE THE RECOVERY FROM POWER LOW / |----------------------------| / |return from interupt service| - (of a known irq) / |----------------------------| DISMIS, CLA CLL / JUST IN CASE.... SIGNAL / SET THE "SOMETHING HAPPENED" FLAG DISMS1, TAD INTLK / ++++ RTF / ++++ CLA / RESTORE FIELDS, LINK, ETC. TAD INTAC / AND AC JMP I 0 / RETURN FROM INTERRUPT / CLKINT, -1 / COUNTS TICS PER TENTH -12 / 8A TICS PER .1 SECOND XJSWAP, PATCHT / CALLED TO AVOID CPU HOGGING DCA JWAC TAD XJSWAP DCA XJWAIT / MAKE BELIEVE HE CALLED JWAIT SIGNAL JMP XJW1 / XJWAIT, XX / CALLED TO WAIT FOR EXT. EVENT DCA JWAC XJW1, JMS XJSAVE / SAVE JOB STATUS TAD THSJOB DCA PRVJOB TAD I PRVJOB / GET NEXT JOB PTR GOJOB, DCA THSJOB / MAKE IT CURRENT TAD THSJOB / THEN RESTORE HIS STUFF DCA X0 TAD I X0 / DF-LINK CLL RAR TAD CIDF0 DCA JWAC TAD I X0 / ++++ MQL / MQ TAD I X0 / ++++ DCA XJWAIT / RETURN ADDR TAD I X0 / AC JWAC, 0 / (SAVE LOC AND CIF-CDF INST) JMP I XJWAIT / GO TO IT!!! / PRVJOB, 0 / PREVIOUS JOB / XJSAVE, XX / ROUTINE TO SAVE JOB STATUS TAD THSJOB / FIND JOB STATUS SAVE AREA DCA X0 RDF / ++++ RAL / SAVE DATA FIELD AND LINK CDF THSFLD / CHANGE TO OUR FIELD DCA I X0 / SAVE DF-LINK MQA / ++++ DCA I X0 / SAVE MQ TAD XJWAIT / ++++ DCA I X0 / SAVE RETURN ADDR TAD JWAC / ++++ DCA I X0 / SAVE AC JMP I XJSAVE XJEXIT, XX / CALLED TO DE-COUPLE CURRENT JOB DCA JWAC / SAVE AC TAD XJEXIT / ++++ DCA XJWAIT / MAKE LIKE JWAIT JMS XJSAVE / SAVE JOB STATUS FOR RESTART LATER TAD I THSJOB / THEN CLIP US OUT OF CHAIN DCA I PRVJOB DCA I THSJOB / CLEAR OUR CHAIN PTR, TO SHOW NON-ACTIVE SIGNAL / MAYBE SOMEONE'S WAITING JMP GOJOB-1 / THEN GO DO NEXT JOB JKX1= XJSWAP / TEMP 1 / XJSTRT, NULJOB / CALLED TO ENTER NEW JOB IN CHAIN DCA XJS2 / SAVE JSB PTR GETRTF / ++++ DCA XJX1 / GET RTN FIELD SIGNAL TAD I XJS2 / LOOK AT JSB CHAIN PTR SZA CLA / ++++ JMP XJX1 / JUST QUIT IF NON-ZERO TAD I THSJOB / MOVE OUR CHAIN TO HIS DCA I XJS2 TAD XJS2 / ++++ DCA I THSJOB / AND CHAIN US TO HIM XJX1, CIF CDF .-. / RESTORE USER FIELD JMP I XJSTRT / THEN RETURN XJS2= JKX1 / TEMP 1 / XGETRT, XX / RTNS CIFCDF INST IN AC DCA X0 / SAVE AC FOR CALLER RDF / GET DATA FIELD TAD CIDF0 / MAKE CIF-CDF INST CDF THSFLD / MAKE EVERYTHING KOSHER JMP I XGETRT / AND RETURN /------------------ PAGE / ------------ / | NULL JOB | / ------------ NULJOB, CLA CMA / ++++ DCA INTFLG / CLEAR SIGNAL FLAG JWAIT / TRY ALL JOBS NULLP3, TAD CLOCK / ++++ SZA CLA / ++++ JMS CLKSRV / UPDATE CLOCK IF NECESSARY IFDEF CONDOR < / ---------------------------------------------- /A081 /D128 ISZ INITH2FLAG / /a078 /D128 JMP .+3 / /a090 /D128 JMS INITONCE / INITIALIZE ONCE AT POWER-UP /a090 /D128 DCA .-3 / /a090 JMS TSTPS / (TEST FOR "print screen" flag) /a090 > / END IFDEF CONDOR ------------------------------------ /A081 TAD INTFLG / ++++ SNA CLA / ++++ JMP NULJOB / LOOP ON SIGNAL ISZ RANDOM / ++++ JMP NULLP3 / WAIT LOOP TIL COUNT EXHAUSTED /d078 CLA MQA / ++++ /d078 CLL RAL / ++++ /d078 SZL / ++++ /d078 IAC / ++++ /d078 MQL / ROTATE MQ JMP NULLP3 / AND RESTART LOOP /D128 IFDEF CONDOR < / ---------------------------------------------- /A081 /D128INITH2FLAG, 5400 / changed from 7764 /M116 /D128 > / END IFDEF CONDOR ------------------------------------ /A081 XENQUE, XX / CALLED TO QUEUE A FUNCTION / / CIF 0 / ENQUE;QBLK / WHERE: / QBLK, QNAME;X;X;Z;...DATA... / / ZIS SET 0 BY ENQUE, NZ WHEN DONE / AC7777 / ++++ TAD I XENQUE / GET QBLK-1 DCA X0 ISZ XENQUE / BUMP TO RTN ADDR RDF / ++++ TAD CDF0 / GET DATA FIELD DCA XENCDF TAD CDF0 / ++++ DCA XENCDX / INIT Q SEARCH DF TAD I X0 / GET QHDR PTR DCA T1 TAD T1 XENQ1, DCA X1 XENCDX, CDF .-. / QSEARCH DF TAD I X1 / GET NEXT DF SNA / ++++ JMP XENQ2 / END OF Q, IF 0 DCA XENCDX / ELSE KEEP CHAINING TAD I X1 JMP XENQ1 / XENQ2, AC7777 / ++++ TAD X1 / ++++ DCA X1 / RESTORE INDEX TAD XENCDF / ++++ DCA I X1 / CHAIN NEW ONE TO END OF Q TAD X0 / ++++ DCA I X1 XENCDF, CDF .-. / NEW QBLK DF DCA I X0 / CLEAR CHAIN FIELDS OF NEW ONE DCA I X0 DCA I X0 / CLEAR DONE FLAG CDF 0 TAD I T1 / ++++ JSTRT / START UP SERVER AC0002 / ++++ TAD XENCDF / CONSTRUCT CIF INSTRUCTION DCA .+1 .-. / RETURN TO CALLER'S FIELD JMP I XENQUE XDEQUE, XX / CALLED BY Q SERVER / / DEQUE;QNAME / / RETURNS AC=0 IF NOTHING IN Q / ELSE, AC=CDF (QBLK FIELD) / AND X0=QBLK-1 (I.E., WORD BEFORE DONE FLAG) / CLA / ++++ TAD I XDEQUE / GET QHDR PTR GETRTF / ++++ DCA XDEQX / GET RETURN FIELD ISZ XDEQUE / BUMP TO RTN ADDR TAD I X0 / GET FIRST CDF SNA / ++++ JMP XDEQX / OUT QUICK IF NOTHING THERE DCA XDQCDF AC7777 / ++++ TAD X0 / ++++ DCA X1 / SET WRITE PTR TAD I X0 / ++++ DCA X0 / AND READ PTR JMS XDEQLX / ++++ JMS XDEQLX / "UNWIND" ONE ENTRY TAD XDQCDF / RETURN QBLK CDF IN AC ISZ XDEQUE / BUMP RTN ADDR FOR SUCCESS XDEQX, CIF CDF .-. JMP I XDEQUE / XDEQLX, XX / SUBROUTINE TO COPY FROM QBLK TO FIELD 0 XDQCDF, CDF .-. TAD I X0 CDF THSFLD DCA I X1 JMP I XDEQLX / / INPUT/OUTPUT ROUTINES FOR DEVICE "U1" / IOT DEFNS / U1KCF=IOTU1I U1KSF=U1KCF+1 U1KCC=U1KSF+1 U1KRS=U1KCC+2 U1KIE=U1KRS+1 U1KRB=U1KIE+1 / U1TFL=IOTU1O U1TSF=U1TFL+1 U1TCF=U1TSF+1 U1TCP=U1TCF+2 U1TSK=U1TCP+1 U1TLS=U1TSK+1 / / IFDEF FRENCH / ALLOW UPPER-CASE GOLD-HALT IF FRENCH /D035 IFDEF FRENCH / ALLOW UPPER-CASE GOLT-HALT IF FRENCH /A035 / IFDEF ENGLSH IFDEF ITALIAN IFDEF ITALIAN /ALLOW UPPER-CASE GOLD-HALT IF ITALIAN IFDEF ENGCAN IFDEF FRENCH IFDEF FRENCH /ALLOW UPPER-CASE GOLD-HALT IF FRENCH /A035 IFDEF DUTCH IFDEF GERMAN IFDEF V30FAO /A165 IFDEF V30FAO /A165 IFDEF SPANISH /A169 IFDEF SPANISH /A169 IFDEF V30SWE /A166 IFDEF V30SWE /A166 IFDEF V30NOR IFDEF V30NOR / U1ICHR, XX GETRTF / ++++ DCA U1ICHX / GET RETURN FIELD TAD U1ICNT / ANYTHING THERE? SNA CLA / ++++ JMP U1ICX / RETURN 0 IF NOTR TAD I U1IGET / GET CHAR SPA / ++++ DCA U1IGET / WRAP IF NEC. CIF 0 AC7777 / ++++ TAD U1ICNT / ++++ DCA U1ICNT TAD I U1IGET ISZ U1IGET / BUMP PTR ISZ U1ICHR / BUMP RETURN ADDRESS. JMP U1ICHX / EXIT /A034 U1ICX, JMS U1ARON / TURN AUTO-REPEAT BACK ON. /A034 U1ICHX, CIF CDF .-. / MAP CALLER FIELD. JMP I U1ICHR / RETURN TOO CALLER / U1IGET, U1IBUF U1ICNT, 0 / / THIS ROUTINE CHECKS WHETHER ITS ARGUMENT IS AN XON OR XOF. / IF AN XOF, IT MAKES A REGULAR RETURN WITH AC=1. / IF AN XON, IT MAKES A REGULAR RETURN WITH AC=0. / OTHERWISE, IT MAKES A SKIP RETURN WITH AC CLEARED. / / AC = INPUT CHARACTER / JMS CHKXNF / AC=1 (XOF), AC=0 (XON) / AC=0 (CHARACTER WASN'T XOF OR XON) / IFNDEF FORIN < / ----------------------------------------------- CHKXNF, XX / TAD INTMP1 / GET THE CHARACTER AND P377 / STRIP ANY MODE BITS /M160 / TAD (-XOF) / IS IT AN XOF? SNA JMP CHKXN1 / YES--JUMP TO HANDLE IT TAD (XOF-XON) / IS IT AN XON? SZA CLA ISZ CHKXNF / NO--MAKE A SKIP RETURN JMP I CHKXNF / YES--MAKE A REGULAR RETURN WITH AC=0 / CHKXN1, AC0001 / RETURN ONE TO SIGNAL XOF JMP I CHKXNF > / END IFNDEF FORIN ---------------------------------- / U1BREAK moved here to create space for TST8BT to expand. /a164 U1BREAK,/ B_R_E_A_K / /a090 /d101 JMS H2OBRK / /a090 /d101 TAD BREAKF / /A041 /a101 SZA CLA / /A041 /a101 JMP U1ENDOFLIST / (already breaking) /a101 AC7777 / SET BREAK FLAG! /A041 /a101 DCA BREAKF / ... /A041 /a101 JMS H2OTFL / WAKE UP HOST (IF NOT ALREAD) /A041 /a101 JMP U1ENDOFLIST / /a090 /------------------- PAGE / U1OCHR, XX GETRTF / ++++ DCA U1OCHX / GET RETURN FIELD TAD X0 / RESTORE AC AND P377 DCA I U1OPUT TAD U1OCNT / TEST FOR FULL TAD (-U1OSIZ) SNA CLA / ++++ JMP U1OFUL / JUMP IF SO U1OCH1, CIF 0 / DELAY RUPTS ISZ U1OCNT TAD U1BFLG / OUTPUT ALREADY RUNNING? SNA CLA / ++++ U1TFL / FORCE READY IF NOT ISZ U1OPUT / BUMP PTR TAD I U1OPUT / WRAP IF NEC. SPA / ++++ DCA U1OPUT ISZ U1OCHR / BUMP RTN ADDR FOR SUCCESS SKP CLA / CLEAR AC U1OFUL, TAD I U1OPUT / RETURN AC=CHAR TO SHOW FULL U1OCHX, CIF CDF .-. JMP I U1OCHR / U1OPUT, U1OBUF U1OCNT, 0 U1BFLG, 0 U1CTLS, DCA U1CTQF / clear "STOP" flag here U1CTLB, TAD U1BFLG / SNA CLA / U1TFL / EXINTR / EXIT U1CTQF, 0 / STOP FLAG / --------------------------------------------------------- / / -------- DEVICE "KB INPUT" INTERRUPT CHAIN ENTRY -------- /M0068 /m090 / --------------------------------------------------------- / / /-----(O_R_D_E_R important)-----/ JMP U1PWRF / POWER RESUMED ENTRY TSTUIN / INTERRRUPT CHAIN LINK TSTKBI, U1KSF / TEST THE INPUT FLAG /M0020 JMP I TSTKBI-1 / NO INPUT -- CONTINUE CHAIN. /M0068 /\jmp U1INPT / INPUT FLAG IS SET--GO GET CHAR. /A0020 /----(E_N_D order important)----/ / U1INPT, U1KRB / U1ISTO, AND P377; DCA INTMP1 / ISOLATE ONLY 8 BITS /M160 /A041 JMS CHKXNF; JMP U1CTLS / / Compare the 7-bit ascii keyboard (U1) character /a090 / to the list of "ESC" sequences in the "U1ESCLIST" /a090 /a090 TAD INTMP1 / 8-bit ascii from keyboard /M160 /a090 TAD (-ESC) / /a090 SNA CLA / /a090 JMP U1ESCSTART / "ESC" found (start of sequence)/a090 /m091 U1TSTLIST, / /a090 TAD U1ESCPOINTER / /a091 SNA CLA / /a091 JMP U1NOMATCH / /a091 /M093 TAD I U1ESCPOINTER / /a090 SNA / /a090 JMP U1NOMATCH / NO MATCHES - END OF "U1ESCLIST"/a090 /m091 CMA IAC / /a090 /m091 TAD INTMP1 / /a090 TAD SEQATTRIBUTE / N000 /a095 SNA CLA / /a090 JMP U1ESCMATCH / MATCHed 1 char of an "ESC" list /a090 / NO match / /a090 TAD I U1ESCPOINTER / /a090 ISZ U1ESCPOINTER / (ultimately moves over "jmp" /a095 SMA CLA / /a090 JMP .-3 / loop / until "JMP" within list found /a090 JMP U1TSTLIST / TRY NEXT "ESC" LIST /a090 / M_A_T_C_H_E_D at least 1 character of the "ESC" list /a090 / /a090 U1ESCMATCH, / /a090 ISZ U1ESCPOINTER / move over character that matched... /a090 TAD I U1ESCPOINTER / ...to test the next entry of the list /a090 SPA CLA / skip next if more yet to come in /a090 JMP I U1ESCPOINTER / EXECUTE functionality (of ESC) /a090 TAD (1000) / /a095 TAD SEQATTRIBUTE / /a095 JMP U1PUT / (save the keyboard character) /a090 U1HALT, / H_A_L_T / /a090 AC7777 / /a090 JMP U1ENDOFLIST / /a090 IFDEF CONDOR < / ---------------------------------------------- /A090 U1PS, / P_R_I_N_T S_C_R_E_E_N/ /a090 CDFMNU /---------------------/ /a090 ISZ I (PRNTSCREEN) / FLAG (shouldn't overflow) /a090 CDFMYF /---------------------/ /a090 > / END IFDEF CONDOR ------------------------------------ /A090 U1ENDOFLIST, / /a090 / /a090 / ENTER with the ac=0 or 7777 / /a090 / (to clear or set halt flag) / /a090 / /a090 U1NOMATCH, / /a091 DCA U1HLTF / (any keyboard char clear the halt flag/a090 SKP CLA / /a091 U1ESCSTART, / /a091 TAD (U1ESCLIST) / /a090 DCA U1ESCPOINTER / /a090 U1PUT, / DCA SEQATTRIBUTE / 0, 1000, 2000, 3000 /a095 TAD U1ICNT / CHECK FOR FULL JMS TSTFUL / DO TSTFUL ROUTINE /C135 1 / CALLER NUMBER /A007 JMS U1STUF / STUFF CHAR IN BUFFER. CHECK FOR /A045 / PANEL MEMORY ESC SEQ. (CHAR WILL BE /A045 / READY ALREADY.) /A045 JMP U1INPT / GET NEXT CHAR. /A045 EXINTR / EXIT U1ESCPOINTER, / /a090 ZBLOCK 1 / 0 means not processing ESC sequence /m091 SEQATTRIBUTE, ZBLOCK 1 / 0, 1000, 2000, 3000 /a095 / U1 out I_N_T_E_R_R_U_P_T level service / TSTU1A, DCA U1OGET / HERE FOR WRAP TSTU1O, AC0001 / ++++ DCA U1BFLG / JUST IN CASE... U1OCK1, TAD I U1ONOF / SETTING AUTO-REPEAT ON/OFF? /A034 SZA; JMP U1OXOF / JMP IF YES. /A034 TAD U1OCNT / ANYTHING MORE TO DO? SNA CLA / ++++ JMP TSTU1C / JUMP IF NOT TAD U1CTQF / STOP FLAG? SZA CLA / ++++ JMP TSTU1C / JUMP IF SO TAD I U1OGET / GET CHARACTER SPA / ++++ JMP TSTU1A / WRAP IF NECESSARY JMS U1OCHK / CHECK FOR ESC SEQ OR TERMINATOR, ETC. /A034 U1TLS / PRINT IT AC7777 / ++++ TAD U1OCNT / ++++ DCA U1OCNT / ISZ U1OGET / AND PTR EXINTR / THEN EXIT U1OGET, U1OBUF / U1MASK, IFDEF FRENCH <175> IFNDEF FRENCH <177> U1OXOF, U1TLS / PRINT IT /A034 ISZ U1ONOF / BUMP FOR NEXT TIME. /A034 EXINTR / RETURN TO CALLER. /A034 /A034 U1ONOF, RPTON / TURN AUTO-REPEAT ON/OFF. /A034 PAGE / U1BREAK, moved this edit to ceate space for TST8BT to expand /a164 U1ESCLIST,/ O_R_D_E_R I_M_P_O_R_T_A_N_T /a090 / /a090 IFDEF CONDOR < / ---------------------------------------------- /a075 / CONDOR "print screen" is "ESC [ 1 2 ~"/a090 133+0 / [ /a090 61+1000 / 1 /a090 /m095 62+2000 / 2 /a090 /m095 176+3000 / ~ (tilde) /a090 /m095 JMP U1PS / STOPPER /a090 / CONDOR "break" is "ESC [ 1 5 ~" /m091 /\133+0 / [ /\61+1000 / 1 65+2000 / 5 /m091 /m095 176+3000 / ~ (tilde) /m095 JMP U1BREAK / STOPPER > / END IFDEF CONDOR ------------------------------------ /A075 / HALT defines as "ESC O P halt" 117+0 / O /m095 120+1000 / P /m095 HALT+2000 / /M035 /m095 JMP U1HALT / /M006 /m090 120+0 / VT52 GOLD:HALT defined as ESC P halt /A155 HALT+1000 / ... /A155 JMP U1HALT / /A155 IFNDEF CONDOR < / --------------------------------------------- /A075 / BREAK KEY DEFN IS "ESC O T" /A041 /\117+0 / O /M095 124+1000 / T /M095 JMP U1BREAK / STOPPER /A041 > / END IFNDEF CONDOR ----------------------------------- /A075 0 / "ESC" list terminator /a091 / E_N_D O_R_D_E_R I_M_P_O_R_T_A_N_T /\/\/\/\/\ IFDEF FRENCH < / ---------------------------------------------- /A035 HALT1 /A035 0 /A035 1 /A035 1 /A035 > / END IFDEF FRENCH ------------------------------------ /M090 TM1= "=&177 TM2= 76 / CLOSE ANGLE BRACKET. TMBA= "A&177 TMBZ= "Z&177 TMLA= "a&177 TMLZ= "z&177 U1OCHK, XX / CHECK FOR ENTERING/TERMINATING ESC SEQ. DCA U1OTMP / SAVE CHARACTER TO OUTPUT. TAD U1OTMP / GET CHARACTER BACK. TAD (-ESC / ARE WE OUTPUTTING AN ESCAPE? SNA CLA;JMP U1ESC1 / JMP IF YES. LAST ESC SEQ (IF ANY) TERMINATED. TAD U1ESC / ARE WE IN THE MIDDLE OF AN ESC SEQ? SNA CLA;JMP U1ESC2 / JMP IF NO. LAST ESC IS TERMINATED. TAD U1OTMP / GET CHAR TO OUTPUT BACK. WE ARE IN THE MIDDLE / OF AN ESC SEQ SO CHECK FOR TERMINATORS. / TERMINATORS INCLUDE =,CLS ANG BRKT,A-Z,a-z. TAD (-TM1) / CHECK FOR TERMINATOR. SNA;JMP U1OTRM / JMP IF TERMINATOR. TAD (-TM2+TM1) SNA;JMP U1OTRM / JMP IF TERMINATOR. TAD (-TMBA+TM2) SPA;JMP U1NTRM / JMP IF NOT TERMINATOR. TAD (-TMBZ+TMBA) SPA SNA;JMP U1OTRM / JMP IF TERMINATOR. TAD (-TMLA+TMBZ) SPA;JMP U1NTRM / JMP IF NOT TERMINATOR. TAD (-TMLZ+TMLA) SMA SZA;JMP U1NTRM / JMP IF NOT TERM. U1OTRM, CLA / TERMINATOR SEEN. CLEAR "IN-ESC-SEQ" FLG, OUTPUT. DCA U1ESC / CLEAR FLAG. U1NTRM, CLA / TERMINATOR NOT SEEN. JUST OUTPUT CHARACTER. TAD U1OTMP / ... JMP I U1OCHK / RETURN TO CALLER. / / TSTU1C moved from here this edit to make space for TST8BT /a164 U1ESC1, AC0001 / SAY THAT WE ARE IN THE MIDDLE OF AN ESC SEQ. DCA U1ESC / ... U1ESC2, TAD U1OFLG / ARE WE TO SET AUTO REPEAT ON/OFF? SNA;JMP U1NTRM / NO. JUST OUTPUT CHARACTER. U1ESC3, SMA CLA;TAD (RPTON-RPTOFF) / + ==]- TURN AUTO-REPEAT ON. TAD (RPTOFF) / - ==]- TURN AUTO-REPEAT OFF. DCA U1ONOF / SET AUTO-REPEAT STRG POINTER. TAD U1OFLG / SAVE FLAG TO SAY WHAT WE JUST SWITCHED TO. DCA U1OLFG / SAVE AS "LAST FLAG". DCA U1OFLG / SAY NO PENDING FLAGS. JMP U1OCK1 / START OUTPUTTING STRING. U1OTMP, 0 / TEMP TO HOLD CHARACTER. U1OFLG, 0 / - ==]- TURN AR OFF. + ==]- TURN AR ON. 0 NADA U1OLFG, 1 / SAVED COPY OF U1OFLG. WILL EITHER BE 1 OR -1. U1ESC, 0 / 0 MEANS NOT IN ESC SEQ. NE 0 MEANS IN ESC SEQ / enter with the (AC) = 0 U1ARON, XX / ROUTINE TO TURN SET FLAGS TO CAUSE AR TO / BE TURNED ON (IF NOT ALREADY). IOF / MUST BE CALLED WITH INTERRUPTS ON!!! /d101 CLA / GET STATE OF LAST ESC SEQ SENT. /d101 TAD U1OLFG / ... SMA CLA / IF - THEN LAST SENT WAS OFF. JMP U1AONX / IF + THEN LAST SENT WAS ON AND WE ARE DONE. AC0001 / SET OFLG TO + TO INDICATE THAT AR IS TO BE DCA U1OFLG / ENABLED. TAD U1BFLG / OUTPUT GOING? SNA CLA / SKIP IF YES. U1TFL / START OUTPUT GOING. U1AONX, ION / RE-ENABLE INTERRUPTS. JMP I U1ARON / RETURN TO CALLER. / enter with the (AC) = 0 U1AROF, XX / ROUTINE TO SET FLAGS TO CAUSE AR TO BE TURNED / OFF (IF NOT ALREADY). IOF / MUST BE CALLED WITH INTERRUPTS ON!!! /d101 CLA / GET STATE OF LAST ESC SEQ. /d101 TAD U1OLFG / ... SPA CLA / IF + (WILL NEVER BE 0) THEN LAST SENT WAS ON. JMP U1AOFX / IF - THEN LAST SENT WAS OFF AND WE ARE DONE. AC7777 / SET OFLG TO - TO INDICATE THAT AR IS TO BE DCA U1OFLG / DISABLED. TAD U1BFLG / OUTPUT GOING? SNA CLA / SKIP IF YES. U1TFL / START OUTPUT GOING. U1AOFX, ION / RE-ENABLE INTERRUPTS. JMP I U1AROF / ... /Routine to trap 8 bit characters put here as no room in SRCH page. /a160 TST8BT, XX / Routine to trap non-GOLD & -ESC 8 bits/a160 DCA SRCHCA / Save the character to test /a160 TAD SRCHU1 / Check to see if GOLD or ESC current /a160 SZA CLA / If so, 8-bit search required /m164 JMP IUTST / and check for U-^ and I-" /a164 TAD SRCHCA / Get character to test /a160 AND (200) / Is it 8 bit? /a160 SNA CLA / If so return normally /a160 TST8OK, ISZ TST8BT / Else make skip return /a160 TST8EX, TAD SRCHCA / Return with preserved accumulator /a160 JMP I TST8BT / Make return /a160 IUTST, TAD SRCHCA / Get the character back /A164 TAD (-333) / Is it a U-circumflex? /a164 SZA / .... /A164 TAD (333-317) / Is it an I-umlaut? /a164 SZA CLA / .... /A164 JMP TST8OK / No, skip exit /a164 DCA SRCHU1 / Yes, therefore can not be modified as /a164 / will cause confusion with GOLD-ALT KEY/a164 JMP TST8EX /a164 /------------------ PAGE / Subroutine to get 1 character from the host input ring buffer / CALL: HS2IN; RETURN (AC)=0 if buffer empty; else RETURN (AC)=char H2ICHR, XX GETRTF / ++++ DCA H2ICHX / GET RETURN FIELD TAD H2ICNT / ANYTHING THERE? SNA CLA / ++++ JMP H2ICHX / RETURN 0 IF NOTR CDFBF1, CDF THSFLD / Map buffer field (patched at run-time)/A108 TAD I H2IGET / GET CHAR CDF THSFLD / Back to this field. /A108 SPA / ++++ DCA H2IGET / WRAP IF NEC. CIF 0 / HOLD INTERRUPTS AC7777 / ++++ TAD H2ICNT / REDUCE COUNT DCA H2ICNT AC7775 / ++++ TAD H2ICNT / ++++ SZA CLA / ++++ JMP CDFBF2 / XON NEEDED? /M108 TAD (XON) / ++++ DCA H2OXOF / DO IT IOF / TURN INTERRUPTS OFF. /A041 JMS H2OTFL / WAKE OUTPUT SIDE ION / ENABLE INTERRUPTS AGAIN. /A041 CDFBF2, CDF THSFLD / Map buffer field. /A108 TAD I H2IGET / GET CHAR ISZ H2IGET / BUMP PTR ISZ H2ICHR / BUMP RTN ADDR H2ICHX, CIF CDF .-. / Map return field. JMP I H2ICHR / RETURN / H2IGET, H2IBUF /pointer/ host input buffer (increments as buffer fills) H2ICNT, 0 /counter/ # of char's within buffer (zero means empty) / / OUTPUT 1 CHARACTER over the communications line / (enter with the contents of the AC to the character to output) / IF the AC is negative then the buffers are reset ("JMP H2ORST") / 7401 = BREAK and 7402 = HANGUP are special cases /A123 / / TAD (n); CIFSYS; HS2OU; RETURN WITH AC=CHAR MEANS BUFFER FULL; RETURN AC=0 OK / H2OCHR, XX GETRTF / GET THE RETURN FIELD DCA H2OCHX / AND SAVE IT TAD DTRTIMER / CHECK FOR HANGUP OR /A123 TAD BREAKF / BREAK IN PROGRESS /A123 SZA CLA / (CAN'T BE BOTH, SO LINK IGNORED) /A123 JMP H2OBSY / YES, GO RETURN USER'S CODE TO HIM /A123 H2INLN, TAD X0 / RESTORE AC (saved at 'getrtf') SPA / ++++ JMP H2ORST / JUMP IF RESET CALL AND P377 DCA I H2OPUT TAD H2OCNT / TEST FOR BUFFER FULL TAD (-H2OSIZ) SNA CLA / ++++ JMP H2OFUL / JUMP CAUSE BUFFER IS FULL ISZ H2OCNT / BUMP FILL COUNT ISZ H2OPUT / BUMP PTR H2OOKY, IOF / TURN INTERRUPTS OFF /A041 JMS H2OTFL / (the interrupts must be 'OFF' within "H2OTFL") ION / ENABLE INTERRUPTS AGAIN /A041 TAD I H2OPUT / WRAP IF NEC. SPA / ++++ DCA H2OPUT H2OOKX, ISZ H2OCHR / BUMP RTN ADDR FOR SUCCESS SKP CLA / CLEAR AC H2OFUL, TAD I H2OPUT / RETURN AC=CHAR TO SHOW FULL H2OCHX, CIF CDF .-. JMP I H2OCHR H2OBSY, TAD X0 / RETURN FULL AC TO CALLER /A123 JMP H2OCHX /A123 / PART OF H2ORST, ROUTINE TO RESET COMM OUTPUT /A136 H2RSET, /A123 AC7775 / ++++ TAD H2ICNT / SET TO (RE)SEND XON SPA SNA CLA / ++++ TAD (XON) DCA H2OXOF DCA H2OXON DCA H2OCNT / CLEAR FILL COUNT DCA H2CTQF / CLEAR STOP FLAG TAD H2OPUT / ++++ DCA H2OGET / REALIGN BUF PTRS JMP H2OOKY / TAKE OK RETURN / H2OPUT, H2OBUF /pointer/HOST OUTPUT BUFFER (increments as buffer fills) H2OCNT, 0 /counter/increments representing # of char's in buffer H2BFLG, 0 /flag / =1 means 'OUTPUT' going / *** ---------------------------- *** / *** INTERRUPT LEVEL CODE FOLLOWS *** - HOST (comm) input / *** ---------------------------- *** H2INPT, / JMP here for comm reciever service IFNDEF CONDOR < JMS USIOT > / DECMATE I ROUTINE /A075 H2KRB / IOT / transfer into ac:4-11 char from device IFDEF CONDOR < / ---------------------------------------------- /A075 AND P377 /mask / (cause ac0-3 is junk when condor) > / END IFDEF CONDOR ------------------------------------ /A075 DCA INTMP1 / SAVE THE INPUT CHAR DCA INTMP2 / CLEAR ERROR STATUS. /A043 JMS H2ECHK /break? / BREAK if any errors!! /A043 IFDEF CONDOR < / ---------------------------------------------- /A075 TAD (70) / DISMISS THE COMM INTERRUPT LDREG / CR0A / CLA / > / END IFDEF CONDOR ------------------------------------ /A075 / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SWSYS1, NOP / THIS INSTRUCTION IS ALTERED AT RUN TIME - IT / IS EITHER A 'NOP' OR A 'JMP SYSLOC', DEPENDING / WHETHER XON/XOF'S ARE TO BE INTERCEPTED / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JMS CHKXNF / ++++ JMP H2CTLS SYSLOC, TAD H2ICNT / GET COUNTER JMS TSTFUL / DO TSTFUL ROUTINE /C135 0 / CALLER NUMBER /A007 TAD INTMP2 / ADD IN ERROR BITS (3400) /A065 CDFBF3, CDF THSFLD / Map buffer field (patched on the fly)./A108 DCA I H2IPUT / STORE CHAR IN BUF ISZ H2ICNT / BUMP COUNTER ISZ H2IPUT / BUMP PTR TAD I H2IPUT / DO WRAP IF NECESSARY CDF THSFLD / Back to this field. /A108 SPA / ++++ DCA H2IPUT CLA / Clean up incase we exit. /A108 ISZ IX1 / set to -1 in "TSTFUL" if almost full JMP H2IEXIT / EXIT TAD (XOF) / SEND XOF IF ALMOST FULL DCA H2OXOF JMP H2CTLB H2CTLS, DCA H2CTQF / CLEAR STOP FLAG H2CTLB, TAD H2BFLG / RESTART OUTPUT SNA CLA H2OJMS, JMS TSTH2O JMP H2IEXIT / Exit interrupt. /A108 H2CTQF, 0 / STOP FLAG H2IPUT, H2IBUF /pointer/ address increments as characters come in H2OXOF, XON / / H2OXON, -XON / / /------------------ PAGE H2OTFL, XX TAD H2BFLG SNA CLA / SKIP IF ALREADY GOING. /M041 JMS TSTH2O JMP I H2OTFL / *** ---------------------------- *** / *** INTERRUPT LEVEL CODE FOLLOWS *** / *** ---------------------------- *** TSTH2A, DCA H2OGET / HERE FOR WRAP SKP TSTH2O, XX AC0001 / ++++ DCA H2BFLG TAD BREAKF / ARE WE TO DO A BREAK? /A041 SPA CLA / SKIP IF NO. /A041 JMP DOBRK / START THE BREAK GOING... /A041 TAD H2OXOF / ++++ TAD H2OXON / |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| / |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| / |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| SWSYS2, SZA CLA / THIS IS PATCHED AT RUN TIME - IT IS / EITHER 'SZA CLA' (WHEN XON/XOF IS TO BE SENT) / OR 'SKP CLA' / |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| / |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| / |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| JMP H2OXXF TAD H2OCNT / ANYTHING MORE TO DO? SNA CLA / ++++ JMP TSTH2C / JUMP IF NOT TAD H2CTQF / STOP FLAG? SZA CLA / ++++ JMP TSTH2C / JUMP IF SO TAD I H2OGET / GET CHARACTER SPA / ++++ JMP TSTH2A / WRAP IF NECESSARY IFNDEF CONDOR < / --------------------------------------------- /A075 TAD (400) / TELL SCD TO WRITE!!! JMS USIOT > / END IFNDEF CONDOR ----------------------------------- /A075 H2TLS / PRINT IT AC7777 / ++++ TAD H2OCNT / ++++ DCA H2OCNT / DECR COUNTER ISZ H2OGET / AND BUMP PTR JMP I TSTH2O H2OXXF, TAD H2OXOF IFNDEF CONDOR < / --------------------------------------------- /A075 TAD (400) / TELL SCD TO WRITE!!! JMS USIOT > / END IFNDEF CONDOR ----------------------------------- /A075 H2TLS / SEND XON OR XOF CLA TAD H2OXOF CIA DCA H2OXON / SAVE FOR LATER COMPARE JMP I TSTH2O / TSTH2C, DCA H2BFLG / CLEAR BUSY JMP I TSTH2O H2PWRF, JMS H2OFF / TURN H2 INTERRUPTS OFF. /M042 IFNDEF CONDOR < / --------------------------------------------- /A075 JMS H2ONN / ENABLE SELECTED H2 PORT. /M042 JMP H2OJMS > / END IFNDEF CONDOR ----------------------------------- /A075 IFDEF CONDOR < EXINTR > /A075 H2OGET, H2OBUF / /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ / DOBRK, AC0001 / SET "BREAK GOING" FLAG FOR "CLKSRV" /A041 DCA BREAKF / (WAS -1; STORE 1). /A041 TAD (CLOCK+1) / SET UP PTR TO CURRENT TIME. /A041 DCA CLKPT / ... /A041 TAD (TIMER) / SET UP PTR TO TIME TO STOP BREAK. /A041 DCA TIMEPT / ... /A041 TAD (CLKLIM) / SET UP PTR TO TIMER LIMITS. /A041 DCA LIMPT / ... /A041 TAD (-4) / SET UP LOOP COUNTR (10THS,SEC,MIN,HR) /A041 DCA LOOPCT / ... /A041 / /A041 JMS GETBTM / GET THE BREAK TIME /A157 DOBRK1, TAD I CLKPT / ADD IN THE CURRENT TIME. /A041 DCA I TIMEPT / SAVE THE STOP TIME. /A041 DCA OVFLOW / RESET OVERFLOW AMOUNT. /A041 DOBRK2, TAD I TIMEPT / GET IT BACK. /A041 TAD I LIMPT / SEE IF OVER THE INCREMENTAL TIME LIMIT/A041 SPA / SKIP IF YES. THE XTRA AMNT IS IN AC. /A041 JMP DOBRK3 / JMP IF TIME INCR IS OK. /A041 DCA I TIMEPT / SAVE NEW TIME. /A041 ISZ OVFLOW / SAVE OVERFLOW AMNT. /A041 JMP DOBRK2 / SEE IF STILL OVER. /A041 / /A041 DOBRK3, CLA / GET OVERFLOW AMOUNT (TO ADD IN TO /A041 TAD OVFLOW / THE NEXT THINGIE). /A041 ISZ TIMEPT / INCREMENT POINTERS FOR NEXT THINGIE. /A041 ISZ CLKPT / ... /A041 ISZ LIMPT / ..... /A041 ISZ LOOPCT / FINALLY THE LOOP COUNTER. /A041 JMP DOBRK1 / PROCESS NEXT TIME PIECE. /A041 / /A041 CLA / SET COMMAND REGISTER. /A041 TAD (10) / break / SET IT FOR A BREAK. /A041 JMS DOBIOT / DO THE BREAK IOT STUFF. /A041 JMP I TSTH2O / RETURN TO CALLER. BREAK IS GOING!!! /A041 / Subroutine to check for errors from the HOST (framing, overrun, parity) H2ECHK, XX / CHECK FOR ERROR ON INPUT LINE. /A043 IFDEF CONDOR < / ---------------------------------------------- /A075 /\cdf 0 /---[a] reg select--/ AC4000 / 'READ'/ IAC / status register #1 SELREG / IOT / SETUP CR0 CLA / RDREG / EXECUTE 'read' status register #1 /\and (377) / CLL RAR / (before RAR, bit5: FE, bit6: OVR, bit7: PE) > / END IFDEF CONDOR ------------------------------------ /A075 IFNDEF CONDOR < / --------------------------------------------- /A075 CLA / READ "SCD: INTERNAL STATUS REGISTER" /M065 TAD (1000) / ... /M065 JMS USIOT; PRB0 > / END IFNDEF CONDOR ----------------------------------- /A075 AND (70) / ISOLATE THE ERROR BITS. /A043 SNA / SKIP IF ERROR OCCURED. /A043 JMP I H2ECHK / RETURN (ZERO AC) IF NO ERROR. /A043 CLL RAR; BSW / PACK ERROR BITS INTO AC:3400 /A043 DCA INTMP2 / SAVE. /A043 TAD BREAKF / BREAK IN PROGRESS? /A065 SMA SZA CLA / SKIP IF <= 0 (BREAK NOT IN PROGRESS) /A065 TAD (10) / break / SET BREAK FLAG IF CURRENTLY BREAKING. /A065 JMS DOBIOT / WRITE COMMAND REGISTER. /A065 JMP I H2ECHK / RETURN TO CALLER. /A043 CLKPT, 0 / PTR TO CLOCK+1 TABLE /A041 TIMEPT, 0 / PTR TO TIMER TABLE. /A041 LIMPT, 0 / PTR TO CLKLIM TABLE. /A041 LOOPCT, 0 / LOOP COUNTER (4) /A041 OVFLOW, 0 / COUNTER OF # OF NEXT THINGIES (0-2) /A041 /THE CONTENTS OF THE AC AT ENTRY INTO "H2OCHR" WAS MINUS... / / 7777 means reset buffer only / 7401 means initiate a BREAK, then reset buffer /A123 / 7402 means HANG UP THE MODEM, then reset buffer /A083 / H2ORST, /A136 / THE FOLLOWING CODE WAS ADDED BECAUSE WE ALLOW THE USER TO CHANGE /A136 / THE BAUD RATE WHILE THE PRINTER IS USING THE HOST PORT (DD HOST) /A136 / WITHOUT THIS CODE THE IOT RESETTING THE BAUD RATE WOULD HALT FURTHER /A136 / HARDWARE INTERRUPTS THAT THE SOFTWARE EXPECTED, AND THE SYSTEM /A136 / WOULD HANG IN THE TIGHT LOOP NEAR H2BWT /A136 IFDEF CONDOR < /A136 IAC /SEE IF AC WAS 7777--RESET BUFFER ONLY /A136 SZA CLA / /A136 JMP H2BWT /NO, GO CHECK FOR HANGUP OR DTR /A136 IOF /TURN OFF INTERRUPTS WHILE WE DO THIS! /A136 DCA H2BFLG /RESET THE INTERRUPT EXPECTED FLAG /A136 > /END IFDEF CONDOR /A136 JMP H2RSET /GO RESET BUFFER, ETC /A136 /------------------ / / / Moved here on Edit 163 for space reasons /M163 / and later on edit 167 /M167 / / DISABLE communications (H2) IRQ's / H2OFF, XX / TURN OFF H2 INTERRUPTS. CLA / DISABLE all comm interrupts /M040 MCIE / MODEM CONTROL IRQ /A016 H2KIE / reciever irq H2TSK / transmitter irq IFNDEF CONDOR < / --------------------------------------------- /A075 OPRIE / OTHER PORT (USUALLY 1) RECEIVE /A016 OPSIE / OTHER PORT (USUALLY 1) TRANSMIT /A016 > / END IFNDEF CONDOR ----------------------------------- /A075 JMP I H2OFF / RETURN TO CALLER. /A042 PAGE / THIS IS THE SERIAL LINE PRINTER HANDLER FOR THE WS78 AND VT278. IT HANDLES / DOCUMENT DESTINATIONS DP2, SQ1, AND SQ2. / / THE IOTS / D2KSF2=6321 / SKIP ON INPUT PORT FLAG, CLEAR IF SET D2KIE2=6325 / SET/CLEAR INPUT PORT INTERRUPT ENABLE FROM AC11 D2KRB2=6326 / TRANSFER INPUT PORT TO AC(4:11) AND ENABLE INTERRUPTS / D2SPF2=6330 / SET PRINTER FLAG D2TSF2=6331 / SKIP ON PRINTER FLAG, CLEAR IF SET D2TPC2=6334 / TRANSFTER AC(4:11) TO PRINTER; DON'T ENABLE INTERRUPT D2TSK2=6335 / SET/CLEAR PRINTER INTERRUPT ENABLE FROM AC11 D2TLS2=6336 / TRANSFER AC(4:11) TO PRINTER; ENABLE INTERRUPTS / //////////////////////////////////////////////////////////////////////////// //// NOTE!! DO NOT MOVE ANY OF THE SYMBOLS FROM LPTYPE TO SQREST //////// //// WITHOUT CHANGING THE DEFINITION IN WPF1.PA!!! //////// //////////////////////////////////////////////////////////////////////////// / D2XONF IS ZERO IFF AN XON IS RECEIVED FROM THE PRINTER AND /A142 / IT IS ALREADY X'ED ON /A142 D2XONF, 1 / PRINTER DOUBLE XON FLAG /A142 LPDNFG, 1 / THE DONE FLAG (POSITIVE MEANS DONE) LPPWR, EXINTR / THE POWER FAILURE LINK LPICHN, TSTLON / THE NEXT ENTRY IN THE INTERRUPT CHAIN TSTLPO, D2TSF2 / CHECK OUTPUT FLAG. /M068 JMP I TSTLPO-1 / NO -- CONTINUE CHAIN. /M068 JMP D2CK7 / YES -- JMP TO HANDLE OUTPUT. /M068 HBCNT, D2OCNT / THIS IS A POINTER TO THE BUFFER COUNTER USED IN THIS / HANDLER. THERE IS A SIMILAR ENTRY IN THE SAME RELATIVE / POSITION IN ALL THE PRINTER HANDLERS. IT IS USED TO / ENABLE CHECKING ON THE PROGRESS OF THE HANDLERS. LPOCHR, XX JMP LPOCH1 / JUMP TO REAL ROUTINE /A011 SQREST, XX / ENTRY POINT TO SEND RESTORE TO SERIAL /A011 / PRINTER JMP SQRES / JUMP TO REAL ROUTINE /A011 D2CTQF, 0 / VARIABLE TO XON/OFF PRINTER /A036 D2GOIN, 0 / 0 WHEN NO OUTPUT INTERRUPTS PENDING. /A055 / 1 WHEN OUTPUT INTERRUPTS PENDING. /A055 LPOCH1, GETRTF / GET THE RETURN FIELD /M011 DCA D2OCHX / AND SAVE IT TAD X0 / RECOVER THE CHARACTER SPA / /A114 JMP D2ORST / IF CHR IS NEGATIVE, RESET HANDLER /A114 / THE AC NOW CONTAINS THE CHARACTER WHICH SHOULD BE OUTPUT. AND P377 / /A105 DCA TACHAR / save the character /a161 JMP TEST8B / go test for 8 bits output /a161 D2CONT, /a161 SNA / IF NOT NULL CONTINUE /A130 JMP D2OSUC / ELSE IGNORE AND TAKE SUCESS RETURN /A130 DCA I D2OPUT / WRITE INTO THE OUTPUT BUFFER TAD D2OCNT / COMPARE THE NUMBER OF CHARACTERS NOW STORED TAD NLPOSZ / WITH THE MAXIMUM SIZE / IF THE AC IS NOW ZERO, THE OUTPUTCBEFFER IS FULL. SNA CLA JMP D2OFUL / JUMP TO HANDLE A FULL BUFFER CIF 0 / TURN OFF INTERRUPTS BRIEFLY ISZ D2OCNT / INCREMENT THE BUFFER COUNT ISZ D2OPUT / INCREMENT THE BUFFER POINTER / IF THE OUTPUT HANDLER PART IS NOT ALREADY RUNNING, START IT UP. TAD LPDNFG / CHECK THE DONE FLAG--IS THE HANDLER RUNNING? SNA CLA JMP D2OCH2 / YES--SKIP THE START UP DCA LPDNFG / CLEAR THE DONE FLAG AC0001 / SAY THAT SQP IS GOING. /A055 DCA D2GOIN / ... /A055 D2SPF2 / FORCE OUTPUT TO BEGIN / NOW, IF THE POINTER NOW POINTS TO THE END OF THE BUFFER, RESET THE POINTER / TO THE BEGINNING. THE END OF THE BUFFER IS MARKED BY THE ADDRESS OF THE / BEGINNING OF THE BUFFER. D2OCH2, TAD I D2OPUT / GET THE WORD POINTED TO IN THE BUFFER SPA DCA D2OPUT / IT WAS THE END OF BUFFER FLAG--USE TO RESET / THE BUFFER POINTER D2OSUC, ISZ LPOCHR / MAKE A SKIP RETURN TO SHOW SUCCESS SKP CLA / CLEAR THE AC AND RETURN D2OFUL, TAD I D2OPUT / THE OUTPUT BUFFER WAS FULL--RETURN THE CHAR / TO SHOW FAILURE D2OCHX, CIF CDF .-. / CHANGE BACK TO THE FIELD OF THE CALLER JMP I LPOCHR / AND RETURN D2ORST, / RESET THE HANDLER /A114 AC0001 / CLEAR AC AND SET TO 1 /A114 CIFSYS / HOLD INTERRUPTS FOR A MOMENT /A114 DCA LPDNFG / SET DONE FLAG /A114 DCA D2CTQF / INSURE XON STATE /A127 DCA D2OCNT / CLEAR COUNT /A114 / WE MUST CAREFULLY ASSURE THAT THE PUT AND GET POINTERS ARE MADE EQUAL /A134 / HOWEVER, THE ORDER WE DO THIS IS IMPORTANT. WE MUST COPY THE PUT /A134 / POINTER TO THE GET POINTER, AND NOT VISA VERSA, ELSE WE CAUSE A BUG /A134 / IF WE TRY TO RESET THE HANDLER AT THE TIME THE PUT POINTER IS POINTING/A134 / TO THE BUFFER WRAP POINTER! (WE MADE THIS MISTAKE ONCE. IT CAUSES /A134 / BURSTS OF CHARACTERS TO BE MISSING AND NOT TRANSMITTED TO THE PRINTER /A134 TAD D2OPUT / GET THE PUT POINTER /A134 DCA D2OGET / MAKE GET POINTER THE SAME /A134 JMP D2OCHX / AND EXIT W/O SKIP RTN /A114 D2CK3, DCA D2OGET / WRAP POINTER TO BEGINNING OF BUFFER D2CK7, TAD I D2STAT / ARE WE PROCESSING A STATUS REQUEST? /A055 SZA;JMP D2CK8 / JMP IF YES. CONTINUE TO OUTPUT IT. /A055 TAD D2OCNT / CHECK FOR SOMETHING TO OUTPUT SNA CLA / ++++ JMP D2CK2 / NO TAD D2CTQF / SZA CLA / AM I XOFFED? JMP D2CK9 / DO XOF EXITTING. /A055 TAD I D2OGET / NO, GET CHARACTER SPA / ++++ JMP D2CK3 / IS IS REALLY A POINTER D2TLS2 / SEND AC7777 / ++++ TAD D2OCNT / ++++ DCA D2OCNT / DECRAMENT COUNTER ISZ D2OGET / MOVE POINTER EXINTR D2CK2, AC0001 DCA LPDNFG / SET TO DONE D2CK9, DCA D2GOIN / SAY NOT GOING NO MORE. /A055 EXINTR D2CK8, ISZ D2STAT / POINT TO NEXT STATUS CHAR FOR NXT TIME/A055 D2TLS2 / OUTPUT THIS STATUS CHARACTER. /A055 EXINTR / EXIT 'RUPTS. /A055 /D2CTQF, 0 /DEFINED ABOVE /D036 ICHKXN, CHKXNF NLPOSZ, -LPOSIZ D2OGET, LPOBUF D2OPUT, LPOBUF D2OCNT, 0 D2STAT, / PTR TO STATUS SEQ TO OUTPUT (IF ANY). /A055 ESCXX+2 / MUST POINT TO A PERMANENT ZERO /A103 /THE PURPOSE OF THIS ROUTINE IS TO TRANSMIT EITHER A RESTORE /OR A REQUEST FOR STATUS TO THE SERIAL LQP. IT DOES NOT USE /THE HANDLER, BECAUSE THESE REQUESTS MUST RECEIVE PRIORITY OVER WHATEVER /IS WAITING TO BE TRANSMITTED. /THE FIRST THING IT DOES IS DISABLE PRINTER INTERRUPTS. THIS ENABLES US /TO TELL WHEN THE CHARACTER HAS BEEN TRANSMITTED WITHOUT WORRYING ABOUT /THE DONE FLAG BEING CLEARED BY THE HANDLER. /WHEN TRANSMITTING A RESTORE, THE HANDLER IS FIRST XOFFED. WHEN THE LQP /COMPLETES RESTORATION, IT WILL XON THE HANDLER. IN THIS WAY, WE CAN BE SURE /NO CHARACTERS ARE TRANSMITTED DURING THE RESTORATION. / ELIMINATE POSSIBLE CORRUPTION OF D2GOIN BY KEEPING /A079 / INTERRUPTS OFF UNTIL EXIT. /A079 / ADDED CODE TO CLEAR BUFFER IF A RESTORE /A079 SQRES, GETRTF / THIS SAVES 1 WORD & DOES SAME JOB /A130 DCA SQRESX / AND SAVE IN EXIT SECTION /A079 TAD X0 / RECOVER THE SELECTION FLAG /C135 CDISYS / HOLD INTERRUPTS & MAP OUR FIELD. /A059 TAD ("0&177) / MAKE "0", "6", OR "c". /A059 DCA ESCXX+1 / SAVE. /A059 TAD (ESCXX / SET UP FOR A STATUS REQUEST. /A059 DCA D2STAT / SET POINTER... /A059 TAD X0 / RESTORE? /A059 /C135 SNA CLA / SKIP IF YES. /A059 JMP SQRES1 / JMP IF STATUS REQUEST. WE'RE DONE. /A059 AC0001 / SET XOF FLAG. /A059 DCA D2CTQF / (RESTORE IMPLIES XOF IMPLICITLY) /A059 TAD D2OPUT / CLEAR THE PRINT BUFFER /A079 DCA D2OGET / BY RESETTING THE POINTERS /A079 DCA D2OCNT / AND THE COUNT /A079 / (INTERRUPTS ARE OFF DUE TO CDISYS ABOVE /A079 SQRES1, CDISYS / STILL HOLD OFF INTERRUPTS /A079 TAD D2GOIN / IS SQP GOING? /A059 SNA CLA;D2SPF2 / START IT UP IF NOT GOING. /A059 AC0001 / SAY SQP IS GOING. /A059 DCA D2GOIN / ... /A059 SQRESX, XX / CHANGE BACK TO CALLER'S FIELD /C079 JMP I SQREST / AND RETURN /D135 SQSV, 0000 / STORES CHARACTER ON ENTRY /A036 /C135 ESCXX, ESC;0;0 / BUFFER FOR CHARACTERS OUTPUT VIA SQREST / SEPARATE FROM LPOBUF BECAUSE HANDLER / MUST BE BYPASSED IN CASE XOF OR FULL BUFFER BRKOFF, XX / /A041 /a101 JMS DOBIOT / SET COMMAND REG WITH NO BREAK./A041 /a101 DCA BREAKF / TURN BREAK FLAG OFF. /A041 /a101 DCA H2BFLG / TURN OFF "HOST BUSY" FLAG. /A041 /a101 IOF / DISABLE INTERRUPTS. /A041 /a101 JMS H2OTFL / START UP HOST OUTPUT SIDE. /A041 /a101 ION / ENABLE INTERRUPTS. /A041 /a101 JMP I BRKOFF / RETURN TO CALLER. /A041 /a101 /------------------ PAGE /FUNCTIONAL DESCRIPTION: / TSTFUL PREVENTS UNWANTED CHARACTERS FROM BEING INSERTED INTO A / DOCUMENT DUE TO INPUT FROM A KEYBOARD OR HOST AFTER THE INPUT / BUFFER HAS BECOME OR IS NEAR FULL. FOR EXAMPLE - IF THE BUFFER / HAS ONLY TWO EMPTY LOCATIONS AND A THREE CHARACTER ESC SEQ IS / TYPED BEFORE THE BUFFER HAS EMPTIED ENOUGH TO ACCOMMODATE IT, / THE ESC SEQ IS IGNORED THUS PREVENTING PARTS OF IT FROM BEING / INCLUDED IN THE DOCUMENT AS TEXT. / / TSTFUL PSEUDO-CODE / / SAVE CURRENT BUFFER COUNT / GET CALLER NUMBER FROM PARAM AT CALL+1 / IF PARAM <> HOST / THEN / DEVELOP ADDRESS OF OVERFLOW COUNT BUFFER / IF CHARACTER EQ ESC / THEN / CLEAR KBD'S OVERFLOW COUNT / IF WITHIN 2 CHARACTERS FROM END OF BUFFER / THEN / SETUP AND SAVE 3 CHARACTER DELAY / IF EXTENDED OVERFLOW FROM ESC SEQ IN PROGRESS / THEN / UPDATE OVERFLOW COUNT / EXIT ROUTINE / IF CHARACTER BUFFER FULL / THEN / EXIT ROUTINE / SETUP XON/XOF COUNT / BUFFER CHARACTER FOR RETURN / UPDATE RETURN ADDRESS / RETURN WITH CHARACTER TO CALLER / /EXIT ROUTINE / EXIT INTERRUPT WITHOUT CHARACTER / /CALLING SEQUENCE: TAD XXXCNT /GET BUFFER COUNT / CIFPRT /CIF TO PRINTER FIELD / DTSTFL /DO TSTFUL ROUTINE / 0,1, OR 2 /CALLER NUMBER / / TSTFUL IS CALLED FROM WPSYS AS ABOVE. / /INPUT PARAMETER: AC = BUFFER COUNT / / / /IMPLICIT INPUT: TSTFUL, P177, BUFCNT, OVCLST, INTMP1 (FLD. 0) / / TEMPT / / / /OUTPUT PARAMETERS: IF EXIT THROUGH TSTO21 (OK, ROOM IN BUFFER), THE/ / AC WILL CONTAIN THE CURRENT INPUT CHARACTER. IF EXIT THROUGH / / EITHER TSTF15 OR TSTF20 (NO ROOM IN BUFFER), AC WILL EQL 0. / / / /IMPLICIT OUTPUT: BUFCNT,TEMPT,IX1 (FLD. 0) / / / /COMPLETION CODES: NONE / / / /SIDE EFFECTS: / / 1) IF LOCATION OF TSTFUL IS CHANGED WPF1.PA'S DEFINITION OF / / TSTFUL MUST BE CHANGED ALSO. / / 2) THIS ROUTINE IS RUN WHILE IN THE INTERRUPT SKIP CHAIN. / / 3) IF KBD OR HOST BUFF TOO FULL TO ACCEPT INPUT, CHARACTERS ARE / / IGNORED. / / 4) THERE IS NO CHECKING DONE TO DETERMINE WHETHER INCOMING ESC / / SEQ IS 2 OR 3 CHARACTERS OR A SEQUENCE OF 4 CHARACTERS / (EX: G-HALT, G-RUL ... ETC.). ROUTINE DEFAULTS TO 4. / THUS IF BUFFER IS FULL THE NUMBER OF INCOMING CHARACTERS / SET IN THE OVERFLOW COUNT WILL BE DISREGARDED UNTIL THAT / COUNT EQUALS 0. EACH TIME AN ESC CHAR. IS DETECTED THE / OVERFLOW COUNT IS RESET BEFORE PROCEEDING. THIS IS NOT A / FOOL PROOF METHOD SINCE DIFFERENT COMBINATIONS OF GOLD-??? / (EX: G-ADV, G-BKP ... ETC.) MAY BE PARTIALLY INSERTED INTO / THE BUFFER AND OTHER PARTS REJECTED DUE TO LACK OF SPACE. / TO CORRECT THIS WE NEED A SMART TSTFUL. / 5) IN WPSYS.PA A CONDITIONALIZED NOP WAS PLACED IN THE SAME PAGE / AS SWSYS2 WHICH IS DEFINED IN WPF1.PA. THIS WAS DONE TO / AVOID CONDITIONALIZING SWSYS2 DEFINITION IN WPF1.PA. /***********************************************************************/ / / / TSTFUL--ROUTINE TO TEST IF WE ARE GETTING CLOSE TO FILLING / / THE COMMUNICATIONS INPUT BUFFER. IF SO, WE MIGHT / / HAVE TO TAKE SPECIAL ACTION / / / / TSTFUL IS CALLED FROM WPCU3 AND WPSYS / / / / TWO LOCATIONS IN THIS ROUTINE ARE PATCHED DEPENDING ON THE / / SIZE AND LOCATION OF THE COMMUNICATIONS BUFFER, WHICH CHANGES / / WHEN WE ENTER AND LEAVE COMMUNICATIONS. THESE LOCATIONS ARE / / DEFINED IN WPF1 AND PATCHED BY WPCU3: / / H2IMAX AND H2XOFP / / / /***********************************************************************/ ESCSIZ=3 /DEFAULT NUMBER OF CHARS. IN ESC. SEQ. /Entry point for TSTFUL is at the top of the page so that the /location will not change if the routine is changed. The location is /defined in WPF1.PA and if the location changes the definition in WPF1.PA /must change also. TSTFUL, XX DCA BUFCNT /SAVE BUFFER COUNT TO TEST TAD I TSTFUL /GET CALLER NUMBER PARAM AT CALL+1 SNA /SKP IF PARAM <> HOST JMP TSTO21 TAD (OVCLST) /DEVELOP ADDR OF OVERFLOW COUNT DCA TEMPT TAD I (INTMP1) /GET CHARACTER /D135 CDFMYF /CDF TO MY FIELD AND P377 /CHARACTER EQL ESC ? /M160 TAD (-ESC) SZA CLA /SKP: IF SO JMP TSTF10 DCA I TEMPT / reset overflow count TAD (-U1ISIZ-1+ESCSIZ)/WITHIN 2 CHARS. FROM BUFFER END ? TAD BUFCNT SPA CLA /SKP: IF SO JMP TSTF10 AC0004 /SET UP 4 CHAR DELAY - this may be a / four char. esc. string. ex: G - HALT DCA I TEMPT TSTF10, TAD I TEMPT /OVERFLOW FROM ESC SEQ IN PROG? SZA /SKP: IF NOT JMP TSTF15 /YES TAD (-U1ISIZ) / See if KB buffer full. JMP TSTO22 / ... TSTO21, TAD BUFCNT / See if time to send XOF yet. TAD H2XOFP / If so then set IX1 to "-1" so that / the host will get xoffed. DCA I (IX1) / TAD H2IMAX /IS BUFFER FULL? TSTO22, TAD BUFCNT SNA CLA /SKP: IF NOT JMP TSTF20 /YES - IGNORE CHAR ISZ TSTFUL /UPDATE RETURN ADDRESS TAD I (INTMP1) /RESTORE OK CHAR TO AC JMP I TSTFUL /RETURN - NOT FULL TSTF15, TAD (-1) /DECREMENT OVERFLOW COUNT DCA I TEMPT /UPDATE OVERFLOW COUNT TSTF20, TAD I (INTXIT) / get interrupt return address DCA TEMPT / save it for next JMP I JMP I TEMPT / exit interrupt without character H2IMAX, -H2ISIZ / Negative of Max Buffer Size. H2XOFP, -21 / -21 for sm buffer, -2001 for lg buffe BUFCNT, 0 / HOLDS BUFFER COUNT PASSED BY CALLER TEMPT, 0 /POINTER TO KBD BUFFER OVERFLOW COUNT / and also used as pointer for exit / interrupt. OVCLST, ZBLOCK 3 /OVCLST - HOST OVERFLOW COUNT /OVCLST+1 - KBD1 OVERFLOW COUNT /OVCLST+2 - KBD2 OVERFLOW COUNT / AT THIS POINT, WE KNOW THAT THE INTERRUPT THAT WE HAVE /A069 / INTERCEPTED WAS BECAUSE THE PRINTER WANTED TO SUPPLY AN /A069 / INPUT CHARACTER. /A069 / /A069 D2CKIO, D2KRB2 / READ INPUT /A069 DCA INTMP1 / SAVE IN A TEMPORARY /A069 JMS CHKXNF / SEE IF THE INPUT IS AN XON OR XOF /A069 JMP D2CK1 / YES--JUMP TO HANDLE IT /A069 TAD INTMP1 / RECOVER THE CHARACTER /A069 DCA I LPIPUT / AND SAVE IN BUFFER / THE SQPINP ROUTINE WAS DELETED AND THE FOLLOWING CODE ADDED REV103 ISZ LPIPUT / BUMP BUFFER POINTER TAD I LPIPUT / AND SEE IF NEED WRAP SPA DCA LPIPUT / YES, RESET POINTER CLA / NO TAD LPIPUT / SEE IF BUFFER IS FULL CIA TAD LPIGET / IF SO POINTERS WILL MATCH ISZ LPICNT / NOTIFY LPICHR THAT WE HAVE A BOGIE SZA CLA / SKIP IF FULL EXINTR / ALL OK, DISAPPEAR! / AT THIS POINT THE LPIBUF HAS OVERFLOWED DCA LPICNT / RESET THE COUNT / WE WANT TO DETECT IF THE BUFFER IS BIG ENOUGH / FOR DEVELOPMENT PURPOSES WE WILL INCLUDE A HALT HERE / SO WE CAN SEE IF WE EVER HIT IT / RESETTING THE COUNT SHOULD EFFECTIVELY CLEAR THE BUFFER / SINCE THE POINTERS ARE ALREADY KNOWN TO BE EQUAL IFDEF DEVEL NOP EXINTR / NOW WE MAY VANISH LPICHR, XX GETRTF / ++++ DCA LPICHX / GET RETURN FIELD TAD LPICNT / ANYTHING THERE? SNA CLA / ++++ JMP LPICHX / RETURN 0 IF NOTR TAD I LPIGET / GET CHAR SPA / ++++ DCA LPIGET / WRAP IF NEC. CIF 0 AC7777 / ++++ TAD LPICNT / ++++ DCA LPICNT TAD I LPIGET ISZ LPIGET / BUMP PTR ISZ LPICHR / BUMP RETURN ADDRESS. LPICHX, CIF CDF .-. / MAP CALLER FIELD. JMP I LPICHR / RETURN TOO CALLER / LPIPUT, LPIBUF LPIGET, LPIBUF LPICNT, 0 / THE INPUT CHARACTER WAS A XOF (AC=1) OR AN XON (AC=0). /A069 /A069 D2CK1, / XON OR XOF FROM PRINTER RECEIVED /A142 SZA / SEE WHICH /A142 JMP D2CK1A / XOFF, JUST GO SET IT /A142 TAD D2CTQF / XON, JUST COPY CURRENT XON/OFF FLAG /A142 DCA D2XONF / TO DOUBLE FLAG /A142 D2CK1A, /A142 DCA D2CTQF / SET THE STOP FLAG /A069 TAD D2GOIN / IS THE HANDLER BUSY? /A069 SNA CLA / SKIP IF YES. /A069 D2SPF2 / START PRINTER GOING. /A069 AC0001 / SAY PRINTER IS GOING. /A069 DCA D2GOIN / ... /A069 EXINTR / EXIT THE INTERRUPT /A069 / IFDEF CONDOR < / ---------------------------------------------- /A090 / test for "print screen" / when the contents of "PRNTSCREEN" = 0 then no print screen requested / when the contents of "PRNTSCREEN" = 4xxx then a print screen in process / when the contents of "PRNTSCREEN" = 1 then a print screen is requested TSTPS, XX / CDFMNU/---------------------/ TAD I (PRNTSCREEN) / FLAG CDFMYF/---------------------/ SPA SNA CLA / JMP I TSTPS / TAD (PSJOB) / JSTRT / START the "print screen" job / NOTE that "prntscreen" job will "dca PRNTSCREEN" and execute a "JEXIT" JMP I TSTPS / PSJOB, 0 / pointer to next "job status block" 40 / field (#2 times two) + link = 0 0 / mq PRNTSCREEN+2 / the address of the Print Screen job /m162 0 / ac > / END IFDEF CONDOR ------------------------------------ /A090 / INITONCE CODE FORMERLY AT THIS LOCATION HAS MOVED /A128 / TO WPCU2 TO AVOID A COMM INITIALIZATION RACE CONDITION. /A128 / ITS FUNCTION IS NOW PERFORMED BETWEEN LOCATIONS /A128 / CUDXIT AND CUDLUP IN THAT ROUTINE. /A128 / (END OF M112) / /---------------------- PAGE / *** ------------------------------------- *** / *** WPEDTB - MATCH TABLE FOR EDITOR INPUT *** / *** ------------------------------------- *** /THIS TABLE IS COMPATIBLE WITH VT-278 GENERATED ANSI ESCAPE SEQUENCES /THIS TABLE IS USED BY "SRCH" TO MATCH ESCAPE SEQUENCES WITH THEIR MEANINGS. / (THE MEANINGS ARE INTEGER CODES) /AN ESCAPE SEQUENCE IS VARIABLE LENGTH. ALL EXCEPT THE LAST /CHARACTER OF A SEQUENCE IS CALLED A MODIFIER. AS MODIFIERS ARE IDENTIFIED /IN THIS TABLE BY "SRCH", THE MODIFIER NUMBER IS BUILT UP. /FOLLOWING ARE THE MODIFIER SEQUENCES: / 1) ESC ESCAPE 200 / 2) ESC O ALTERNATE KEYPAD 400 / 2b/6) ESC [ pp ~ (CONDOR) alternate keypad 1400 /a073 / 2c) ESC [ p ~ /a078 / 3) ESC O P GOLD KEY 600 / 4) ESC O P ESC GOLD KEY ESCAPE 1000 / 5) ESC O P ESC O GOLD KEY ALTERNATE KEYPAD 1200 / 6b/7) ESC O P ESC [ pp ~ (CONDOR) GOLD key alt keypad 1600 /a073 / 6c) ESC O P ESC [ p ~ /A112 /FOR EXAMPLE, PRESSING GOLD MENU TRANSMITS "ESC O P M" /GOLD MENU IS ENCODED IN THIS TABLE AS 600 + M (THE VALUE OF GOLD KEY PLUS /THE VALUE OF M. FOUR PASSES THROUGH THIS TABLE WOULD BE MADE BY "SRCH" /TO MATCH GOLD MENU--THREE TO BUILD UP THE MODIFIER, AND ONE TO MATCH /THE M. /THE TABLE IS DIVIDED INTO SECTIONS--ONE FOR EACH MODIFIER. /200 IS SUBTRACTED FROM THE MODIFIER VALUE BEFORE THE ASCII VALUE /IS ADDED IN ASSEMBLING THE TABLE BECAUSE THE ASSEMBLER USES 8-BIT /ASCII VALUES WHICH ARE 200 LARGER THAN THE 7-BITS TRANSMITTED BY /M008 /THE VT-100. /THIS TABLE WAS DERIVED FROM THE ORIGINAL VERSION. IT IS DESIGNED /SPECIFICALLY FOR THE VT-100, SO THE CONDITIONAL PARTS WERE ELIMINATED. /IN ADDITION, THIS TABLE SUPPORTS VT-100 IN ANSI MODE. /M008 /NOTE: /AS IN THE ORIGINAL VERSION, ALL TABLE ENTRIES MUST BE IN ORDER FROM /LOWEST TO HIGHEST, AS "SRCH" DEPENDS ON THIS PROPERTY. EACH ENTRY IS /FOLLOWED BY ITS INTEGER CODE. /MODIFIERS: EDESC1=400 / (1) /ESCAPE /M164 EDESC2=600 / (2) /ALTERNATE KEYPAD USED /M164 EDESC3=1000 / (3) /GOLD KEY /M164 EDESC4=1200 / (4) /GOLD KEY, THEN ESCAPE /M164 EDESC5=1400 / (5) /GOLD KEY, THEN ALTERATE KEYPAD /M164 IFDEF CONDOR < / ---------------------------------------------- /A073 /Entire section below (modifier definitions) superseded by cursor /A112 / keypad stuff -- routine SRCH and the search table rewritten to /A112 / handle sequences of the form "ESC [ p ~" OR "ESC [ pp ~" /A112 / / --------------------------------------------------------------- / | Note that if the modifier is '4nnn', the entire sequence is | /A112 / | in except for the trailing tilde. To compress the table, | /A112 / | the modifier is of the form 4000 + (-translated code) | /A112 / --------------------------------------------------------------- EDESC6=1600 / CONDOR alt keypad ESC [ /M164/A112 EDES61=2000 / ESC [ 1 /M164/A112 EDES62=2200 / ESC [ 2 /M164/A112 EDES63=2400 / ESC [ 3 /M164/A112 EDESC7=2600 / GOLD CONDOR alt keypad ESC [ /M164/A112 EDES71=3000 / ESC [ 1 /M164/A112 EDES72=3200 / ESC [ 2 /M164/A112 EDES73=3400 / ESC [ 3 /M164/A112 NOFUNC=3600 /A112 > / END IFDEF CONDOR ------------------------------------ /A073 /THIS SECTION PRODUCES MATCHES WITH NO MODIFIERS. SRCHTB, 1; EDPWFL / POWER-FAIL FLAG FROM TTYIN IFNDEF CONDOR < 10; EDHYPS> / HYPHEN PUSH /M073 11; EDTAB / TAB IFNDEF CONDOR < 12; EDRBWD> / RUBOUT WORD /M073 15; EDNWLN / NEW LINE IFDEF CONDOR < 30; EDRBWD> / RUB WORD /A073 33; EDESC1 / (1) / ESCAPE 177; EDRBCH / RUBOUT CHAR /THIS SECTION IDENTIFIES SEQUENCES MODIFIED BY ESC. / All these tables have been modified this edit to accept 8 bit /a164 / characters /a164 SX=EDESC1-200 SX+233; EDESC1 / (1*) / ESC ESC (treated as one "ESC") /m083 SX+"O; EDESC2 / (2) / ALTERNATE KEYPAD IFDEF CONDOR < SX+"[;EDESC6 > / (6) / (CONDOR) alt keypad /A073 NODEF= 4400 /M101 /THIS SECTION IDENTIFIES SEQUENCES PRODUCED ON THE ALTERNATE KEYPAD. /40 IS ADDED SO THE DEFAULT EXPECTATION WILL BE LOWER CASE LETTERS. /WHERE UPPER CASE IS EXPECTED, THE 40 IS SUBTRACED OFF. SX=EDESC2-200+40 / Following section has been updated for real cursor keypad /A112 / functions. "ARROWS" is no longer needed /A112 / SX+"A-40; EDUPAR / CURSOR UP /A112 SX+"B-40; EDDNAR / CURSOR DOWN /A112 IFDEF CONDOR < / ---------------------------------------------- /A130 IFDEF LFTRGT < / --- (RIGHT/LEFT CURSOR DIFFERENT FUNCTION) --- /A112 SX+"C-40; EDRARO / CURSOR RIGHT /A112 SX+"D-40; EDLARO / CURSOR LEFT /A112 > / END IFDEF LFTRGT ------------------------------------ /A112 IFNDEF LFTRGT < / --- (RIGHT/LEFT CURSOR = ADVANCE/BACKUP) ---- /A112 SX+"C-40; EDADVN / CURSOR RIGHT (same as ADVANCE) /A112 SX+"D-40; EDBKUP / CURSOR LEFT (same as BACKUP) /A112 > / END IFNDEF LFTRGT ----------------------------------- /A112 > / END IFDEF CONDOR ------------------------------------ /A078 IFNDEF CONDOR < SX+"C-40;EDSWAP / SWAP (UPPER CASE) /M130 SX+"D-40;EDHELP > / HELP /A130 SX+"M-40;EDENTR / NE KEY (UPPER CASE) SX+"P-40;EDESC3 / (3) / GOLD KEY (UPPER CASE) SX+"Q-40;EDPAGE / DEFINE PAGE (UPPER CASE) SX+"R-40;EDDLTW / DELETE WORD (UPPER CASE) SX+"S-40;EDDLTC / DELETE CHAR (UPPER CASE) IFNDEF CONDOR < / --------------------------------------------- /A073 / the OT (break key) ignored here / because it is serviced by the keyboard handler SX+"T-40;0 / OT (Break Key) /A041 > / END IFNDEF CONDOR ----------------------------------- /A073 SX+"L; EDPSTE / PASTE SX+"M; EDSCUT / CUT SX+"N; EDSLCT / SELECT SX+"P; EDADVN / ADVANCE SX+"Q; EDBKUP / BACKUP SX+"R; EDLINE / LINE SX+"S; EDUPPR / UPPER CASE SX+"T; EDWORD / WORD SX+"U; EDPARA / PARAGRAPH SX+"V; EDBOLD / BOLD SX+"W; EDSENT / SENTENCE SX+"X; EDTABP / TAB POSITION SX+"Y; EDUNDL / UNDERLINE /THIS SECTION IDENTIFIES SEQUENCES PRECEEDED BY PRESSING GOLD. SX=EDESC3-200 IFDEF ENGLSH < IFNDEF V30FAO < /A165 IFNDEF ENGCAN < / ENGLISH DEFINITIONS ARE DEFAULT (if foreign language not defined) IFNDEF CONDOR < SX+210;EDHYPL> / HYPHEN PULL /M073 SX+211; EDINTB / TAB CENTER IFNDEF CONDOR < SX+212;EDRBSE> / RUBOUT SENTENCE /M073 SX+215; EDCRET / CURSOR RETURN IFDEF CONDOR < SX+230;EDRBSE> / RUB SENTENCE /A073 SX+233; EDESC4 / (4) / GOLD, THEN ESC SX+" ; EDRQSP / NONBREAKING SPACE /A112 SX+"'; EDREPL / REPLACE SX+",; EDFIND / FIND SX+"-; EDHYP1 / PRINTING BREAK HYPHEN SX+".; EDSRCH / CONTINUE SEARCH SX+"/; EDCONT / CONTINUE SEARCH AND SELECT SX+"0; EDUDK0 / USER DEFINED KEYS: SX+"1; EDUDK1 / #1 SX+"2; EDUDK2 / #2 SX+"3; EDUDK3 / #3 SX+"4; EDUDK4 / #4 SX+"5; EDUDK5 / #5 SX+"6; EDUDK6 / #6 SX+"7; EDUDK7 / #7 SX+"8; EDUDK8 / #8 SX+"9; EDUDK9 / #9 SX+"=; EDDICT / DICTIONARY SX+"A; EDSUBS / SUBSCRIPT SX+"B; EDBOTM / BOTTOM SX+"C; EDCENT / CENTER SX+"D; EDDEAD / DEAD KEY SX+"F; EDFILE / FILE DOCUMENT SX+"G; EDDCMT / GET DOCUMENT SX+"L; EDGETC / GET PARAGRAPH SX+"M; EDMENU / MENU SX+"N; EDNPAG / NEW PAGE SX+"P; EDPMRK / PAGE MARKER SX+"Q; EDSUPS / SUPERSCRIPT SX+"R; EDRULR / RULER /D113 IFNDEF CONDOR < /A109 SX+"S; EDFIND / GOLD-SEARCH /A047 /D113 > /A109 SX+"T; EDTOP / TOP SX+"V; EDVIEW / VIEW SX+333; EDPCMD / COMMAND (LEFT SQUARE BRACKET - VT100) /A009 SX+334; EDTIME / DATE AND TIME SX+337; EDHYP2 / INVISIBLE HYPHEN SX+340; 0 / HALT (serviced by keyboard handler) SX+373; EDPCMD / COMMAND SX+377; EDRBLN / RUBOUT LINE > /END IFNDEF ENGCAN /M008 > /END IFNDEF V30FAO /A165 > /END IFDEF ENGLSH /M008 /END OF ENGLISH SPECIAL CHARACTERS TRANSLATION /THESE ARE THE ITALIAN GOLD-KEY CHARACTERS IFDEF ITALIAN < IFNDEF CONDOR < SX+210;EDHYPL> / HYPHEN PULL /M073 SX+211; EDINTB / TAB CENTER IFNDEF CONDOR < SX+212;EDRBSE> / RUBOUT SENTENCE /M073 SX+215; EDCRET / CURSOR RETURN IFDEF CONDOR < SX+230;EDRBSE> / RUB SENTENCE /A073 SX+233; EDESC4 / (4) / GOLD, THEN ESC SX+" ; EDRQSP / NONBREAKING SPACE /A112 SX+"); EDHYP1 / PRINTING BREAK HYPHEN SX+"*; EDTIME / DATE AND TIME SX+"-; EDDICT / DICTIONARY SX+"0; EDUDK0 / USER DEFINED KEYS: SX+"1; EDUDK1 / #1 SX+"2; EDUDK2 / #2 SX+"3; EDUDK3 / #3 SX+"4; EDUDK4 / #4 SX+"5; EDUDK5 / #5 SX+"6; EDUDK6 / #6 SX+"7; EDUDK7 / #7 SX+"8; EDUDK8 / #8 SX+"9; EDUDK9 / #9 SX+":; EDSRCH / CONTINUE SEARCH SX+";; EDFIND / FIND SX+274; 0 / HALT (serviced by keyboard handler) SX+"=; EDPCMD / COMMAND SX+"A; EDSUBS / SUBSCRIPT SX+"B; EDBOTM / BOTTOM SX+"C; EDCENT / CENTER SX+"D; EDDEAD / DEAD KEY SX+"F; EDFILE / FILE DOCUMENT SX+"G; EDDCMT / GET DOCUMENT SX+"L; EDGETC / GET PARAGRAPH SX+"M; EDMENU / MENU SX+"N; EDNPAG / NEW PAGE SX+"P; EDPMRK / PAGE MARKER SX+"Q; EDSUPS / SUPERSCRIPT SX+"R; EDRULR / RULER /D113 IFNDEF CONDOR < /A109 SX+"S; EDFIND / GOLD-SEARCH /A047 /D113 > /A109 SX+"T; EDTOP / TOP SX+"V; EDVIEW / VIEW SX+377; EDRBLN / RUBOUT LINE > /END IFDEF ITALIAN /M008 / THIS COMPLETES THE ITALIAN GOLD KEY FUNCTIONS /THESE ARE THE FAO GOLD-KEY CHARACTERS IFDEF V30FAO < IFNDEF CONDOR < SX+210;EDHYPL> / HYPHEN PULL /M073 SX+211; EDINTB / TAB CENTER IFNDEF CONDOR < SX+212;EDRBSE> / RUBOUT SENTENCE /M073 SX+215; EDCRET / CURSOR RETURN IFDEF CONDOR < SX+230;EDRBSE> / RUB SENTENCE /A073 SX+233; EDESC4 / (4) / GOLD, THEN ESC SX+" ; EDRQSP / NONBREAKING SPACE /A112 SX+"'; EDHYP1 / PRINTING BREAK HYPHEN SX+"+; EDDICT / ABBREV SX+",; EDFIND / FIND SX+"-; EDCONT / CONTINUE SEARCH AND SELECT SX+".; EDSRCH / CONTINUE SEARCH SX+"0; EDUDK0 / USER DEFINED KEYS: SX+"1; EDUDK1 / #1 SX+"2; EDUDK2 / #2 SX+"3; EDUDK3 / #3 SX+"4; EDUDK4 / #4 SX+"5; EDUDK5 / #5 SX+"6; EDUDK6 / #6 SX+"7; EDUDK7 / #7 SX+"8; EDUDK8 / #8 SX+"9; EDUDK9 / #9 / SX+":; EDSRCH / CONTINUE SEARCH / SX+";; EDFIND / FIND SX+274; 0 / HALT (serviced by keyboard handler) SX+"?; EDHYP2 / Invisible Print Hyphen SX+"A; EDSUBS / SUBSCRIPT SX+"B; EDBOTM / BOTTOM SX+"C; EDCENT / CENTER SX+"D; EDDEAD / DEAD KEY SX+"F; EDFILE / FILE DOCUMENT SX+"G; EDDCMT / GET DOCUMENT SX+"L; EDGETC / GET PARAGRAPH SX+"M; EDMENU / MENU SX+"N; EDNPAG / NEW PAGE SX+"P; EDPMRK / PAGE MARKER SX+"Q; EDSUPS / SUPERSCRIPT SX+"R; EDRULR / RULER /D113 IFNDEF CONDOR < /A109 SX+"S; EDFIND / GOLD-SEARCH /A047 /D113 > /A109 SX+"T; EDTOP / TOP SX+"V; EDVIEW / VIEW SX+"`; EDPCMD / COMMAND SX+377; EDRBLN / RUBOUT LINE > /END IFDEF FAO /M008 /THESE ARE THE SPANISH GOLD-KEY CHARACTERS /A169 IFDEF SPANISH < IFNDEF CONDOR < SX+210;EDHYPL> / HYPHEN PULL /M073 SX+211; EDINTB / TAB CENTER IFNDEF CONDOR < SX+212;EDRBSE> / RUBOUT SENTENCE /M073 SX+215; EDCRET / CURSOR RETURN IFDEF CONDOR < SX+230;EDRBSE> / RUB SENTENCE /A073 SX+233; EDESC4 / (4) / GOLD, THEN ESC SX+" ; EDRQSP / NONBREAKING SPACE /A112 SX+"'; EDHYP1 / PRINTING BREAK HYPHEN SX+"+; EDDICT / ABBREV SX+",; EDFIND / FIND SX+"-; EDCONT / CONTINUE SEARCH AND SELECT SX+".; EDSRCH / CONTINUE SEARCH SX+"0; EDUDK0 / USER DEFINED KEYS: SX+"1; EDUDK1 / #1 SX+"2; EDUDK2 / #2 SX+"3; EDUDK3 / #3 SX+"4; EDUDK4 / #4 SX+"5; EDUDK5 / #5 SX+"6; EDUDK6 / #6 SX+"7; EDUDK7 / #7 SX+"8; EDUDK8 / #8 SX+"9; EDUDK9 / #9 / SX+":; EDSRCH / CONTINUE SEARCH / SX+";; EDFIND / FIND SX+274; 0 / HALT (serviced by keyboard handler) SX+"?; EDHYP2 / Invisible Print Hyphen SX+"A; EDSUBS / SUBSCRIPT SX+"B; EDBOTM / BOTTOM SX+"C; EDCENT / CENTER SX+"D; EDDEAD / DEAD KEY SX+"F; EDFILE / FILE DOCUMENT SX+"G; EDDCMT / GET DOCUMENT SX+"L; EDGETC / GET PARAGRAPH SX+"M; EDMENU / MENU SX+"N; EDNPAG / NEW PAGE SX+"P; EDPMRK / PAGE MARKER SX+"Q; EDSUPS / SUPERSCRIPT SX+"R; EDRULR / RULER /D113 IFNDEF CONDOR < /A109 SX+"S; EDFIND / GOLD-SEARCH /A047 /D113 > /A109 SX+"T; EDTOP / TOP SX+"V; EDVIEW / VIEW SX+"`; EDPCMD / COMMAND SX+377; EDRBLN / RUBOUT LINE > /END IFDEF SPANISH /A169 IFDEF DUTCH < /A170 IFNDEF CONDOR < SX+210;EDHYPL> / HYPHEN PULL /M073 SX+211; EDINTB / TAB CENTER IFNDEF CONDOR < SX+212;EDRBSE> / RUBOUT SENTENCE /M073 SX+215; EDCRET / CURSOR RETURN IFDEF CONDOR < SX+230;EDRBSE> / RUB SENTENCE /A073 SX+233; EDESC4 / (4) / GOLD, THEN ESC SX+" ; EDRQSP / NONBREAKING SPACE /A112 SX+"'; EDREPL / REPLACE SX+",; EDFIND / FIND SX+"-; EDHYP1 / PRINTING BREAK HYPHEN SX+".; EDSRCH / CONTINUE SEARCH SX+"/; EDCONT / CONTINUE SEARCH AND SELECT SX+"0; EDUDK0 / USER DEFINED KEYS: SX+"1; EDUDK1 / #1 SX+"2; EDUDK2 / #2 SX+"3; EDUDK3 / #3 SX+"4; EDUDK4 / #4 SX+"5; EDUDK5 / #5 SX+"6; EDUDK6 / #6 SX+"7; EDUDK7 / #7 SX+"8; EDUDK8 / #8 SX+"9; EDUDK9 / #9 SX+"=; EDDICT / DICTIONARY SX+"A; EDSUBS / SUBSCRIPT SX+"B; EDBOTM / BOTTOM SX+"C; EDCENT / CENTER SX+"D; EDDEAD / DEAD KEY SX+"F; EDFILE / FILE DOCUMENT SX+"G; EDDCMT / GET DOCUMENT SX+"L; EDGETC / GET PARAGRAPH SX+"M; EDMENU / MENU SX+"N; EDNPAG / NEW PAGE SX+"P; EDPMRK / PAGE MARKER SX+"Q; EDSUPS / SUPERSCRIPT SX+"R; EDRULR / RULER /D113 IFNDEF CONDOR < /A109 SX+"S; EDFIND / GOLD-SEARCH /A047 /D113 > /A109 SX+"T; EDTOP / TOP SX+"V; EDVIEW / VIEW SX+333; EDPCMD / COMMAND (LEFT SQUARE BRACKET - VT100) /A009 SX+334; EDTIME / DATE AND TIME SX+337; EDHYP2 / INVISIBLE HYPHEN SX+340; 0 / HALT (serviced by keyboard handler) SX+373; EDPCMD / COMMAND SX+377; EDRBLN / RUBOUT LINE > /END IFDEF DUTCH IFDEF V30SWE < /A166 IFNDEF CONDOR < SX+210;EDHYPL> / HYPHEN PULL /M073 SX+211; EDINTB / TAB CENTER IFNDEF CONDOR < SX+212;EDRBSE> / RUBOUT SENTENCE /M073 SX+215; EDCRET / CURSOR RETURN IFDEF CONDOR < SX+230;EDRBSE> / RUB SENTENCE /A073 SX+233; EDESC4 / (4) / GOLD, THEN ESC SX+" ; EDRQSP / NONBREAKING SPACE /A112 SX+"'; EDTIME / DATE & TIME SX+"+; EDHYP1 / PRINT HYPHEN SX+",; EDFIND / FIND SX+"-; EDCONT / CONTINUE SEARCH AND SELECT SX+".; EDSRCH / CONTINUE SEARCH SX+"0; EDUDK0 / USER DEFINED KEYS: SX+"1; EDUDK1 / #1 SX+"2; EDUDK2 / #2 SX+"3; EDUDK3 / #3 SX+"4; EDUDK4 / #4 SX+"5; EDUDK5 / #5 SX+"6; EDUDK6 / #6 SX+"7; EDUDK7 / #7 SX+"8; EDUDK8 / #8 SX+"9; EDUDK9 / #9 / SX+":; EDSRCH / CONTINUE SEARCH / SX+";; EDFIND / FIND SX+274; 0 / HALT (serviced by keyboard handler) SX+"?; EDHYP2 / Invisible Print Hyphen SX+"A; EDSUBS / SUBSCRIPT SX+"B; EDBOTM / BOTTOM SX+"C; EDCENT / CENTER SX+"D; EDDEAD / DEAD KEY SX+"F; EDFILE / FILE DOCUMENT SX+"G; EDDCMT / GET DOCUMENT SX+"L; EDGETC / GET PARAGRAPH SX+"M; EDMENU / MENU SX+"N; EDNPAG / NEW PAGE SX+"P; EDPMRK / PAGE MARKER SX+"Q; EDSUPS / SUPERSCRIPT SX+"R; EDRULR / RULER /D113 IFNDEF CONDOR < /A109 SX+"S; EDFIND / GOLD-SEARCH /A047 /D113 > /A109 SX+"T; EDTOP / TOP SX+"V; EDVIEW / VIEW SX+377; EDRBLN / RUBOUT LINE > IFDEF V30NOR < /A166 IFNDEF CONDOR < SX+210;EDHYPL> / HYPHEN PULL /M073 SX+211; EDINTB / TAB CENTER IFNDEF CONDOR < SX+212;EDRBSE> / RUBOUT SENTENCE /M073 SX+215; EDCRET / CURSOR RETURN IFDEF CONDOR < SX+230;EDRBSE> / RUB SENTENCE /A073 SX+233; EDESC4 / (4) / GOLD, THEN ESC SX+" ; EDRQSP / NONBREAKING SPACE /A112 SX+"'; EDTIME / DATE & TIME SX+"+; EDHYP1 / PRINT HYPHEN SX+",; EDFIND / FIND SX+"-; EDCONT / CONTINUE SEARCH AND SELECT SX+".; EDSRCH / CONTINUE SEARCH SX+"0; EDUDK0 / USER DEFINED KEYS: SX+"1; EDUDK1 / #1 SX+"2; EDUDK2 / #2 SX+"3; EDUDK3 / #3 SX+"4; EDUDK4 / #4 SX+"5; EDUDK5 / #5 SX+"6; EDUDK6 / #6 SX+"7; EDUDK7 / #7 SX+"8; EDUDK8 / #8 SX+"9; EDUDK9 / #9 / SX+":; EDSRCH / CONTINUE SEARCH / SX+";; EDFIND / FIND SX+274; 0 / HALT (serviced by keyboard handler) SX+"?; EDHYP2 / Invisible Print Hyphen SX+"A; EDSUBS / SUBSCRIPT SX+"B; EDBOTM / BOTTOM SX+"C; EDCENT / CENTER SX+"D; EDDEAD / DEAD KEY SX+"F; EDFILE / FILE DOCUMENT SX+"G; EDDCMT / GET DOCUMENT SX+"L; EDGETC / GET PARAGRAPH SX+"M; EDMENU / MENU SX+"N; EDNPAG / NEW PAGE SX+"P; EDPMRK / PAGE MARKER SX+"Q; EDSUPS / SUPERSCRIPT SX+"R; EDRULR / RULER /D113 IFNDEF CONDOR < /A109 SX+"S; EDFIND / GOLD-SEARCH /A047 /D113 > /A109 SX+"T; EDTOP / TOP SX+"V; EDVIEW / VIEW SX+377; EDRBLN / RUBOUT LINE > /THIS SECTION IDENTIFIES THE SEQUENCE PRECEDED BY GOLD, ESC. /AND GOLD-8 BIT CHARACTERS, WHICH WILL NEVER CLASH WITH GOLD-ESC AS /U-CIRCUMFLEX (EQUIV TO GOLD-ESC-[) AND I-UMLAUT (EQUIV TO GOLD-ESC-O) /HAVE BEEN TRAPPED OUT IN 'TST8BT' AND CAN NOT BE USED AS GOLD-command /KEYS. (THIS IS OK AS THEY DO NOT OCCUR ON ANY NATIONALITIES KEYBOARD) SX=EDESC4-200 IFDEF ITALIAN < SX+260; EDHYP2 / INVISIBLE HYPHEN (8-bit degree) > SX+"O; EDESC5 / (5) / GOLD, THEN ALTERNATE KEYPAD IFDEF CONDOR < SX+"[;EDESC7 > / (7) GOLD key alternate key pad /A073 IFDEF V30FAO < SX+321; EDREPL / Replace (8-bit N~) /A165 SX+347; EDTIME / Date and time (8 bit c cedilla) /A165 SX+361; EDREPL / Replace (8 bit n~) /A165 > IFDEF SPANISH < SX+321; EDREPL / Replace (8-bit N~) /A169 SX+347; EDTIME / Date and time (8 bit c cedilla) /A169 SX+361; EDREPL / Replace (8 bit n~) /A169 > IFDEF ITALIAN < SX+354; EDPCMD / COMMAND (8-bit i-grave) /A009 SX+362; EDCONT / CONTINUE SEARCH AND SELECT (8-bit o-grave) SX+371; EDREPL / REPLACE (8-bit u-grave) > IFDEF V30SWE < SX+344; EDREPL / REPLACE (A UMLAUT) /A166 SX+345; EDPCMD / COMMAND (A RING) /A166 SX+374; EDDICT / ABBREV (U UMLAUT) /A166 > IFDEF V30NOR < SX+345; EDPCMD / COMMAND (A RING) /A166 SX+346; EDREPL / REPLACE (AE Ligature) /A166 SX+370; EDDICT / ABBREV (U UMLAUT) /A166 > /THIS SECTION IDENTIFIES SEQUENCES PRECEDED BY GOLD, ALT KEYPAD. SX=EDESC5-200+40 IFDEF CONDOR < / ---------------------------------------------- /A082 SX+"A-40; EDGBKP / GOLD CURSOR UP = GOLD BACKUP /A112 SX+"B-40; EDGADV / GOLD CURSOR DOWN = GOLD ADVANCE /A112 SX+"C-40; EDGRAR / GOLD CURSOR RIGHT (END OF LINE) /A112 SX+"D-40; EDGLAR / GOLD CURSOR LEFT (BEGIN OF LINE) /A112 SX+"M-40;EDSWAP / SWAP /A073 SX+"P-40;EDESC3 / (3*) / GOLD...GOLD (treated as one "GOLD") /M083 > / END IFDEF CONDOR ------------------------------------ /A082 IFNDEF CONDOR < / --------------------------------------------- /A130 SX+"A-40; EDPRSC / GOLD CURSOR UP = PREVIOUS SCREEN /A130 SX+"B-40; EDNXSC / GOLD CURSOR DOWN = NEXT SCREEN /A130 SX+"D-40; EDDO / GOLD CURSOR LEFT = DO /A130 > / END IFNDEF CONDOR ----------------------------------- /A130 SX+"Q-40;EDGPGE / GOLD DEFINE PAGE (UPPER CASE) SX+"R-40;EDUDLT / UNDELETE (UPPER CASE) SX+"S-40;EDUDLT / UNDELETE (UPPER CASE) SX+"L; EDGPST / GOLD PASTE SX+"M; EDGCUT / GOLD CUT SX+"P; EDGADV / GOLD ADVANCE SX+"Q; EDGBKP / GOLD BACKUP / GOLD LINE IS NOT A LEGAL FUNCTION. IT'S DEFINED HERE TO PREVENT /A008 / THE EDITOR COMMAND MATCHER FROM INTERPRETING "ESC O P ESC O r" /A008 / AS "ESC O P ESC O R" (UNDELETE). GOLD LINE WILL ADVANCE THE /A008 / CURSOR TO THE BEGINNING OF THE NEXT LINE (SAME AS LINE). /A008 SX+"R; EDLINE / GOLD LINE /A008 SX+"S; EDLOWR / LOWER CASE SX+"V; EDUBLD / UNBOLD SX+"X; EDCOLM / NEW KEY FOR COLUMM (GOLD TABPOS) /A152 SX+"Y; EDUUDL / REMOVE UNDERLINE / This entire section redone for the cursor keypad application /A112 IFDEF CONDOR < / ------------------------------------------ /A112 /THIS SECTION IDENTIFIES SEQUENCES PRODUCED ON CONDOR ALTERNATE KEYPAD /A112 SX=EDESC6-200 /ESC [ p ~ or ESC [ pp ~ /A112 SX+"1; EDES61 /A112 SX+"2; EDES62 /A112 SX+"3; EDES63 /A112 SX+"4; 4000-EDSLCT /p=4 SELECT /A112 SX+"5; 4000-EDPRSC /p=5 PREV SCREEN /A112 SX+"6; 4000-EDNXSC /p=6 NEXT SCREEN /A112 SX+"A; EDUPAR /CURSOR UP /A112 SX+"B; EDDNAR /CURSOR DOWN /A112 IFDEF LFTRGT < / -- (RIGHT/LEFT CURSOR DIFFERENT FUNCTION) -- /A112 SX+"C; EDRARO /CURSOR RIGHT /A112 SX+"D; EDLARO /CURSOR LEFT /A112 > / END IFDEF LFTRGT ------------------------------------ /A112 IFNDEF LFTRGT < / --- (RIGHT/LEFT CURSOR = ADVANCE/BACKUP) --- /A112 SX+"C; EDADVN /CURSOR RIGHT = ADVANCE /A112 SX+"D; EDBKUP /CURSOR LEFT = BACKUP /A112 > /END IFNDEF LFTRGT /A112 SX=EDES61-200 /A112 SX+"2; 4000 /pp=12 PRINT SCREEN (ignore) /A112 SX+"3; 4000-EDSETUP /pp=13 SETUP /A112 SX+"5; 4000 /pp=15 BREAK (ignore) /A112 SX+"~; EDFIND /p=1 FIND /A112 SX=EDES62-200 /A112 IFDEF CONDOR < /A143 SX+"3; 4000-EDTC /pp=23 TECH CHAR (F11 [ESC]) /C150 /A143 SX+"4; 4000-EDHYPS /pp=24 NEW HYPEN-PUSH (F12) /A152 SX+"5; 4000-EDRBWD /pp=25 NEW RUB-WORD (F13) /A152 > /END IFDEF CONDOR /A143 SX+"6; 4000-EDINOV /pp=26 UDK KEY (F14) Now INsert-Overstrike / key /M167 /A148 SX+"8; 4000-EDHELP /pp=28 HELP /A112 SX+"9; 4000-EDUDKY /pp=29 DO- Now UDK key /A167 /A112 SX+"~; EDPSTE /p=2 INSERT = PASTE /A112 SX=EDES63-200 /A112 /D152 SX+"3; 4000-EDCOLM /PP=33 COLUMN KEY /A137 SX+"4; 4000-EDHYPS /pp=34 HYPHEN PUSH /A112 SX+"~; EDSCUT /p=3 REMOVE = CUT /A112 /THIS SECTION IDENTIFIES SEQUENCES PRODUCED BY GOLD CONDOR ALT KEYPAD /A112 / NOTE: NOFUNC modifier is necessary so that the search routine /A112 / will eat the final tilde and then return an invalid code. /A112 / Without this, the invalid code is detected before the tilde /A112 / comes in and the tilde is then taken as the next (valid) /A112 / character. /A112 SX=EDESC7-200 / GOLD ESC [ p ~ or GOLD ESC [ pp ~ /A112 SX+"1; NOFUNC /p=1 GOLD FIND (NO FUNCTION) /A112 /D153 SX+"2; 4000-EDGPST /p=2 GOLD INSERT = GOLD PASTE /A112 SX+"2; EDES72 /GET PAST ESC [ 2 /A153 SX+"3; EDES73 /A112 SX+"4; NOFUNC /p=4 GOLD SELECT (NO FUNCTION) /A112 SX+"5; NOFUNC /p=5 GOLD PREV SCREEN (NO FUNCTION) /A112 SX+"6; NOFUNC /p=6 GOLD NEXT SCREEN (NO FUNCTION) /A112 SX+"A; EDGBKP /GOLD CURSOR UP = GOLD BACKUP /A112 SX+"B; EDGADV /GOLD CURSOR DOWN = GOLD ADVANCE /A112 SX+"C; EDGRAR /GOLD CURSOR RIGHT = END OF LINE /A112 SX+"D; EDGLAR /GOLD CURSOR LEFT = BEGIN OF LINE /A112 SX=EDES72-200 /A152 SX+"4; 4000-EDHYPL / NEW HYPEN-PULL (GOLD F12) G $ [ 2 4 ~ /C153 SX+"5; 4000-EDRBSE / NEW RUB-SENTENCE (GOLD F13) G $[25~ /C153 SX+"~; EDGPST / ESC [ 2 ~ /A153 SX=EDES73-200 /A112 SX+"4; 4000-EDHYPL /pp=34 GOLD HYPHEN PULL /A112 SX+"~; EDGCUT /p=3 GOLD REMOVE = GOLD CUT /A112 > / END IFDEF CONDOR ------------------------------------ /A073 7777 / **** END OF TABLE TERMINATOR **** /---------------- / PAGE / Allow underflow from next page /D152 MN1FLD= 20 U1XLAT, XX GETRTF / ++++ DCA U1XCHX /"ARROWS" superseded by cursor keypad application / U1XLA1, DCA U1XLT2 /[A0034] INIT TO NO CHAR. U1XLA2, TAD U1HLTF / GET HALT FLAG /D148 CDF MN1FLD / CALL A ROUTINE TO RETURN A CHAR JMS GETUDK / FROM THE CURRENT UDK IF ONE IS ACTIVE JMP U1XLA3 / NO UDK ACTIVE /D148 CDF MN1FLD / CHECK TO SEE IF CHAR /D148 JMS CHKUDK / IS ANOTHER UDK ? CIFMNU /A148 JMS I CHKUDX /A148 SKP / NO, JUST RETURN CHAR. (INHIBIT MAY /M046 / HAVE BEEN SET) /M046 JMP U1XLA2 / YES, GET CHAR FROM NEW UDK DCA U1XLT2 / SAVE CHAR. /A046 JMP U1XLA8 / TAKE SUCCESS RETURN. /A046 / U1XLA3, CDFSYS / BACK TO HOME FIELD U1XLAA, /A122 PCMRDJ=JMP PCMDAT /SET JMP FOR OVERLAY FROM HERE /A122 NOP /GET DATE FROM PAN MEM IF WINNIE FIRMWARE/A122 TTYIN / ++++ JMP U1XLA9 / GET NEXT CHAR FROM KEYBOARD U1XLAB, /122 AND P377 /M160 JMS SRCH / ++++ SPA / ++++ JMP U1XLA4 / CHECK FOR UDK KEY IF SPECIAL TAD (-40) / ++++ SPA / ++++ JMP U1XLA3 / IGNORE IF CNTL TAD (40) JMP U1XLA5 / PROCESS GOTTEN CHARACTER BELOW. /A046 /A046 U1XLA4, /C148 /D148 CDF MN1FLD / CHECK TO SEE IF CHAR /A046 /D148 JMS CHKUDK / IS ANOTHER UDK ? /A046 /D148 SKP / NO, JUST RETURN CHAR. (INHIBIT MAY /A046 /D148 / HAVE BEEN SET) /A046 /D148 JMP U1XLA2 / YES, GET CHAR FROM NEW UDK /A046 DCA STUCHR / First save the char /A168 TAD STUACF / Is he running SETUP ? /A168 SZA CLA / /A168 JMP KYUDST / yes ,and he hit UDK so trap it /A168 TAD STUCHR / No , get char back /A168 CIFMNU /A148 JMS I CHKUDY /A148 JMP U1XLA5 /A148 JMP U1XLA2 /A148 JMP U1XLA3 /A148 KYUDST, TAD STUCHR / Allow UDK on its own /A168 U1XLA5, CDFSYS / /a084 DCA U1XLT2 /[[A034] SAVE CURRENT CHAR TO RETURN. TAD U1XLT2 / GET CHAR. SMA;JMP U1XLA7 / JMP IF AUTO-REPEAT ALLOWABLE. CIA / TAD U1XLT1 / IS IT THE SAME AS THE LAST CHAR? SZA CLA / SKIP IF YES. JMP U1XLA7 / JMP TO TURN AR ON -- CHARS ARE DIFFERENT. TAD U1XLT2 / GET CHAR. TAD (-EDNWLN) / IS IT ? SNA CLA;JMP U1XLA7 / JMP IF YES. DON'T AUTO XOF. / HERE TO TURN AR OFF -- CHARS ARE THE SAME. TAD U1DUMP /[[A039] ARE WE IN DUMP MODE YET? SPA;JMP U1XLA6 / JMP IF NOT YET. PASS 1ST REPEATED CHAR. SZA CLA;JMP U1XLA1 / JMP IF IN DUMP MODE. JMS U1AROF / CALL ROUTINE TO DISABLE AR. (JMS with AC=0) TAD U1XLT2 / GET CHAR TO BE RETURNED. TAD (-EDADVN) / IS IT ADV CHAR? SNA CLA;AC7775 / IF ADV SET COUNT TO -2 U1XLA6, IAC;SNA;IAC /[[A039] IF GOES TO 0 THEN SET TO 1. / [A039]] PASS THIS 1 TO USER BUT IGNORE NEXT. / ELSE SET COUNT TO 1 (DUP/DUMP COUNT). JMP U1XLA8 / MERGE BELOW TO EXIT. U1XLA7, / CLA / /a101 JMS U1ARON / CALL ROUTINE TO ENABLE AR. (JMS with AC=0) U1XLA8, ISZ U1XLAT / TAKE SUCCESS EXIT. U1XLA9, DCA U1DUMP / SET DUMP MODE FLAG. TAD U1XLT2 / GET CHAR TO RETURN. DCA U1XLT1 / SAVE FOR NEXT TIME. TAD U1XLT1 / [A034]] RETURN CHARACTER. /"ARROWS" superseded by cursor keypad application / U1XCHX, CIF CDF JMP I U1XLAT / U1XLT1, 0 /A034 TEMP. U1XLT2, 0 /A034 ANOTHER TEMP. U1DUMP, 0 /A039 -1 = PASS CHAR TO USER & GO TO 1. /A039 1 = IGNORE CHAR UNTIL CHAR CHANGES. /A039 0 = PASS CHAR TO USER. CHKUDX, CHKUXX /A148 CHKUDY, CHKUYY /A148 /\/\/\/\/\ U1PWRF, DCA U1CTQF / CLEAR STOP FLAG AC0003 U1KIE / MUST RE-ENABLE EACH INTERRUPT INDIVIDUALLY U1TSK / FOR VT-278. U1TFL / AND SET OUTPUT FLAG AC0001 / ++++ JMP U1ISTO / RETURN SOH FOR POWER UP SIGNAL / /A148 / XH2PT2 HAS BEEN MOVED FROM HERE TO THE VACUUM CREATED /A148 / BY H.PREBLE IN EDIT #139 /A148 / /A148 / / GET DATE FROM PANEL MEMORY /122 / PCMDAT, /122 ISZ PCMRD1 /INC PTR /122 JMS PCMRD /READ CHAR FROM P.M. /122 JMP U1XLAB /IS A CHAR /122 TAD (NOP /BUFFER M.T. /122 DCA U1XLAA /OVERLAY TO CONTINUE /122 JMP U1XLAA /CONTINUE /122 / MOVED HERE ON EDIT # 151 /A151 / / lower "DTR" for "n" seconds / ENTER WITH THE (AC) = NEGATIVE NUMBER OF SECONDS HANGUP, XX / / DCA DTRTIMER/ -# / (of seconds to wait) /D151 AC0010 / /D156 TAD (0013) / DROP DTR & KEEP 10 & 11 RESET /A151 JMS TSTIMB / CK FOR INTEGRAL MODEM ENABLED /A156 TAD (0010) / THIS BIT WILL DROP DTR /A156 IFNDEF CONDOR < / DMI HAS THE REVERSE SENSE OF DMII /A133 / IN SETTING "DTR" (& "RTS") /A133 CLL RAL / AC=XXXXXXX10XXX SETS "RTS" & RESETS "DTR"/A133 JMS WRTCTL / GO PREP IOT FOR ACTIVE PORT /A133 > / END IFNDEF CONDOR /A133 H2DTR / / 'hang-up' the modem JMP I HANGUP / EXIT / AC NOT EQUAL ZERO / TSTU1C moved here for space reasons this edit /a164 TSTU1C, TAD U1OFLG / ARE WE TO CHANGE AR SETTING? /A034 SZA; JMP U1ESC3 / JMP IF YES. EXIT (& CLEAR BUSY) IF NO./A034 DCA U1BFLG / CLEAR BUSY EXINTR / AND EXIT / X=. PAGE UD1OPS, XX / THIS ROUTINE IS CALLED WITH THE AC= ACTION DESIRED / CIFSYS / UDKOPS / RETURN (AC=0) / THE ONLY ACTIONS IMPLEMENTED ARE / AC=0 UDK'S ACTIVE / AC#0 UDK'S INHIBITED / GETRTF / ++++ DCA UD1CHX CDF MN1FLD JMS UDOPSB UD1CHX, .-. JMP I UD1OPS / UDOPSB, XX DCA I (UDKPTR) / CLEAR UDK STACK TAD X0 / GET OP WORD SZA / ++++ AC7777 / DO ENABLE OR DISABLE DCA I (UDKINH) JMP I UDOPSB / AND RETURN CLKSRV, XX / SERVICE CLOCK TICK CIF 0 / INHIBIT INTERRUPTS TAD LPDNFG / WHILE WE DO PRINTER TIME OUT SMA CLA / ++++ JMP CLKT4 / IF NECESSARY ISZ LPDNFG / ++++ JMP CLKT4 / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!! D E F I N E D WITHIN W P F 1 . P A !!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! CLKOP, NOP / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!! D E F I N E D WITHIN W P F 1 . P A !!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! AC0001 / ++++ DCA LPDNFG CLKT4, CDF 20 / ++++ ISZ I (CLKCHG) / ++++ NOP CDF 50 / ++++ ISZ I (CLKCHG) / ++++ NOP CDF 0 TAD (CLOCK+1) / ++++ DCA T1 TAD (CLKLIM-1) / ++++ DCA X0 ISZ TENTHS / KEEP TRACK OF # OF TENTHS OF SEC GONE BYE/A057 JMP CLKT2 / JMP IF NOT ANOTHER SECOND. /A057 JMS TSTDTRTIMER / (are we in the process of hanging up?)/a078 TAD CLKLIM / RESET TO 10 TENTHS (PER SECOND). /A057 DCA TENTHS / ... /A057 ISZ TIMOUT / INCREMENT THE TIME OUT VARIABLE/051/057/097 NOP / NEEDED WITH ISZ TIMOUT /A097 CLKT2, TAD I X0 CLKT1, ISZ I T1 TAD I T1 SZA CLA / ++++ JMP CLKT0 DCA I T1 ISZ T1 TAD I X0 SZA / ++++ JMP CLKT1 / UPDATE ALL COUNTERS / WE GET HERE ON MIDNIGHT. ISZ DAYEAR / BUMP DAY OF YEAR AC0003 / ++++ AND YEAR / CHECK FOR NEW YEAR SNA CLA / ++++ CMA TAD (-D365) TAD DAYEAR / NEW YEAR? SPA SNA / ++++ JMP YEAROK DCA DAYEAR / IF SO, UPDATE DAY ISZ YEAR / AND YEAR YEAROK, JMS FIXDAT TAD BREAKF / IS BREAK GOING? /A041 SMA SZA CLA / SKIP IF NO. /A041 JMS BRKOFF / TURN BREAK OFF. /A041 CLKT0, ISZ CLOCK / ++++ JMP CLKSRV+1 TAD BREAKF / IS BREAK GOING? /A041 SPA SNA CLA / SKIP IF YES. SEE IF TIME TO TURN OFF. /A041 JMP CLKDON / BREAK NOT GOING SO JUST EXIT. /A041 TAD (TIMER+3) / PTR TO BREAK "STOP TIME". /A041 DCA CT1 / /A041 TAD (CLOCK+1+3) / PTR TO CURRENT TIME. /A041 DCA CT2 / /A041 TAD (-4) / LOOP COUNTER. /A041 DCA T1 / /A041 CLKCK1, TAD I CT1 / GET "STOP TIME" TIME PIECE. /A041 CIA / COMPUTE -"STOP TIME" /A041 TAD I CT2 / COMPUTE "CURRENT TIME"-"STOP TIME" /A041 SZA / SKIP IF TIME THE SAME. TRY NEXT THING./A041 JMP CLKCK2 / SEE IF "BREAK TIME" IS UP. /A041 AC7777 / MOVE ON TO THE NEXT TIME PIECE. /A041 TAD CT1 / STARTING AT THE MOST SIGNIFICANT /A041 DCA CT1 / PIECE AND MOVING TO THE LEAST SIGNIF/A041 AC7777 / ICANT PIECE. /A041 TAD CT2 / /A041 DCA CT2 / /A041 ISZ T1 / LOOP COUNTER. /A041 JMP CLKCK1 / TRY NEXT PIECE. /A041 JMP CLKDON / WE ARE DONE. SO EXIT TO CALLEE /A041 CLKCK2, SMA CLA / SKIP IF "BREAK TIME" NOT UP YET. I.E. /A041 / SKIP IF "CURRENT TIME"-"STOP TIME" < 0 /A041 / IE SKIP IF "CURRENT TIME" < "STOP TIME" /A041 JMS BRKOFF / TURN BREAK OFF. /A041 CLKDON, JMP I CLKSRV / CT1, 0 / TEMP POINTER. /A041 CT2, 0 / TEMP POINTER. /A041 TENTHS, -1 / then -12 / # OF TENTHS LEFT IN CURRENT SECOND. /A057 CLKLIM, -12 / ++++ -74 / seconds / ++++ -74 / minutes / ++++ -30 / hours / ++++ 0 / CLOCK COUNTER LIMITS TIMER, ZBLOCK 4 / "BREAK TIME" "STOP TIME" TIME /A041 / /FOLLOWING MOVED HERE VER..122 / / ---------------------------------------------------------- / / -------- DEVICE "KB OUTPUT" INTERRUPT CHAIN ENTRY -------- /M0068 / ---------------------------------------------------------- / / /M0068 /-----(O_R_D_E_R important)-----/ EXINTR / POWER RESUME ENTRY /A0068 TSTUON / INTERRUPT CHAIN LINK /A0068 TSTKBO, U1TSF / TEST THE OUTPUT FLAG /M0020 JMP I TSTKBO-1 / NO OUTPUT--CONTINUE THE 'RUPT CHAIN /M0020 JMP TSTU1O / OUTPUT FLAG IS SET--JUMP TO HANDLE IT /M0020 /----(E_N_D order important)----/ / / IFDEF FORIN < / THESE SUBS. ARE PUT HERE 'CAUSE OF ROOM CHKXNF, XX / CHECK FOR XON/XOF TAD INTMP1 / ++++ AND P377 / STRIP GARBAGE /M160 TAD (-XOF) / XOF? SNA / ++++ JMP CHKXN1 / JUMP IF SO TAD (XOF-XON) / XON? SZA CLA / ++++ ISZ CHKXNF / SKIP IF SO JMP I CHKXNF CHKXN1, AC0001 / ++++ JMP I CHKXNF / > / END IFDEF FORIN /------------------ PAGE SYFORK, XX / CALLED BY "FRKINT" CLA TAD I SYFORK SZA CLA / ++++ EXINTR / JUST EXIT IF ALREADY QUEUED TAD FRKCHN SNA / ++++ JMP DOFORK / JUMP IF THIS IS FIRST IN CHAIN DCA I SYFORK / ELSE TACK THIS ONE ON THE FRONT TAD SYFORK DCA FRKCHN EXINTR / AND EXIT FRKNXT, / JUMPED TO BY "FRKXIT" IOF / ++++ CLA / ENSURE CLEANLINESS TAD FRKCHN DCA SYFORK TAD I SYFORK / GET NEXT IN CHAIN JMP DOFRK1 / AND DO IT / DOFORK, TAD INTAC / ++++ DCA ASTAC / COPY ALL INT'RPT SAVE STUFF TAD 0 / ++++ DCA ASTPC TAD INTLK / ++++ DCA ASTFL MQA / ++++ DCA ASTMQ TAD (FRKEND) / SET OUR CLEANUP PROCESS DOFRK1, DCA FRKCHN / AS NEXT IN CHAIN DCA I SYFORK / SHOW THIS ONE NO LONGER IN QUEUE ISZ SYFORK / BUMP TO ENTRY POINT JMP I SYFORK / AND ENTER ROUTINE WITH RUPTS OFF FRKEND, 0 / DUMMY CHAIN LINK FOR CLEANUP ROUTINE TAD ASTFL / ++++ RTF / ++++ CLA / RESTORE ALL SAVED STUFF TAD ASTMQ / ++++ MQL SIGNAL / SET WAKEUP FLAG (LIKE DISMIS) TAD ASTAC JMP I ASTPC / AND RETURN TO MAIN LINE WITH RUPTS ON / ASTAC, .-. / SAVED AC ASTMQ, .-. / SAVED MQ ASTFL, .-. / SAVED FIELDS AND LINK BIT ASTPC, .-. / SAVED PC (RETURN POINT) / FIXDAT, XX AC0003 / CHECK FOR LEAP YEAR AND YEAR SNA CLA / ++++ IAC TAD (D28) / SET LENGTH OF FEB. DCA FEBDAY DCA MONTH / COMPUTE MONTH OF YEAR TAD (DAPERM-1) DCA T1 TAD DAYEAR CIA ISZ MONTH ISZ T1 TAD I T1 SPA / ++++ JMP .-4 CIA TAD I T1 DCA DAMNTH / AND DAY OF MONTH AC7777 TAD YEAR / NOW DO DAY OF WEEK CLL RAR CLL RAR TAD YEAR TAD DAYEAR TAD (-7) SMA / ++++ JMP .-2 TAD (10) DCA DAWEEK / 1=SUNDAY, 7=SATURDAY TAD DAMNTH BSW / ++++ TAD MONTH DCA PAKDAT JMP I FIXDAT DECIMAL D365=365 D28=28 DAPERM, 31 / JAN FEBDAY, 28 / 29 / FEB 31 / MAR 30 / APR 31 / MAY 30 / JUN 31 / JUL 31 / AUG 30 / SEP 31 / OCT 30 / NOV 31 / DEC OCTAL / ENABLE communications (H2) IRQ's H2ONN, XX / ENABLE SELECTED PORT INTERRUPTS. /A042 JMS H2ECHK /break? / issue BREAK if comm errors /A066 AC0003 / ENABLE SOME 'RUPTS. /A041 IFNDEF CONDOR < JMS USIOT > /A075 H2KIE / ENABLE RECIEVER INTERRUPTS. /A066 IFNDEF CONDOR < JMS USIOT > /A075 H2TSK / ENABLE TRANSMITTER INTERRUPTS. /A066 CLA / clear the accumulator JMP I H2ONN / exit / RETURN TO CALLER (with the ac=0) /A042 IFDEF CONDOR < /A130 / /READ CHAR FROM PANEL MEM.... /....THIS ROUTINE IS SET AT LOAD TIME... IS EXECUTED DURING START UP /.....WHEN FIRST END OF BUFFER IS READ(NULL) CALL TO ROUTINE WILL BE NOOPED / PCMADR=7732 /ADDRESS OF P.M. DATE /A122 PCMSTR=7600 /START OF PANEL MEM DATA /A122 PCMCMD=PCMSTR+10 /ADDRESS OF P.M.CMND STR /A122 PCMRD, 0 /A122 CLA /A129 PRQ3 /A122 5006 /IOT READ P.M..50XY.. X=OUTPUT FIELD Y=INPUT FIELD /A122 PCMRD1, PCMSTR-1 / LOCATION IN INPUT FIELD TO BE READ /A122 /C126 /C146 PCMRD2 / LOCATION TO PUT RESULTS /A122 -1 /- NO CHARS TO BE READ /A122 -1 /TERMINATOR /A122 TAD PCMRD2 /GET CHAR /A122 AND P177 / Strip down to 7 bits /A163 SZA /END OF BUFFER /A122 /C125 JMP I PCMRD /A122 ISZ PCMRD /YES /A122 /M125 TTYIN /IGNORE POWER FAIL STRTUP /A125 NOP /A125 CLA /A125 JMP I PCMRD /RET /A125 PCMRD2, 0 /CHAR JUST READ /A122 > /END IFDEF CONDOR /A130 / /------------------ PAGE / WPSRCH - EDITOR COMMAND MATCHER --- rewritten for '073' incl CONDOR cond's SRCH, XX / CALLED WITH (AC) = 7-BIT CHAR TO MATCH JMS TST8BT / Test for 8 bit non-modded character /a160 JMP I SRCH / Return with 8 bit char if non mod /a160 / Otherwise, if 7 bit or modded then... /a160 IFDEF CONDOR < / ---------------------------------------------- /A073 /This section rewritten for expanded table /A112 ISZ TILDEFLAG /LOOKING FOR A TILDE? /A112 JMP SRCH1 /(NO) /A112 TAD (-176) /YES, DO WE HAVE ONE? /A112 SZA CLA /A112 JMP SRCH3 /(NO, PROCESS A NON-MATCH) /A112 TAD SRCHU1 /YES, GET THE MODIFIER /A112 TAD (-4000) /STRIP THE 4000 /A112 CIA /NEGATE TO FORM XLATED CODE /A112 JMP SRCH4A /GO PROCESS A MATCH /A112 > / END IFDEF CONDOR ------------------------------------ /A073 SRCH1, /A112 DCA SRCHCA / 7-bit / SAVE CHAR IFDEF CONDOR < /A112 DCA TILDEFLAG > /RESET THE TILDE FLAG /A112 SKP /A112 SRCHRE, /A112 DCA SRCHU1 / CLEAR FOR NEXT MODIFIER BUILD /A112 AC7777 / -1 / DCA SRCHT2 / t2=0 / CLEAR FLAG FOR FIRST TIME THROUGH SRCH0, / drop / OR ENTER WITH (AC) = -40 /a083 TAD SRCHCA / 7-bit / STORE THE CHARACTER RECEIVED IN TEMP / IF THERE IS NO MATCH ON THE FIRST PASS THROUGH / THE TABLE THE CHARACTER SRCHCA IS MADE UPPER CASE / AND THE TABLE IS SEARCHED AGAIN. DCA SRCHT1 / t1 / TAD SRCHT1 / t1 / SNA / ++++ JMP I SRCH / ac=0 / IGNORE NULLS TAD SRCHU1 / CLL CIA /negate / SET FOR COMPARE (note link really=0 here) DCA SRCHT3 / TAD (SRCHTB-2) / WITH TABLE DCA SRCHX2 / X2 / SRCH2, ISZ SRCHX2 / +1 / TAD I SRCHX2 / GET NEXT TABLE ENTRY TAD SRCHT3 /-value / COMPARE SNA / ++++ JMP SRCH4 / match / JUMP CAUSE THEY MATCHED SNL CLA / ++++ JMP SRCH2 / loop / CONTINUE binary SEARCHING (still LOW) / The entire 'srchtb' has been searched w/o a match / IF this is pass I / THEN make the character (within 'srcht1') UPPER case and search again, / IF this is pass II / THEN there is no match to make (so exit) ISZ SRCHT2 / JMP SRCH3 / PASS 2 (no match) /m083 TAD SRCHCA / MAKE SEARCH CHARACTER UPPER CASE / make character within 'SRCHCA' upper case (or "jmp srch3" if already u/c) TAD (-140) / SPA SNA CLA / /a083 JMP SRCH3 / jmp / (7-BIT CHAR WAS UPPER CASE AT ENTRY) /a083 TAD (-40) / /a083 JMP SRCH0 / loop / pass II / SEARCHED THE ENTIRE TABLE WITHOUT A MATCH /a083 / /a083 / IF the contents of program location "SRCHU1" = 0 /a083 / THEN no modifier was in the process of being built /a083 / /a083 / (EXIT-because this is a legal key stroke), but /a083 / /a083 / IF the contents of "SRCHU1" are NOT = 0 /a083 / THEN a modifier was being built /a083 / when the entire table was searched w/o a match /a083 / /a083 / (EXIT-to beep the illegal key stroke) /a083 / /a083 / *** BUT BEFORE EXITING... *** /a083 / /a083 / NOTE!!!! The following comment did not seem to have anything whatever /A112 / to do with what the code was actually doing. In fact what we /A112 / want to do is check for an ESC. If we got no match, but now /A112 / have an ESC, we want to resynch the entire sequence on the ESC /A112 / SRCH3, TAD SRCHU1 /mod / get the modifier (or 0) /a083 SNA CLA / / skip next if modifier was being built /a083 JMP SRCH5 /to EXIT/ o.k. (one key stroke) /a083 TAD SRCHT1 /GET THE CHARACTER /A112 TAD (-33) /WAS IT AN ESCAPE? /A112 SNA CLA /(NO) /A112 JMP SRCHRE /YES, GO RESYNCH /A112 TAD (NODEF) /-value / this neg val will cause a "beep" /a083 DCA SRCHCA /"nodef"/ /a083 JMP SRCH5 / /(jmp cause not DECmate II "modifier") /a083 / MATCHED AN ENTRY IN THE TABLE SRCH4, TAD I SRCHX2 / GET MATCHED VALUE /This section rewritten to provide a new way of knowing when we /A112 / must look for a trailing tilde as well as handle escape /A112 / sequences of the forms ESC [ p ~ OR ESC [ pp ~ /A112 / /If the modifier value is negative, it is either the final translated /A112 / code or the end of a condor sequence that merely needs a final /A112 / tilde /A112 /If the value is 4xxx, it is a condor sequence and the modifier value /A112 / equals minus the translated code + 4000 /A112 /NOTE: This assumes, therefore, that the set of translated codes is /A112 / always at least 6000 /A112 SRCH4A, DCA SRCHCA /STORE MATCHED VALUE /A112 TAD SRCHCA /A112 IFDEF CONDOR < / ------------------------------------ /A112 SMA /A112 JMP SRCH5 /+ OR 0 -- GO STORE AS MODIFIER /A112 CLL RAL /WHICH TYPE NEGATIVE IS IT? /A112 SPA CLA /A112 JMP SRCH5 /(TRANSLATED CODE) /A112 AC7777 /CONDOR SEQ, SET TILDE FLAG /A112 DCA TILDEFLAG /A112 TAD SRCHCA /GET VALUE TO STORE AS MODIFIER /A112 > /END IFDEF CONDOR > / ------------------------------------ /A112 IFNDEF CONDOR < /A112 SPA /A112 CLA > /A112 SRCH5, DCA SRCHU1 /0; mod / CLEAR for next 'jms srch'; or BUILD mod TAD SRCHU1 / xfer vector:: (1), (2), (2b/6), ... SNA CLA / (else = 0 if translated ok) TAD SRCHCA / ?? / 8-bit char at entry or translated (neg) value/M160 JMP I SRCH / exit / / 'SRCHT1' contains the character in 'SRCHCA' / (if first time thru the table) / ELSE it contains the UPPER case of that character / (because it is the 2nd time thru the table) SRCHT1= T1 / (pass I-same as 'srchca'; pass II-UPPER case) SRCHT2= T2 / 1ST, 2ND TIME THRU SEARCH TABLE FLAG SRCHT3= T3 / NEGATIVE value of MODIFIER to match SRCHX2= X2 / POINTER TO SEARCH TABLE IFDEF CONDOR < / ---------------------------------------------- /A073 TILDEFLAG, ZBLOCK 1 / = 1 MEANS WAITING FOR 'tilde' > / END IFDEF CONDOR ------------------------------------ /A073 / HOST #2 (communications initialization) / (this routine was divided into 2 parts to get space for edit "078") /a078 XH2INI, XX / ENTRY POINT. /A042 GETRTF / GET RETURN FIELD (and "CDF 0") /A042 DCA XH2XIT / SET RETURN CDI. /A042 / Communications (host) is only initialized if (CMONLN) is nonzero /C104 / enabling the execution of DECmate II software on a DECmate I /a078 / FOR DEVELOPMENT PURPOSES /a078 TAD CMONLN / /C104 SNA CLA / /a078 JMP XH2XIT / ...SAYS THERE IS NO COMM... /a078 JMS H2OFF / TURN H2 INTERRUPTS OFF. /A042 IFNDEF CONDOR < / --------------------------------------------- /A075 CDFMNU / DETERMINE WHICH PORT IS SELECTED. /A042 TAD I (MUBUF+MNPRTB) / CDFMYF RTR RTR AND (1) DCA SWPORT / SAVE PORT SELECT. TAD SWPORT / SEE WHICH PORT IS SELECTED. /A042 SNA CLA > / END IFNDEF CONDOR ----------------------------------- /A075 TAD (MNPRIM-MNSECN) / IF 0 THEN PRIMARY (MNPRIM) /A042 TAD (MUBUF+MNSECN) / COMPUTE ADDRESS OF PORT CHARACTERISTICS/A042 DCA H2INT1 / WORD. SAVE IT. /A042 CDFMNU / MAP MENU FIELD. /A042 TAD I H2INT1 / GET PORT CHARACTERISTICS WORD. /A042 DCA H2INT1 / SAVE. /A042 AC0001 / CHeck XON/XOF bit of MNXONF. /A111 AND I (MUBUF+MNXONF) / "xon"/"xof" /M111 CDFMYF / /A042 KSZACLA,SZA CLA / ZERO MEANS SET JMP KSZ1 / /M111 TAD (NOP) DCA I (SWSYS1) TAD KSZACLA / /A083 JMP KSZ2 /M111 KSZ1, TAD (SYSLOC&177+JMP+200) /M111 DCA I (SWSYS1) TAD (SKP CLA) KSZ2, DCA I (SWSYS2) /M111 / -------------------------------------------------------------------- /a078 JMP XH2PT2 / /a078 / -------------------------------------------------------------------- /a078 /m083 / + + + + jmp here from within "XH2PT2" + + + + /m083 /m083 XH2XIT, XX / EXIT CID. JMP I XH2INI / RETURN TO CALLER. H2INT1, ZBLOCK 1 / TEMP / DDD DPP SSB BBB /(D)- data,(P)- parity,(S)- stop bits,(B)- baud / ------------------------- / | null job STATUS BLOCK | / ------------------------- NULJSB, . / NULJOB STATUS BLOCK 0 / FIELD 0, LINK 0 37 / MQ XJSTRT+1 / PC PRJOB / AC /----------------------- PAGE / CUSM - SETS THE VALUES FOR THE MENU TO BE DISPLAYED / THE VALUES FOR THE 278 COMM LINES (HOST LINES) CHARACTERISTICS ARE / PACKED (BY WPCU4) INTO MNPRIM/MNSECN FOR THE PRIMARY/SECONDARY PORT / LINES. THE VALUES ARE PACKED IN SUCH A WAY THAT PACKING AND UNPACKING / CAN BE DONE IN AN EFFICIENT MANNER. MNPRTB CONTAINS INFO PERTAINING / TO THE PRINTER BAUD RATE, BREAK-TIME, PORT SELECTION, AND CX TERMINAL / MODE. A BREAKDONW OF THESE PACKINGS FOLLOWS: / / FORMAT FOR "MNPRIM/MNSECN": / / BITS INFORMATION / / 11 - 8 THE CHARACTER SIZE ONLY COUNTING THE BITS IN THE / CHARACTER NOT PARITY OR STOP BITS / / 7,6 PARITY / / 5,4 STOP BITS / / 3-0 /BAUD / / FORMAT FOR "MNPRTB": / / 0-2 TERMINAL MODE (0=VT52, 1=VT278, 2=DECWORD52) /A044 / / 3-6 BREAK TIME (.1 TO 1.5 SECS. IN TENTHS OF A SECOND). / / / / 7 PORT SELECT (0=PRIMARY, 1=ALTERNATE) / / 8-11 PRINTER BAUD RATE. / / ********************************************************** / / LIMITS - VALUES THAT ARE CHECKED FOR IN THE MENU / / CHARACTER SIZE - CAN BE FROM 5 - 8 / / PARITY - 2 = NO PARITY, 1 = ODD, 0 = EVEN / / STOP BITS - 1 OR 2 NOTE: IF SET FOR 5 FOR CHARACTER SIZE AND 1 FOR STOP / IT WILL AUTOMATICALLY SET FOR 1.5 STOP BITS / / AND BAUD: / / VALUE BAUD / 0 50 / 1 75 / 2 110 / 3 134.5 (MAGCARD) / 4 150 / 5 300 (DEFAULT) / 6 600 / 7 1200 / 10 1800 / 11 2000 / 12 2400 / 13 3600 / 14 4800 / 15 7200 / 16 9600 / 17 19200 / IFNDEF CONDOR < / --------------------------------------------- /A075 /.SBTTL USIOT - CREATES THE IOTS FOR USRPTI/O / / CALL: JMS USIOT; IOT / / (where 'IOT' is the IOT minus the device code to execute) USIOT, XX DCA USIOT1 / STORE THE AC TAD SWPORT TAD (H2IOTB) / GET THE DEVICE CODE FOR PORT SPECIFIED DCA USIOT2 TAD I USIOT AND (7017) / GET IOT TAD I USIOT2 / ADD DEVICE CODE DCA I USIOT TAD USIOT1 / RESTORE AC JMP I USIOT / done USIOT1, 0 / holds the AC at entry USIOT2, 0 / pointer to 'PORT' 0 or 1 device code SWPORT, 0 / PORT select (bit 11:0 - port 0, 11:1 - port 1) H2IOTB, IOTH2I&760 / PORT 0 IOT'S. IOTH2A&760 / PORT 1 IOT'S. / Enter with (AC) = 10 means issue 'BREAK' DOBIOT, XX / /A041 TAD (3425) / SET COMMAND REGISTER / 3400 = WRITE COMMAND REGISTER. / BITS (4-5) = NORMAL OPERATING MODE (0). / BIT (6) IS NOT USER & SET TO 0. / BIT (7) IS RESET ERROR (SET). / BIT (8) IS FORCE BREAK (see AC at entry). / BIT (9) IS RECIEVE CONTROL (SET). / BIT (10) IS NOT USED (AND NOT SET). / BIT (11) IS TRANSMIT CONTROL (SET). JMS USIOT;PTB0 / WRITE THE COMMAND REGISTER. /A041 CLA / /A041 JMS USIOT;PRB0 / PREFORM DUMMY READ. /A041 CLA / /A041 JMP I DOBIOT / /A041 > / END IFNDEF CONDOR ----------------------------------- /A130 / IF the contents of program location "dtrtimer" is negative / THEN we are in the process of "hanging-up" the modem / / (the negative number within "dtrtimer" represents the time / in "seconds" that DTR will be kept low) / TSTDTRTIMER, XX / TAD DTRTIMER / SNA CLA / JMP I TSTDTRTIMER / EXIT ISZ DTRTIMER / JMP I TSTDTRTIMER / EXIT /d083 AC0010 / 10 / IFNDEF CONDOR < / DMI HAS THE REVERSE SENSE OF DMII /A133 AC0003 / IN SETTING "DTR" (& "RTS") /A133 R3L / AC=XXXXXXX11XXX SETS "RTS" & "DTR" /A133 JMS WRTCTL / GO PREP IOT FOR ACTIVE PORT /A133 > / END IFNDEF CONDOR /A133 IFDEF CONDOR < / KEEP BITS 10 & 11 FALSE ON DM II /A151 /D156 AC0003 / /A151 JMS TSTIMB / CK FOR INTEGRAL MODEM ENABLED /A156 > / END IFDEF CONDOR /A151 H2DTR / / set DTR (completes modem 'hang-up') CLA / JMP I TSTDTRTIMER / EXIT DTRTIMER,ZBLOCK 1 / IFNDEF CONDOR < /A133 WRTCTL, XX / SET UP "WRITE CONTROL REG." IOT FOR /A133 / APPROPRIATE DMI PORT /A133 DCA USIOT1 / SAVE AC (USE SAME TEMP AS USIOT) /A133 TAD SWPORT / GET ACTIVE PORT /A133 RTL / PUT INTO PROPER POSITION FOR IOT /A133 MQL / & SAVE IN MQ /A133 TAD I WRTCTL / GET IOT /A133 AND (7773) / MASK OUT PORT SELECT BIT /A133 MQA / & IOR WITH SAVED PORT SELECT /A133 DCA I WRTCTL / PUT IOT BACK /A133 TAD USIOT1 / RESTORE AC /A133 JMP I WRTCTL / & RETURN TO EXECUTE IOT /A133 > / END IFNDEF CONDOR /A133 IFNDEF CONDOR < / --------------------------------------------- /A130 / CUSVL - SETS THE COM LINES ON THE 78 FOR THE VALUES SET BY THE USER / / / THIS ROUTINE SETS THE BAUD, PARITY, DATA, AND STOP BITS FOR THE VT278. / TWO REGISTERS MUST BE WRITTEN: MODE REGISTER 1 AND MODE REGISTER 2. / / THE BIT ASSIGNMENTS FOR MODE 1 ARE: / / 4-5 STOP BITS (00=INVALID, 01=1, 10=1.5, 11=2) / 6-7 PARITY (00=NONE, 01=ODD, 10=NONE, 11=EVEN) / 8-9 DATA BITS (00=5, 01=6, 10=7, 11=8) / / 10-11 MUST BE "01" TO SPECIFY ASYCHRONOUS TRANSMISSION / / THE BIT ASSIGNMENTS FOR MODE 2 ARE: / / 4-5 NOT USED / 6-7 11 TO INDICATE INTERNAL CLOCKING / 8-11 BAUD RATE SELECTION (NORMAL PROGRESSION FROM 50 TO 192000) / / 0-3 MUST BE "0101" IN ORDER TO LOAD THE MODE REGISTERS. THE / REGISTERS ARE ACCESSED SEQUENTIALLY. H2DTR=6362 /(AC)=0 SET DTR, (AC)=10 DROP DTR /A130 CUSVL, XX / |----------| / |RESET PORT| / |----------| CLL CLA / TAD SWPORT RTR / SET AC00 TO SWPORT. RACD / PORT initialize / |-----------------| / |COMPUTE STOP BITS| - (00) invalid; (01) is 1 stop bit; (10) is 1.5; (11) is 2 / |-----------------| CLA / START W/ NOTHING! /A043 TAD SLUAS / GET THE NUMBER OF STOP BITS / WANT TO CHANGE 01--01, 10--11 CLL RAR / GET RID OF THE LEAST BIT STL RAL / CHANGE IT TO A 1, GET BACK INTO AC RTL / MOVE THE BITS FURTHER INTO THE AC / |-------------------| / |COMPUTE PARITY BITS| - (00) is no parity; (01) is odd; (11) is even / |-------------------| TAD SLUAP / GET THE ENCODING OF THE PARITY BIT / THE CONVENTION IS NONE=10, EVEN=01, ODD=00 / FOR THE VT278, NONE=10, EVEN=11, ODD=01 RTR / GET LOW BIT IN AC0 SPA STL / IF AC0=1, (EVEN PARITY), SET THE LINK SNL / IF LINK=0 (ODD PARITY) MAKE AC0=1 TAD (4000) RTL / GET BACK INTO THE AC RTL / MOVE THE BITS FURTHER INTO THE AC / |-----------------| / |COMPUTE DATA BITS| - (00) is 5 bit char's; (01) is 6; (10) is 7; (11) is 8 / |-----------------| TAD SLUAD / GET THE DATA BITS (character length) TAD (-5) / SCALE THEM DOWN CLL RTL / GET INTO AC8-9 TAD (2401) / ADD IN CONSTANT BITS / 2400 = SCD: MODE REGISTER 1/2 (WRITE). / AC ALREADY CONTAINS MODE SETTINGS FOR / STOP BITS (4-5), PARITY (6-7), AND / DATA BITS (8-9). BITS 10-11 ARE SET TO / 01 FOR ASYN 1 X RATE. JMS USIOT; PTB0 / SEND THE WORD. / |-----------------| / |COMPUTE BAUD RATE| / |-----------------| / 0000 - 50 / 0001 - 75 / 0010 - 110 / 0011 - 134.5 / 0100 - 150 / 0101 - 300 / 0110 - 600 / 0111 - 1200 / 1000 - 1800 / 1001 - 2000 / 1010 - 2400 / 1011 - 3600 / 1100 - 4800 / 1101 - 7200 / 1110 - 9600 / 1111 - 19200 TAD SLUAB / GET THE BAUD RATE TAD (2460) / ADD IN THE CONSTANT BITS / 2400 = SCD:7; 11 is 8 MODE REGISTER 1/2 (WRITE). / BITS 4-5 ARE NOT USED. 6-7 (60) IS / SET FOR INTERNAL TRANSMITTER/RECIEVER / CLOCK. 8-11 IS THE BAUD RATE SELECTION / IN THE AC ALREADY. JMS USIOT; PTB0 / SEND THE WORD. > / END IFNDEF CONDOR ----------------------------------- /A075 / ** CONDITIONAL REMOVED FROM TSTDTRTIMER AND THE CODE ** /A130 / ** MOVED TO B4 DMI'S CUSVL ROUTINE TO ALLOW A CLEAN ** /A130 / ** FALL THROUGH OF THE DMI CUSVL ROUTINE. ** /A130 IFDEF CONDOR < / ---------------------------------------------- /M130 / (AC) at entry = 10 means issue break DOBT1, ZBLOCK 1 / temp / LOCAL TEMP FOR SUBROUTINE "DOBIOT" /m083 DOBIOT, XX / CLL RAL / move / to bit 7 DCA DOBT1 / temp / local temporary /d086 TAD (20) / TAD (60) / /a086 /\cdf 0 /----[a] reg sel----/ LDREG / CR0A / CLA / reset ERROR flags and STATUS registers / --------------------------------------------------------------- / |CR5A| 4 5 6 7 8 9 10 11| TRANSMITTER ENABLE/DISABLE | / | | 0 0 0 0| | / |------------------------------|------------------------------| / | |0 0| | | | 5 bits (or less) | / | |0 1| | | | 7 bits | / | |1 0| | | | 6 bits | / | |1 1| | | | 8 bits | / | |----|--|--| | | / | | | 1| | | BREAK | / | |----|--|--| | | / | | | | 1| | ENABLE transmitter IRQ | / --------------------------------------------------------------- TAD (5) / SELREG / CIA / -5 / (SCALE) TAD SLUAD / TRANSMIT DATA BITS (same as reciever) BSW / CLL RAR / (into bits 5 and 6) TAD (10) / ENABLE transmit irq's TAD DOBT1 / 20? / (BIT 7 = 1 MEANS ISSUE 'BREAK') / |-------------------------| / |WRITE control register #5| / |-------------------------| LDREG / WRITE control register #5 CLA / JMP I DOBIOT / exit / done / COMMUNICATIONS INITIALIZATION / ENTER WITH THE CONTENTS OF THE AC = 0; AND / ENTER WITH THE DATA FIELD = FIELD 0 CUSVL, XX / ENTER WITH THE CONTENTS OF THE AC CLEAR / the DECmate II communications chip / ---- M U S T B E s e t u p T H I S W A Y----- / eachtime any parameter is modified SELREG= 6366 / (AC) = REGISTER NUMBER TO SELECT LDREG= 6366 / (AC) = VALUE TO LOAD INTO REGISTER RDREG= 6366 / (AC) GETS CONTENTS OF REGISTER H2DTR= 6362 / (AC) = 03 LOWER "DTR"; (AC) = 13 SET "DTR" H2BAUD= 6363 / (AC) IS THE BAUD RATE TO SET / first of all at the time this chip was chosen / it was the only one to contain all the 'neet stuff' / (async/sync; modem control, etc) that 'they' wanted / (you know who they are) therefore this chip is in / CT and RAINBOW as well as DECmate II. / / secondly it is a JAPanneessee chip which means / that the technical specification was originally written / in that language and somewhere in the translation / new meanings (misinterperations of the translator--probably / one of those "technical" writers) were born / consequently a big fuss was made because the chip didn't / work as the spec documented. / / THEREFORE at the time the communications code / was written (late in the project) there was no / time to "experiment" with different register / setup sequences...so that's the way it is. / / YOU'LL SEE IT IS A "BEAR" TO PROGRAM / / (IOT 6366 does not clear the AC) / / (the code "AC0013; 6362" hangs-up the modem) RACD / RESET / (this is a chip reset) / -------------------------------------------------- / |CR0A| | not used| crc | command | reg select | / | | 0 | 1 2 3 | 4 5 | 6 7 8 | 9 10 11 | / -------------------------------------------------- /\ cdf 0 /--- [A] REG SELECT---/ TAD (30) / reset / LDREG /channel/ (this is a channel A reset) CDF 10/--- [B] REG SELECT---/ / reset / (NOTE that the ac still = 30) LDREG /channel/ (this is a channel B reset) /\cla / / ------ / |CR2A| / ------ CDF 0 /--- [A] REG SELECT---/ AC0002 / CR2A / SELREG / select/ /\cla / /\tad (20) / fixed / TAD (16) / fixed / 2 + 16 = 20 LDREG / load / / ------ / |CR2B| / ------ CDF 10/--- [B] REG SELECT---/ AC0002 / CR2B / SELREG / select/ CLA / 0 / LDREG / load / / --------------------------------------------------------------- / |CR4A| 4 5 6 7 8 9 10 11| MODE AND PARITY SELECTIONS | / | | 0 1 0 0 | | / | |-------------------------|------------------------------| / | | |0 0| | ILLEGAL stop bit definition | / | | |0 1| | 1 stop bit | / | | |1 0| | 1.5 stop bits | / | | |1 1| | 2 stop bits | / | | |----|-------|------------------------------| / | | | x 0 | NO parity | / | | | 0 1 | ODD parity | / | | | 1 1 | EVEN parity | / --------------------------------------------------------------- CDF 0 /--- [a] REG SELECT---/ AC0004 / CR4A / SELREG / select/ AC0002 / AND SLUAS / USER DEFINED STOP BITS IAC / CLL RTL / TAD SLUAP / USER DEFINED PARITY TAD (100) / fixed / LDREG / load / / ------ / |CR1A| - interrupt enables/disables / ------ /\cdf 0 /--- [A] REG SELECT---/ AC0001 / CR1A / SELREG / select/ /\tad (26) /fixed / MUST NOT CHANGE TAD (25) / fixed / 1 + 25 = 26 LDREG / load / / ----- / |CR1B| / ----- CDF 10/--- [B] REG SELECT---/ AC0001 / CR1B / SELREG / select/ /\tad (26) / fixed / TAD (25) / fixed / 1 + 25 = 26 LDREG / load / / --------------------------------------------------------------- / |CR3A| 4 5 6 7 8 9 10 11| reciever enables/disables | / | | 0 0 0 0 0 | | / | |-------------------------|------------------------------| / | | 0 0| | | 5 bits (or less) | / | | 0 1| | | 7 bits | / | | 1 0| | | 6 bits | / | | 1 1| | | 8 bits | / | | | 1| ENABLE reciever | / --------------------------------------------------------------- CDF 0 /--- [A] REG SELECT---/ AC0003 / CR3A / SELREG / select/ /\tad (-5) / (scale) TAD (-10) / / +3 -10 = -5 TAD SLUAD / USER DEFINED DATA BITS BSW / IAC /enable / reciever irq LDREG / load / /D151 CLA / /D156 AC0003 / RESET BITS 10 & 11 /A151 JMS TSTIMB / CK FOR INTEGRAL MODEM ENABLED /A156 /--\ / --------------------------------------------------------------- /--\ / |CR5A| 4 5 6 7 8 9 10 11| TRANSMITTER ENABLE/DISABLE | /--\ / | | 0 0 0 0| | /--\ / |------------------------------|------------------------------| /--\ / | |0 0| | | | 5 bits (or less) | /--\ / | |0 1| | | | 7 bits | /--\ / | |1 0| | | | 6 bits | /--\ / | |1 1| | | | 8 bits | /--\ / | |----|--|--| | | /--\ / | | | 1| | | BREAK | /--\ / | |----|--|--| | | /--\ / | | | | 1| | ENABLE transmitter IRQ | /--\ / --------------------------------------------------------------- /--\ /\cdf 0 /--- [A] REG SELECT---/ /--\ TAD (5) / CR5A / /--\ SELREG / select/ /--\ CLA / /--\ TAD CR5VAL / /--\ LDREG / load / /--\ CLA / H2DTR / SELECT INTERNAL CLOCK & ASSERT "DTR" CLA / TAD SLUAB / USER DEFINED BAUD RATE H2BAUD / /\ cla / / |---------------------------------------------------| / |THE COMM CHIP IS NOW READY FOR TRANSMIT AND RECIEVE| / |---------------------------------------------------| > / END IFDEF CONDOR ------------------------------------ /A075 / -------------------------------------------------------------------- / | c a u t i o n d r o p f r o m a b o v e | / -------------------------------------------------------------------- CLA; JMS DOBIOT / SET COMMAND REGISTER. AC7777 / clear... CIFSYS / input buffer... HS2OU / of any previous... NOP / garbage...(AND ISSUE XON) CIFSYS / clear input buffer /A064 HS2IN / OF PENDING CHARACTERS /A064 SKP CLA / SKIP WHEN ALL MT. (that's empty) /A064 JMP .-3 / GO GET THE NEXT ONE (& TOSS IT OFF). /A064 JMP I CUSVL / exit / SLUAD, 0 / 000 000 00d ddd / DATA bits SLUAP, 0 / 000 000 000 0pp / PARITY SLUAS, 0 / 000 000 000 0ss / STOP bits SLUAB, 0 / 000 000 00b bbb / BAUD rate H2IEXIT, / /A108 IFNDEF CONDOR < /A108 JMS USIOT > / Map following IOT. /A108 H2KSF / See if pending input interrupt. /A108 EXINTR / Exit if no; end of interrupt service JMP H2IMRG / Merge below to continue MTing input silo/A108 / DUE TO SPACE REASONS THAT ONLY DEVELOPERS CAN KNOW, THE FOLLOWING / LOCATIONS FORMERLY LOCATED ON THE SAME PAGE AS THE "H2" INTERRUPT / HANDLER HAS BEEN MOVED TO IT'S NEW LOCATION HERE. DONE AS PART OF (068). / /************************************************************************* /**** /**** /**** INTERRUPT CHAIN ENTRY /**** /**** /**** /************************************************************************* / /M0068 / DEVICE "HOST INPUT" INTERRUPT CHAIN ENTRY. /M0068 / /M0068 JMP H2PWRF / POWER RESUMED ENTRY TSTHIN / INTERRRUPT CHAIN LINK /M0068 TSTHSI, / TEST INPUT FLAG IFNDEF CONDOR < JMS USIOT > / DECMATE-I PROCESSING ROUTINE /A075 H2KSF / TEST INPUT FLAG JMP I TSTHSI-1 / NO INPUT -- CONTINUE CHAIN /M0068 H2IMRG, / Merge point for Host Input Exit. /A108 IFNDEF CONDOR < JMP H2INPT > / DECMATE-I PROCESSING ROUTINE /A105 IFDEF CONDOR < / ---------------------------------------------- /A075 / / the communications chip used for DECmate II has only one IRQ flag / which could either mean: a. HARDWARE ERROR, b. TRANSMITTER INTERRUPT / c. RECIEVER INTERRUPT, d. PARITY, FRAMING, OR OVERRUN ERRORS CDF 10/--- [B] REG SELECT---/ TAD (4002) / SR2B / status register 2b SELREG / select/ CLA / RDREG / GET THE CONTENTS OF STATUS REGISTER 2B AND (7) / / the value of the AC is defined as follows: / 0 - hardware malfunction / 1 - hardware malfunction / 2 - hardware malfunction / 3 - hardware malfunction / 4 - transmitter buffer empty / 5 - hardware malfunction / 6 - receive data available / 7 - hardware malfunction or parity, overrun or framing errors CDF 0 /--- [A] REG SELECT---/ /\DCA H2BSTATUS / /\TAD H2BSTATUS / TAD (-4) / transmitter irq ? /a083 SZA CLA / skip means transmitter irq /a083 JMP H2INPT / receiver irq---or hardware malfunction/a083 H2TFL / 6310 / SET THE 'DUMMY' TRANSMITTER FLAG JMP I TSTHSI-1 / service the xmit irq later in chain /\H2BSTATUS,ZBLOCK 1 / > / END IFDEF CONDOR ------------------------------------ /A075 PAGE / DEVICE "HOST OUTPUT" INTERRUPT CHAIN ENTRY. /M068 / EXINTR / POWER RESUME ENTRY POINT. /M068 TSTHON / INTERRUPT CHAIN LINK /M068 TSTHSO, / TEST OUTPUT FLAG (dummy flag if CONDOR) IFNDEF CONDOR < JMS USIOTZ >/ DECMATE-I proc routine /A075 H2TSF / TEST OUTPUT FLAG JMP I TSTHSO-1 / No Output -- Continue chain /M068 IFDEF CONDOR < /------------------------------------------------/A075 / dismiss the transmitter interrupt, and / issue 'end of interrupt' command / /\cdf 0 /---[a] reg select----/ TAD (50) / LDREG / CR0A / DISMISS THE TRANSMIT INTERRUPT TAD (20) / (70) / LDREG / CR0A / ISSUE THE END OF INTERRUPT COMMAND CLA / > / END IFDEF CONDOR ------------------------------------ /A075 JMP H2OJMS / OUTPUT -- JUMP TO HANDLE IT. / /A0068 / *** DEVICE "LP INPUT" INTERRUPT CHAIN ENTRY. /A0068 / /A0068 EXINTR / POWER RESUME ENTRY POINT. /A0068 TSTLIN / INTERRUPT CHAIN LINK. /A0068 TSTLPI, D2KSF2 / TEST LP INPUT FLAG. /A0068 JMP I TSTLPI-1 / NO INPUT -- CONTINUE CHAIN /A0068 JMP D2CKIO / GO SERVICE LINE PRINTER INPUT /A103 /**** /**** END INTERRUPT CHAIN ENTRY /**** /************************************************************************* / POINTER AND STACK PUT HERE SO LOACATIONS MAY NOT MOVE. /A148 / THEY ARE REFERENCED IN CHKUDK, CHUDK0 IN WP2CMF /A148 / ADDRESSES ARE IN WPF1 /A148 /A148 U1STPT, 0 / POINTER TO STACK /A148 U1STCK, ZBLOCK 12 / STACK /A148 /A148 CTTYIN, 0 / USED BY UDK CODE FROM FIELD 2 /A148 / ADDRESS DEFINED IN WPF1 /A148 CLA /A148 TTYIN /A148 JMP .-2 /A148 AND P377 /A148 JMS SRCH /A148 CDIMNU /A148 JMP I CTTYIN /A148 GETUDK, /A148 XX /A148 SZA CLA / TEST HALT FLAG /A148 /D149 JMS GETUD9 / FLAG SET, EXIT /A148 /D149 JMP I GETUDK / EXIT /A149 JMP GETUD6 / CLEAR STACK POINTER ON GOLD HALT /A149 CDFMNU /A148 TAD I (UDKINH / TEST INHIBIT FLAG /A148 CDFSYS /A148 SZA CLA /A148 /D149 JMS GETUD9 / INHIBIT SET, EXIT /A148 JMP I GETUDK /A149 GETUD1, /A148 /D149 TAD U1STPT / GET LOCATION IN STACK TO ACCESS /A148 /D149 SNA /A148 /D149 JMS GETUD9 / STACK EMPTY, EXIT /A148 /D149 TAD (U1STCK-1 /A148 /D149 DCA GT1 / ACTUAL CORE ADDRESS IN STACK /A148 JMS GETUD3 / COMPUTE ADDRESS /A149 GETUD4, / HERE AFTER END OF UDK AND READ /A149 ISZ I GT1 / BUMP ADDRESS OF UDK IN STACK /A148 TAD I GT1 / GET ADDRESS OF UDK CHARACTER /A148 AND P377 / SAVE WORD PART /A148 SNA CLA /A148 JMS GETUD5 / END OF BUFFER, NEED READ /A148 TAD I GT1 / OK TO GET THIS CHARACTTER /A148 AND P377 /A148 TAD (CUDBUF / CONSTRUCT ACTUAL CORE ADDRESS /A148 DCA GT2 /A148 CDFMNU /A148 TAD I GT2 /A148 CDFSYS /A148 SNA /A148 JMP GETUD2 / FOUND END OF UDK /A148 ISZ GETUDK / HAVE CHARACTER, BUMP RETURN /A148 /D149 JMS GETUD9 /A148 JMP I GETUDK /A149 GETUD2, / CLEAR POINTER IN STACK /A148 / DECREMENT POINTER TO STACK, TRY AGAIN /A148 DCA I GT1 /A148 CMA /A148 TAD U1STPT /A148 DCA U1STPT /A148 /D149 JMP GETUD1 /A148 JMS GETUD3 / SET UP POINTER FOR NEXT ACCESS /A149 JMS GETUD5 / READ NEW BUFFER /A149 JMP GETUD4 / GET FROM NEW BUFFER /A149 /A148 GETUD5, / READ NEXT BLOCK /A148 0 /A148 TAD I GT1 / GET ADDRESS /A148 AND (7400 / KEEP BLOCK PART /A148 BSW / MOVE TO BITS 8-11 /A148 CLL RTR /A148 / IAC / BUMP TO NEXT BLOCK /D148 /D149 DCA GT2 / KEEP FOR UPDATE OF STACK /A148 /D149 TAD GT2 /A148 TAD (DLUDKS+1 / CONSTRUCT BLOCK TO READ (CHANGE +1) /C148 CIFMNU /A148 JMS I CHRRDX / READ THE DISK /A148 /D149 TAD GT2 / UPDATE STACK WITH CURRENT BLOCK /A148 /D149 BSW /A148 /D149 CLL RTL /A148 /D149 DCA I GT1 / AND PUT IN STACK /A148 JMP I GETUD5 /A148 /D149 GETUD9, / ALL PURPOSE EXIT /A148 /D149 0 /A148 /D149 NOP /A148 /D149 JMP I GETUDK /A148 /A148 GT1, 0 /A148 GT2, 0 /A148 CHRRDX, CHRUDX / REFERENCE IN WPF1 /A148 / ************ ADD ADAM *********** GETUD3, 0 TAD U1STPT / POINTER TO STACK SNA / ANYTHING IN STACK? JMP I GETUDK / NO, EXIT TAD (U1STCK-1 / POINTER + ADDRESS OF STACK DCA GT1 / PLACE IN STACK TO GET FROM JMP I GETUD3 GETUD6, DCA U1STPT / CLEAR STACK POINTER BEFORE EXIT ON HALT JMP I GETUDK / ********** END ADD ADAM ******* / U1STUF - CHECKS THE CHARACTER TO PUT INTO THE TERMINAL INPUT / RING BUFFER. IF IT IS AN ESCAPE, THEN A CHECK IS MADE FOR / THE ESISTANCE OF ANOTHER CHARACTER (THE ANSI INTRODUCER). / IF SUCH A CHARACTER EXISTS THEN THE ESCAPE MUST BE PART OF / A FUNCTION KEY ESCAPE SEQUENCE. IF IT IS NOT PART OF A / FUNCTION KEY ESCAPE SEQUENCE, THE ESCAPE IS FLAGGED WITH / THE 200 BIT SET. IF IT IS THEN A RETURN IS MADE TO ALSO / GET THE NEXT CHARACTER. / U1STUF, XX /A045 TAD (-ESC) / IS THIS CHARACTER AN ESC CHAR? /A045 SNA / SKIP IF NO. /A045 JMP U1IST3 / JMP TO CHECK OUT THE ESCAPE. /A045 SKP / DON'T SET 200 BIT IF NOT AN ESC. /A045 U1IST1, TAD (200) / SET 200 FOR ESC THATS USER ENTERED. /A045 TAD (ESC) / GET CHARACTER BACK. /A045 CLL / SAY NO CHARACTER FOLLOWS. /A045 U1IST2, DCA I U1IPUT / SAVE CHARACTER IN RING BUFFER. /A045 ISZ U1ICNT / 1 MORE CHARACTER IN BUFFER. /A045 ISZ U1IPUT / INC THE STUFF POINTER. /A045 TAD I U1IPUT / ARE WE AT THE END OF THE BUFFER? /A045 SPA / SKIP IF NO. /A045 DCA U1IPUT / RESET PTR TO START OF BUFFER. /A045 SNL CLA / SKIP IF FUNCTION ESCAPE. /A045 ISZ U1STUF / FOR NON-FUNCTION ESC WE WANT SKIP RETN/A045 JMP I U1STUF / RETURN TO CALLER. /A045 /A045 U1IST3, U1KSF / IS THERE ANOTHER CHARACTER PENDING? /A045 JMP U1IST1 / JMP IF NO. THIS ESCAPE IS USER ENTERED/A045 TAD (ESC) / RETURN REGULAR ESCAPE! /A045 STL / SET LINK FOR FUNCTION ESCAPE. /A045 JMP U1IST2 / STUFF CHAR & GET NEXT ONE. /A045 U1IPUT, U1IBUF PAGE /M148 / THIS CODE IS PART OF H2OCHR. IT IS HERE FOR /A123 / REASONS OF SPACE. /A123 / THE CALLER SENT THE AC<0. CHECK FOR BREAK OR DTR /A123 / CODES AND START APPROPRIATE ACTION, OR GO BACK TO /A123 / RESET THE BUFFER. /A123 /D136 H2ORST, CLA /A123 H2BWT, TAD H2BFLG / WAIT UNTIL LINE IS NOT BUSY /A123 SZA CLA /A123 JMP H2BWT / GO WAIT SOME MORE /A123 TAD X0 / OK, LINE FREE. RESTORE AC & TEST FUNCTION /A123 TAD (-7402 / HANGUP THE MODEM? /A123 SNA /A123 JMP H2HANG / YES /A123 IAC / START A BREAK? /A123 SZA CLA /A123 JMP H2RSET / NO. RESET THE BUFFER /A123 AC7777 / FLAG TO START BREAK /A123 DCA BREAKF /A123 JMS H2OTFL / WAKE UP THE HOST /A123 JMP H2OOKX / TAKE SUCCESS RETURN /A123 H2HANG, AC7775 / 3 SECONDS. /A123 JMS HANGUP / DROP DTR /A123 JMP H2OOKX / TAKE SUCCESS RETURN /A123 / /------------------ /D148 PAGE /MOVED TO ABOVE H2BWT TO MAKE ROOM / FOLLOWING IS MOVED HERE TO MAKE ROOM ELSEWHERE /M148 ~31 LINES / "JMP" to here from within "XH2INI" /a078 / (because of lack of pdp memory) /a078 XH2PT2, TAD (SLUAD-1) / GET ADDRESS OF ENTITIES WORDS /A042 DCA X0 / SAVE. /A042 TAD H2INT1 BSW / ++++ RTR AND (17) DCA I X0 / SLUAD / DATA BITS. TAD H2INT1 BSW AND (3) DCA I X0 / SLUAP / PARITY. TAD H2INT1 RTR / ++++ RTR AND (3) DCA I X0 / SLUAS / STOP BITS. TAD H2INT1 / AND SEPARATE THEM FOR DISPLAY/MODIFY AND (17) DCA I X0 / SLUAB / BAUD RATE. / * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * /m083 JMS CUSVL / iots / SET THE VALUES (into the comm chip) /m083 / * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * /m083 IOF / (cause "JMS H2ONN" wants it that way) /m083 JMS H2ONN / /m083 ION / /m083 /m083 / reutrn from "h2onn" with the accumulator = 0 /m083 /m083 JMP XH2XIT / /m083 /END M148 ~31 LINES / INTCHAIN, /A135 / |-----------------------| / |FIX UP INTERRUPT CHAINS| / |-----------------------| / /The following equates determine the order of the interrupt chain. However, /power low (which is checked first) and the clock (checked second) are not /affected by these equates. So, to change the order of any but power low or /clock, simply change the following equates. To change order of power low or /the clock, you must go into the code. The power low checking is done (after /saving AC, DF, LINK etc.) at location START and is followed by the check for /clock interrupt. / / -------- -------- / --------(SEE 'TSTHSI' IFDEF CONDOR) -------- / -------- -------- / /The following three equates were changed to put checking of COMM PORT in /front of the keyboard and screen. This had the effect of greatly improving /CX capabilities on the VT278. There is still a limitation when using the /HOST TO SCREEN (HS) option in CX of only going to 4800 baud. 19200 baud /is ok otherwise. / /The equates below were re-arranged as of (068) to put the printer /A068 /input at a higher priority than the kb output. /A068 TSTLPO=TSTLPT / THIS RESOLVES THE FORWARD REFERENCE BELOW*** /A068 TSTXXX=TSTHSI / First check host input /M068 TSTHIN=TSTLPI / Then check LP input /M068 TSTLIN=TSTKBI / Then KB input, then /M068 TSTUIN=TSTHSO / check host output (SEE 'TSTHSI' IF-DEF CONDOR)/M075 TSTHON=TSTKBO / Then check KB output /M068 TSTUON=TSTLPO / Then check LP output /M068 TSTLON=TSTLST / Then handle unrecognized interrupt GETBTM, XX / RETURNS BREAK TIME /A157 JMS TSTIM1 / FIRST TEST FOR INTEGRAL MODEM ENABLED /A157 JMP SETBT2 / ENABLED - GO SET TO (2 sec.) /A157 / DISABLED - CONTINUE /A157 CDFMNU / GET BREAK TIME FROM MENU LOCATION. /A041 TAD I (MUBUF+MNPRTB) / BREAK TIME IS BITS 3-6 /M154 CDFMYF / BACK TO US. /A041 RAL / SHIFT OVER 1 POSITION /A154 BSW / ISOLATE THE BT. /A041 AND (17) / /a089 JMP I GETBTM / RETURN VALUE /A157 SETBT2, TAD (20) / SET BREAK TIME TO (2 sec.) /A157 JMP I GETBTM / RETURN THE 2 sec. VALUE /A157 TSTIMB, XX / SET INTEGRAL MODEM BIT IF ENABLES & PRESENT /A156 / CALLED BY - HANGUP, TSTDTR, & CUSVL /A156 JMS TSTIM1 / GO DO THE TEST /A157 AC4000 / ENABLED - SET BIT 0 TO ENABLE INTEGRAL MODEM /A157 TAD (0003) / ENABLED RET. - KEEP BITS 10 & 11 SET /A157 DCA TSTIMT / SAVE IN TEMP /A159 TAD SLUAB / PICK UP BAUD RATE /A159 TAD (-7 / TEST FOR HIGH OR LOW SPEED /A159 SMA CLA / SKIP IF LOW SPEED, LESS THAN 1200 BAUD /A159 JMP TSTIMC / JMP IF HIGH SPEED, 1200 OR GREATER /A159 AC0004 / SET TO LOW SPEED /A159 TSTIMC, TAD TSTIMT / PICK UP BITS FROM TEMP /A159 JMP I TSTIMB / RETURN /A157 TSTIM1, XX / TEST FOR INTERGAL MODEM ENABLED & PRESENT /A157 CLA / /A157 CDFMNU / /A156 TAD I (MUBUF+MNFMAT) / /A156 CDFMYF / /A156 AND (MNFM4X / /A156 SZA CLA / SKIP IF NOT ENABLED /A156 JMP TSTIM2 / ENABLED - CK IF PRESENT /A157 ISZ TSTIM1 / SKIP RETURN /A157 JMP I TSTIM1 / /A157 TSTIM2, TAD (4003) / ISSUE AN ENABLE /A157 H2DTR / /A157 CLA / AC MUST BE CLEARED /A157 LAS / READ BITS /A157 AND (4000) / MASK MODEM BIT /A157 SNA CLA / /A157 JMP I TSTIM1 / BIT <0> = 0 - PRESENT, TAKE NON-SKIP RETURN /A157 AC0003 / BIT <0> = 1 - NOT PRESENT - DISABLE /A157 H2DTR / /A157 CLA / MUST BE CLEARED /A157 ISZ TSTIM1 / TAKE SKIP RETURN /A157 JMP I TSTIM1 / /A157 /Routine to trap 8 bit chars on output /a161 /Calls a routine that now resides where the startup code in DSKHND /a161 / used to be to deal with the 8 bit char /a161 / RETURNS with the ac =0 if the fallback has been sent /a161 / ac = char if no fallback required /a161 TEST8B, TAD TACHAR / get the char /a161 AND P200 / test the 8bit bit set /a161 SZA CLA / skip if we dont have an 8 bit char /a161 JMP TEST83 / yes an 8bit /a161 TEST81, TAD TACHAR / get the char back /a161 TEST82, JMP D2CONT / continue LPTOU /a161 / The next piece of code calls a test for an LQPO2 if it has one then /a161 / lots of 7 bit chars cold be sent as fallback for th present 8 bit char/a161 / Therefore we have to save the original RETURN address and FIELDS /a161 / in order to replace them and return to the right place /a161 / No 8 bit chars can or will be sent as Fallback chars so this code /a161 / will only be run once for each 8 bit char /a161 TEST83, TAD LPOCHR / get LPTOUs return address /a161 DCA LPTRSV / save it /a161 TAD D2OCHX / get the return field /a161 DCA LPTFSV / save it /a161 TAD TACHAR / get the char /a161 JMS I PRT8FB / (7600 call PRT8FB /a161 DCA TACHAR / save the char returned /a161 TAD LPTRSV / get the old return address /a161 DCA LPOCHR / put it back /a161 TAD LPTFSV / get the return feild /a161 DCA D2OCHX / put it back /a161 JMP TEST81 / return /a161 /----------------------- PAGE / NOW FOLLOW THE JOB STATUS BLOCKS /A139 / FIRST IS THE DSKQUE AND RXJOB BLOCK /A139 / NEXT IS THE PRINTER JOB BLOCK PRJOB /A139 / NEXT ARE OTHER JOB BLOCKS USED BY CX, ETC /A139 DSKQUE, / DEFINED IN WPF1 /A139 RXJOB / ++++ 0 / ++++ 0 / DSKQUE HEADER / ZBLOCK NJSBS^5 / ALLOCATE XTRA JSB'S / THE FOLLOWWNG IS THE FINAL CLEANUP CODE WHICH RUNS WHEN THE SYSTEM / IS LOADED. IT IS DESIGNED TO BE THE MINIMUM AMOUNT OF CODE WHICH ENDS / UP RESIDENT. MUCH OF THE INITIALIZATION CODE WHICH RUNS AT BOOT TIME / IS RESIDENT IN THE VARIOUS WPSYS BUFFERS. AFTER THAT CODE IS EXECUTED, / WPSYS MUST CLEAN ITSELF UP. THIS INVOLVES CLEARING ALL THE BUFFERS / AND INSTALLING THE WRAP POINTERS AT THE END OF EACH BUFFER (THIS IS / DONE BY CODE AT PATCHM. PATCHN, DCA I PATCHA / CLEAR PATCH CODE ISZ PATCHA ISZ PATCHA+1 / ++++ JMP PATCHN JMP I PWRJMP / NOW REALLY START UP SYSTEM / PATCHA, PATCHT / LOC TO START CLEARING / THIS IS WHERE THE BUFFERS BEGIN. THE FIRST LOCATION OF LPOBUF / DOUBLES AS AN ISZ COUNTER WHICH WILL CLEAR ITSELF AS THE ABOVE CODE / RUNS, AND THEREFOR CAN BECOME PART OF LPOBUF / THE BUFFER SIZES ARE DEFINED IN WPF1 / THE BUFFERS ARE LOCATED AS FOLLOWS: (X= ARE DEFINED IN WPF1) X=LPOBUF /PRINTER OUTPUT BUFFER U1IBUF=LPOBUF+LPOSIZ+2 U1OBUF=U1IBUF+U1ISIZ+2 X=H2IBUF /HOST INPUT BUFFER H2OBUF=H2IBUF+H2ISIZ+2 LPIBUF=H2OBUF+H2OSIZ+2 /A103 X=PRFVBF /PRINTER FIELD VARIABLE SAVE BUFFER /A139 ENDBUF=PRFVBF+PRFVSZ /C139 / RXHAN OCCUPIES THE SPACE BETWEEN RXDLDP AND 7777 /A110 XTRBUF=RXDLDP-ENDBUF-1 /A110 IFZERO XTRBUF+4000&4000 /A110 LPOBUF, PATCHT-PATCHZ-1 / LENGTH TO CLEAR /----------------------------------------------------------------- / THIS SECTION OF INITIALIZATION CODE RESIDES IN LPOBUF / IT CLEARS FROM THE END OF ITSELF (THEREFORE IT MAY NOT USE LINKS / OR LITERALS) TO RXDLDP, AND INSTALLS ALL THE BUFFER WRAP POINTERS / THE BUFFER IN WHICH IT RESIDES (LPOBUF) MUST BE LARGER THAN THIS / SECTION OF CODE PATCHT, CIFPRT / PTC7R0 NOW IN PRINTER FIELD /A138 / LEAVE DATA FIELD SET TO SYS /A138 JMS I (PTC7R0 / DO THE DRIVE SIZING /A114 JMS COMINI / INITIALIZE COMM /A135 PATCHU, /A114 DCA I PATCHB / CLEAR BUFFER CORE AREA ("PATCHZ" THRU RXDLDP) ISZ PATCHB / ++++ ISZ PATCHD /A110 JMP PATCHU /LOOP /A110 /C114 TAD PATCHS / ++++ DCA X0 / SET END PTRS JMS I XPATCM / DO PATCHES JMP PATCHN / GO CLEAR OUT THIS CODE /A135 PATCHB, PATCHZ PATCHD, PATCHZ-RXDLDP XPATCM, PATCHM PATCHM, XX / /M090 TAD I X0 / GET LOC TO BE PATCHED SNA / ++++ JMP I PATCHM / QUIT IF 0 DCA T1 TAD I X0 / ++++ DCA I T1 / MOVE NEW CONTENTS TO LOC JMP PATCHM+1 / AND LOOP FOR MORE / PATCHS, . LPOBUF+LPOSIZ+1 / ++++ LPOBUF / BUFFER END PTR PATCHS U1IBUF+U1ISIZ+1 / ++++ U1IBUF U1OBUF+U1OSIZ+1 / ++++ U1OBUF H2IBUF+H2ISIZ+1 / ++++ H2IBUF H2OBUF+H2OSIZ+1 / ++++ H2OBUF LPIBUF+LPISIZ+1 / ++++ /A103 LPIBUF /A103 0 / END OF END PTR PATCHS / / IFZERO .-LPOBUF-LPOSIZ-1&4000 / PATCHZ, / START OF BUFFER AREA TO BE CLEARED /------------------------- PAGE COMINI, XX /A135 / THIS SECTION DETERMINES IF COM IS PRESENT /C104 / AND SETS UP THE CMONLN FLAG /C104 / IF COM IS PRESENT ON A DECMATE-I THEN /C104 / REQUEST TO SEND AND DATA TERMINAL READY ARE ACTIVATED /C104 IFNDEF CONDOR < / -------------------------------------------- /A075 CLA OSR / BIT 11=0 SAYS COMM PRESENT /M021 CMA / MAKE POSITIVE /A036 AND X0001 / MASK OFF ALL BITS EXCEPT COM /A036 DCA CMONLN / SET CMONLN /C104 TAD CMONLN / GET IT BACK TO TEST /C104 SNA CLA / SEE IF COM IS PRESENT /A037 JMP I COMINI / IF NOT RETURN /C135 TAD X0030 / SET REQUEST TO SEND AND TERMINAL READY/A037 WRTP0 / WRITE PORT ZERO CLA RACD / RESET COMMUNICATIONS DEVICE /A037 CLA / /A040 TAD X0030 / SET REQUEST TO SEND AND TERMINAL READY/A040 WRTP1 / FOR PORT 1. /A040 AC4000 /A040 RACD / RESET COMMUNICATIONS DEVICE FOR PORT 1/A040 CLA / CLEAR THIS 4000 OUT! /A107 JMP I COMINI / RETURN /A135 X0001, 1 / X0030, 30 / > / END IFNDEF CONDOR --------------------------------- /A075 IFDEF CONDOR < / ------------------------------------------- /A107 AC0001 / IN DECMATE-II DCA CMONLN / COMMUNICATIONS HARDWARE ALWAYS PRESENT / --------------------------------------------- / | DEVELOPMENT requirements for DECmate II:: | / --------------------------------------------- / / IF the hardware system at boot-up time is a DECmate I / THEN the clock IOT within program location 'XCLKSKP' is o.k. / BUT the comm hardware is disabled cause DM-2 has different IOT's / / IF the hardware system at boot-up time is a DECmate II / Then set a new clock IOT within program 'XCLKSKP' / / (because as of 10-may-82 an RX01 is the only drive on PDP-11/70 'arson') / (available to 'write out' new systems) / AC4000 / (set interupt mode 'NORMAL' if DEcmate I) CLKSET / CMOD / SET clock flag (or if DECmate I then 'CMOD') DM2IOT, CLKSK2 / SKIP / if DEcmate II clock flag=1 (from 'clkset') JMP DM1 / WE ARE RUNNING ON A DECMATE-I / WE ARE RUNNING ON THE DECMATE-II FAMILY / FIRST WE PATCH THE CORRECT CLOCK SKIP IOT CLA / (cause AC=4000) TAD DM2IOT / iot / get the DEcmate II clock 'skip' IOT DCA I (XCLKSKP / and reset program location 'XCLKSKP' /m076 / NOW WE DETERMINE IF WE ARE RUNNING ON A DECMATE II OR III /A147 / TO DO THIS WE EXAMINE A LOCATION IN PANEL MEMORY /A140 / THEN OR ONE OF THE FOLLOWING CONSTANTS INTO RXTYPE /A140 / 0400 DECMATE II /A140 / 2000 DECMATE III /A140 / 1000 DECMATE IV (SHOULD NEVER? HAPPEN) /A147 /At this point RXONLN must have been set; i.e. CONINI called after PT7CRO /A145 PRQ3 /FETCH SYSTEM TYPE (II, IV OR III) /A140 CDFMYF&10+5001 /PANEL FIELD 1 TO MYFLD /A140 0021 /FROM PANEL LOC 0021 /A140 T1 /TO T1 /A140 -1 /1 WORD /A140 -1 /A140 CDFSYS /A147 CLA /A147 TAD T1 /EXAMINE ACTUAL TYPE /A140 SMA /SKIP IF LT 0 (NOT DMII) /A140 JMP DM300 /DONE IF DMII /A140 CLL RTL /LOOK AT BIT1 /A147 SNL /NO LINK IF DMIII /A147 JMP DM200 /A147 HLT /!HALT! /A147 JMP .-1 /NOT DMII OR DMIII /A147 DM200, /A147 AC0002 /DMIII ONLY HAS 2 DRIVES /A145 DCA RXONLN /A145 AC2000 /LOAD CODE FOR DMIII /A147 COMIN1, TAD RXTYPE /OR CODE INTO TYPE SETUP WORD /A140 DCA RXTYPE /A140 JMP I COMINI / RETURN /A135 DM1, CLA /CAUSE AC=4000 /A078 DCA CMONLN /DM-II SOFTWARE ON A DM-I HAS NO COM /A107 DM300, CLA /NEEDED IF ENTER FROM ABOVE /A140 TAD (0400) /LOAD CODE FOR DECMATE-II /A140 JMP COMIN1 /GO OR INTO RXTYPE & EXIT /A140 > / END IFDEF CONDOR ----------------------------------- /A107 /--------------------- PAGE PRQ3=6236 THSFLD=1 CDFMYF=THSFLD^10+CDF CIFMYF=THSFLD^10+CIF FIELD THSFLD / PRINTER FIELD /A138 *PRBOTM / OVERLAY BUFFER AREA /A138 PTC7R0, XX / THIS SUBROUTINE DETERMINES WHAT KINDS OF DISK DEVICES ARE PRESENT / AT BOOT TIME. IT IS ONCE ONLY CODE. IT IS CALLED FROM WPSYS / BUT IS HERE BECAUSE OF WPSYS WRITEOUT SPACE PROBLEMS / IN THE MOVE HERE, ALL FORMER DIRECT REFERENCES TO RXONLN AND /A138 / RXTYPE CHANGED TO I (RX---- INDIRECT REFERENCES. THE ASSUMPTION /A138 / IS MADE THROUGHOUT THIS SUBROUTINE THAT THE DATA FIELD REMAINS AT /A138 / CDFSYS UNLESS THE CODE SPECIFICALLY INDICATES OTHERWISE /A138 / T H E R E F O R E . . . /A138 / THERE SHOULD BE NO OFF PAGE REFERENCES TO VARIABLES IN THESE /A138 / ROUTINES * * * * * * * * * * * * * * * * * * * * * * * * * * * /A138 IFNDEF CONDOR < / --------------------------------------------- /A072 / THIS SUBROUTINE SETS RXONLN TO THE NUMBER OF RX DRIVES WHICH ARE ON / LINE--EITHER 0, 2, OR 4. SINCE WE BOOTED OFF DRIVE 0, THERE /M050 / MUST BE AT LEAST 2 SO WE JUST TEST FOR THE PRESENCE OF 4. /A050 CLA;6750 / SELECT DRIVE 0 (BOOT DRIVE). /A050 6755;NOP / CLEAR DRIVE 0 DONE FLAG /A050 6754;NOP / CLEAR DRIVE 0 ERROR FLAG /A050 6753;NOP / CLEAR DRIVE 0 TRANSFER FLAG /A050 CLA / /A050 PTC7R1, TAD (12) / READ DEVICE STATUS (12 BIT MODE). /A050 6751 / ... /A050 6755;JMP .-1 / WAIT FOR DONE (WE BOOTED SO IT MUST /A050 / HAPPEN SOONER OR LATER!!!) /A050 6754 / CHECK ERROR FLAG. SKIP IF ERR FLG SET./A053 JMP PTC7R2 / NO ERROR. READ STATUS BELOW. /A053 CLA / TRY DOUBLE DENSITY READ. /A053 TAD (400) / ... /A053 JMP PTC7R1 / .... /A053 /A053 PTC7R2, 6752 / READ STATUS REGISTER FROM CONTROLLER. /A050 AND (10) / ISOLATE THE RX01(RX8E)/RX02(RX28) BIT./A050 SZA CLA / SKIP IF RX01 (RX8E) /A050 IAC / SET RXTYPE TO 1 FOR RX02(RX28). /A050 DCA I (RXTYPE / .... /A050 / /A050 AC0001 JMS PTC7R3 / SEE IF THE SECOND UNIT IS ON LINE / DONE FLAG WILL BE SET IF IT IS AC0002 / THE FIRST PAIR IS ALWAYS ON LINE 6755 / SKIP IF THE DONE FLAG WAS SET SKP / THE DONE FLAG WASN'T SET AC0004 / THERE ARE TWO PAIRS ON LINE DCA I (RXONLN / SAVE THE VALUE 6755;NOP / CLEAR DRIVE 1 DONE FLAG /A050 6754;NOP / CLEAR DRIVE 1 ERROR FLAG /A050 6753;NOP / CLEAR DRIVE 1 TRANSFER FLAG /A050 CLA / SELECT THE FIRST PAIR AGAIN. /A050 JMS PTC7R3 / WILL SET DONE FLAG / /***********THE FOLLOWING IS TEMPORARY**********(BUT IT WORKS)*** / THE FOLLOWING CODE(6757 INITIALIZE) IS HERE BECAUSE IT / APPEARS THAT WHEN THE SELECT CODE IS ISSUED TO A PAIR NOT / CONNECTED SOME UNSPECIFIED RESULTS OCCUR. INIT DOES CLEAR / CLEAR THE PROBLEMS...I AM STILL CHECKING THE WHY'S AND WILL / DELETE THIS CODE WHEN IT IS CLEAR. 6755;NOP / CLEAR DRIVE 0 DONE FLAG /A050 6754;NOP / CLEAR DRIVE 0 ERROR FLAG /A050 6753;NOP / CLEAR DRIVE 0 TRANSFER FLAG /C050 6752 / CLEAR REQUEST /A058 CLA /SET FOR RETURN /A058 6757 /INIT DISK /A058 6755 /DONE? /A058 JMP .-1 /NO. /A058 CDISYS / CHANGE TO SYSTEM FIELD /A138 JMP I PTC7R0 / RETURN / THIS SUBROUTINE CLEARS THE DONE, ERROR, AND TRANSFER FLAGS OF THE RX / UNIT SPECIFIED IN THE AC UPON CALL. IT THEN CAUSES THE DONE FLAG TO / BE SET IF THE UNIT IS ON LINE. PTC7R3, XX 6750 / SELECT THE PROPER UNIT 6755;NOP / CLEAR DONE FLAG 6754;NOP / CLEAR ERROR FLAG 6753;NOP / CLEAR TRANSFER FLAG TAD DELAY DCA T1 / SET DELAY LOOP COUNT / WE NOW DETERMINE WHETHER THE SELECTED UNIT IS ACTUALLY ON LINE. TO DO / THIS, WE ISSUE A READ ERROR CODE FUNCTION (16). IF THE UNIT IS ON / LINE, IT WILL RESPOND BY SETTING THE DONE FLAG. THIS FLAG IS TESTED / TO DETERMINE IF THE UNIT IS ON LINE. TAD (16) / LOAD READ ERROR CODE COMMAND (12 BIT MODE). 6751 ISZ T1 JMP .-1 / WAIT FOR THINGS TO SETTLE DOWN / CAN'T SIMPLY TEST THE FLAG TO TELL IF THE / COMMAND IS THROUGH, SINCE WE DON'T KNOW IF / THERE IS ACTUALLY A UNIT ON LINE. JMP I PTC7R3 / RETURN--THE FLAG IS SET IF THE UNIT IS ON LINE DELAY, -20 / THE DELAY COUNT > / END IFNDEF CONDOR ----------------------------------- /A072 IFDEF CONDOR < / ---------------------------------------------- /A072 / This subroutine sets the contents of RXONLN / to the correct number of RX drives which are on line / (either to 2, 4, 6, or 8) / AND this subroutine sets the contents of RXTYPE / (specifically bits 10 and 11) / (bit 11=1 means drive 0 is an 8 inch diskette) / (bit 10 = 1 means drive 4 is an RX02) / The RX SELect IOT 67x0 (previously documented as a NOP) / AND this subroutine determines the type of APU board / attached, if any / with the contents of the AC (bits 0 and 11) / is used to determine which drive 'pairs' on-line / (NOTE that 'x' means don't care when external RX02 adapter is OUT) /------------------------------------------------------------------------------- / AC bits: RX02 adapter ACTION / (0) (11) (Select an RX50 or RX02 pair) /------------------------------------------------------------------------------- / x 0 out drive pair #1 (drives 0, 1) / x 1 out drive pair #2 (drives 2, 3) /------------------------------------------------------------------------------- / 0 0 in RX50 drive pair #1 (drives 0, 1) / 0 1 in RX50 drive pair #2 (drives 2, 3) / 1 0 in RX02 drive pair #1 (drives 4, 5) / 1 1 in RX02 drive pair #2 (drives 6, 7) /------------------------------------------------------------------------------- / NOTE that since this code is being executed / we must have booted from drive 0 / therefore there is at least 1 drive pair (2 drives) on-line / RX50 or RX02 drive pair #1 (drives 0, 1) must be on-line / (cause we booted up) / THEREFORE issue a 'READ STATUS REGISTER' function code / (to determine the 'size' of the diskette in drive 0) IFDEF WINNIE < DCA I (RXONLN /CLEAR NUM PAIRS ON LINE /A132 JMS WNINIT /INIT WINNIE /A115 JMP PTC7R1 /NOT A WINNIE CONTINUE /A115 /D122 TAD WNOPTN /A115 DCA I (RXTYPE /SET IT /A115 AC0004 /SET # DRIVES=8 /A110 TAD I (RXONLN / #=10 IF 0=WINNIE /A132 DCA I (RXONLN /A110 JMP NORX78 > /END IFDEF WINNIE /A115 PTC7R1, ISZ I (RXONLN / Drive pair (drives 0, 1) must be on-line /C132 PTC7RA, AC0000; 6750 / SEL / firstly, 'select' drive pair 6755; NOP / SDN / (remember that 'SEL' sets done for protocol) JMS P7STAT /GET STATUS***SPACE WARS*** /A132 SZA CLA / skip next if drive 0 is RX50 AC0001 / DCA I (RXTYPE / (bit 11 - 1 means drive 0 is an RX01 or RX02) / POLL RX50 or RX02 drive pair #2 (drives 2, 3) AC0001 / JMS RXPOLL / poll / poll the drive pairs defined by AC: 0, 11 SZA CLA / Skip next if DONE flag set in "RXPOLL"/a092 JMS RXINIT / INIT / issue INIT cause drive pair NOT on-line ISZ I (RXONLN / +1 / RX50 or RX02 Drive pair (drives 2, 3) on-line /\ jmp .+1 / / CONTINUE polling for RX02 drive pair #1 (drives 4, 5) AC4000 / / JMS RXPOLL / poll / poll the drive pairs defined by AC: 0, 11 SZA CLA / Skip next if DONE flag set in "RXPOLL"/a092 JMP NORX78 / exit / prepare to exit cause drive pair NOT on-line / A drive pair is selected / BUT it could be drives 0, 1 or drives 4, 5 / (IF the RX02 adapter is 'IN' then drives 4, 5 are on-line) LAS / read the hardware register AND (4) /bit 9 / M140, /A138 SZA CLA / skip next if RX02 adapter is 'IN' (bit 9 = 0) JMP NORX78 / jump cause RX02 adapter is 'OUT' (bit 9 = 1) AC0003 / / (close any holes and make it look like) DCA I (RXONLN / (drives 0, 1, 2, 3, 4, 5 are on-line) / READ the status register / to determine if drive 4 is an RX02 or not JMS P7STAT /GET STATUS***SPACE WARS*** /A132 SNA CLA / skip next if drive 4 is an RX02 JMP POLL67 / jump cause drive 4 is an RX50 TAD T1 / T1 / get back the status AND (10) /bit 8 / CLL RTR /bit 10 / BIT 10 = 1 means RX02; 10 = 0 means RX01 TAD I (RXTYPE / DCA I (RXTYPE / / POLL for RX02 drive pair #2 (drives 6, 7) POLL67, TAD (4001) / JMS RXPOLL / poll / poll the drive pairs defined by AC: 0, 11 SNA CLA / SKIP BUMP OF DRIVE PAIR IF NOT THERE /C138 ISZ I (RXONLN / +1 / RX02 Drive pair #2 (drives 6, 7) is on-line / a 'JMP NORX78' means the RX78 controller was OUT, or / RX02 drive pair #1 (drives 4, 5) is NOT on-line / (therefore an RX02 drive pair #2 (drives 6, 7) can't exist) NORX78, AC0000; JMS RXPOLL / REselect controller of drives 0,1,2,3 /a077 CLA / /a092 JMS RXINIT; NOP / INIT / issue RX INIT to 'clean up' things /A094 TAD I (RXONLN / get the number of 'drive pairs' on-line CLL RAL / x2 / 'times' 2 gets the number of drives on-line DCA I (RXONLN / IFDEF CONDOR < JMS FRMCHK /SET FIRMWARE BIT(40) IN RZTYPE IF WINNIE/A118 JMS APUCHK /CHECK FOR APU BOARD /M138 > /END IFDEF CONDOR /A118 CDISYS / CHANGE TO SYSTEM FIELD /A138 JMP I PTC7R0 / exit / / P7STAT, XX /GET STATUS /A132 TAD (12); 6751 / LCD / 'read status register' function code 6755; JMP .-1 / SDN / (wait for 'done' flag--up to 120ms) 6752 / XDR / 'transfer data register' (gets status into AC) DCA T1 / temp / save the status TAD T1 / AND (140) / 5; 6 / BITS 5&6 both = 1 means RX50 drives TAD M140 / USE A SZA CLA FOR (-140) /C138 JMP I P7STAT /RET WITH ACC=0 IF RX50 DEVICE /A132 / This subroutine is called to select a drive pair as defined / with the contents of AC bits 0 and 11 / IF the drive pair polled is on-line / then the DONE flag will be set / E_X_I_T with the contents of the AC = 0 means the DONE flag was set /a092 / /a092 / E_X_I_T with the contents of the AC = 7777 means the done flag was NOT/a092 / RXPOLL, XX / Enter with the contents of the AC live 6750 / SEL / Issue SELECT DRIVE PAIR iot 6750 / SEL / 2nd time needed for drvs 6&7 /A094 / NOTE: that IOT 6750 does set the DONE flag / BUT this is not the 'done' we want / (CAUSE this 'done' only acknowledges the 'SEL' IOT as to protocol) 6755; NOP / SDN / Skip next if DONE flag is set (then clear) 6754; NOP / SER / Skip next if ERROR flag is set (then clear) 6753; NOP / STR / Skip next if TRANSFER REQ flag set (clear it) TAD (12) / 1010 / Execute 'READ STATUS REG' fc (5) /a092 6751 / LCD / (sets DONE flag if selected pair is on-line) TAD (7600) / delay / /a092 DCA T1 / set delay loop count (to wait for done) RXLOOP, / /a092 ISZ T2; JMP RXLOOP / wait the specified DELAY for done /a075t 6755 / SDN / SKIP next if done flag set /a092 SKP CLA / /a092 JMP I RXPOLL / EXIT / with the (AC) = 0 means DONE FLAG SET /a092 ISZ T1; JMP RXLOOP / wait the specified DELAY for done /a075t AC7777 / -1 / /a092 JMP I RXPOLL / exit / with (AC) = -1 means NO done flag /a092 > / END IFDEF CONDOR ------------------------------------ /A072 / RXINIT IS USED FOR BOTH CONDOR AND NONCONDOR / Subroutine to issue the RX INIT iot / because if a drive pair was polled that was not on-line / the DONE flag will never set RXINIT, XX / 6757 / INIT / issue the RX INIT iot 6755; JMP .-1 / SDN / WAIT for the DONE flag to set ISZ RXINIT / +1 to the EXIT address JMP I RXINIT / exit / IFDEF CONDOR < PCMWT0, XX /A125 PRQ3 /A122 CDFMYF&70%10+4060 /40XY X=OUTPUT FLD Y=INPUT FLD /C138 /D146 FRMTYP /LOC TO GET DATA /A122 PCMWT1, /M146 IDSTRT /LOC TO GET DATA /A122 /C146 PCMSTR /WRITE LOC IN P.M. /A122 /C146 IDSTRT-IDEND /-#CHARS TO MOVE /A122 /C146 -1 /TERMINATOR /A122 /D146 ISZ PCMWT1 /SET TO NEXT LOC /A122 JMP I PCMWT0 /RET /A125 APUCHK, XX / ROUTINE TO CHECK FOR APU BOARD /A138 / ASSUMES LINK IS CLEAR ON ENTRY /A144 LAS / READ SWITCH REGISTER AND (10) / LOOK AT THIS BIT SNA CLA / SKIP IF APU/XPU NOT PRESENT /m144 STL IAC / SET 1 IN AC TO REQUEST SET OF OUTPUT /A144 / DATA AVAIL FLAG IN XPU, LINK WILL BE /A144 / "APU/XPU PRESENT" BIT /A144 6170 / AC=1 , SET "SODAV" FLAG IN XPU /A144 6171 / TEST & CLR " " , SKIP IF SET /A144 CLA / CLEAR THE "XPU" BIT FROM AC /A144 RAL / ROTATE THE "XPU" AND "APU/XPU PRESENT"/A144 / BITS INTO AC10 & AC11 /A144 BSW / AND BYTE SWAP THEM INTO AC4 & AC5 /A144 / (MNRX7X & MNRX6X) /A144 /d144 TAD (MNRX6X) / APU BOARD PRESENT, SET THIS BIT TAD I (RXTYPE / AND UPDATE WORD IN WPSYS DCA I (RXTYPE / JMP I APUCHK / RETURN > / END IFDEF CONDOR /-------------------- PAGE IFDEF CONDOR < /**********FOLLOWING CODE ADDE FOR WINNIE VERSION 115**** / /Setup drive table in DSKACP for winchhester devices / / 4000 = WINNIE DEVICE------4001 = WINNIE DEVICE MOUNTED / RXTYPE----BIT <7> =DRIVE 0 = WINNIE ------------MNRX2X / --BIT <8> =DRIVE 1 = MOUNTED WINNIE-----MNRX3X / --BIT <9> =WINNIE ON LINE --------------MNRX4X GTVOL=12 DMTVOL=10 /DISMOUNT CODE FOR DIRECT CALL /A131 WNINIT, 0 CLA IAC /CHECK FOR WINNIE RDNOOP /IF WINNIE CLEAR AC SZA CLA JMP I WNINIT /RETURN JMS RXPOLL /SEE IF RX50 ON LINE /A132 SNA CLA /0=YES /C158 JMP WNINT2 /RX01,2 ON LINE /A158 JMS RXINIT /CLEAR IF NOT /C158 CLA /SKIPPED /C132 AC4000 /SET TO SEL /A158 JMS RXPOLL /ARE THEY THERE? /A158 SZA CLA /0=YES /A158 JMS RXINIT /CLEAR IF NOT /A132 WNINT2, /A158 ISZ I (RXONLN /INC DRIVE PAIR IF ON LINE(RXINIT SKIPS)/A132 ISZ WNINIT /SET WINNIE RET CDFACP /A131 TAD I (RXSTRT+1) /DRIVE 0 /C132 CDFSYS /A131 SMA CLA /0=RX50 H/O BIT =WINNIE /A131 JMS WININ1 /DISMOUNT 0 FIRST TIME THRU/A131 WINSTF, CAM /IGNORE ERROR CODE(MOUNTED WINNIE CHK /C132 TAD (-GTVOL /GET VOLUME /A131 DCA WINFNC /SET CODE /A131 JMP WINNXT /NEXT /A131 WINGTV, /A131 JMS WININ1 /NEXT /A131 SMA CLA /RETURN... - = ERROR IAC /DRIVE IS MOUNTED TAD (4000 /WINNIE CDFACP /ACP FIELD DCA I T1 /SET IT IN TABLE /C132 CDFSYS /THIS FIELD WINNXT, /A131 ISZ WINCUR /INC DRIVE # ISZ WINNUM /DONE? JMP WINGTV /NO--DO NEXT / SET RXTYPE FOR WINNIE CLA CLL IAC / BIT 1 SET /A132 /MOUNTED BIT CDFACP /ACP FIELD AND I (RXSTRT+1) /POINTER TO SYS DRIVE /C132 CDFSYS DCA FRMTYP /SAVE OPTION BIT FOR DRIVE 0..1=WINNIE /C122 TAD FRMTYP /A132 SZA /IS DRIVE 0=WINNIE /A132 JMP WININ2 /YES...LET DRIVE 1 STAY WINNIE /A132 DCA I (RXONLN /CLEAR COUNT FOR RX50 BOOT /A132 ISZ (RXSTRT+1) /SET POINTER TO DRIVE 1 /C132 CDFACP TAD I (RXSTRT+1) /C132 RAR /BIT 1=MOUNTED IF SET SNL CLA /IS IT MOUNTED? DCA I (RXSTRT+1) /NOT MOUNTED CLEAR WINNIE BIT..VER 1.5 /C132 CDFSYS TAD FRMTYP /GET OPTION /C122 WININ2, /A132 RTL /LINK BIT=DRIVE 1 MOUNTED AS WINNIE IAC /SET FOR WINNIE ON LINE RTL /SET INTO BITS <8,9,10> /D122 DCA WNOPTN /SET IT JMP I WNINIT /RETURN /USED TO DISMOUNT 0 IF RX50 THEN CHECK DEVICES FOR MOUNT/A131 WININ1, XX /DISMOUNT 0 IF RX50 THEN CHECK DEVICES FOR MOUNT/C131 TAD WINCUR /CURRENT DRIVE # TAD (RXSTRT+1) /ADD TO DRIVE 0 PTR /C132 DCA T1 /POINTER TO CURRENT DRIVE IN TBLE /C132 TAD (CIFMYF) /RETURN FIELD /C138 CDFMYF /A138 CIFDSK /DRIVE FIELD JMS I (RXDLDP /DIRECT CALL TO HANDLER WINCUR, WNSTRT /CURRENT DRIVE # 0 /START BLOCK # MUST BE VALID N0 CDFMYF /THIS FIELD WINBUF /BUFFER TO STORE VOL IF READ(24 DEC WRDS) 0 /BLK COUNT 0 /TRACK NO WINFNC, /A131 -DMTVOL /READ VOL FNC CODE IN HNDLER FORMAT CDFSYS /C138 JMP I WININ1 /RET /A131 / /THIS ROUTINE CHECKS FOR WINNIE DEVICE.. IF ON LINE CHECKS FIRMWARE TYPE /SETS BIT (6)--[40] IF WINNIE FIRMWARE-THIS TO ALLOW RETURN TO MASTER MENU / FRMCHK, XX /A118 TAD I (RXTYPE /A118 RAR /L/O BIT =RX01/02 =SYSTEM /A118 SZL CLA /A118 JMP I FRMCHK /IGNORE /A118 SETPRQ, /BOOT WINNIE OR RX50D /A118 PRQ3 /GET FIRMWARE STATUS WORD /A118 CDFMYF&70+5001 /50XY X=RECEIVING FIELD IN MAIN MEMORY /C138 / Y=SOURCE FIELD IN PANEL MEMORY /C138 0 /ADDRESS IN P. MEM /A118 FRMTYP /ADDRESS TO STORE.FIRMWARE TYPE /A118 -1 /# WORDS TO GET /A118 -1 /TERMINATOR /A118 CLA IAC /1 /A118 /C121 TAD FRMTYP /TYPE 0=RX50 -1=WINNIE /A118 SZA CLA /IS WINNIE FIRMWARE? /A118/C0121/C122 JMP I FRMCHK /NO, RETURN /C138 JMS FRMCHL /CHECK IF BOOT FROM MASTER MENU /A141 TAD (MNRX5X /SET WINNIE FIRMWARE BIT FOR WINNIE BOOT/A141 TAD I (RXTYPE /ADD OPTION BITS /A118 DCA I (RXTYPE /SET IT /A118 /D138 APUCHK MADE SEPARATE ROUTINE AGAIN /A138 JMP I FRMCHK /RETURN /A118 FRMTYP, 0 /A118 /M130 /LOAD PANEL MEMORY TO USER MEMORY / PCMRD0, 0 /ROUTINE TO GET CHAR FROM P.M. /A122 PRQ3 /A122 CDFMYF&70+5006 /50XY X=OUTPUT FIELD Y=INPUT FIELD /A122 /C138 PCMRD3, PCMSTR /READ DATE LOC IN P.M. /C141 IDSTRT /LOC TO PUT DATA /A122 /C146 IDSTRT-IDEND /-#CHARS TO MOVE /A122 /C146 -1 /TERMINATOR /A122 /D146 ISZ PCMRD3 /SET TO NEXT LOC /A122 /D146 TAD FRMTYP /A122 JMP I PCMRD0 /A122 WINMAX=10 /MAX NUM DRIVES=8 WNSTRT=0 /START WINNIE DRIVE NUMBER WINNUM, WNSTRT-WINMAX /NUMBER DEVICES TO CHECK PAGE /A141 > /END IFDEF CONDOR /A118 / ****** DECmate I code moved here for space reasons ******* /A130 / CONDOR does not have enough space here for /A130 / them both to assemble here /A130 IFNDEF CONDOR < /A130 /READ CHAR FROM PANEL MEM.... /....THIS ROUTINE IS SET AT LOAD TIME... IS EXECUTED DURING START UP /.....WHEN FIRST END OF BUFFER IS READ(NULL) CALL TO ROUTINE WILL BE NOOPED / PCMADR=7732 /ADDRESS OF P.M. DATE /A122 PCMSTR=7600 /START OF PANEL MEM DATA /A122 PCMCMD=PCMSTR+10 /ADDRESS OF P.M.CMND STR /A122 PCMRD, 0 /A122 CLA /A129 PRQ3 /A122 CDFMYF&70+5006 /50XY X=OUTPUT FIELD Y=INPUT FIELD /A122 /C138 PCMRD1, PCMSTR / LOCATION IN INPUT FIELD TO BE READ /A122 /C126 PCMRD2 / LOCATION TO PUT RESULTS /A122 -1 /- NO CHARS TO BE READ /A122 -1 /TERMINATOR /A122 TAD PCMRD2 /GET CHAR /A122 SZA /END OF BUFFER /A122 /C125 JMP I PCMRD /A122 ISZ PCMRD /YES /A122 /M125 CDFMYF /A138 CIFSYS /A138 TTYIN /IGNORE POWER FAIL STRTUP /A125 NOP /A125 CLA /A125 CDFSYS /A138 JMP I PCMRD /RET /A125 PCMRD2, 0 /CHAR JUST READ /A122 > /END IFNDEF CONDOR /A130 / ******* End of MOVE of non-CONDOR code edit 130 ******** /A130 IFDEF CONDOR < /A138 /D146 PCMSET, XX /A122 /D146 CLA IAC /SET UP BUFFER FOR POWER FAIL CHK(USED TO INIT SYSTEM /A125 /D146 CDFMYF / /A141 /D146 DCA FRMTYP /A125 /D146 CDFSYS / /A141 /D146 PCMSTA, JMS PCMRD0 /READ 1 CHAR FROM P.M. /A122 /D146 SNA CLA /END OF DATE? /A122 /D146 JMP I PCMSET /YES /A122 /C126 /D146 JMS PCMWT0 /MOVE TO P.M. /A125 /D146 JMP PCMSTA /NEXT /A122 FRMCHL, 0 /A141 JMS PCMRD0 /M146 FRMCHM, /NEXT /A141 /M146 CDFMYF / /A141 TAD I CMDPTR /POINTER TO COMMAND LIST /A141 TAD I IDPNTR /TO START OF STRING /A146 CDFSYS / /A141 SZA CLA /IS IN STRING? /A141 JMP FRMCHX /NOT CALLED FROM MASTER MENU(WPS-cmd) /A141 /.......DO NOT GET DATE/COMMAND STRING /A141 ISZ IDPNTR /INC PNTR /A146 ISZ CMDPTR /NEXT LETTER /A141 ISZ CMDCNT /COMMAND LENGTH COUNTER(-7 IF WHOLE CMND)/A141 JMP FRMCHM /LOOP-NEXT CHAR /A141 /D146 TAD (PCMADR /LOAD DATE ADDRESS /A141 /D146 CDFMYF / /A141 /D146 DCA PCMRD3 /SET IT /A141 /D146 CDFSYS / /A141 TAD (PCMRDJ) /JMS TO PCMREAD /A122 DCA U1XLAA /SET IT UP /A122 /D146 JMS PCMSET /MOVE DATE IN P.M. /A122 JMS SETDAT /MOVE AND SET DATE AND TIME /A146 FRMCHX, JMP I FRMCHL /RETURN /A141 / SETDAT, 0 /MOVE TIME AND DATE INTO STRING AND WRITE TO P.M. /A146 CDFMYF /A146 TAD (-7531 /SIGNATURE=VER 2 MENU /A146 TAD IDSIGN /GET SIGNATURE THIS SYSTEM /A146 SZA CLA /IS THIS OLDER VERSION MASTER MENU /A146 JMP SETD0 /NO-- /A146 TAD (PRESTR /SET WRITE OUT ADDRESS /A146 DCA PCMWT1 /A146 TAD (PRESTR-IDSTRT /NO SET UP TO STORE DATE AND TIME /A146 SETD0, /A146 TAD (IDSTRT-1 /OR SET TO MOVE DATE ONLY /A146 DCA X4 /A146 TAD (IDDATE-1 /TIME ADDRESS /A146 DCA X3 /A146 SETD1, TAD I X3 /A146 SNA /END DATE STRING /A146 JMP SETD2 /YES /A146 DCA I X4 /SET IT /A146 JMP SETD1 /NEXT /A146 SETD2, TAD (" &377 /SPACE /A146 DCA I X4 /A146 TAD (-7531 /IS TIME IN HTIS VERSION /A146 TAD IDSIGN /GET SIGNATURE /A146 SZA CLA /IS TIME AVAILABLE /A146 JMP SETD4 /NO /A146 TAD (IDTOFD-1 /TIME OF DAY /A146 DCA X3 /INPUT POINTER /A146 SETD3, TAD I X3 /MOVE TIME /A146 DCA I X4 /A146 ISZ IDCNT /DONE MOVING HH:MM /A146 JMP SETD3 /NO /A146 TAD (15 /C.R. FORCE DATE TIME /A146 DCA I X4 /SET IT /A146 SETD4, /A146 JMS PCMWT0 /WRITE IT BACK TO PANEL MEMORY /A146 CDFSYS /A146 JMP I SETDAT /A146 / IDCNT, -5 /COUNT HH:DD /A146 CMDCNT, CMDLST-CMDLSE /-7 WOULD CHECK (WPS-cmd) -3 CHECKS(WPS)/A141 IDPNTR, IDSTRT /START OF STRING /A146 CMDPTR, CMDLST /PTR TO COMMAND LIST /A141 CMDLST, -"W+200 / /A141 -"P+200 /A141 -"S+200 /A141 -"_+200 /A141 -"c+200 /A141 -"m+200 /A141 -"d+200 /A141 CMDLSE=. /END LIST ENTRY /A141 /----------------------- PAGE *PTC7R0-200 /ADDRESS OF BUFFER IN THIS FIELD /C146 WINBUF, / OF 24 DECIMAL LOCS FOR VOLUME DATA /C146 PRESTR, ZBLOCK 6 /NEW START LOC /A146 IDSTRT, ZBLOCK 7 /LOC 0-6 /WPS-CMD /A146 NULL1, 0 /LOC 7 /TERMINATOR /A146 BINLEN, 0 /LOC 8 /LENGTH OF COMMAND SRTING /A146 CMNDTXT,ZBLOCK 120 /LOC 9-88 /COMMAND STRING /A146 NULL2, 0 /LOC 88 /CMND STRING TERMINATOR /A146 IDDATE, ZBLOCK 10 /LOC 90-97 /DATE MM/DD/YY(ALWAYS) /A146 NULL3, 0 /LOC 98 /DATE TERMINATOR /A146 IDSIGN, 0 /LOC 99 /SIGNATURE /A146 IDVERS, 0 /LOC 100 /MASTER MENU VERSION NUM/A146 IDDOFW, ZBLOCK 11 /LOC 101-109 /DAY OF WEEK(SUNDAY-SATURDAY) /A146 NULL4, 0 /LOC 110 /TERMINATOR /A146 IDTOFD, ZBLOCK 10 /LOC 111-118 /TIME OF DAY HH:MM:SS /A146 IDLWCLK, 0 /LOC 119 /CLOCK LOW /A146 IDHICLK, 0 /LOC 120 /CLOCK HIGH /A146 IDDFMT, 0 /LOC 121 /DATE FORMAT 0=INVALID /A146 / 1=MM/DD/YY /A146 / 2=YY/MM/DD /A146 / 3=DD/MM/YY /A146 IDEND=. /END OF STRING /A146 > / END IFDEF CONDOR /A138 / .TITLE WPINDX - INDEX COMMAND / .VERSION / / / / COPYRIGHT (C) 1980 / DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754 / / THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED / ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE / INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER / COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY / OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY / TRANSFERRED. / / THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE / AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT / CORPORATION. / / DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS / SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. / / WPINDX - INDEX COMMAND / / 029 EMcD 24-Sep-85 Add Dutch and Spanish Xlations (conditional) / 028 EMcD 12-Sep-85 Add Nordic translations / (conditionalised) / 027 EMcD 11-Apr-85 Allow Dead keys in Doc name / 026 WCE 20-AUG-84 CHANGED # TO "NO." IN HEADER / 025 DFB 19-JUN-84 Set to recognize hard disk for ver 2.0 / 024 JFS 26-APR-84 Line up time / 023 JFS 20-APR-84 British/American date / 022 JFS 20-APR-84 code moved to make space for 023 / 021 WJY 06-FEB-84 DECmate I compatability / 020 TCW 27-SEP-83 Add check and text for Winchester drive / 019 HLP 31-AUG-83 Detect Uninitialized Diskette / Fixed QAR EZ-65 wrong msg CI to full disk / 018 WCE 17-AUG-83 Removed code that generates CDF/CIF's / 017 TCW 01-JUN-83 QAR#341 reset flags after disk error / 016 AIB 30-NOV-82 QAR#215 altered index display to avoid / empty final page / 015 AIB 11-NOV-82 QAR#181 removed blank line from Index / display header, moving everything else / up one line / 014 AIB 31-AUG-82 Changed title of index display from / "DOCUMENT INDEX" to "INDEX OF DOCUMENTS" / 013 GDH 08-FEB-82 Fixed elapsed time display in CUIDT2. / 012 DFB 05-NOV-81 Add get density to set den on device / 011 GDH 16-AUG-81 De-implemented LOCK/UNLOCK code. / 010 GDH 26-AUG-81 WPFILS calling seq changes. / 009 TT 07-JUL-81 Removed superfluous conditionals / 008 DM,JM 15-SEP-80 Merged Scandi and Europe/English / 007 REG 12-AUG-80 ADDED THIS STANDARD HEADER / 006 GLT 23-JUL-80 French grammatical fixes / 005 DSS 09-JUL-80 MODIFIED FOR ENGLISH/FRENCH-CANADIAN / 004 CMW 06-MAY-80 ENTERED CANADA TRANSLATIONS / 003 DSS 17-APR-80 ENTERED DUTCH FIXES / 002 DSS 14-FEB-80 ADDED FOREIGN DATE STUFF / 001 CW GLT 09-JAN-80 Add French Dutch and German conditionals / / French diacritical substitution: / / "["=L.A.E, "]"=L.G.E; "&" does not capitalize / / German diacritical substitutions: / / "["=L.U.A, "\"=L.U.O, "]"=L.U.U; "7" usable / III.D KEE 29-MAR-78 CHANGES FOR WT78 FILE # REPRESENTATION / / AND PUT IN SYMBOLS FOR DX REQUESTS / 2.7-5 KEE 02/15/78 SOME CLEAN UP / 2.7A-2 LDB 01/28/78 FIX I{ BUG FOR WT78 AND * BUG FOR / / DOCUMENTS WITH NO NAME / 2.7.1 KEE 11/22/77 PUT IN WT78 INDEX SPEEDUP / 2.5.1 KEE 11/04/77 FIX INDEX NOT IGNORING WORD WRAP BLANKS / / AND CARRIAGE RETURNS / 2.5-1 RLT 10/21/77 MERGE FROM WT78 PACK / 2.4B KEE 10/10/77 FIX REMEMBERANCE BUG / 2.N KEE 09/09/77 PUT IN WS102 INTERLOCKS / 2.J KEE ALLOW 'NUMBER.DOC' FOR REFERENCES / 2.G-3 MB 08/13/77 PUT INDEX IN SEPERATE OVERLAY *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLONDX 100 CDF 20 -DSONDX 0 CDFMYF= CDFBUF FIELD 2 /LOADED INTO FIELD 4 *100 /THE FIRST 100 LOCATIONS ARE USED FOR THE SYSTEM /LOCATIONS USED BY INDEX CUICPO, 0 /CURRENT POSITION IN THE LINE BUFFER CUIPCT, 0 /TEMP CUIDFG, 0 /DOCUMENT FLAG 0 = NORMAL INDEX; NOT 0 = TO DOCUMENT CUIEOF, 0 /WHEN NONZERO, EOF OF INDEX DOC WAS FOUND CUIREM, 0 / neg count of docs remaining to display /A016 CUIPGE, 0 / numb of docs displayed on current screen /A016 CUIOVR, 0 /FLAG SET TO NON ZERO IF THE DISK HAS 10 BLOCKS LEFT CUIDRV, 0 /DRIVE NUMBER OF THE DRIVE WHOSE INDEX IS BEING DONE CUIDC1, 0 /FILE NUMBER (DRIVE NUMBER W DOCUMENT NUMBER) OF INDEX DOCUMENT CUIDCN, 0 /FOR CI, FILE NUMBER (DRIVE NUMBER W DOC NUMBER) OF THE DOC /TO RECEIVE THE COPY OF THE INDEX CUIDFO, 0 /DOC NUMBER OF THE DOCUMENT WHOSE INFORMATION IS CURRENTLY /BEING DISPLAYED. CUCPYC, 0 CUISTP, 0 QUBLK, DSKQUE; 0; 0 QUQBLK, ZBLOCK 17 /--------------------- PAGE /WPINDX - INDEX FUNCTION, EITHER TO DOCUMENT OR TO THE SCREEN / THE INDEX PROGRAM PRODUCES A LIST OF DOCUMENTS CURRENTLY IN EXISTENCE FOR THIS / USER. THE LIST OF DOCUMENTS IS PLACED ON THE SCREEN, AND MAY OPTIONALLY BE / WRITTEN TO A NEW OR EXISTING DOCUMENT. / THE INDEX OPERATION IS DONE IN THE FOLLOWING STEPS: / I) GET THE INFORMATION FOR THE TOP FEW LINES OF THE SCREEN. / A) READ THE ALLOC BLOCK AND EXTRACT INFORMATION FOUND THERE ONLY / B) READ THE HOME BLOCK FOR THE REST OF THE TOP INFORMATION / C) COUNT THE NUMBER OF DOCUMENTS THAT EXIST AND DISPLAY THE HEADER LINES / II) LIST ALL OF THE EXISTENT DOCUMENTS. / A) OPEN THE INDEX DOCUMENT. / B) LIST ALL THE DOCUMENTS. LIST IN GROUPS OF FIVE AT A TIME. / 1) FIRST LIST EACH DOCUMENT FOR WHICH THERE IS AN INDEX DOCUMENT ENTRY / ALONG WITH SIZE INFORMATION, ETC. MARK EACH ENTRY WHICH HAS BEEN / LISTED IN THE COPY OF THE HOME BLOCK OR BITMAP SO THAT IT WILL NOT BE / LISTED ALONG WITH THOSE DOCUMENTS WITHOUT NAMES. / 2) LIST EACH DOCUMENT WHICH WAS NOT PREVIOUSLY LISTED. / 3) FOR EACH OF THE 5 DOCUMENTS LISTED, KEEP THE NUMBER AND NAME / IN A BUFFER. / C) WHEN NOT TO A DOCUMENT, WAIT FOR THE USER TO PRESS RETURN OR GOLD MENU. / 1) WHEN THE RETURN WAS ENTERED, DISPLAY THE NEXT INDEX PAGE. / 2) FOR GOLD MENU, UPDATE THE USERS CURRENT DEFAULT FILE NUMBER AND / TERMINATE THE INDEX. / THE INFORMATION EXPECTED FROM THE MENU IS AS FOLLOWS - / MNTMP1- FOR CI COMMANDS, TYPE OF MODIFICATION OF THE OUTPUT DOCUMENT / MNTMP2- FLAG TO INDICATE INDEX TO DOCUMENT (TO DOCUMENT WHEN NONZERO) / MNTMP5- CONTAINS THE DRIVE NUMBER OR AREA NUMBER WHOSE INDEX IS TO BE DONE / MNFNO - FILE NUMBER (INCLUDING DRIVE NUMBER) OF DOCUMENT TO RECEIVE INDEX / MNDRV - DRIVE NUMBER OF DOCUMENT TO RECEIVE COPY OF INDEX / MNFMAT- DATE/CURRENCY CODE /DEFINED CONSTANTS / BUFFERS LENBFD=400 LENBF1=400 LENTBF=1200 /NAMES AND DOCUMENT NUMBERS FOR 5 DOCUMENTS /(ENTRIES 200 WORDS EACH) LENBAD=300 /THE NEXT HIGHEST MULTIPLE OF 100 AFTER 2 LINES OF /80 CHARACTERS FOR AN ENTRY CUIBFD=3200 /BUFFER USED TO HOLD HOME BLOCK/BITMAP PACKET CUIBF1=CUIBFD+LENBFD /BUFFER TO HOLD HEADER BLOCK/INDEX INFORMATION PACKET /FOR DOCUMENT CURRENTLY BEING DISPLAYED. CUIBAD=CUIBF1+LENBF1 /BUFFER USED TO BUILD LINE FOR DISPLAY ON THE SCREEN CUITBF=CUIBAD+LENBAD /BUFFER USED TO STORE THE DOCUMENTS NAMES AND NO. THAT /ARE ON THE SCREEN. EACH ENTRY IS ALLOWED 200 WORDS, /SO THAT 5 ENTRIES MAY BE DISPLAYED AT A TIME IFNZRO 6000-CUITBF-LENTBF&4000 /(SCROLL BUFFERS BEGIN AT 6000) /STARTING COLUMN FOR EACH FIELD IN THE INDEX DECIMAL IFDEF ENGLSH < CUINMB=0 /NUMBER CUINME=8 /NAME CUICRE=29 /CREATION DATE CUIERO=29 /ERROR MESSAGE CUIMOD=38 /LATE MODIFIED DATE CUISIZ=53 /DOCUMENT SIZE CUIVER=58 /VERSION CUILTE=67 /THE TIME OF THE LATE EDIT (DELTA TIME) CUITTE=74 /THE TOTAL TIME SPENT ON THIS DOCUMENT EDITING > IFDEF ITALIAN < CUINMB=0 /NUMBER CUINME=8 /NAME CUICRE=29 /CREATION DATE CUIERO=29 /ERROR MESSAGE CUIMOD=38 /LATE MODIFIED DATE CUISIZ=53 /DOCUMENT SIZE CUIVER=58 /VERSION CUILTE=67 /THE TIME OF THE LATE EDIT (DELTA TIME) CUITTE=74 /THE TOTAL TIME SPENT ON THIS DOCUMENT EDITING > IFDEF V30NOR < CUINMB=0 /NUMBER CUINME=8 /NAME CUICRE=29 /CREATION DATE CUIERO=29 /ERROR MESSAGE CUIMOD=38 /LATE MODIFIED DATE CUISIZ=53 /DOCUMENT SIZE CUIVER=58 /VERSION CUILTE=67 /THE TIME OF THE LATE EDIT (DELTA TIME) CUITTE=74 /THE TOTAL TIME SPENT ON THIS DOCUMENT EDITING > IFDEF V30SWE < CUINMB=0 /NUMBER CUINME=8 /NAME CUICRE=29 /CREATION DATE CUIERO=29 /ERROR MESSAGE CUIMOD=38 /LATE MODIFIED DATE CUISIZ=53 /DOCUMENT SIZE CUIVER=58 /VERSION CUILTE=67 /THE TIME OF THE LATE EDIT (DELTA TIME) CUITTE=74 /THE TOTAL TIME SPENT ON THIS DOCUMENT EDITING > IFDEF DUTCH < CUINMB=0 /NUMBER CUINME=8 /NAME CUICRE=29 /CREATION DATE CUIERO=29 /ERROR MESSAGE CUIMOD=38 /LATE MODIFIED DATE CUISIZ=52 /DOCUMENT SIZE CUIVER=58 /VERSION CUILTE=67 /THE TIME OF THE LATE EDIT (DELTA TIME) CUITTE=74 /THE TOTAL TIME SPENT ON THIS DOCUMENT EDITING > IFDEF SPANISH < CUINMB=0 /NUMBER CUINME=8 /NAME CUICRE=29 /CREATION DATE CUIERO=29 /ERROR MESSAGE CUIMOD=38 /LATE MODIFIED DATE CUISIZ=53 /DOCUMENT SIZE CUIVER=58 /VERSION CUILTE=67 /THE TIME OF THE LATE EDIT (DELTA TIME) CUITTE=74 /THE TOTAL TIME SPENT ON THIS DOCUMENT EDITING > / MISCELLANEOUS CONSTANTS OCTAL OFSBTM=12 /OFFSET OF INDIVIDUAL FILE POINTERS WITHIN HOME BLOCK TAB=11 SPACE=40 BS=10 /BACK SPACE INDICATING START OF DEAD KEY WRAPBT=2000 /WORD WRAP BIT BELL=7 /CONTROL-G (NEEDS-WORD-WRAPPING) LT=74 /LEFT ANGLE BRACKET FF=14 /FORM FEED (NEW PAGE OF SOME VARIETY) ERBIT=4000 /ERROR BIT FOR HANDLER CALLS CUIRTZ, XX /CUINDX - INDEX COMMAND JMS CUINDX CDIMNU JMP I CUIRTZ /CUCOPY - ROUTINE TO COPY BLOCK OF MEMORY / JMS CUCOPY / ADDR OF FROM / CDF FROM FIELD / ADDR OF TO / CDF TO FIELD / NUMBER OF WORDS TO COPY / RETURN, AC = 0 CUCOPY, XX AC7777 /GET FIRST ADDR - 1 FOR INDEX REGISTER TAD I CUCOPY ISZ CUCOPY DCA X0 TAD I CUCOPY /AND FIELD ISZ CUCOPY DCA CUCPY0 /SAVE FOR LATER USE AC7777 /DO SAME FOR TO VALUES TAD I CUCOPY ISZ CUCOPY DCA X1 TAD I CUCOPY ISZ CUCOPY DCA CUCPY1 TAD I CUCOPY ISZ CUCOPY /GET COUNT CIA /MAKE ISZ COUNT DCA CUCPYC /AND SAVE FOR USE CUCPYL, CUCPY0, .-. /A CDF FOR FIRST FIELD TAD I X0 /GET WORD CUCPY1, .-. /A CDF FOR THE RECEIVING FIELD DCA I X1 /STORE WORD ISZ CUCPYC /DONE? JMP CUCPYL /NO - DO NEXT WORD CDFMYF /YES - BACK TO OUR FIELD JMP I CUCOPY /RETURN TO CALLER CUISTR, XX /STORE DOCUMENT NO. CONVERTED TO ASCIZ INTO FNAMBF. DCA T1 /SAVE CHAR RDF; TAD CIDF0 /COMPUTE RETURN FIELD DCA CUISTX /AND STORE FOR RETURN CDFMNU TAD T1 DCA I CUISTP /STORE INTO MENU NAME BUFFER ISZ CUISTP /BUMP PTR (NO. BETTER BE LESS THAN STRLEN) CUISTX, .-. JMP I CUISTR / CUICLS -- takes care of the positioning for the screen /R016 CUICLS, XX /R016 CLA /R016 TAD CUIDFG / don't erase if going to a document /R016 SZA CLA /R016 JMP I CUICLS /R016 CIFMNU /R016 JMS I IOACAL /R016 0 / go directly to the screen /R016 CUICSR / ^P!E /R016 600 /R016 JMP I CUICLS /R016 CUIFNO, 0 CUIDST, ZBLOCK STRLEN IFNZRO CUIFNO+1-CUIDST /---------------- PAGE CUINDX, XX /INDEX COMMAND / I) GET INFORMATION FOR THE TOP LINES OF THE LISTED INDEX CLA DCA CUIOVR /CLEAR THE OVERFLOW DISK FLAG TAD (CUIBAD) DCA CUICPO /SET THE STARTING POINTER TO LINE BUFFER DCA CUINFS /ZERO TOTAL DOCUMENTS PROCESSED CDFMNU TAD I (MUBUF+MNTMP5) CDFMYF DCA CUIDRV /SAVE TAD CUIDRV /BUILD INDEX NUMBER WITH DRIVE NUMBER BSW RTL CLL IAC DCA CUIDC1 JMS CUICKW / CK FOR WINCHESTER DRIVE INST. /A020 TAD CUIDRV /CURRENT DRIVE /A012 DCA QUQBLK+RXQDRV /A012 TAD (RXEDN+4000 /SET GET DEN CMND /A012 DCA QUQBLK+RXQFNC /A012 JMS QURX /A012 SPA CLA /ERROR? /A012 JMP CUIDER /YES /A012 JMS CUINGD /SEE IF GOING TO A DOCUMENT RIF TAD CDF0 DCA QUQBLK+RXQBFD /SET FIELD TAD (CUIBFD /GET BUFFER ADDRESS DCA QUQBLK+RXQBAD / A) FOR NON-78 ASSEMBLIES - / 1) READ THE ALLOC BLOCK AND EXTRACT ITS INFORMATION / - TOTAL NUMBER OF BLOCKS IN THE FILE SYSTEM / - NUMBER OF REMAINING FREE BLOCKS / 2) READ THE HOME BLOCK AND GET THE REST OF ITS INFORMATION / - THE FLOPPY NAME / - THE MAXIMUM NUMBER OF FILES ON THE FLOPPY (NEGATIVE) TAD (RXERD+ERBIT /ERROR RECOVER READ DCA QUQBLK+RXQFNC TAD CUIDRV /SET THE DRIVE IN THE Q BLOCK DCA QUQBLK+RXQDRV TAD (RXBALC /GET ALLOC BLOCK FIRST DCA QUQBLK+RXQBLK JMS QURX SPA CLA JMP CUIDER /DISK ERROR TAD CUIBFD+1 /GET BLOCK TYPE /A019 AND (70) /A019 TAD (-40) /SEE IF REALLY IS ALLOC BLOCK /A019 SZA CLA / /A019 JMP CUIINV /NO, INVALID DISK /A019 TAD CUIBFD+2 /GET # OF BLOCKS IN FILE SYSTEM DCA CUINBF TAD CUIBFD+3 /AND # FREE DCA CUINFB TAD (RXBDIR /NOW READ IN HOME BLOCK AND LEAVE IN CORE DCA QUQBLK+RXQBLK JMS QURX SPA CLA JMP CUIDER /DISK ERROR TAD CUIBFD+1 / GET THE BLOCK TYPE /A019 AND (70) /A019 TAD (-30) / SEE IF HOME BLOCK /A019 SZA CLA / /A019 JMP CUIINV / INVALID WPS DISK /A019 TAD (CUIBF1 /CONVERT THE FLOPPY NAME DCA CUIB1P /SAVE BUFFER 1 PTR, TO CONVERT NAME TO ASCII DCA CUICNT /INIT COUNT OF BYTES TAD (-6 /INIT MAX CHARACTERS COUNTER DCA CUITMP CUIND2, JMS GETCHR /GET NEXT BYTE CUICNT CUIBFD+2 SNA TAD (-37 /ZERO IS END TAD (37 /MAKE ASCII DCA I CUIB1P ISZ CUIB1P /SAVE AND DO NEXT BYTE ISZ CUICNT ISZ CUITMP JMP CUIND2 DCA CUIBF1+6 /ENSURE THAT IT'S ASCIZ TAD CUIBFD+11 /INITIAL NEG MAX NUMBER OF DOCUMENTS DCA CUIDPC / B) COUNT THE NUMBER OF DOCUMENTS AND DISPLAY THE HEADER TAD (CUIBFD+OFSBTM-1 /INIT ADDR TO CHECK TO COUNT DCA X0 TAD CUIDPC /NUMBER OF DOCS MAX (NEGATIVE) DCA T1 CUIND1, TAD I X0 /GET WORD SZA CLA ISZ CUINFS /GOT ANOTHER ONE ISZ T1 /INCR MAX COUNT JMP CUIND1 /TRY ANOTHER ONE JMP CUIN2A /NEXT PAGE / CLEAN UP AND TERMINATE / 1 - IF TO A DOCUMENT, / CLOSE THE DOCUMENT / CLEAR TO TO DOCUMENT FLAG / 2 - IF WT78 / CLOSE THE INDEX DOCUMENT / IF AT LEAST ONE DUCUMENT WAS LISTED, SEND A QUIT INDEX CUINDR, CLA TAD CUIDFG /IF GOING TO A DOCUMENT WHEN DONE CLOSE IT. SNA CLA JMP CUIN4D DCA CUIDFG /CLEAR FOR NEXT TIME CIFFIO FILEIO XDSKCL /CLOSE /M0010 CUIN4D, JMP I CUINDX /RETURN CUIB1P, 0 CUITMP, 0 /R016 /----------------- PAGE CUIN2A, TAD CUINFS / MAKE COUNTER FROM NUMBER OF DOCS /A016 CMA IAC /A016 DCA CUIREM /A016 TAD CUIDRV /PUT DRIVE NUMBER IN DISPLAY REQUEST DCA CUIDRN IFDEF CONDOR < /A020 JMS CUICKW / CK FOR WINCHESTER DRIVE /A020 > / END IFDEF CONDOR /A020 JMS CUIPDS /DISPLAY THE TOP LINES /II. LIST ALL EXISTENT DOCUMENTS. /R016 / A) OPEN THE INDEX DOCUMENT /R016 TAD (CUIBFD+OFSBTM /INIT PTR AND COUNT FOR ENTRY SEARCH /R016 DCA CUIDPT /R016 TAD (CUIBF1 /PATCH WHERE WE READ TO BE BUFFER DCA QUQBLK+RXQBAD DCA CUIEOF TAD CUIDC1 /OPEN INDEX DOCUMENT FOR READ CIFFIO FILEIO XRDFIN /M0010 / B) LIST ALL DOCUMENTS IN GROUPS OF FIVE AT A TIME. CUIND3, CLA /GET 5 ENTRIES TAD (-5 DCA CUICNT DCA CUIPGE / clear displayed doc count for this page /A016 JMS CUICLS /POSTIONS THE CURSOR AND CLEARS THE SCREEN CUIND4, JMS CUIENT /DO ENTRY PROCESSING / C) FOR EACH OF THE FIVE LISTED DOCUMENTS, KEEP ITS NAME AND NUMBER IN A / BUFFER. / FIRST COMPUTE THE BUFFER SLOT TO BE USED. THE FORMULA USED: / SLOT = BUFFER START + 200 * (NUMBER OF ENTRIES ON PAGE) - 200 TAD CUIPGE / this numb is bumped by CUIENT by CUIDSP /M016 BSW CLL RAL /TIMES 200 TAD (CUITBF-200) /PLUS BUFFER ADDRESS - 200 DCA CUIN4A /SAVE IN COPY CALL TAD CUID1 /GET DOCUMENT NUMBER (WITHOUT DRIVE) DCA CUIFNO JMS CUCOPY /COPY NAME AND NUMBER CUIFNO CDFMYF CUIN4A, 0 CDFMYF STRLEN+1 TAD CUIREM /END OF DOCUMENTS? /M016 SNA CLA /M016 JMP CUIND5 /YES ISZ CUICNT /NEXT? JMP CUIND4 JMS CUIWAT /WAIT FOR USER TO TYPE SOMETHING /A016 JMP CUINDR / :G:Menu -- return to main menu /A016 JMP CUIND3 / :RETURN -- continue with next entry /A016 CUIND5, JMS CUIWAT /WAIT FOR USER TO TYPE SOMETHING JMP CUINDR / :G:Menu -- return to main menu JMP CUINDR / :RETURN -- return to main menu anyway /M016 CUICNT, 0 CUIINV, / INVALID DISK INSTALLED /A019 CDFMNU / SET UP CODE FOR MENU /A019 AC0004 / /A019 DCA I (MUBUF+MNTMP1 / /A019 CDFMYF / /A019 CIFMNU / GO TO A MENU /A019 JMS I MNUCAL / AND TELL USER /A019 DLMEM1 / MENU BLOCK /A019 JMP CUINDR / /A019 IFNZRO 200-STRLEN-1&4000 /------------------------- PAGE /CUIWAT - WAIT FOR USER TO DO SOMETHING / C) WHEN NOT TO A DOCUMENT, WAIT FOR THE USER TO PRESS EITHER RETURN OR GOLD M / 1)WHEN RETURN IS PRESSED, SIMPLY GET THE NEXT SCREENFUL CUIWAT, XX CLA TAD CUIDFG /IF SET FOR DOCUMENT THE USER CANNOT RESPOND SO RETURN SNA CLA JMP CUIWAJ TAD CUIOVR /SEE IF THE DISK HAS OVERFLOWED IF SO PUT UP ERROR MESS SZA CLA JMP CUIFLL JMP CUIWAC /NOT OVERFLOWED RETURN CUIWAJ, TAD CUIPGE / GET NUMBER OF ENTRIES /M016 CDFMNU DCA I (MUBUF+MNTMP1) /SAVE IN TEMP1 TAD CUIREM / pass number of undisplayed docs /A016 DCA I (MUBUF+MNTMP2) /A016 CDFMYF CIFMNU JMS I MNUCAL /CALL MENU DLMIN2 CDFMNU TAD I (MUBUF+MNTMP1) /GET TEMP1 CDFMYF SZA /ZERO MEANS JUST RETURN PRESSED JMP CUIWA1 /OTHERWISE SET REMEMBERENCE AND RETURN TO CALLER CUIWAC, ISZ CUIWAT /SKIP RETURN CUIWAR, JMP I CUIWAT / 2) WHEN GOLD MENU IS PRESSED, REMEMBER THAT THE USERS LAST USED DOCUMENT / IS THE ONE MARKED BY THE ASTERISK CUIWA1, BSW /GET BUFFER ADDRESS = BASE + 200 * (ENTRY NUMBER FROM CLL RAL /SCREEN) TAD (CUITBF-200) /ADD OFFSET DCA CUIWA2 /SAVE TAD CUIDRV / DCA T3 TAD I CUIWA2 CDFMNU /SAVE SNA /DOCUMENT NUMBER NON-ZERO? JMP CUIWA6 /ZERO, DON'T ADD DRIVE NUMBER IN (THIS FILE NUMBER /IS IN ERROR) DCA I (MUBUF+MNDOCN /STORE DOCUMENT NUMBER, ETC. TAD T3 /THEN STORE DRIVE NUMBER DCA I (MUBUF+MNDRV) TAD T3 /PLACE DRIVE NUMBER WITH DOCUMENT NUMBER BSW RTL CLL TAD I (MUBUF+MNDOCN) CUIWA6, DCA I (MUBUF+MNFNO) /STORE ZERO OR FILE NUMBER 'MNFNO' TAD I (FNAMSP CDFMYF DCA CUIWA5 TAD CUIWA2 /NOW COPY NAME IAC /(SKIP THE WORD WITH THE FILE NUMBER) DCA CUIWA4 TAD I CUIWA4 /CHECK FOR NO NAME SNA CLA JMP CUIWA7 /YES, USE NO. JMS CUCOPY CUIWA4, 0 CDFMYF CUIWA5, 0 CDFMNU STRLEN JMP I CUIWAT /DONE - NON-SKIP CUIWA7, TAD CUIWA5 DCA CUISTP /SET UP PTR TAD CUIWA2 DCA CUIWA8 CIFMNU JMS I IOACAL /CONVERT NO. TO ASCIZ CUISTR CUISTT CUIWA8, .-. CLA JMS CUISTR /STORE 0 FOR END JMP I CUIWAT /RETURN CUISTT, TEXT '!D' CUIOUS, XX /OUTPUTS TO THE SCREEN AND P377 /GET RID OF ANY FUNNIES /M027 TAD (-TAB) /MAKE TABS SPACES SNA TAD (SPACE-TAB) TAD (TAB) JMP CUIOSS CUIOSW, CIF 0 JWAIT CUIOSS, CIF 0 TTYOU JMP CUIOSW JMP I CUIOUS CUIWA2, 0 /R016 CUIFLL, /DISPLAY ERROR IN CI COMMAND IF THERE ARE 10 BLOCKS OR FEWER / ON THE DISKETTE CIFMNU JMS I IOACAL /CLEAR THE SCREEN 0 CUICSR 0 CDFFIO / /M0010 TAD I (SCFSPC) /PUT UP THE NUMBER OF BLOCKS LEFT CDFMNU /THIS WAS MISSING CAUSING BUG EZ-65 /A019 DCA I (MUBUF+MNTMP2) AC0003 /SET TO 3 TO TELL THE MENU WHICH DISPLAY DCA I (MUBUF+MNTMP1) CDFMYF CIFMNU JMS I MNUCAL DLMEM1 JMP CUIWAR /-------------------- PAGE /CUIENT - DO NEXT ENTRY / B) LIST ALL THE DOCUMENTS. LIST IN GROUPS OF FIVE AT A TIME. / 1) FIRST LIST EACH DOCUMENT FOR WHICH THERE IS AN INDEX DOCUMENT ENTRY / ALONG WITH SIZE INFORMATION, ETC. MARK EACH ENTRY WHICH HAS BEEN / LISTED IN THE COPY OF THE HOME BLOCK OR BITMAP SO THAT IT WILL NOT BE / LISTED ALONG WITH THOSE DOCUMENTS WITHOUT NAMES. CUIENT, XX CLA /INIT NAME PTRS TAD (CUIDST DCA CUINP TAD CUIEOF /END OF FILE ON INDEX FILE - CHECK FOR UN-OUTPUTTED SZA CLA JMP CUIEN1 /GO LOOK FOR THEM JMS CUISRC /LOOK FOR NEXT CUIBN JMP CUIEO1 /EOF TAD (-STRLEN /MAX NUMBER OF CHARS IN DISPLAYED NAME DCA CUIECT CUIEL1, /ASSUME AC ZERO HERE JMS CUIGCH /GET NEXT CHAR JMP CUIEO1 /EOF TAD (-LF /IS IT EOL? SNA JMP CUIEGN /YES - END OF NAME, GET NUMBER TAD (LF-LT /LEFT ANGLE BRACKET? SNA JMP CUIEGN /YES TAD (LT-TAB /TAB? SNA JMP CUIEGN /YES TAD (TAB-FF /FF OF SOME SORT? SNA JMP CUIEGN TAD (FF DCA I CUINP /SAVE AS NEXT CHAR OF NAME ISZ CUINP /NEXT TIME NEXT CHAR ISZ CUIECT /INCR COUNT JMP CUIEL1 /LOOP CUIEGN, DCA I CUINP /ZERO LAST BYTE FOR ASCIZ JMS CUISRC /SEARCH FOR <#> CUIBNO JMP CUIEO1 JMS CUINUM /GET NUMBER JMP CUIEO1 /EOF DCA CUIFNO /SAVE NUMBER TAD CUIFNO JMS CUIDSP /DISPLAY INFO JMP I CUIENT /DONE CUIEO1, AC7777 /DON'T DO FILE STUFF NEXT TIME DCA CUIEOF / 2) LIST EACH DOCUMENT WHICH WAS NOT PREVIOUSLY LISTED. CUIEN1, CLA TAD I CUIDPT /GET DIR PTR SPA JMP CUIEN2 /NEGATIVE MEANS ENTRY ALREADY SHOWN SZA JMP CUIEN3 /NOT SHOWN - DO IT CUIEN2, ISZ CUIDPT /INCR PTR ISZ CUIDPC /AND COUNT JMP CUIEN1 /DO ANOTHER ENTRY JMP I CUIENT /DONE - RETURN CUIEN3, CLA TAD CUIDPT /GET ADDR CHECKED TAD (-CUIBFD-OFSBTM+1 /MAKE INTO A FILE NUMBER DCA CUIFNO DCA CUIDST /ZAP STRING TO ASCIZ EMPTY TAD CUIFNO /GET NUMBER JMS CUIDSP /DISPLAY IT JMP I CUIENT /RETURN TO CALLER CUINP, 0 CUIECT, 0 CUIDPT, 0 CUIDPC, 0 / GET THE NEXT CHARACTER FROM THE DOCUMENT THAT 'RDFIL' CURRENTLY HAS OPEN - / UPON ENTRY - / AC ZERO, GET THE NEXT CHARACTER FROM THE DOCUMENT / NONZERO, RETURN THE LAST CHARACTER A SECOND TIME / PAR 1 LOCATION RETURNED TO WHEN EOF IS ENCOUNTERED / 'RDFIL' HAS A DOCUMENT OPENED. / UPON RETURN - / AC NEXT CHARACTER, WITH THE FOLLOWING EXCEPTIONS - / WORD-WRAP BLANKS AND RETURNS / START AND END OF DEADKEY / 'NEEDS-WORD-WRAP' CHARACTERS CUIGCH, XX /GET CHAR FROM DOCUMENT SNA CLA /RETURN LAST CHARACTER AGAIN? JMP CUIGC2 /NO, GET NEXT ONE INSTEAD. TAD CUIBK JMP CUIGC1 CUIGC2, CIFFIO FILEIO XRDFNC /GET NEXT CHAR /M0010 SPA SNA JMP I CUIGCH /EOF OR DISKERR CUIGC1, DCA CUIBK /SAVE BACKUP TAD CUIBK TAD (-WRAPBT-LF) /IGNORE WORD WRAP CR SZA TAD (WRAPBT+LF-WRAPBT-SPACE) /OR WORD WRAP BLANKS SNA CLA /EITHER? JMP CUIGC2 /YES, ONE OR THE OTHER - GET NEXT CHARACTER TAD CUIBK /GET CHARACTER AND P177 /ONLY LOW ORDER BITS TAD (-BS /IGNORE BACKSPACE (START OF DEADKEY) /d027 SNA /d027 JMP CUIGC2 IAC /AND ALSO CNTRL-G ('NEEDS-WORD-WRAP') SNA JMP CUIGC2 /d027 TAD (BELL-CR /BETTER IGNORE CR ALSO (END OF DEADKEY) /d027 SNA /d027 JMP CUIGC2 TAD (BELL /GET CHAR BACK /M027 ISZ CUIGCH /SKIP EOF RETURN JMP I CUIGCH /RETURN CUIBK, 0 IFNZRO 7-BELL /-------------------------------- PAGE CUIBN, "<-200; "N-200+40; ">-200; 0 CUIBNO, "<-200; "#-200; ">-200; 0 CUIDSP, XX /DISPLAY INFO ABOUT DOCUMENT AND P377 DCA CUIDFO /SAVE THE FILE NUMBER DCA CUID1 /INIT FILENO ISZ CUIPGE / count docs displayed on this page /A016 TAD CUIDFO /CHECK IT SNA JMP CUIDBN SPA JMP CUIDBN TAD (-MAXDOC SMA CLA JMP CUIDBN /DISPLAY BAD NUMBER TAD CUIDFO /GET HEADER BLOCK NUMBER TAD (CUIBFD+OFSBTM-1 DCA T1 TAD I T1 SNA JMP CUIDBN /DOESN'T EXIST SMA / if >0, incr undisplayed doc counter /A016 ISZ CUIREM /A016 NOP /A016 SMA /MAKE IT NEGATIVE IF IT ISN'T ALREADY CIA /SO THAT WE REMEMBER THAT WE DISP'ED IT DCA I T1 TAD I T1 CIA /GET POSITIVE DCA QUQBLK+RXQBLK JMS QURX /GET HEADER SPA CLA /CHECK ERROR CODES JMP CUIDBN TAD CUIDFO DCA CUID1 CIFMNU JMS I IOACAL /RETURNS AC=0 CUIOUT CUID10 CUID1, 0 JMS CUIPOS CUINME /DO THE NAME CIFMNU JMS I IOACAL CUIOUT CUIDS2 CUIDST JMS NWLINE /NEXT LINE, RETURNS AC=0 JMS CUIPOS CUICRE TAD (CUIBF1+6) /DISPLAY THE CREATED DATE JMS CUIDDT /RETURNS AC=0 NOP /IGNORE 'NODATE' JMS CUIPOS CUIMOD /DISPLAY THE DATE/TIME LAST MODIFIED TAD (CUIBF1+10) /OUTPUT THE DATE JMS CUIDDT JMP CUIDN6 /SKIP IF NO DATE TAD CUIBF1+14 /ELSE, OUTPUT TIME /A022 BSW /A022 AND P77 /A022 DCA CUID6 /SAVE THE HOURS /A022 TAD CUIBF1+14 /FETCH MINUTES /A022 AND P77 /A022 DCA CUID7 /A022 JMS CUIPOS /TAB TO TIME COLUMN /A024 CUIMOD+11 /A024 CIFMNU /A022 JMS I IOACAL /A022 CUIOUT /A022 CUIDS4 /A022 CUID6, 0 /A022 CUID7, 0 /A022 CUIDN6, JMS CUIPOS CUISIZ /SIZE CIFMNU JMS I IOACAL CUIOUT CUIDS5 CUIBF1+5 JMS CUIPOS CUIVER /VERSION CIFMNU JMS I IOACAL CUIOUT CUIDS6 CUIBF1+12 JMS CUIPOS CUILTE /DISPLAY TIME EDITED IFNDEF ITALIAN < TAD CUIBF1+16 JMS CUIDT2 /RETURNS AC=0 JMS CUIPOS CUITTE /DISPLAY TOTAL TIME EDITED TAD CUIBF1+17 JMS CUIDT2 > CUIDSR, JMS NWLINE /GO TO NEXT LINE JMS NWLINE /GO TO NEXT LINE JMP I CUIDSP /AND RETURN TO CALLER /----------------------------- PAGE /CUIDDT - DISPLAY THE DATE THAT IS POINTED TO BY AC / THE FIRST WORD HAS DATE, PACKED MONTH, DAY / THE SECOND WORD CONTAINS THE YEAR. / CUIPCT CONTAINS THE DATE SEPARATOR CUIDDT, XX DCA T1 /SAVE THE DATE ADDRESS TAD I T1 SNA JMP CUIDTN /IF ZERO DISPLAY 'NODATE' AND P77 /ELSE, UNPACK MO/DAY DCA CUID3 TAD I T1 BSW AND P77 DCA CUID2 /SET UP AS IF DD/MM/YY ISZ T1 /POINT TO YEAR /A023 TAD I T1 DCA CUID4 CDFMNU /A023 TAD MNDSEP+MUBUF /A023 DCA CUIPCT /SET UP SEPARATOR FOR IOA /A023 AC0002 /A023 AND MNFMAT+MUBUF /DMYDAT SELECTED? /A023 SNA /A023 JMP CUIDD8 /DONE IF REALLY DMY /A023 AC0001 /A023 AND MNFMAT+MUBUF /NO, IS IT YMD? /A023 SNA CLA /A023 JMP CUIDD0 /A023 TAD CUID4 /YES, IT'S YMD, SO /A023 MQL / SWITCH Y,D /A023 TAD CUID2 /A023 DCA CUID4 /A023 JMP CUIDD5 /A023 CUIDD0, /NO, IT'S MDY, SO /A023 TAD CUID3 / SWITCH M,D /A023 MQL /A023 TAD CUID2 /A023 DCA CUID3 /A023 CUIDD5, /A023 ACL /COMPLETE DAY MOVE /A023 DCA CUID2 /A023 CUIDD8, /A023 CDFMYF /A023 CIFMNU JMS I IOACAL CUIOUT CUIDS3 CUID2, 0 /DATE VALUES /A023 CUISEP, CUIPCT /A023 CUID3, 0 CUIPCT /A023 CUID4, 0 ISZ CUIDDT JMP I CUIDDT CUIDTN, CIFMNU JMS I IOACAL CUIOUT CUIDN2 / "NO/DA/TE" JMP I CUIDDT CUIPOS, XX /SIMULATE TAB IN LINE BUFFER, CUIBAD / Call: AC=0 /A022 / JMS CUIPOS / / Return: AC = 0 TAD I CUIPOS /Get the column position TAD (CUIBAD) /MAKE IT A buffer pointer ISZ CUIPOS /Increment the argument pointer for return CIA /Negate the value of the buffer address TAD CUICPO /Get current pos.(AC=# columns to desired col) SMA JMP CUIPRT /Exit if currrent position after desired pos DCA CUIPCT /Store the # of columns to get to desired col TAD (TAB) /INSERT A TAB FOR A DOCUMENT JMS CUIOUT ISZ CUIPCT /Increment positions to move SKP /Skip if not done. JMP CUIPRT /IF ONLY ONE CHAR TO INSERT RETURN CUIPLP, TAD (WRAPBT+SPACE) /FILL REST WITH SPECIAL SPACES FOR THE EDITOR JMS CUIOUT /OUTPUT A JUSTIFYING SPACE ISZ CUIPCT /Increment the spaces-to-be-output counter JMP CUIPLP /Not done: loop CUIPRT, /Finished: Exit. CLA JMP I CUIPOS / CUISRC - SEARCH FOR STRING IN DOCUMENT CURRENTLY OPEN BY 'RDFIL' / CALL: / JMS CUISRC / ADDRESS OF ASCII STRING TO BE MATCHED, ENDING WITH ZERO / RETURN LOCATION WHEN NO MATCH FOUND BEFORE EOF / MATCH RETURN / ON RETURN - / AC NORMAL RETURN - 0 / ERROR RETURN - UNCERTAIN / T1,T2 CLOBBERED /A022 / THE LAST CHARACTER TAKEN FROM THE DOCUMENT MATCHED THE LAST CHARACTER / OF THE STRING. CUISRC, XX /SEARCH FOR STRING IN DOCUMENT AC7777 DCA CUIFRS /RETURN THE LAST CHARACTER A SECOND TIME CUISR1, TAD I CUISRC /GET ARG DCA CUISSP /SAVE AS STRING PTR CUISR2, AC0001 /RETURN LAST CHAR AGAIN ISZ CUIFRS /FIRST CALL? CLA /NO, RETURN NEXT CHARACTER FROM FILE JMS CUIGCH /GET NEXT CHAR JMP CUISR3 /NON-SKIP EOF RETURN CIA /COMPARE WITH NEXT CHAR IN STRING TAD I CUISSP /GET THE CHAR SZA CLA JMP CUISR1 /NO - RE-INIT ISZ CUISSP /GET NEXT CHAR FROM STRING TAD I CUISSP /END? SZA CLA JMP CUISR2 /NO - CHECK NEXT CHAR ISZ CUISRC /YES - ALL DONE - SKIP RETURN CUISR3, ISZ CUISRC JMP I CUISRC /RETURN CUISSP=T2 /CHAR PTR /A022 CUIFRS=T1 /FLAG TO INDICATE FIRST PASS THRU SEARCH LOOP - /IF FIRST PASS, RETURN LAST FILE CHARACTER A SECOND TIME. CUINUM, XX /PICK UP THE NUMBER FROM THE DOCUMENT CURRENTLY OPEN TO 'RDFIL' DCA CUINNV /INIT VALUE (ASSUME AC ZERO HERE) CUINL1, /ASSUME AC ZERO HERE JMS CUIGCH /GET CHAR JMP I CUINUM /NON-SKIP RETURN TAD (-72 /NUMERIC? SMA JMP CUINDN /DONE TAD (LF SPA JMP CUINDN /STILL NO DCA T1 /SAVE TAD CUINNV CLL RTL TAD CUINNV CLL RAL TAD T1 DCA CUINNV JMP CUINL1 /LOOP - NEXT CHAR CUINDN, CLA TAD CUINNV ISZ CUINUM /SKIP RETURN JMP I CUINUM /RETURN CUINNV=T2 /NUMBER ACCUMULATOR /A022 /------------------------------------------- PAGE CUIPDS, XX /THE FIRST N LINES DISPLAYED AND NOT ERASED CIFMNU JMS I IOACAL 0 CUICSR /CLEAR THE SCREEN 0 CIFMNU JMS I IOACAL /PUT THE RULER AND START IF PRINTER CONTROL IN CUIOUD CUIDS2 CUIDRL CIFMNU /DISPLAY THE DOCUMENT INDEX MESSAGE JMS I IOACAL CUIOUT CUILN1 JMS NWLINE CIFMNU JMS I IOACAL /OUTPUT THE STATUS LINE CUIOUT CUIIS1 CUISA1, CUIWS1 / ADDR OF SUB-STRING /A020 CUIDRN, 0 CUIBF1 CUINFS, 0 CUINFB, 0 CUINBF, 0 JMS NWLINE /NEXT LINE JMS CUIDOT /OUTPUT ------ JMS NWLINE /NEXT LINE JMS CUITLN /DISPLAY THE first line of COLUMN INFO CUITP1 /"Document" CUICRE /column for creation date CUITNL /"null" to INSERT A TAB (for document) CUIMOD /column for last modified date CUITNL /"null" to insert a tab (for document) CUISIZ /column for document size CUITNL /"null" to insert a tab (for document) CUIVER /column for document version number CUITNL /"null" to insert a tab CUILTE /column for the time of the last edit CUIP11 /"Elapsed Time" 0 /end of list JMS NWLINE JMS CUITLN /Display the second line of column info CUITP2 /"Number Name" CUICRE /column for creation date/time CUITP3 /"Created" CUIMOD /column for modification date/time CUITP4 /"modified" CUISIZ /column for document size CUITP5 /"Size" CUIVER /column for version number CUITP6 /"Version" CUILTE /column for time of last edit CUITPE /"Last" CUITTE /column for total time spent editing CUIP13 /"Total" 0 /end of list JMS NWLINE /NEXT LINE JMS CUIDOT /DISPLAY ----- JMS NWLINE /NEXT LINE CIFMNU JMS I IOACAL /PUT IN THE END OF PRINTER CONTROL CUIOUD CUIDS2 CUIDR2 JMP I CUIPDS CUIDT2, XX /DISPLAY THE TIME FROM WHAT IS IN THE AC. / THE FORMAT IS IN MINUTES AND IS DISPLAYED IN HOURS AND MINUTES. / the elapsed time is given in minutes and is to be taken to be a positive/M013 / value. ie. 4000 is taken to mean 34 hrs, 8 minutes. 4001 is 34:09, etc. /M013 / RETURNS AC=0 IFNDEF ITALIAN < MQL DCA CUID2T /CLEAR THE HOUR COUNTER MQA SMA JMP CUIDL2 /Skip if elapsed time more than 34:07 /A013 CUIDL1, TAD (-74) / 1 less Hr. /A013 SMA / skip if still more than 34:07 /A013 JMP CUIDL3 / Jmp if new time less than or equal to 34:07 /A013 ISZ CUID2T / 1 more Hr. /A013 JMP CUIDL1 / do this again. /A013 CUIDL2, TAD (-74) /GET HOURS SPA JMP CUIDL4 CUIDL3, ISZ CUID2T JMP CUIDL2 CUIDL4, TAD (74) DCA CUID3T /STORE THE MINUTES CIFMNU JMS I IOACAL CUIOUT CUIDS4 CUID2T, 0 CUID3T, 0 > JMP I CUIDT2 CUIOUT, XX /OUTPUT ROUTINE FOR SCREEN OR GO TO DOCUMENT OPTION DCA T1 /SAVE THE CHARACTER TO OUTPUT RDF TAD CIDF0 /MAKE CROSS FIELD CALLABLE DCA CUIOUX CDFMYF TAD T1 /Get the character to output SNA JMP CUIOUX /SKIP NULLS DCA I CUICPO /STORE IN BUFFER ISZ CUICPO /Increment the buffer pointer CUIOUX, 0 /Restore field JMP I CUIOUT /Exit CUITLN, XX /DISPLAY THE IOA TEXT STRINGS THAT ARE PASSED / TO IT BY ARGUMENTS BY THE CALLER. THE NEXT ARGUMENT TELLS WHERE / HORIZONTALLY TO MOVE AFTER THE DISPLAY. TO MAKE THE DOCUMENT APPEAR THE SAME / A TAB HAS TO BE INSERTED INTO THE DOCUMENT INSTEAD OF THE MOVE IF THE / DOCUMENT OPTION IS BEING USED. / CALL: JMS CUITLN / ADDRESS IF 6-BIT IOA STRING - NO ARGS. / LOCATION TO MOVE OR ZERO FOR THE END CUITLP, CLA /Clear the AC TAD I CUITLN /Get the string address ISZ CUITLN /Increment the arg pointer DCA CUITL1 /Store the string address CIFMNU JMS I IOACAL /Print the IOA string CUIOUT /Using this output routine CUITL1, 0 /Address of the string to be printed TAD I CUITLN /Get the column to print the next string at ISZ CUITLN /Increment the col pointer SNA JMP I CUITLN /If col is Zero then exit DCA CUITL2 /Otherwise store the column position JMS CUIPOS /Position the cursor or make tabs in document CUITL2, 0 /column position JMP CUITLP /Loop for next argument set /----------------------------------- PAGE / IOA OUTPUT STRINGS CUIIS1, IFDEF ENGLSH < TEXT '&^S: ^D, &NAME: ^A, &NO. OF &DOCS: ^D, &BLOCKS LEFT: ^D (OF ^D)' > /C026 IFDEF ITALIAN < TEXT '&^S: ^D, &NOME: ^A, &QUANTIT\A: ^D, &BLOCCHI LIBERI: ^D (SU ^D)' > IFDEF V30NOR < TEXT '&^S: ^D, &NAVN: ^A, &ANT. DOK.: ^D, &LEDIGE BLOKKER: ^D (AV ^D)'> /A028 IFDEF V30SWE < TEXT '&^S: ^D, &NAMN: ^A, &ANTALDOK: ^D, &LEDIGA BLOCK: ^D (AV ^D)'> IFDEF DUTCH < TEXT '&^S: ^D, &NAAM: ^A, &AANTAL DOCUMENTEN: ^D, &VRIJE BLOKKEN:' *.-1 TEXT '& ^D (UIT ^D)' > IFDEF SPANISH < TEXT '&^S: ^D, &NOM: ^A, &NO. DE &DOC: ^D, BLOQUES RESTANTES: ^D (OF ^D)'> CUIDS2, TEXT '^A' CUIDS3, /DATE FORMAT, WITHOUT TRAILING SPACE /A024 TEXT '^D^S^D^S^D' /A023 CUIDS4, TEXT '^D:^2D' /TIME IFNDEF DUTCH < CUIDS5, TEXT ' !D' /SIZE > IFDEF DUTCH < CUIDS5, TEXT ' !D' /SIZE > CUIDS6, TEXT ' !D' /VER# CUIDS7, IFDEF ENGLSH < TEXT '&THERE IS NO DOCUMENT WITH THE NUMBER !D' > IFDEF ITALIAN < TEXT '&NON ESISTE IL DOCUMENTO !D' > IFDEF V30NOR < TEXT '&DOKUMENT NR. !D FINNES IKKE'> /A028 IFDEF V30SWE < TEXT '&DET FINNS INGET DOUKMENT MED NUMMER !D'> IFDEF DUTCH < TEXT '&ER IS GEEN DOCUMENT MET NUMBER !D'> IFDEF SPANISH < TEXT '&NO HAY DOCUMENTO CON N\ZMERO !D'> CUIDE2, IFDEF ENGLSH < TEXT '^P!E ^P&UNABLE TO READ INDEX INFORMATION FROM ^S ^D.'> IFDEF ITALIAN IFDEF V30NOR < TEXT '^P!E ^P&KAN IKKE LESE DATA I DOK.-FORTEGNELSEN I ^S ^D.'> /A028 IFDEF V30SWE < TEXT '&KAN INTE L\DSA INNEH\ELLSF\VRTECKNINGEN I ^S ^D' > IFDEF DUTCH < TEXT '^P!E ^P&INDEX-INFORMATIE ONLEESBAAR VAN ^S ^D.'> IFDEF SPANISH < TEXT '^P!E ^P&IMPOSIBLE LEER LA INFORMACI\SN \MNDICE DE ^S ^D.'> CUILN2, TEXT '-^S^S' /Used for ------- in index display CUID10, TEXT ' ^D' CUIDN2, IFDEF ENGLSH < TEXT '&N&O/&D&A/&T&E' > IFDEF ITALIAN < TEXT '00/00/00' > IFDEF V30NOR < TEXT "&B&L/&A&N/&K&T" > /A028 IFDEF V30SWE < TEXT '00/00/00' > IFDEF DUTCH < TEXT '00-00-00'> IFDEF SPANISH < TEXT '00-00-00'> CUILN1, IFDEF ENGLSH < TEXT '-- !&INDEX !&OF !&DOCUMENTS --' > /M014 IFDEF ITALIAN < TEXT '-- !&INDICI !&DOCUMENTI --' > IFDEF V30NOR < TEXT '-- !&DOKUMENTFORTEGNELSE --'> /A028 IFDEF V30SWE < TEXT '-- &INNEH\ELLSF\VRTECKNING \VVER DOKUMENT --'> IFDEF DUTCH < TEXT '-- !&INDEX --'> IFDEF SPANISH < TEXT '-- !&INDICE !&DE !&DOCUMENTOS --'> CUITP1, IFDEF ENGLSH < TEXT '&DOCUMENT' > IFDEF ITALIAN < TEXT '&DOCUMENTO' > IFDEF V30NOR < TEXT "&DOKUMENT" > /A028 IFDEF V30SWE < TEXT '&DOKUMENT' > IFDEF DUTCH < TEXT '&DOCUMENT'> IFDEF SPANISH < TEXT '&DOCUMENTO'> CUITP2, IFDEF ENGLSH < TEXT '&NUMBER &NAME' > IFDEF ITALIAN < TEXT '&NUMERO &NOME' > IFDEF V30NOR < TEXT "&NUMMER &NAVN" > /A028 IFDEF V30SWE < TEXT '&NUMMER &NAMN' > IFDEF DUTCH < TEXT '&NUMMER &NAAM'> IFDEF SPANISH < TEXT '&NOMBRE &N\ZMERO'> CUITP3, IFDEF ENGLSH < TEXT '&CREATED' > IFDEF ITALIAN < TEXT '&CREATO' > IFDEF V30NOR < TEXT '&OPPRETTET'> /A028 IFDEF V30SWE < TEXT '&SKAPAT'> IFDEF DUTCH < TEXT '&GEEMAKT'> IFDEF SPANISH < TEXT '&CREADO'> CUITP4, IFDEF ENGLSH < TEXT '&MODIFIED' > IFDEF ITALIAN < TEXT '&MODIFICATO' > IFDEF V30NOR < TEXT '&REDIGERT'> /A028 IFDEF V30SWE < TEXT '&DNDRAD'> IFDEF DUTCH < TEXT '&BEWERKT'> IFDEF SPANISH < TEXT '&MODIFICADO'> CUITP5, IFDEF ENGLSH < TEXT '&SIZE' > IFDEF ITALIAN < TEXT '&DIMENS.' > IFDEF V30NOR < TEXT '&STR.'> /A028 IFDEF V30SWE < TEXT '&STORLEK'> IFDEF DUTCH < TEXT '&OMVNG'> IFDEF SPANISH < TEXT '&TAMA\QO'> CUITP6, IFDEF ENGLSH < TEXT '&VERSION' > IFDEF ITALIAN < TEXT '&VERS.' > IFDEF V30NOR < TEXT 'VERSJON'> /A028 IFDEF V30SWE < TEXT '&VERSION'> IFDEF DUTCH < TEXT '&VERSIE'> IFDEF SPANISH < TEXT '&VERSI\SN'> IFDEF ENGLSH < CUIWS1, TEXT 'DRIVE' /A020 CUIWS2, TEXT 'DEVICE' /A020 > IFDEF ITALIAN < CUIWS1, CUIWS2, TEXT 'UNIT\A' > IFDEF V30NOR < CUIWS1, TEXT 'STASJON' /A028 CUIWS2, TEXT 'ENHET' /A028 > IFDEF V30SWE < CUIWS1, TEXT 'ENHET' CUIWS2, TEXT 'ENHET' > IFDEF DUTCH < CUIWS1, TEXT 'DISKETTE' CUIWS2, TEXT 'GEBIED' > IFDEF SPANISH < CUIWS1, TEXT 'UNIDAD' CUIWS2, TEXT 'DISPOSITIVO'> CUINGD, XX /GET THE DOCUMENT THAT THE INDEX IS TO GO TO IF DESIRED. / OPEN THE DOCUMENT AND SET THE FLAGS FOR IT. CDFMNU TAD I (MUBUF+MNTMP2) /ZERO TO SCREEN, NONZERO TO DOCUMENT CDFMYF SNA JMP I CUINGD DCA CUIDFG /SET THE FLAG CDFMNU TAD I (MUBUF+MNFNO) /GET DOCUMENT NUMBER CDFMYF DCA CUIDCN TAD CUIDCN MQL /SAVE IN MQ FOR SCROLL AC7776 /IF 2 THEN GO TO MAIN MENU CDFMNU TAD I (MUBUF+MNTMP1) /GET TYPE OF OPEN CDFMYF SNA JMP CUINDR /RETURN TAD (2) CIFFIO FILEIO XDSKIN /M0010 JMP I CUINGD NWLINE, XX /FLUSH THE BUFFER TO THE SCREEN AND THE DOCUMENT IF HAVE TO CLA TAD (CR) /PUT A CR INTO THE BUFFER FOR THE SCREEN DCA I CUICPO ISZ CUICPO TAD (LF) /AND ADD THE LINE FEED DCA I CUICPO ISZ CUICPO TAD (CUIBAD) DCA CUIPCT /SET THE POINTER TO THE BEGINING NWLINL, TAD I CUIPCT JMS CUIOUS /OUTPUT TO SCREEN TAD I CUIPCT /NOW TO DOCUMENT JMS CUIOUD ISZ CUIPCT TAD CUICPO /COMPARE TO LAST CHAR CIA TAD CUIPCT SPA CLA JMP NWLINL TAD (CUIBAD) /RESET THE CURRENT POSITION DCA CUICPO JMP I NWLINE CUIDOT, XX CIFMNU JMS I IOACAL /DISPLAY THE ---- CUIOUT CUILN2 IN1DAS IN1DAS JMP I CUIDOT /-------------------------------------- PAGE / IOA OUTPUT STRING IN1DAS, TEXT '---------------------------------------' /RULER AND PRINTER CONTROLS CUIDRL, IFDEF ENGLSH < 16 /Begin ruler code "@-200 /Marker to introduce the forward pointing ruler "1-200;"D-200 /Left margin (single spacing) "9-200;"C-200 /Tab at column 9 "1-200;76;"C-200 /Tab at column 30 (76 is closing angle brckt "2-200;"7-200;"C-200 /Tab at column 39 and cannot be used in "3-200;"6-200;"C-200 /Tab at column 54 conditional code.) "3-200;";-200;"C-200 /Tab at column 59 "4-200;"4-200;"C-200 /Tab at column 68 "4-200;";-200;"C-200 /Tab at column 75 "4-200;"?-200;"E-200 /Ragged Right margin at 79 17 /End ruler code 207 /Word wrap next line 1014 /Start print control 164 /t 157 /o 160 /p 12 /End print control 0 > IFDEF ITALIAN < 16 /Begin ruler code "@-200 /Marker to introduce the forward pointing ruler "1-200;"D-200 /Left margin (single spacing) "9-200;"C-200 /Tab at column 9 "1-200;76;"C-200 /Tab at column 30 (76 is closing angle brckt "2-200;"7-200;"C-200 /Tab at column 39 and cannot be used in "3-200;"6-200;"C-200 /Tab at column 54 conditional code.) "3-200;";-200;"C-200 /Tab at column 59 "4-200;"4-200;"C-200 /Tab at column 68 "4-200;";-200;"C-200 /Tab at column 75 "4-200;"?-200;"E-200 /Ragged Right margin at 79 17 /End ruler code 207 /Word wrap next line 1014 /Start print control "I-200 /I "N-200 /N "I-200 /I "Z-200 /Z "I-200 /I "O-200 /O 12 /End print control 0 > IFDEF DUTCH < 16 /Begin ruler code "@-200 /Marker to introduce the forward pointing ruler "1-200;"D-200 /Left margin (single spacing) "9-200;"C-200 /Tab at column 9 "1-200;"4-200;"C-200 /Tab at column 20 "2-200;"2-200;"C-200 /Tab at column 34 "3-200;"0-200;"C-200 /Tab at column 48 "3-200;"9-200;"C-200 /Tab at column 57 "4-200;"2-200;"C-200 /Tab at column 66 "4-200;"9-200;"C-200 /Tab at column 74 "4-200;"?-200;"E-200 /Ragged Right margin at 79 17 /End ruler code 207 /Word wrap next line 1014 /Start print control 164 /t 157 /o 160 /p 12 /End print control 0 > /End IFDEF DUTCH IFDEF NORWAY < 16 /Begin ruler code "@-200 /Marker to introduce the forward pointing ruler "1-200;"D-200 /Left margin (single spacing) "9-200;"C-200 /Tab at column 9 "1-200;76;"C-200 /Tab at column 30 (76 is closing angle brckt "2-200;"7-200;"C-200 /Tab at column 39 and cannot be used in "3-200;"6-200;"C-200 /Tab at column 54 conditional code.) "3-200;74;"C-200 /Tab at column 60 (74 is opening angle brkt "4-200;"4-200;"C-200 /Tab at column 68 see above.) "4-200;";-200;"C-200 /Tab at column 75 "4-200;"?-200;"E-200 /Ragged Right margin at 79 17 /End ruler code 207 /Word wrap next line 1014 /Start print control 164 /t 157 /o 160 /p 160 /p 12 /End print control 0 > /END IFDEF NORWAY IFDEF SWEDSH < 16 /Begin ruler code "@-200 /Marker to introduce the forward pointing ruler "1-200;"D-200 /Left margin (single spacing) "8-200;"C-200 /Tab at column 8 "1-200;":-200;"C-200 /Tab at column 26 "2-200;"3-200;"C-200 /Tab at column 35 "3-200;"1-200;"C-200 /Tab at column 49 "3-200;"9-200;"C-200 /Tab at column 57 "4-200;"2-200;"C-200 /Tab at column 66 "4-200;":-200;"C-200 /Tab at column 74 "4-200;"?-200;"E-200 /Ragged Right margin at 79 17 /End ruler code 207 /Word wrap next line 1014 /Start print control 164 /t 157 /o 160 /p 160 /p 12 /End print control 0 > /END IFDEF SWEDSH IFDEF SPANISH < 16 /Begin ruler code "@-200 /Marker to introduce the forward pointing ruler "1-200;"D-200 /Left margin (single spacing) "9-200;"C-200 /Tab at column 9 "1-200;"4-200;"C-200 /Tab at column 20 "2-200;"2-200;"C-200 /Tab at column 34 "3-200;"0-200;"C-200 /Tab at column 48 "3-200;"9-200;"C-200 /Tab at column 57 "4-200;"2-200;"C-200 /Tab at column 66 "4-200;"9-200;"C-200 /Tab at column 74 "4-200;"?-200;"E-200 /Ragged Right margin at 79 17 /End ruler code / 207 /Word wrap next line 1014 /Start print control / 164 /t / 157 /o / 160 /p 151 /i 12 /End print control 0 > CUIDR2, 1414 CUITNL, 0 CUITPE, IFDEF ENGLSH < TEXT '&LAST' > IFDEF ITALIAN < TEXT ' ' > IFDEF V30NOR < TEXT '&SIST'> /A028 IFDEF V30SWE < TEXT '&SENASTE'> IFDEF DUTCH < TEXT '&BEWERK'> IFDEF SPANISH < TEXT '&ULTIMO'> CUIP11, IFDEF ENGLSH < TEXT '&ELAPSED &TIME' > IFDEF ITALIAN < TEXT ' ' > IFDEF V30NOR < TEXT '&MEDG\ETT TID'> /A028 IFDEF V30SWE < TEXT '&ANV\DND TID'> IFDEF DUTCH < TEXT '&LAATST/TOT.'> IFDEF SPANISH < TEXT '&TIEMPO &TRANSCURRIDO'> CUIP13, IFDEF ENGLSH < TEXT '&TOTAL' > IFDEF ITALIAN < TEXT ' ' > IFDEF V30NOR < TEXT '&I ALT'> /A028 IFDEF V30SWE < TEXT '&SAMMANLAGD'> IFDEF DUTCH < TEXT '&TIJD'> IFDEF SPANISH < TEXT '&TOTAL'> QURX, XX CLA CIFSYS; ENQUE; QUBLK CIFSYS; JWAIT TAD QUQBLK+RXQCOD SNA;JMP .-4 JMP I QURX GETCHR, XX CLA TAD I GETCHR DCA T1 ISZ GETCHR TAD I T1 CLL RAR TAD I GETCHR DCA T1 TAD I T1 SNL BSW AND P77 ISZ GETCHR JMP I GETCHR / / The following piece of code really belongs to CUIOUD but guess / what ... there isn't enough room on that page , quel surprise. / / CUI8BT, / Ouput 8 bit char as dead /A027 CLA / /A027 MQA / Get char back /A027 AND P177 / Strip off 8th bit /A027 DCA CUMNCH / Save char /A027 TAD (CUMNSTR / Get address of dead string /A027 DCA CUMNPTR / Save it /A027 CU8NXT, TAD I CUMNPTR / Get next char in loop /A027 SNA / Is it the zero terminator ? /A027 JMP CUIODX / Yes rejoin mailine /A027 CIFFIO / Off to Files /A027 FILEIO / Output to document /A027 XPUTST / Put char to scroll /A027 ISZ CUMNPTR / Bump to next /A027 JMP CU8NXT / And go again /A027 CUMNSTR,10;40;62 / Start of dead , space , MNC intro /A027 CUMNCH, 0 / MN char (modified in line) /A027 CUMNRST,15;0 / End of dead and terminator /A027 CUMNPTR,0 / Pointer into "dead thing" string /A027 /------------------------------------------ PAGE /THE ERROR ROUTINE THAT IS USED BY INDEX WHEN THE FILE DOESNT /MATCH THE NUMBER IN THE INDEX FILE CUIDBN, CLA TAD CUIDFO DCA CUID8 CIFMNU JMS I IOACAL CUIOUT CUID10 CUID8, 0 JMS CUIPOS CUINME CIFMNU JMS I IOACAL CUIOUT CUIDS2 CUIDST JMS NWLINE JMS CUIPOS CUIERO CIFMNU JMS I IOACAL /Print "No document with number !D" CUIOUT /Output routine CUIDS7 /Address of string CUID8 /Document number JMP CUIDSR /RETURN CUIDER, CLA TAD CUIDRV /GET DRIVE NUMBER FOR ERROR MESSAGE DCA CUIDE1 CIFMNU JMS I IOACAL 0 CUIDE2 0 700 CUISA2, CUIWS1 / ADDR OF SUB-STRING /A020 CUIDE1, 0 CLA DCA CUIPGE / SET ENTRIES = 0 /A017 DCA CUIREM / SET DOC. REMAINING = 0 /A017 TAD (-5) DCA CUICNT JMS CUIWAT / WAIT FOR USER RESPONSE JMP CUINDR / CLEAN UP AND TERMINATE JMP CUINDR /DON'T REMOVE THIS LINE CUIOUD, XX /OUTPUT TO A DOCUMENT IF NEEDED MQL /FIRST SEE IF SHOULD GO TO DOCUMENT RDF /MAKE CROSS FIELD CALLABLE TAD CIDF0 DCA CUIODX TAD (-13) /SEE IF THE DISK HAS 10 BLOCKS OR LESS ON IT FREE CDFFIO TAD I (SCFSPC) CDFMYF /M0010 SMA CLA JMP CUIOU2 AC0001 DCA CUIOVR /SET FLAG FOR OVERFLOW JMP CUIODX CUIOU2, CDFMYF TAD CUIDFG SNA CLA JMP CUIODX MQA TAD (-CR) /GET RID OF CR SNA TAD (-CR) TAD (CR) TAD (-200) / Is it 8 bit /A027 SMA SZA / /A027 JMP CUI8BT / yes , Go set it up /A027 TAD (200) / No , Add back 200 /A027 CIFFIO FILEIO XPUTST /M0010 CUIODX, XX JMP I CUIOUD /THIS IS USED IN CUIOVR, HERE FOR ROOM CUICSR, TEXT '^P!E' /**************************************************************************** / / THIS ROUTINE CHECKS FOR A WINCHESTER DRIVE ON THE SYSTEM. / /**************************************************************************** CUICKW, XX / RETURN ADDR /A020 CLA / CLEAR AC /A020 /D025 CDFMNU / MENU FIELD /A020 /D025 TAD MUBUF+MNOPTN / FETCH OPTION WORD /A020 /D025 CDFMYF / BACK TO THIS FIELD /A020 /D025 DCA CUIOPT / SAVE VALUE /A020 /D025 AC0004 / MASK VALUE FOR WINNIE /A020 /D025 AND CUIOPT / IS WINNIE BIT SET ? /A020 /D025 SNA CLA / YES - SKIP & CONTINUE /A020 /D025 JMP CUICTD / NO - INSERT "DRIVE /A020 /D025 TAD CUIDRV / CK FOR DRIVE 0 /A020 /D025 SNA / NO - SKIP & CONTINUE /A020 /D025 JMP CUICTD / YES - INSERT "DRIVE /A020 /D025 TAD (-1 / IS IT 1 ?, DRIVE OR DEVICE /A020 /D025 SZA CLA / YES - SKIP & CONTINUE /A020 /D025 JMP CUICTW / NO - INSERT "DEVICE /A020 /D025 AC0010 / MASK - VOLUME ASSIGNED TO 1 /A020 /D025 AND CUIOPT / IS VOLUME ASSIGNED ? /A020 /D025 SNA CLA / YES - SKIP & CONTINUE /A020 TAD CUIDRV /CURRENT DRIVE NUMBER /A025 TAD (RXSTRT+1 /ACP DRIVE TABLE START ADDRESS /A025 DCA CUIPTR /POINTER TO DRIVE DATA IN ACP /A025 CDFACP /ACP DATA FIELD /A025 TAD I CUIPTR /GET DEVICE DATA /A025 CDFMYF /A025 SMA CLA /IS HARD DISK DEVICE? /A025 /....4000=H.D.UNMOUNTED /A025 /....4001 = H.D. MOUNTED /A025 /.... H. ORDER BIT =0 =RXDEVICE /A025 JMP CUICTD / NO - INSERT "DRIVE /A020 / ****** CHANGE TEXT TO "DEVICE /A020 CUICTW, TAD (CUIWS2) / ADDR OF "DEVICE /A020 DCA CUISA1 / INTO PARAMETER LIST /A020 TAD (CUIWS2) / AGAIN, THERE ARE 2 CALLS /A020 DCA CUISA2 / INTO PARAMETER LIST /A020 JMP CUICWE / BRANCH TO EXIT /A020 CUIPTR, RXSTRT+1 /POINTER TO ACP TABLE /A025 / ****** CHANGE TEXT TO "DRIVE /A020 CUICTD, CLA / CLEAR AC /A020 TAD (CUIWS1) / ADDR OF "DRIVE /A020 DCA CUISA1 / INTO PARAMETER LIST /A020 TAD (CUIWS1) / AGAIN, THERE ARE 2 CALLS /A020 DCA CUISA2 / INTO PARAMETER LIST /A020 CUICWE, JMP I CUICKW / THIS IS THE EXIT POINT /A020 CUIOPT, 0 / OPTION WORD /A020 /------------------------------------------- PAGE / IF CODE OVERFLOWS INTO BUFFER AREA, ERROR. IFNZRO CUIBFD-.&4000   / WPTRNS - DOCUMENT TRANSFER / / 045 EMcD 14-Sep-85 Add Nordic translations / (conditionalised) / 044 RCME 08-Jul-85 Allow multiple option characters / in AX/DX menu. / 043 EMcD 28-Feb-85 Add DECDEV switch / / --------------- All below refer to V2.0 and earlier ------------------ / / 042 HLP 15-NOV-84 Search & Replace: / USOCHR=TTYOU / HTICHR=HS2IN / HTOCHR=HS2OU / 041 TCW 28-NOV-84 Terminate text packet before a QUIT / 040 TCW 24-OCT-84 Write all rec. packets before quiting / 039 TCW 12-OCT-84 Add flag cks & sets before IOA calls / 038 TCW 02-AUG-84 Add (CLA) before menu call / 037 GDH 31-JUL-84 Bug fix for losing packets. / Fix EZLINK BYE packet detection. / 036 JFS 18-JUN-84 DM-III mods / 035 WCE 11-MAY-84 Remove all occurances of USERNO / 034 TCW 02-MAR-84 Ring bell for invalid character / 033 TCW 21-FEB-84 Add ck for local init. of recrtn / 032 TCW 27-JAN-84 Limit menu input to 64 chars. / 031 TCW 29-DEC-83 a) Send back a "NO" packet when unable / to create document. / b) Close document when unable to create / c) Put any text in "NO" packet on / Problem: line. / d) Add special cases of "NO" packet; / 1) Response to "RCV" packet. / 2) Response to "SOD" packet. / e) Move "Problem:" to line 4. / f) Reset Status:, Problem: & Message: / lines on S & R options. / 030 FJL 17-NOV-83 Change to fix comm. bug, erroneous msg / 029 GDH 28-JUL-83 Changed default filename generator / to not generate "1." if drive 1. / 028 GDH 21-JUL-83 Eliminated bad "AC7773" reference. / 027 GDH 6-JUN-83 General Cleanup & Rewrite of terminal / I/O / 026 DFB 01-JUN-83 Fix to close DX doc / 025 GDH 26-MAY-83 Rearranged GTLINE char checks per WPF1 / 024 GDH 18-MAY-83 Moved LARGE BUFFER to field 6. / 023 GDH 18-APR-83 Eliminated unneeded label DLYINT. / Eliminated unreferenced pool DOCLSA. / Free list buffer linkage now done at / assembly time instead of run-time. / Eliminated redundant initialization / of CMADSX. / Eliminated DXSTLS initializations. / AX/DX is reloaded each time it's / invoked. / Implemented EZ-LINK chain back to CX. / 022 EH 08-OCT-82 Limit input chars for ID/PASSWORD to 64 / 021 SBB 25-AUG-82 Changed vt278 message to / DM-II(IFDEF'ed) / 020 SBB 15-JUL-82 Made timeout delays variable from menu. / 019 GDH 15-FEB-82 Fixed AX-DX to not clobber loc 53 in / header when copying print settings / to recieve document. / 018 GDH 30-NOV-81 Changed TIMOUT to TIMEOU due to WPF1 / definition of TIMOUT. / 017 EH 28-OCT-81 Merged differences from 78,1 into here / 016 GDH 21-OCT-81 Deleted phoney CIF/CDF mapping stuff. / 015 EH 16-OCT-81 Made dx clear error count prior to / each transmition. / 014 GDH 14-OCT-81 De-implemented LOCK/UNLOCK. / 013 GDH 26-AUG-81 WPFILS calling seq changes. / 012 TT 07-JUL-81 Removed superfluous conditionals / 011 JM 01-APR-81 Text change for CANADA / 010 DIM 27-MAR-81 FIXED PAGE ERROR FOR DUTCH / 009 DAO 1-JAN-81 PUT IN FIX TO DX BUG IN 278 WHICH / RESULTED IN TOO MANY PACKET ERRORS / WHEN 278 RECEIVED AT BAUD RATES GREATER / THAN 600. STILL HAS A PROBLEM AT / 19200 BAUD. / 008 DRH 4-DEC-80 CONNECTED TO "VT278" IN AX/DX ADDED / 007 GR,DAO 17-OCT-80 CONDITIONALIZED ESCAPE SEQUENCES / 006 DM,JM 15-SEPT-80 Merged Scandi and Europe/English / 005 DSS 09-JUL-80 MODIFIED FOR ENGLISH/FRENCH-CANADIAN / 004 CMW 6-MAY-80 ENTERED CANADA TRANSLATIONS / 003 DSS 17-APR-80 ENTERED DUTCH FIXES / 002 GLT 2-APR-80 Change WS201, WS202 messages to WS81, / WS82 / 001 CMW GLT 10-JAN-80 Added French, German and Dutch / conditionals / French diacritical substitutions: / "["=L.A.E, "]"=L.G.E; "&" does not UPPERCASE / German diacritical substitutions: / "["=L.U.A, "\"=L.U.O, "]"=L.U.U; "&" usable / 3.0 MB 31-JUL-78 PUT IN NULLS AFTER CR IN A PACKET OPTION / QA3.3 MB 13-APR-78 FIX RESPONSE PACKET TO T,B OPTION IN AX-DX / 2.6+ MB NEW PROTOCOL / 2.5-1 MB FIX THE CREATE PROBLEMS IN THE WT78 10/15/77 / 2.P-4 KEE ADD CODE TO UNLOCK 102 FILES / 2.G-2 MB PUT IN CHANGE FOR MOVED MENU AREA 8/10/77 / 2.G-1 MB GET FROM THE 78 PACK / / THIS PAGE WRITES OUT WPTRNS / *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLODWC / ++++ 100 / ++++ IFNDEF DECDEV < CDF 10 / ++++ > IFDEF DECDEV < CDF 30 / ++++ > -DSODWC DLODW2 / ++++ 7400 / ++++ IFNDEF DECDEV < CDF 20 / ++++ > IFDEF DECDEV < CDF 40 > -DSODW2 0 / / HERE ARE THE CONSTANTS USED BY WPTRNS / / THESE ARE THE CONSTANTS THAT HANDLE I/O FOR A CHAR / / / SET UP CONSTANTS FOR THE PROGRAM / BUFCNT=5 / THE NUMBER OF BUFFERS IN THE POOL BUFSIZ=100 / THE STANDARD BUFFER SIZE NAKLM=-41 / THE IS THE NUMBER OF RETRNANSMITS IT WILL DO TOLIM=-5 / THE NUMBER OF TIMES YOU RESEND AFTER A TIME OUT / BELL=7 CR=15 / SENT AS AN END OF LINE DESIGNATOR FOR A TIME SHARING SYSTEM LF=12 / LINE FEED SPACE=40 / BLANK BKSPAC=10 RUBOUT=177 / THE RUBOUT CHARACTER SPECHR=140 / USED TO TELL THE DIFFERENCE FROM A PACKET AND A COMMAND RESET=175 / VERSIO=40 / THE VERSION OF THE PROTOCOL SHOULD BE INCREMENTED WITH EVERY / CHANGE TO THE PROTOCOL THAT WOULDNOT ALLOW THE NEW / TO TALK TO THE OLD / TYPE=40 / THE TYPE OF THE PROTOCOL / ZERNUL=137 / NUMBER OF NULLS REQUESTED FROM THE OTHER SYSTEM AFTER A PACKET / 40 = ZERO. IT IS SENT IN THE INIT AND INIT-ACK PACKETS / / THE VALUES FOR SYSTY1. THEY TELL THE OTHER SYSTEM SOFTWARE / WHAT IS RUNNING / ON THIS SYSTEM AX OR DX / AXSYS=41 DXSYS=40 / / THE TIME OUT CONSTANTS / /D020 SEC1=-2 /D020 SEC3=-4 /D020 SEC30=-37 /D020 SEC15=-11 / 9 SEC /A017 /D020 SEC5=-6 / / VALUES FOR THE OPTIONS / OPTNUL=40 / NOTHING OPTBYE=41 / JUST BYE MESSAGE OPTBM=42 / BYE AND NORMAL MESSAGE OPTBMS=43 / BYE, NORMAL, AND SEND OPTALL=44 / EVERYTHING / / CONSTANTS FOR THE COMMAND COMPARE / /d044 IFDEF ENGLSH < /d044 SEND="S&177 /d044 RECEIV="R&177 /d044 MESSAG="M&177 /d044 BYE="B&177 /d044 > /d044 IFDEF ITALIAN < /d044 SEND="I&177 /d044 RECEIV="R&177 /d044 DOCMNT="D&177 /d044 MESSAG="M&177 /d044 BYE="T&177 /d044 > / / THE FLAG CHARACTERS FOR THE PACKET TYPE AND THE COMMANDS FOR / THE LOW LEVEL / IF THE VALUES CHANGE TELL HSTTBL BECAUSE USE THEN AS OFFSETS / THEY ALL HAVE THE SAME PACKET FORMAT / TYPYES=140 / THE OK PACKET TYPE TYPMOD=141 / DOCUMENT OPTIONS PACKET RESPOND WITH A PROMPT / ANSWER PACKET TYPMES=142 / THE NORMAL MESSAGE TYPBYE=143 / BYE MESSAGE PACKET, WILL TERMINATE A TRANSFER TYPSOD=144 / FIRST PACKET OF A DOCUMENT CONTAINING SIZE / AND PRINTER SETTINGS TYPDTA=145 / NORMAL TEXT PACKET OF A DOCUMENT TYPEOF=146 / LAST PACKET OF A DOCUMENT. CONTAINS THE LAST / 64 BYTES OR LESS TYPHIT=147 / HIGH LEVEL INITALIZE PACKET THAT HAS THE / TERMINAL MESSAGE IN IT TYPHAK=150 / THE HIGH LEVEL ACK TYPSND=151 / WANT TO SEND A DOCUMENT TYPRCV=152 / WANT TO RECEIVE A DOCUMENT TYPOPT=153 / THE OPTION PACKET TYPDOC=154 / USED WHEN SENDING A LIST IT IS A PROMPT FOR / THE DX USER TO ANSWER TYPNO=164 / ANO RESPONSE TO A PACKET TYPPAN=172 / ANSWER TO PROMPT CONTAINS WHAT THE USER TYPED TYPPMT=175 / PROMPT PACKET TYPPNE=176 / PROMPT WITH NO ECHO / / THE LOW LEVEL PACKET TYPES. HTE FORMATS ARE DIFFERENT THAN ABOVE'S. / NAK=160 ACK=170 QUIT=171 / TELLS THE SYSTEM THAT THE OTHER SYSTEM GOLD / MENUED INIACK=173 INIT=174 / / CONSTANTS FOR THE GET THE BLOCK SIZE / ISGBK1=INMBLK ISGBK2=ISGBK1+1 / / THE CONSTANTS USED IN THE PRINTER SETTINGS / RDFILB=7400 / START OF THE BUFFER THAT THE HEADER BLOCK IS / READ INTO / SETSAV=ISGBK2+1 / THE START OF THE PRINTER SETTING IN THE INCOMING SETSND=RDFILB+23 / START OF THE PRINTER SETTINGS IN THE RXHAN BUFFER SETSIZ=-30 / SIZE OF THE PRINTER SETTINGS IN WORDS /M019 PRTOFF=21 / THE OFFSET FOR THE FIRST WORD OF THE PRINTER SETTINGS SCHDR=6000 / OFFSET USED TO FIND THE SCROLL BUFFER WITH THE / SETTINGS / / CONSTANTS FOR THE OTHER FIELD / THESE ARE THE ADDRESS IN THE BUFFER FIELD THAT CONTAIN THESE ROUTINE'S / ADDRESS. / AXDIS=200 AXEC=AXDIS+1 AXDON=AXEC+1 ADRCRT=AXDON+1 AXLRT=ADRCRT+1 / RETURN THE LOG FILE AXSR=AXLRT+1 / AX SEND AND RECEIVE ROUTINE REDSIX=AXSR+1 / READ FROM RDFILL A 6-BIT CHARACTER AND TRANSLATE TO 7-BIT WRISIX=REDSIX+1 / TAKE A 7-BIT CHARACTER AND TURN INTO 6 AND WRITE TO DISK CLASIX=WRISIX+1 / INITALIZE THE REDSIX AND WRISIX ROUTINES IFNDEF DECDEV < FIELD 1 > IFDEF DECDEV < FIELD 3 > *100 / THE FIRST 100 LOCATIONS ARE USED FOR THE SYSTEM / / THE USER FIELD CONSTANTS / CDFMYF=CDFEDT / /M016 / / HERE ARE SOME OF THE MORE COMMONLY USED FLAGS / AXFLG, 0 / SET IF IN AX MODE SENDFL, 0 / THE STATUS FLAG: / -5 = TRANSFER ABORTED / -4 = ERROR AND WAITING / -3 = TRANSFER DONE " " / -2 = NOT CONNECTED YET " " / -1 = CONNECTED " " / 0= RECEIVE / 1= SEND INIFLG, 0 / IF 1 = TRANSFER IN PROGRESS DOCNCT, 0 / IN AX THE NUMBER OF DOCUMENTS TRANSFERRED AXREC, 0 / AX SETS THIS FLAG IF WANT TO RECEIVE SNDAD, 0 / AX SETS IF WANTS TO SEND RSTFLG, 0 / DXIPRG SETS IT TO POSITIVE IF INIT DETECTED AND MINUS / IF OTHER SYSTEM HAS WRONG VERSION OPTFLG, 0 / OPTIONS AVAILABLE TO THIS SYTEM'S USER TMPRST, 0 / CONTAINS THE VALUE THAT TELLS THE OTHER SYSTEM / THE OPTIONS IT HAS AVAILABLE AT CONNECT TIME CNGSCF, 0 / CAN BE SET BY ANYONE IF + MAINJOB WILL DISPLAY ONLY THE PART / THAT HAS BEEN SAID TO BY OTHER FLAGS, IF - REPAINT THE SCREEN INIFL3, 0 / THE FLAG IS SET TO NON ZERO IF HIGH LEVEL INIT HAS TAKEN / PLACE MGWTFG, 0 ERRFLG, 0 / SET BY ANYONE. IF - THE ERROR ALL OPTIONS EXCEPT GM / ARE NOT ALLOWED. IF + THEN JUST DISPLAY THE ERROR HSTRAD, 0 / THE ADDRESS OF THE PACKET THAT THE HOST SYSTEM RECEIVED DXGTPT, 0 / A POINTER FOR THE PACKET STARTING WORD MSGAST, 0 / THIS IS THE FLAG TO TELL THE MAINLP THAT A MESSAGE IS BEING / TRANSFERRED AND THE STATUS WORD'S ADDRESS IS ITS VALUE AXPMT, 0 / 1= ACT LIKE A SPECIAL PROMPT FOR AX OSYSAX, 0 / 1= OTHER USER IS IN AX TEMP, 0 / TEMP USED BY ANYONE GTBFPT, INBUFA / BUFFER AREA FOR THE INPUT FROM KEYBOARD /The following variables are modified during start up of /WPTRNS. They are on this page because there is room here. /They can be moved if you can find room. DLY1X, -6 /A020 DLY3X, -12 /A020 DLY6X, -37 /A020 DLY180, -264 /A020 / / THE FOLLOWING 9 WORDS MOVED HERE FOR ROOM AT (022) SENT2, 0 EOF, 0 SENT3, 0 SENTMP, 0 SENT4, 0 DXNONK, 0 DTARTM, 0 BYSETF, 0 NOFLAG, 0 / SPECIAL CASES OF "NO" PACKET /A031 PRBSFG, 0 / TEXT IN "NO" PACKET /A031 GTSTA3, INBUFA / NODSBL, 0 / Set to 0 for UPDATE; 1 for no update / /The following 9 locations must start with CLASXA and must terminate with 0 / CLASXA, CLASIX / Init REDSIX/WRISIX routines. REDSXA, REDSIX / Read SIX bit. WRISXA, WRISIX / Write SIX bit. ADRCRA, ADRCRT / Create a document. AXECA, AXEC / Ask DX user for info needed at connect time. AXDISA, AXDIS / Set up AX. AXSRA, AXSR / AX SEND/RECEIVE routine. AXDONA, AXDON / Log transaction to AX LOG file. 0 / *173 / / THESE FLAGS HAVE TO BE IN THESE LOCATIONS FOR AX TO WORK / SPFLAG, 0 / IF NEGATIVE TELLS THE OTHER JOBS TO EXIT, IF POSITIVE / TELLS THE HOST JOB TO WAIT / FREEPT, BUFBL1 / POINTER TO THE FIRST FREE BUFFER (START OF THE FREE LIST) RECPT, 0 / START OF THE BUFFERS RECEIVED LIST SENDPT, 0 / START OF THE SEND LIST / NULCNT, -2 / THIS IS THE NEGATIVE NUMBER OF NULLS TO SEND AT THE / END OF EVERY PACKET AFTER THE CR. IT IS SET BY THE / RECEIVED INIT PACKET. / SET TO -2 TO WORK CORRECTLY WITH RSX-11M / PAGE / / THE PROGRAM STARTS HERE / DWXTRT, XX CLA RDF TAD CIDF0 DCA RTNCER / SAVE THE CALLERS FIELD CDFMYF / CDF FOR THIS FIELD TAD (OPTALL) / SET THE OPTIONS TO ALL UNTIL LATER DCA TMPRST JMS SETSIX / SET THE CROSS FIELD CALLS JMS XDELAY /INITIALIZE TIME OUT DELAYS /A020 / /D023; TAD (DXSTLS-1) / Get the list of stuff to initialize /M023 /D023; JMS DXIOCL / at start-up /M023 /D023; /D023; / HAS TO BE DONE ONCE /D023; / THIS IS CHAINING THE BUFFERS TOGETHER TO /D023; / CREATE THE INITIAL FREE LIST /D023; TAD (BUFBL1) /D023; DCA FREEPT /D023; TAD (BUFBL2) /D023; DCA BUFBL1 /D023; TAD (BUFBL3) /D023; DCA BUFBL2 /D023; TAD (BUFBL4) /D023; DCA BUFBL3 /D023; TAD (BUFBL5) /D023; DCA BUFBL4 / JMS DXICLA / CLEAR THE FLAGS NEEDED FOR THE IO PROGRAMS TO START /D023; JMP CHKROT / CHECK FOR THE ROUTINE THAT WAS CALLED /D023; / CHKROT RETURNS TO TRNCN5 CHKROT, / /A023 / / CHKROT - SEES WHICH ROUTINE WAS CALLED FROM THE MENU / 1 AUTO TRANSMIT / 2 DOCUMENT TRANSFER / CHKROT, CDFMNU TAD I (MUBUF+MNTMP1) / SEE WHAT PACKAGE WAS CALLED CDFMYF DCA T3 / / INITALIZE THE SYSTEM MESSAGE SENT AT INIT TIME IFDEF ENGLSH < TAD ("D-200) / INITALIZE TO DX > IFDEF ITALIAN < TAD ("D-200) / INITALIZE TO DX > IFDEF V30NOR < TAD ("D-200) / INITALIZE TO DX > IFDEF V30SWE < TAD ("D-200) > DCA SYSTY2 / Save the "DX" name TAD (DXSYS) / TELL THE OTHER SYSTEM THAT THIS SIDE IS IN DX DCA SYSTY1 / / The following was deleted in edit 023 because CMADSX is initialized /A023 / in WPCU3.PA when communications is 1st loaded. /A023 /D023; IFDEF WS102 < /D023; TAD T3 / SET THE FLAG IS WS102 TO WHAT IS SELECTED /D023;/ /D023; CDFSYS / ++++ /D023; DCA I (CMADSX) / ++++ /D023; CDFMYF /D023; > / END IFDEF WS102 AC7777 / CHECK FOR "AX" TAD T3 SZA CLA / ++++ JMP TRNCN5 / IF NOT "AX" THEN RETURN CIFBUF / Call routine to start AX. JMS I AXDISA / ... JMP RTNSY / GOLD MENU RETURN ISZ AXFLG / SET THE TOP MESSAGE TO "AX" IFDEF ENGLSH < TAD ("A-200) / INITALIZE TO AX > IFDEF ITALIAN < TAD ("A-200) / INITALIZE TO AX > IFDEF V30NOR < TAD ("A-200) / INITALIZE TO AX > IFDEF V30SWE < TAD ("A-200) > DCA SYSTY2 / Save the "AX" name TAD (AXSYS) DCA SYSTY1 AC0002 / THE AX OPTIONS CAN NEVER CHANGE FROM 2 DCA OPTREC JMP TRNCN5 TRNCN2, JMS CLAMSL / CLEAR THE MESSAGE LINE OF ANY MESSAGES / OR ERRORS TRNCN5, AC7776 / ++++ DCA SENDFL / SET THE STATUS TO NOT CONNECTED DCA ERRFLG / CLEAR THE ERROR FLAG ON REINITALIZING DCA OSYSAX / CLEAR THE FLAG THAT TELLS THE USER THAT THE / OTHER / SYSTEM IS IN AX DCA INIFL3 / FOR THE HIGH LEVEL TAD OPTREC / RESET THE OPTIONS DCA OPTFLG JMS SETFLG / SET THE FLAGS DCA PMTTMP / CLEAR ALL PENDING PROMPTS DCA INIFL2 / CLEAR THE LOW LEVEL FLAG FOR INITALIZATION DCA INIFL1 / CLEAR THE FLAG FOR THE LOW LEVEL SAYING TO / SEND INIT DCA SPFLAG / CLEAR THE STOP THE HOST FLAG JMS STRJBS / START THE PROGRAMS JMP TRNCN6 / DISP SCREEN FIRST /A039 /D039 JMP MAINL3 / WAIT FOR THE LINE TO INITALIZE / / ******************************* / RTNSY, JMS DOCTRN / KILLS THE JOBS RUNNING AND CLOSES FILE / IFDEF WS102 < / JMS RTN102 / UNLOCK THE LOG DOCUMENT / > / END IFDEF WS102 /D023; CLA CDFMNU / Map MENU field. /A023 TAD I (MUBUF+MNTMP6) / Get EZ-LINK indicator. /A023 CDFMYF / Back to our field. /A023 SZA CLA / Skip if normal exit. /A023 JMP RTNCX / Jmp to chain back to CX. /A023 CIF 60 / Map Alternate buffer field. /A024 JMS I (COMXIT) / Undo field-6 buffers. /A024 / JMS RTCLCM / CLEAR THE FLAG FOR OTHER USER CDFSYS /A017 DCA I (CMADSX) /A017 CDFMYF /A017 / RTNCER, XX JMP I DWXTRT RTNCX, CDFMNU / Map MENU field. /A023 TAD (MUBUF+MNONUM-1)/ Set up to modify MENU Overlay info. /A023 DCA IX1 / ... /A023 TAD (3) / Set up menu code to re-load CX. /A023 DCA I IX1 / Overlay #3 is CX. /A023 TAD (200) / CX entry point is at 200. /A023 DCA I IX1 / ... /A023 TAD (CIF 20) / field to load CX into. /A023 DCA I IX1 / ... /A023 CDFMYF / back to our field. /A023 ISZ DWXTRT / Set to CHAIN to CX /A023 JMP RTNCER / go to it!!! /A023 /D023; /D023;/ /D023;/ THE LIST OF LOCATIONS THAT ON ENTERING THEY HAVE TO BE ZERO /D023;/ /D023;DXSTLS, /D023; DOCNCT / THE DOCUMENT COUNTER FOR AX /D023; AXFLG / THE ALL IMPORTANT AX FLAG IS SET SAYS THE PROGRAM IS AN AX /D023; INBUFA / CLEAR THE KEYBOARD BUFFER /D023; SENDPT / THE POINTER TO THE BUFFERS SENT LIST /D023; RECPT / THE POINTER TO THE RECEIVED LIST /D023; DSKBA1 / CLEAR THE BUFFER FOR DOCUMENT TRANSFER /D023; DSKBA3 / CLEAR THE SECOND BUFFER /D023; DXIHFP / RELEASE THE BUFFER THAT THE INPUT TASK USES /D023; BUFBL5 / THE ZERO IS INSERTED IN THE END OF THE FREE LIST /D023; PUTPRC / CLEAR THE COUNTER OF THE BUFFERS WAITING TO BE ACKED /D023; PTRHED / AND CLEAR THE FIRST ENTRY /D023; PTRHED-1 / AND THE TEMP LOCATION /D023; STRTJB / CLEAR THE FLAG THAT SAYS THE JOBS ARE RUNNING /D023; OPTREC / CLEAR THE OPTIONS OF THE OTHER SYSTEM /D023; HSFLAG / HOST FLAG /D023; TRNERC / CLEAR THE ERROR COUNTER /D023; RDFILF / FLAG SET IF OPEN DOCUMENT FOR READ /D023; 0 /D023;/ GETCHR, XX / Routine to display date & time and get a / character CIFPRT / Call FLABUZ in printer field. JMS I (FLABUZ) / ... (display printer error if appropriate) CIFMNU / Now display updated time. JMS I TIMCAL / ... JMP GETCH1 / no time change. don't update display. JMS CPYTIM / Copy new time values. CIFMNU / Now to update the screen. JMS I IOACAL / ... 0 / output directly to the terminal. TIMSTR / ... 0072 / Line 1, col 59. DATSTR / Time/Date string. JMS DISBL / update bottom line. GETCH1, CIFSYS / Now wait for RETURN or GOLD MENU. XLTIN / ... ISZ GETCHR / Take 2nd return for buffer full. JMP I GETCHR / Return to caller. / / FILMBF - FILLS THE MESSAGE BUFFER INMBLK / FILMBF, XX TAD (INMBLK) JMS FILIBF JMP I FILMBF /------------ PAGE / / SETFLT - CLEAR THE FLAGS FOR THE DX INIT / SETFLT, XX CLA DECIMAL TAD (-1000) / SET THE INITAL COMPARISON COUNTER FOR BLOCK / COUNT OCTAL DCA BLKTMP TAD DSKBA1 / SEE IF THE FIRST OF 2 BUFFERS ARE IN USE SNA / ++++ JMP SETFL2 JMS PUTBUF / ++++ FREEPT SETFL2, TAD DSKBA3 / CHECK FOR THE OTHER SNA / ++++ JMP SETFL3 JMS PUTBUF / ++++ FREEPT SETFL3, TAD (SETFLL-1) JMS DXIOCL CIFBUF JMS I CLASXA / INITALIZE THE RED AND WRI SIX ROUTINES JMS CLDOC / CLOSE ANY DOCUMENTS LEFT OPEN BEFORE OPENING ANOTHER JMP I SETFLT / / SETFLL - THE LIST OF FLAGS THAT ARE CLEARED FOR THE DX / SETFLL, INIFLG / CLEAR THE PROGRAM STARTED TO SEND A DOC FLAG SNDAD / USED FOR THE SEND PART OF AX AXREC / AND USED BY AX RECEIVE INMSFG / FLAG SAYING THAT THERE IS A MESSAGE TO PUT UP BYSETF / BYE COMMAND IS BEING SENT FLAG BLKNUM / THE NUMBER OF BLOCKS SENT CORRECTLY EOF / END OF DOCUMENT FLAG DOCSIZ / SIZE OF THE SENDING DOCUMENT IN BLOCKS RESBFS / CLEAR THE FLAG FOR THE BUFFERS HAVE BEEN CHOSEN DSKBA1 / THE ADDRESS OF THE FIRST BUFFER USED FOR THE TRANSFER DSKBA3 / THE SECOND BUFFER DSKBA4 / THE DISK BUFFER WRITE FLAG DSKBA2 / THE OTHER DISK BUFFER WRITE FLAG BLKOVR PMTFLG / CLEAR THE PROMT FLAG ERRFLG / CLEAR THE ERROR FLAG NOFLAG / SPECIAL CASES OF "NO" PACKET /A031 /D023; DOCLSA / CLEAR THE FIRST ENTRY INTO THE LIST EVERY TIME A /D023; / TRANSFER IS TO START RSTFLG / CLEAR THE RESTART FLAG 0 / / DXICLA - CLEARS THE MAJORITY OF THE FLAGS THAT ARE NEEDED FOR THE LOW / LEVEL INIT / DXICLA, XX TAD (TOCLST-1) JMS DXIOCL JMS HOSTIN / CLEAR THE INPUT BUFFER SKP CLA JMP .-2 JMP I DXICLA / / DXIOCL - CLEARS THE LIST SPECIFIED BY THE AC / DXIOCL, XX DCA IX1 / THE AC CONTAINS THE LIST ADDRESS MINUS 1 DXICLL, TAD I IX1 SNA / ++++ JMP I DXIOCL DCA T2 DCA I T2 / CLEAR THE FLAG JMP DXICLL / / START THE OTHER JOBS / STRJBS, XX CLA TAD STRTJB SZA CLA / ++++ JMP I STRJBS AC0001 / ++++ DCA STRTJB /D035 TAD USERNO /D035 SZA CLA / ++++ /D035 TAD (JSBSZ^4) TAD (JSBX0) / ++++ DCA X0 TAD (JLIST-1) / ++++ DCA IX1 JMP B A, MQL TAD X0 / ++++ DCA T1 CDFSYS RIF CLL RAL DCA I X0 DCA I X0 MQA / ++++ DCA I X0 DCA I X0 ISZ X0 CDFMYF / CDF FOR THIS FIELD (MY FIELD) TAD T1 CIFSYS / ++++ JSTRT B, TAD I IX1 SZA / ++++ JMP A JMP I STRJBS JLIST, HSTPRG / ++++ DXIHJB / ++++ DXOHJB 0 STRTJB, 0 / UNABLE TO CREATE DOCUMENT ERROR PATH /A031 RCVCR3, DCA PMTTMP / CLEAR FLAGS /A031 DCA AXPMT / /A031 TAD (-4) / SIGNAL - "***ERROR***" /A031 DCA SENDFL / /A031 AC7777 / SIGNAL - CHANGE SCREEN /A031 DCA CNGSCF / /A031 JMP MAINLW / RETURN TO MAIN LOOP /A031 / RECEIVED A "NO" PACKET - OTHER SYS UNABLE TO CREATE /A031 RECNO1, AC0003 / SIGNAL - "COULD NOT CREATE DOC." /A031 DCA ERRFLG / /A031 DCA PMTTMP / CLEAR FLAGS /A031 DCA AXPMT / /A031 TAD HSTRAD / RELEASE BUFFER /A031 JMS PUTBUF / /A031 FREEPT / /A031 JMP HSTRST / RESTART HOST /A031 GTLERD, XX / RING BELL HERE /C034 CIFMNU JMS I IOACAL / /C034 0 BELSTR / CONTROL STRING /C034 BELTXT / BELL CODE /C034 JMP I GTLERD / Return to caller. /------------- PAGE / / TRNAGN - WAITS FOR THE HOST JOB TO RESPOND TO THE SPFLAG / TRNAGN, AC0001 / SET THE FLAG INCASE IT WASNT SET JMS HSTSET / SET THE FLAG AND WAIT FOR THE HOST TO GET IT JMP RTNSY / GO BACK TO MAIN MENU JMS CLDOC / CLOSE THE DOCUMENT JMP TRNCN2 / / HSTSET - SETS SPFLAG TO TELL THE HOST SOMETHING AND WAITS / FOR HOST TO SAY IT RECEIVED IT / HSTSET, XX DCA SPFLAG HSTSE2, JMS HLTEST / ++++ JMP I HSTSET TAD HSFLAG / SEE IF THE HOST STOPPED SNA CLA / ++++ JMP HSTSE2 ISZ HSTSET JMP I HSTSET / / RSTPRG - THE HIGH LEVEL INIT ROUTINE / IT WILL SEND AN INITALIZE MESSAGE EVERY / 5 SECONDS AND WAIT FOR A INITALIZE ACK / RSTPRG, TAD (INITYP-1) JMS INIBFS JMP HSTWAT / SPFLAG IS SET SO WAIT JMP TIMEOU / TIMED OUT ISZ INIFL3 / SET IT SO ONLY ONE INIT IS SENT JMP HSTJWT / WAIT FOR OTHERS TO SEE WHAT IS DONE / / CPYITM - COPY FROM THE COMMUNICATIONS KEYBOARD BUFFER TO MENU'S / CPYITM, XX DCA TOKOFT / GET THE STARTING ADDRESS JMS DXCOPY CDFMYF TOKOFT, XX CDFMNU CPYDST, MUBUF+MNIBUF TAD CPYDST / SET THE POINTER TO THE MENU BUFFER CDFMNU DCA I (MUBUF+MNPOS) CDFMYF JMP I CPYITM / / CPYMTB -GET THE DOCUMENT NAME THAT WAS TYPED / CPYMTB, XX DCA CPYMT2 JMS DXCOPY CDFMYF CPYMT2, XX CDFMYF DOCNBF DCA INBUFA / CLEAR THE KEYBOARD BUFFER SINCE DONE WITH IT JMP I CPYMTB / / GTDCNO - GETS THE DOCUMENT NUMBER FROM THE MENU / GTDCNO, XX CDFMNU TAD I (MUBUF+MNFNO) / ALSO SET THE DOCUMENT NUMBER CDFMYF DCA DOCNO JMP I GTDCNO / / HITRTN - HOST ROUTINE THAT WILL TAKE CARE OF A HIGH LEVEL INIT PACKET / HITRTN, TAD AXFLG / KNOW WHAT THE OTHER SYSTEM IS RUNNING BUT DO SNA CLA / ++++ JMP HITRT2 / NEED MORE INFORMATION IF WE ARE AX? CIFBUF JMS I AXECA JMP HSTWAT / SPFLAG IS SET JMP TIMEOU / TIMED OUT DCA TMPRST / SAVE OPTIONS THAT THE OTHER SYSTEM CAN USE HITRT2, AC0004 / GET THE FIRST WORD THE ONE THAT HAS OTHER SYSTEMS TAD HSTRAD / TYPE IN IT IT CAN BE EITHER DX OR AX DCA T1 TAD I T1 TAD (-40) / IF 40 = DX 41=AX DCA OSYSAX TAD OSYSAX SZA CLA / ++++ JMP HITRT4 / IF AX THERE IS NO NEED TO SEND THE OPTIONS TAD TMPRST / RESPOND WITH THE OPTION PACKET DCA OPTSTR+1 TAD (OPTSTR-1) JMS INIBFS JMP HSTWAT JMP TIMEOU HITRT4, AC7777 / ++++ DCA SENDFL / SET STATUS TO WAITING AND INITALIZED TAD HSTRAD / ++++ DCA LN2FG / TELL THE MAINJOB THE ADDRESS OF THE BUFFER TO / DISPLAY AND RELEASE WHEN DONE. AC7777 / ++++ DCA CNGSCF / REPAINT THE SCREEN JMP HSTJWT / WAIT BUT FIRST CLEAR THE INTFLG LN2FG, 0 OPTSTR, TYPOPT XX 0 / / DISBL - DISPLAYS THE BOTTOM LINE AND POSITIONS THE CURSER / DISBL, XX TAD NODSBL / IF 1 THEN DONT DISPLAY THE BOTTOM LINE SZA CLA / ++++ JMP I DISBL CIFMNU JMS I IOACAL 0 CLALIN 2700 CIFMNU JMS I IOACAL / DISPLAY THE BOTTOM LINE KBOUTC BTLINE INBUFA JMP I DISBL / / THIS WILL CLEAR THE MESSAGE LINE ON THE SCREEN / CLAMSL, XX CIFMNU JMS I IOACAL 0 CLALIN 500 / PROBLEM LINE IS NOW ON 4, CLEAR IT TO /A031 CIFMNU /A031 JMS I IOACAL /A031 0 /A031 CLALIN /A031 400 / PROBLEM LINE /A031 JMP I CLAMSL /------------ PAGE / / DXICKV - CHECK THE VERSION OF THE CONNECTING PROTOCOL TO SEE IF SAME / DXICKV, XX AC0002 TAD DXGTPT DCA X5 TAD I X5 / GET WHAT IS SENT TAD (-VERSIO) SZA CLA / ++++ JMP DXICKE / ERROR TAD I X5 / ++++ SZA / ++++ JMS SBOFST / ++++ CIA / ++++ DCA NULCNT / STORE THE NUMBER OF NULLS THE / HOST NEEDS AFTER THE CR DCA ERRFLG / CLEAR ERROR STATUS /A017 / (FOR RECONNECT REASONS) /A017 / / *** NOTE *** / THE SZA IN THE ABOVE SEQUENCE IS THERE TO ALLOW PRE-VER3.1 / SOFWARE NAMELY 3.0 TO TALK TO EACH OTHER. 3.1 IS THE FIRST TO HAVE THE NULL / COUNT ADDED TO IT. SO IT ASSUMES ZERO IF TALKING TO 3.0 / ISZ DXICKV JMP I DXICKV DXICKE, TAD (7) / ++++ DCA ERRFLG / SET FOR THE CORRECT MESSAGE JMP I DXICKV / / INIBFS - SENDS A BUFFER BY PLACING IT IN THE SEND CHAIN / THE AC UPON ENTERING CONTAINS THE ADDRESS IF THE TEXT TO SEND IN THE / PACKET INCLUDING THE TYP. THE ADDRESS IS = TO / THE STRING ADDRESS -1 TO USE IN AN AUTO INDEX REGISTER. / CALL: JMS INIBFS / RETURN TO MAIN MENU / TIMED OUT / SENT OK / INIBFS, XX DCA INITM2 / SAVE THE CHARACTER TO SEND JMS GETFRE / GET A FREE BUFFER AND RETURN THE ADDRESS IN THE AC JMP I INIBFS / ERROR RETURN DCA IBFAX / SAVE THE ADDRES TO THE BUFFER TAD IBFAX DCA IX1 DCA I IX1 / CLEAR THE STATUS FLAG DCA I IX1 / CLEAR THE SEQUENCE WORD TAD INITM2 DCA IX0 INIGF4, TAD I IX0 SNA / ++++ JMP INIGF3 DCA I IX1 JMP INIGF4 INIGF3, DCA I IX1 / INSERT A ZERO TRAILER TAD IBFAX / SEND THE BUFFER JMS PUTBUF / ++++ SENDPT / SEND THE PACKET JMP INIBW3 INIBWT, JMS INIWAT / WAIT AND CHECK THE STOP FLAGS JMP INIBER / ONES SET INIBW3, AC0001 TAD IBFAX DCA T1 TAD I T1 SNA / ++++ JMP INIBWT DCA INITM2 TAD IBFAX / FREE IT JMS PUTBUF / ++++ FREEPT TAD INITM2 SMA CLA / ++++ ISZ INIBFS / ERROR DONT INCREMENT ISZ INIBFS JMP I INIBFS INIBER, TAD IBFAX JMS PUTBUF / ++++ FREEPT / EVEN IF ERROR RELEASE BUFFER JMP I INIBFS INITM2, 0 IBFAX, 0 / / THIS WILL STOP THE JOBS THAT ARE RUNNING AND / CLOSE THE FILE THAT YOU ARE WRITING TO SINCE IT IS A COMPLETE / COPY I DONT ALLOW MULTIPLE DOCUMENTS STORED IN A SINGLE ONE / DOCTRN, XX CLA TAD STRTJB / DONT STOP IF NOTHING STARTED SNA CLA / ++++ JMP I DOCTRN / IF NOTHING STARTED DONT BOTHER CLOSING AC7777 / ++++ DCA SPFLAG / TELL THE OTHER PROGRAMS TO STOP JMP EXTJMP / GO AND CHECK THE PROGRAMS FOR TERMINATION EXTWAT, CIFSYS / ++++ JSWAP / GET DONE AS SOON A IT CAN EXTJMP, TAD DXIFLG / ASSUME THAT THEY WILL BE - ONLY IF EXITED SMA CLA / ++++ JMP EXTWAT TAD DXOFLG SMA CLA / ++++ JMP EXTWAT TAD HSFLAG SMA CLA / ++++ JMP EXTWAT JMS CLDOC / CLOSE THE DOCUMENT JMP I DOCTRN / / CLDOC - CLOSES THE DOCUMENT THAT IS OPENED / CLDOC, XX CLA TAD RDFILF / IF FLAG IS SET THEN THE DOCUMENT WAS OPENED FOR READ SZA CLA / ++++ JMP CLDO2 JMS CLSCRL / CLOSE SCROLL JMP CLDO3 CLDO2, DCA RDFILF CLDO3, DCA DOCNO / CLEAR THE DOCUMENT NUMBER JMP I CLDOC / / HSTOU - USED TO SEND CHARACTERS TO THE HOST. SHOULD BE USED FOR ONLY SENDING / NULLS SINCE THE REGULAR ROUTINE TO SEND A CHARACTER IS HOSTOU. THE REASON / FOR HAVING THIS ROUTINE IS THAT IT IS CALLED BY HOSTOU THROUGH HOSTO2. THE / REASON FOR NOT DOING IT A CLEANER WAY IS ROOM. / HSTOU, XX JMP HSTO2 HSTO3, TAD SPFLAG / IF SET TO -1 THEN RETURN SINCE SYSTEM ABORTED SPA CLA / ++++ JMP I HSTOU CIFSYS / ++++ JWAIT HSTO2, CIFSYS / ++++ HS2OU JMP HSTO3 JMP I HSTOU / / DXIQIT - ROUTINE USED BY INPUT JOB TO ACT ON A RECEIVED QUIT PACKET / DXIQIT, AC7777 / ++++ DCA CNGSCF / MAKE SURE SCREEN IS UPDATED TAD (-11) / ++++ DCA ERRFLG / SET THE ERROR MESSAGE DCA INIFLG / STOP ANY TRANSFERRING JMP DXIHJB /------------ PAGE / / RTCLCM - SETS THE COMMUNICATIONS FLAG TO NOT IN USE. / THE FLAG WAS SET BY CU3COM IN WPCU3.PA BEFORE THIS OVERLAY WAS LOADED / /RTCLCM,XX / CDFSYS / DCA I (CMADSX) / CDFMYF / JMP I RTCLCM / / THIS IS THE MAIN KEYBOARD LOOP / THE LOGIC OF THIS JOB IS TO TAKE CARE OF THE SCREEN AND ALSO THE USER. / IT DISPLAYS MOST OF THE MESSAGES THAT ARE TO APPEAR ON THE SCREEN AND ALSO / PREFORM ANY REQUESTS FROM THE USER / MAINL3, DCA DISTMP / CLEAR DISPLAY LOCK FLAG /C039 MAINLP, JMS GTLINE / SEE IF ANYTHING IS BEING TYPED IN JMP MAINL3 / ERRO SO REDISPLAY JMP RTNSY / GOLD MENU RETURN SKP / OK NOW CHECK FLAGS WHILE WAITING FOR SOMETHING JMP KBDL1 / EOL JMS CHKMSG / Check Msg - See if one is outstanding./A037 NOP / Yes. ignore it. /A037 TAD CNGSCF / DISPLAY THE NEW SETTINGS SZA CLA / ++++ /C039 JMS CKDISF / CK FLAG FIRST AND THEN DISPLAY /C039 TAD RSTFLG / SEE IF HAVE TO RESTART SMA SZA / ++++ JMP TRNAGN / MEANS LOW LEVEL INITED IF + SZA CLA / ++++ JMP MAINLW / THE VERSION OF THE OTHER SYSTEM DOESNT MATCH TAD PMTFLG / SEE IF PROMT FLAG IS SET SZA / ++++ JMP PMTANS TAD SNDAD / SEE OF SENDING TO AX SZA CLA / ++++ JMP SNTOA1 TAD AXREC / SEE IF AX RECEIVE SZA CLA / ++++ JMP RCVRT6 MAINLW, CIFSYS / ++++ JWAIT / NOTHING SEEMS TO BE DONE SO WAIT JMP MAINLP / / MORE OF THE KEYBOARD ROUTINE / CHKMSG, XX / Routine to see if outstanding unanswered msg./A037 TAD MSGAST / IF NOT ZERO THEN A MESSAGE WAS SENT SNA CLA / Skip if there is an outstanding msg. /A037 JMP MSGOK / Jmp if no outstanding msg. /A037 TAD I MSGAST / IF NZ THE ADDRESS OF THE STATUS FOR THE PACKET SPA / ++++ JMP MESTO / TIMED OUT IF NEG. /C034 SNA CLA / If positive then sent ok. /M037 JMP MSGPND / If 0 then msg still pending. /M037 AC7776 / SEE IF JUST SENT A PROMPT ANSWER TAD PMTTMP SPA CLA / ++++ JMP MESSN2 TAD INIFLG / SEE IF ALREADY SET SNA / Skip if already set. AC7777 / ++++ DCA INIFLG MESSN2, DCA PMTTMP / CLEAR THE PROMPT FLAG ISZ MGWTFG TAD CNGSCF / IF SET DONT TOUCH SNA CLA / ++++ ISZ CNGSCF DCA MSGAST / CLEAR FLAG TAD MSGAX JMS PUTBUF / ++++ FREEPT MSGOK, ISZ CHKMSG / Return w/ no message pending. /A037 MSGPND, JMP I CHKMSG / Return w/ message pending. /A037 / / THIS IS THE CHECK FOR VALID COMMAND LOGIC / KBDL1, JMS INITKF / Set TOKOFF to start of input INBUFA string. CIFMNU / Parse 1st token from input string. JMS I NXACAL / This is done primarily for error msgs below. TOKOFF / ptr to input string. TOKBUF / buffer to contain parsed token. JMP MAINLW / No args, so forget it. KBDL3, IFDEF ENGLSH < TAD TOKBUF+2 / SEE IF THE ARG IS TOO BIG > IFDEF ITALIAN < TAD TOKBUF+3 > IFDEF V30NOR < TAD TOKBUF+2 / SEE IF THE ARG IS TOO BIG > IFDEF V30SWE < TAD TOKBUF+2 / SEE IF THE ARG IS TOO BIG > SZA CLA / ++++ JMP KBERRO DCA I GTBFPT / CLEAR THE BUFFER TAD TOKBUF+1 / GET THE ARG / This code changed to accept up to two characters per option (mainly /a044 / due to italian prompting. /a044 TAD (-140) / Convert to six bit packed /a044 SPA / /a044 TAD (40) / /a044 AND P77 / /a044 BSW / Move into top half of word /a044 DCA T1 / and save /a044 TAD TOKBUF+2 / Get the second letter (or zero) /a044 TAD (-140) / Convert it to six bit /a044 SPA / /a044 TAD (40) / /a044 AND P77 / /a044 TAD T1 / Combine it with the other character /a044 CIA / Compement them for the compare /a044 DCA T1 / And save them both together /a044 TAD (KBTBL-1) / Get the address of the valid ans. table/a044 DCA X1 / Save in an auto-index pointer /a044 KBDSRL, TAD I X1 / Get the valid word to compare with /a044 SNA / Is it the end of the table? /a044 JMP KBDEXT / Yes, error. /a044 TAD T1 / Compare it with what the user typed. /a044 SNA CLA / Are they the same? /a044 JMP KBDEXT / Yes, execute the associated routine /a044 ISZ X1 / No, move to cosider the next entry /a044 JMP KBDSRL / Test the next one. /a044 KBDEXT, TAD I X1 / Get the address to jump to /a044 DCA T1 / Save it /a044 JMP I T1 / Jump to it /a044 KBERRO, JMS DISBER / DISPLAY THE ERROR ON THE BOTTOM LINE ISZ NODSBL / SET THE FLAG USED BY RESETS TO TELL IF IT SHOULD UPDDATE / THE BOTTOM LINE AFTER UPDATING THE SCREEN / 0= UPDATE IT 1 = NO / IT IS CLEARED EVERYTIME SOMEONE TYPES A CHARACTER IN GTLINE JMP MAINLW KBTBL, IFDEF ENGLSH < 2200; RECRTN / "R;0 / RECEIVE 2300; SENRTN / "S;0 / SEND 1500; RMESRT / "M;0 / MESSAGE 0200; RBYERT / "B;0 / BYE 0000; KBERRO / 0 / END OF TABLE, ERROR > IFDEF ITALIAN < 2204; RECRTN / "R;"D / RECEIVE 1104; SENRTN / "I;"D / SEND 1115; RMESRT / "I;"M / MESSAGE 1124; RBYERT / "I;"T / BYE 0000; KBERRO / 0 / END OF TABLE, ERROR > IFDEF V30NOR < 2200; RECRTN / "R;0 / RECEIVE 2300; SENRTN / "S;0 / SEND 1500; RMESRT / "M;0 / MESSAGE 0200; RBYERT / "B;0 / BYE 0000; KBERRO / 0 / END OF TABLE, ERROR > IFDEF V30SWE < 2200; RECRTN / "R;0 / RECEIVE 2300; SENRTN / "S;0 / SEND 1500; RMESRT / "M;0 / MESSAGE 0200; RBYERT / "B;0 / BYE 0000; KBERRO / 0 / END OF TABLE, ERROR > /----------- PAGE / / GTLINE - WILL READ IN A CHARACTER FROM THE KEY BOARD AND / INTERPERATE IT FOR ANY SPECIAL MEANING. / / CALL: / JMS GTLINE / NOTHING / RETURN IF THE CHAR. IS A GOLD MENU / OK CHAR THAT HAS BEEN PUT IN THE BUFFER / EOL / GTLINE, XX JMS GETCHR / Get character & display DATE&TIME. SKP / CHAR in AC return. JMP GTLNOK / NOTHING DCA GTLTEM / SAVE THE CHARACTER TYPED DCA NODSBL / CLEAR THE FLAG SO RESETS WILL UPDATE BOTTOM LINE TAD (-INBUFA) / SEE IF IT WAS THE FIRST CHARACTER IN THE BUFFER TAD GTBFPT / IF SO CLEAR THE SCREEN SZA CLA / ++++ JMP GTLIN1 DCA I GTBFPT / FIRST MAKE SURE THE BUFFER IS CLEARED JMS DISBL GTLIN1, TAD GTLTEM TAD (-EDMENU) / CHECK FOR GOLD MENU SNA / ++++ JMP GTLNGM TAD (EDMENU-EDRBCH) / CHECK FOR A RUB CHARACTER SNA / ++++ JMP GTRBCR TAD (EDRBCH-EDRBWD) / NOW CHECK FOR RUB WORD SNA / ++++ JMP GTRBWD TAD (EDRBWD-EDNWLN) / CHECK FOR A RETURN SNA / ++++ JMP GTSTPR TAD (EDNWLN) SPA / ++++ JMP GTERED / SEE IF IT IS A NON VALID EDIT CHAR. AND P177 / IF EVERYTHING PASSES THEN STORE THE CHAR TAD (-40) / GET RID OF CONTROL CHARACTERS SPA / ++++ JMP GTLNOK TAD (40) DCA I GTBFPT TAD I GTBFPT / DISPLAY THE CHAR JMS KBOUTC TAD (-INBUFA-INBUFM)/ CHECK FOR MAX TAD GTBFPT /D034 SZA CLA / ++++ SNA CLA / ++++ /C034 JMP GTERED / MAX - RUB CHAR & RING BELL /A034 ISZ GTBFPT / NOT YET - BUMP POINTER /A034 DCA I GTBFPT / INSERT DELIMITER /A034 JMP GTLNOK / BRANCH TO OK EXIT /A034 GTRBCR, JMS GTRBCH / CALL RUB CHAR JMP GTLNOK / BEGINING OF BUFFER JMP GTLNOK / WORKED OK / / GTRBWR - RUBOUT A WORD / GTRBWD, AC7777 / SEE THE NEXT CHAR WHAT IS IT TAD GTBFPT DCA T1 TAD I T1 TAD (-40) SMA SZA CLA / Skip if space or less (ie not a character). JMP GTRBW2 / found a char (start of word). JMS GTRBCH / Rub out leading spaces (tabs, etc.) JMP GTLNOK / line empty return. JMP GTRBWD / do rest of leading spaces, tabs, etc. GTRBW2, AC7777 TAD GTBFPT / SEE WHAT THE NEXT CHAR IS DCA T1 TAD I T1 TAD (-40) SMA SZA CLA / Skip if not a word character. JMS GTRBCH / Rub out character of word. JMP GTLNOK / line empty so done. JMP GTRBW2 / check out next (preceding) character. GTERED, ISZ GTBFPT / ADJUST FOR RUB CHAR /A034 JMS GTRBCH / RUB CHAR /A034 JMP GTLNOK / NO CHAR RETURN /A034 JMS GTLERD / RING BELL /A034 JMP GTLNOK / TAKE THE NOTHING RETURN /A034 GTSTPR, TAD (INBUFA) / SET THE BEGINNING OF THE BUFFER DCA GTBFPT ISZ GTLINE GTLNOK, ISZ GTLINE GTLNGM, ISZ GTLINE GTERRT, JMP I GTLINE GTLTEM, 0 / / GTRBCH - RUB A CHARACTER IF THERE ARE NO CHARS IT WILL DO A NON SKIP RETURN / IF DID RUB OUT SOMETHING THEN A NORMAL RETURN / GTRBCH, XX CLA TAD (-INBUFA) / CHECK FOR THE POINTER IF IT HAS MOVED TAD GTBFPT SNA CLA / ++++ JMP I GTRBCH / RETURN ISZ GTRBCH AC7777 / DECREMENT THE POINTER TAD GTBFPT DCA GTBFPT DCA I GTBFPT / ERASE THE CHAR FROM THE BUFFER JMS KBOUT / Erase from the screen BKSPAC+4000 / BS SPACE+4000 / SP BKSPAC / BS JMP I GTRBCH / ERROR WHILE CREATING THE RECEIVE FILE /A031 RCVCR1, / ENTRY FOR THE RECEIVER OF THE "REC" PACKET /A031 / SENDS THE "NO" PACKET BACK /A031 DCA INIFLG / CLEAR INIT FLAG /A031 TAD (TYPNO) / "NO" PACKET /A031 DCA ANSBUF / TEMP STORAGE /A031 TAD (ANSBUF-1) / THE POINTER /A031 JMS INIBFS / SEND THE PACKET /A031 JMP HSTPRG / RETURN TO MAIN MENU /A031 JMP TIMEOU / TIMED OUT /A031 RCVCR2, / OK RETURN - PACKET WAS SENT /A031 / ENTRY POINT FROM NORTN - RECEIVER OF A "NO" PACKET /A031 AC0003 / "UNABLE TO CREATE" /A031 DCA ERRFLG / /A031 JMP RCVCR3 / /A031 BELSTR, TEXT '^A' / CONTROL STRING FOR KB ERROR ROUTINE /A034 BELTXT, 207;0 / /A034 /------------ PAGE / / THIS ROUTINE WILL INITALIZE THE PROGRAM FOR SENDING A FILE / SENRTN, JMS CLASTA / CLEAR THE STATUS LINE AND FLAGS /A031 TAD PMTTMP / is the SEND invoked by this user? SNA CLA / Skip if no. JMS INITFN / Set up default filename string. SNDDM1, JMS DOMENU / Prompt for a file name for doc to be sent. DLMA17 / ... JMP KBDL5 / GOLD MENU RETURN TAD TOKOFF / COPY THE LAST INPUT AREA NOT FROM MENU JMS CPYMTB / GET THE FILE NAME TAD AXPMT / SEE IF THE SECOND MENU FOR AX (AN AX PROMPT) SNA CLA / ++++ JMP SNDDM5 DCA AXPMT SNDDM2, AC7776 / TELL NORTN TO USE CANNED MESSAGE /A031 DCA NOFLAG / "UNABLE TO CREATE DOCUMENT" IF NO /A031 AC0002 / SEND THE SEND PAKCET JMP SNDPPK SNDDM5, JMS GTDCNO / GET THE DOCUMENT NUMBER AC0002 / ++++ DCA OPTFLG / SET THE OPTIONS TO SEND A MESSAGE ONLY SNTOA1, DCA SNDAD / CLEAR THE FLAG FOR AX SEND TAD DOCNO CIFFIO / ++++ /M013 FILEIO / ++++ /M013 XRDFIN / OPEN THE FILE FOR READING ISZ RDFILF / SET THE REDFIL FLAG SO TO CLOSE IT / AC0001 / ++++ DCA SENDFL / SET FOR THE SYSTEM TO KNOW THAT IS SEND TAD OSYSAX / IF THE OTHER SYSTEM IS IN AX THEN DISPLAY SNA CLA / the other prompt to tell us what to do. JMP SNDDM2 / JMP if other system not in AX. ISZ AXPMT / SET FLAG FOR PROMT DISPLAY JMS INITKF / INITALIZE THE TOKEN OFFSET TOKOFF TO STARTING OF BUFFER DCA INBUFA / CLEAR BUFFER SO THE SECOND PROMPT ACT LIKE A PROMPT JMP RCVRT0 RCVGLD, JMS CLDOC / CLOSE RECIEVE FILE /A017 KBDL5, AC7777 / THE GOLD MENU RETURN FROM ANY OPTION IN THE KEYBOARD PROGRAM DCA CNGSCF / REDISPLAY THE SCREEN TAD AXFLG / IF SET FOR AX ACT IF NO PROMPT FLAG SET SZA CLA / ++++ JMP KBDL6 TAD PMTTMP / IF IT IS A PROMPT GOLD MENU MEANS GO TO MAIN SZA CLA / ++++ JMP RTNSY KBDL6, TAD INIFLG / IF IN THE MIDDLE OF TRANSFERING THEN JUST CONTINUE SZA CLA / ++++ JMP KBDL7 AC7777 / ++++ DCA SENDFL / SET FOR CONNECTION MADE STATUS TAD OPTREC / ++++ DCA OPTFLG / SET THE OPTIONS BACK TO WHAT THEY WERE KBDL7, DCA AXPMT / CLEAR THE PROMPT STATUS TO AX JMP MAINLW RDFILF, 0 / / ASSEMBLES THE INIT MESSAGE FOR THE OTHER USER / SETUPW, XX JMS GETFRE / GET A FREE BUFFER AND RETURN THE ADRESS IN THE AC JMP HSTWAT / ERROR RETURN DCA SETUPA / STORE THE STARTING ADDRESS CDFFIO / GET THE DOCUMENT SIZE /M013 TAD I (RDFSIZ) CDFMYF / A CDF FOR THIS FIELD (MY FIELD) DCA DOCSIZ TAD SETUPA DCA X1 DCA I X1 / CLEAR THE STATUS DCA I X1 / CLEAR THE SEQUENCE TAD (TYPSOD) / INSERT THE FLAG CHARACTER DCA I X1 TAD DOCSIZ / INSERT IT INTO THE INITAL MESSAGE BSW AND P77 JMS ADOFST DCA I X1 TAD DOCSIZ AND P77 JMS ADOFST DCA I X1 TAD X1 JMS GETPRC / INSERT THE PRINTER SETTINGS TAD SETUPA / PUT THE PACKET INTO THE SEND LIST JMS PUTBUF / ++++ SENDPT JMP SNDFS2 SNDFS1, JMS INIWAT / WAIT JMP HSTWAT / SPFLAG SET SNDFS2, AC0001 / CHECK THE STATUS TAD SETUPA DCA T1 TAD I T1 SNA / ++++ JMP SNDFS1 / NOT DONE DCA TEMP / SAVE STATUS TAD SETUPA / OK JMS PUTBUF / ++++ FREEPT / SO GET RID OF IT TAD TEMP SPA CLA / ++++ JMP TIMEOU / IF - THEN TIMED OUT JMP I SETUPW SETUPA, 0 /-------------- PAGE / / THE ROUTINE TO HANDLE THE RECEIVE COMMAND / RECRTN, JMS CLASTA / CLEAR STATUS LINE AND FLAGS /A031 TAD PMTTMP / who's initing this? SNA CLA / Skip if HOST initing the receive. DCA DOCNBF / For user initiated prompt, clear default. RCVRT0, JMS DOMENU / Put up the RECEIVE menu. DLMA16 / ... JMP KBDL5 / GOLD MENU RETURN TAD TOKOFF JMS CPYMTB / GET THE DOCUMENT NAME CDFMNU / Get MNTMP3 return value. TAD I (MUBUF+MNTMP3) / ... CDFMYF / 3 = ok return; 4 = have to create return. TAD (-4) / check for "have to create" return. SNA CLA / Skip if file already exists. JMP RCVCRT TAD AXPMT / WHATS IT USED FOR A SPECIAL PROMPT TO AX SNA CLA / ++++ JMP RCVMOD / NO DCA AXPMT RCVRT3, AC0003 / SET THE PROMPT RESPONSE TO = RECEIVE JMP SNDPPK RCVMOD, / ASKMOD Gets MNTMP3 value from AC. JMS ASKMOD / Display Top, Bottom, Overwrite & get option. DLMA15 / ... JMP RCVGLD / GOLD MENU RETURN /A017 TAD (-2) / GET BACK TO THE VALUE THAT WAS IN MNTMP1 DCA DOCMOD / STORE THE OPTION JMP RCVRT5 RCVCRT, CIFBUF JMS I ADRCRA / Call CREATE routine. JMP RCVCKP / CREATE ERROR FOR THE PUT ROUTINE /C033 CDFMNU / SET "REMEMBERED" FILE NUMBER. DCA I (MUBUF+MNFNO) / ... TAD I (MUBUF+MNFNO) / GET DOC NUMBER. AND P377 / ... DCA I (MUBUF+MNDOCN) / STORE IT TOO. / the below is not needed as GTDCNO does CDF for us & i need 1 more word. / CDFMYF / Back to our field. RCVRT5, JMS GTDCNO / Copy doc # from menu to DOCNO. RCVRT6, DCA AXREC / CLEAR THE AX RECEIVE FLAG TAD DOCNO MQL TAD DOCMOD / GET THE WAY THE FILE IS TO BE OPENED CIFFIO / ++++ /M013 FILEIO / ++++ /M013 XDSKIN / INITALIZE THE FILE AC0002 / ++++ DCA OPTFLG / SET TO ONLY SEND A MESSAGE AND BYE DCA SENDFL / SET TO RECEIVE TAD OSYSAX / IF THE OTHER SIDE IS AX THEN ANOTHER PROMPT SNA CLA / IS NEEDED JMP RCVRT3 / Jmp if other side NOT in AX. JMS INITKF / INITALIZE THE TOKEN OFFSET TOKOFF TH BEGINING OF BUFFER DCA INBUFA / CLEAR SO OTHER DISPLAY ACTS LIKE A PROMPT ISZ AXPMT JMP SNDDM1 DOCNO, 0 DOCMOD, 0 RCVCKP, CLA / CK FOR LOCAL INIT. OF REC /A033 TAD PMTTMP / /A033 SNA CLA / SKIP IF HOST /A033 JMP RCVCR2 / LOCAL ERROR ONLY /A033 JMP RCVCR1 / HOST REQUIRES A "NO" PACKET /A033 / / IT WILL SEND A MESSAGE TO THE OTHER SYSTEM / RMESRT, JMS WTMARG / WAIT FOR SOMETHING TO BE TYPED TAD (TYPMES) / INSERT THE TYP CODE MSGSET, DCA T3 / STORE THE FLAG CHARACTER / THIS IS A TEMP ON PAGE ZERO BUT I USE IT SINCE / GETBUF ONLY USES 1 AND 2 BUT WATCH OUT IF CHANGED JMP MSGST1 MSGST2, JMS HLTEST / ++++ JMP RTNSY / SEE IF A GOLD HALT WAS PRESSED MSGST1, JMS CHKMSG / See if there is a msg pending an ACK. /A037 JMP MSGST2 / Jmp if yes. Wait for it to be 'ack'ed /A037 JMS GETBUF / ++++ FREEPT JMP MSGST2 DCA MSGAX / SAVE THE ADDRESS OF THE BUFFER FOR LATER TAD MSGAX DCA X3 DCA I X3 / CLEAR THE STATUS FLAG TAD X3 DCA MSGAST / STORE THE ADDRESS OF THE CONDITION CODE DCA I X3 / CLEAR THE SEQUENCE POSITION TAD T3 / INSERT THE FLAG CHARACTER DCA I X3 JMS MSGFIL / FILL THE REMAINING OF THE PACKET TAD MSGAX / PUT IN SEND LIST JMS PUTBUF / ++++ SENDPT / BUT INTO THE SEND BUFFER JMS CLAINF ISZ MESSNF / PUT UP MESSAGE SENT JMP MAINLW / GO AND WAIT FOR THE MESSAGE TO BE SENT MESSNF, 0 MSGAX, 0 MESTO, AC7776 DCA ERRFLG / SET ERROR MESSAGE /A034 DCA MSGAST / MESSAGE SENT FLAG /A034 JMP RCVCR3 / CONTINUE ERROR PATH AT OLD MAINER /A034 /----------- PAGE / / SEND A GOOD-BYE TO THE OTHER TERMINAL / RBYERT, JMS WTMARG / WAIT FOR SOMETHING TYPED THAT CAN BE SENT JMS STPTRN / STOP A TRANSFER IN PROGRESS IF ANY TAD (TYPBYE) / SET THE TYP OF THE BUFFER JMP MSGSET / / PMTANS - WILL DISPLAY THE PROMPT AND WAIT FOR A RESPONSE / PMTANS, DCA PMTTMP / CLEAR THE REAL PROMPT FLAG FOR OTHERS TO BE ALLOWED DCA PMTFLG / WHILE THIS ONE IS BEING ANSWERED DCA INBUFA / CLEAR THE BUFFER FOR THE PROMT TO WORK CORRECTLY JMS INITKF / INITALIZE THE TOKEN POINTER TO BEGINING OF BUFFER TAD PMTTMP / SEE IF IT IS A DOCUMENT MOD PROMPT (4) SPA / ++++ JMP PMTAN3 / IF NEGATIVE TREAT SPECIAL TAD (-4) SNA / ++++ JMP MDRTN TAD (2) / NOW CHECK FOR A SEND/RECEIVE PROMPT (2 AND 3) SPA / ++++ JMP PMTAN3 CIA TAD SENDFL / SEE IF ALREADY IN THE SAME MODE SNA CLA / ++++ JMP PMTERR / YES TAD SENDFL / IF POSITIVE THEN ALREADY IN THE STATUS DESIRED SO DO NOTHING SMA CLA / ++++ JMP MAINLW AC7776 / IF A SEND PACKET RECEIVED GO TO THE SEND ROUTINE TAD PMTTMP / AND RECEIVE FOR A SEND PACKET RECEIVED SNA CLA / ++++ JMP RECRTN JMP SENRTN PMTAN3, CLA / CLEAR BEFORE MENU CALL /A038 CIFMNU JMS I MNUCAL DLMAD5 CIFMNU JMS I IOACAL / DISPLAY THE other half of the PROMPT 0 / that the MN2 starts PMTMES / IOA string for printing buffers IFDEF ENGLSH < 2212 > / cursor position to start at for "TYPE PASSWORD/ID" IFDEF ITALIAN < 2212 > IFDEF V30NOR < 2212 > / cursor position to start at for "TYPE PASSWORD/ID" IFDEF V30SWE < 2212 > / cursor position to start at for "TYPE PASSWORD/ID" DOCNBF / buffer address 2700 / where to position cursor after PMTANW, CIFSYS / ++++ JWAIT JMS GTLINE / READ IN THE TEXT FOR THE PROMT ANSWER JMP PMTAN3 / RE-DISPLAY THE PROMPT /M022 JMP RTNSY / GM /D034 JMP PMTAN0 / CHECK OF # OF CHARS WITHIN LIMITS /A022 JMP PMTANW / CHAR OK OR NOTHING /A034 CLA / CLEAR THE FLAG BECAUSE IF SET WHEN THE PACKET IS DCA PMTTMP / TRANSFERRED THEN INIFLG IS ACTIVATED. AC0001 / SEND THE NORMAL RESPONSE TO THE PROMPT JMP SNDPP2 / THIS ROUTINE CHECKS TO MAKE SURE THAT THE USER PUTS IN / 64 CHARACTERS OR LESS WHEN ENTERING AN ID OR PASSWORD. / THE REASON BEING, IS THAT THE BUFFERS FOR ID/PASS ARE / ONLY 64 LOC LONG /PMTAN0, TAD GTBFPT / POINTER TO INPUT BUFFER /A022 / TAD (-INBUFA-101) / REACHED MAX INPUT? /A022 / SZA CLA / SKIP IF: MAX INPUT REACHED /A022 / JMP PMTANW / WITHIN LIMIT, WAIT FOR MORE /A022 / JMS GTLERD / Display appropriate error msg. /M027 / JMP PMTAN3 / Re-display prompt. /M027 PMTERR, AC7777 / ++++ DCA CNGSCF / SET FLAG SO THE ENTIRE SCREEN IS CHANGED TAD (10) / ++++ DCA ERRFLG JMP MAINLW PMTTMP, 0 / / THE ROUTINE WILL WAIT FOR A YES OR NO SENT FROM THE HOST / IN RESPONSE OF A INITALIZE MESSAGE / WTFRYN, XX CLA WTFRLP, TAD DLY6X / SET THE TIME LIMIT /M020 JMS WAITDT / WAIT FOR 30 SECONDS FOR A RESPONSE JMP TIMEOU / TIMED OUT DCA WTFRT2 TAD HSTRAD / RELEASE IT JMS PUTBUF / ++++ FREEPT TAD WTFRT2 / GET THE CHAR BACK TAD (-TYPNO) / CHECK FOR NO SNA / ++++ JMP CKCSN / NO FOUND NOW VALIDATE TAD (TYPNO-TYPYES) SNA CLA / ++++ JMP CKCSY / CHECK FOR A REAL YES JMP WTFRLP / WAIT AGAIN CKCSY, ISZ WTFRYN CKCSN, JMP I WTFRYN WTFRTP, 0 WTFRT2, 0 / / FILLS THE BUFFER WITH THE CHARACTERS TYPED IN FROM THE / MESSAGE TYPED IN AFTER THE COMMAND OR THE ENTIRE INPUT BUFFER IF A PROMPT / MSGFIL, XX AC7777 / WANT THE SCREEN COMPLETELY DISPLAYED DCA CNGSCF TAD TOKOFF DCA MSGAG1 AC0001 / GET THE STARTING ADDRESS OF THE BUFFER FOR THE PACKET TAD X3 DCA MSGAG2 JMS DXCOPY / GET THE TEXT PART OF THE PACKET CDFMYF MSGAG1, XX CDFMYF MSGAG2, XX MSGFL3, DCA INBUFA / CLEAR THE INPUT BUFFER JMP I MSGFIL CKDISF, XX / /A039 TAD DISTMP / CK FLAG BEFORE CALL /A039 SZA CLA / /A039 JMP MAINLW / HOST IS ACTIVE - RET AND WAIT /A039 TAD CNGSCF / PICK UP VALUE /A039 JMS DISSCR / CALL DISPLAY ROUTINE /A039 JMP I CKDISF / RETURN /A039 /------------ PAGE / / DISSCR - CLEARS THE RESETC FLAG AND CALLS THE CORRECT DISPLAY ROUTINE / DISSCR, XX DCA DISTMP DCA CNGSCF TAD DISTMP SMA SZA / ++++ JMS RESTS SZA CLA / ++++ JMS RESETS DCA DISTMP / CLEAR FLAG FOR HOST PROGRAM JMP I DISSCR / / French needed one location on this page. It appears that / INITKF is not called while DISTMP is in use so for french the / return address location of INITKF is used for temporary storage / IFNDEF FRENCH < DISTMP, 0 > IFDEF FRENCH < DISTMP=INITKF > / / THIS IS RESTS - WHICH HANDLES MOEST OF THE SEPERATE LINES ON THE SCREEN / THAT ARE CHANGED THE MOST / RESTS, XX AC0002 / DONT DISPLAY IF NOT CONNECTED YET TAD SENDFL SNA CLA / ++++ JMP RESTA / CIFMNU JMS I IOACAL / THE NUMBER OF TRANSMIT ERRORS 0 NUMDIS IFDEF ENGLSH < 1060 > IFDEF ITALIAN < 1076 > IFDEF DUTCH < 1065 > IFDEF V30NOR < 1060 > IFDEF V30SWE < 1060 > TRNERC / RESTA, TAD LN2FG / CHECK FOR THE SECOND LINE FLAG SNA / ++++ JMP RESTC TAD (5) DCA LN2F2 CIFMNU JMS I IOACAL 0 OUTLN 205 LN2F2, XX / TAD LN2FG / RELEASE THE BUFFER JMS PUTBUF / ++++ FREEPT DCA LN2FG / CLEAR FLAG RESTC, TAD INIFLG / DISPLAY IF TRANSFER IN PROGRESS SZA SMA CLA / ++++ JMP RESTC2 AC0003 / ++++ TAD SENDFL / IF IN TRANSFER COMPLETE MODE STILL DISPLAY NO. SNA CLA RESTC2, JMS BLKNMD / UPDATE THE BLOCK COUNT ON THE SCREEN / TAD INMSFG / CHECK FOR A MESSAGE FOR THE SCREEN SNA CLA / ++++ JMP RESTI / NO DCA INMSFG / CLEAR THE MESSAGE FLAG / CIFMNU JMS I IOACAL 0 MESSTM / YES , PUT IT UP 505 INMBLK / RESTI, TAD BYSETF / SEE IF A BYE MESSAGE WAS RECEIVED SNA CLA / ++++ JMP RESTM DCA BYSETF / CLEAR THE BYE MESSAGE FLAG / CIFMNU JMS I IOACAL 0 BYESTM 505 INMBLK / RESTM, TAD MGWTFG / SEE IF A MESSAGE HAS BEEN SENT SNA CLA / ++++ JMP RESTN DCA MGWTFG / CLEAR THE FLAG SO IT IS ONLY SHOWN ONCE / CIFMNU JMS I IOACAL / Print " - Recieved" 0 / default output routine OKSTMT / string address IFDEF ENGLSH < 621 / cursor position for "sent - received" > IFDEF ITALIAN < 626 > / cursor position for "inviato - ricevuto" IFDEF V30NOR < 626 > / cursor position for "inviato - ricevuto" IFDEF V30SWE < 626 > / cursor position for "inviato - ricevuto" RESTN, TAD MESSNF / IF SET PUT UP THE MESSAGE FOR A MESSAGE BEING SENT SNA CLA / ++++ JMP RESTO DCA MESSNF / CIFMNU JMS I IOACAL / Print "Message sent" 0 / Default output routine MSGPRG / string address 605 / cursor position / RESTO, TAD ERRFL2 / IF THE ERROR FLAG IS SET THEN DISPLAY IT SNA / ++++ JMP RESTP / /C031 CDFMNU / Map menu field. /A037 TAD (-11) / see if 'other user returned to Main' /A037 SNA CLA / Skip if no. /A037 TAD I (MUBUF+MNTMP6) / Are we in EZLINK (i.e. from CX)? /A037 CDFMYF / Back to my field. /A037 SZA CLA / Jmp if time to return to CX. /A037 JMP RTNSY / Return to CX. /A037 TAD ERRFL2 / Get error code. /A037 CDFMNU DCA I (MUBUF+MNTMP1) / SET THE ERROR CDFMYF CIFMNU JMS I MNUCAL DLMA12 RESTP, TAD PRBSFG / CK FOR TEXT IN "NO" PACKET /A031 SNA CLA / SKIP IF PRESENT /A031 JMP RESTQ / NO - CONTINUE /A031 DCA PRBSFG / RESET FLAG /A031 CIFMNU / MENU /A031 JMS I IOACAL / UP ON SCREEN /A031 0 / /A031 PRBSTM / TEXT "PROBLEM:" /A031 0405 / SCREEN ADDRESS /A031 INMBLK / ADDRESS OF TEXT /A031 RESTQ, / /JMS DISBL / RESET THE BOTTOM LINE /D017 JMS DISBLF / RESET THE BOTTOM LINE AND CLEAR EVENT FLAG/A017 / JMP I RESTS /------------ PAGE / / RESETS WILL RESET THE VALUES ON THE SCREEN THAT ARE PRESENT / MOST OF THE TIME / RESETS, XX CLA / THIS WILL UPDATE THE SCREEN WITH THE INFO NEEDED TAD ERRFLG / ++++ DCA ERRFL2 / SET THE FLAG THAT IS USED TO DISPLAY AN ERROR TAD ERRFLG / SEE IF THE OPTIONS WILL CHANGE SPA / ++++ JMP RESETW SZA CLA / ++++ JMS STPTRN JMP RESETA / STOP ANY TRANSFER AND RESET THE OPTIONS RESETW, CIA / FIRST MAKE POSITIVE DCA ERRFL2 DCA INIFLG / CLEAR THE INIT FLAG TAD AXFLG / IF AX DISPLAY THE MESSAGE BUT DONT CHANGE OPTIONS SNA CLA / ++++ DCA OPTFLG / CLEAR THE OPTIONS RESETA, TAD INIFLG SPA SNA CLA / ++++ JMP CHKST3 TAD (7) JMP CHKST4 CHKST3, TAD (5) TAD SENDFL CHKST4, CDFMNU DCA I (MUBUF+MNTMP1) / SET TEMP 1 TO STATE CDFMYF TAD OPTFLG / SET OPTIONS INTO TEMP 2 TAD (OPTTBL) / GET THE POSITION FOR THE OPTION LINE ON SCREEN DCA T1 TAD I T1 CDFMNU DCA I (MUBUF+MNTMP2) TAD DOCSIZ / LET THE MENU DISPLAY THE APROXIMATE VALUE DCA I (MUBUF+MNTMP3) TAD DOCTMP / GIVE IT THE VALUE TO DISPLAY DCA I (MUBUF+MNTMP4) TAD DOCNCT / DISPLAY THE NUMBER OF DOCUMENTS TRANSFERRED IN AX DCA I (MUBUF+MNTMP5) CDFMYF CIFMNU JMS I MNUCAL DLMA10 RESETY, JMS RESTS / PUT UP THE MESSAGES THAT ARE SPECIAL JMP I RESETS / GO TO WHERE IT WAS CALLED FROM / The following 2 variables (DOCSIZ, DOCTMP) MUST BE ON THIS PAGE DOCSIZ, 0 DOCTMP, 0 ERRFL2, 0 / OPTTBL, 0 2100 1700 1500 1300 / / WTMARG - WAIT FOR AN AGRUMENT TO BE TYPED FOR THE MESSAGE ROUTINE TO SEND IT. / WTMARG, XX CDFMNU / Map menu field. DCA I (MUBUF+MNTMP4) / save switch. set to 0 for MESSAGE/BYE / Set to 1 for "has no meaning" error msg. CDFMYF / Back to our field. JMS DOMENU / Display the menu prompting for a MESSAGE. DLMA14 / ... JMP KBDL5 / GOLD MENU JMP I WTMARG / GOT SOMETHING THAT IT LIKES / / THE TIME OUT ROUTINE / TIMEOU, AC0002 / Set error flag to -2. / / THIS IS THE ERROR RECOVERY IF THERE IS AN ERROR ENCOUNTERED IN / READ DOCUMENT ROUTINE / DSKERR, TAD (-4) / Set error flag to -4 for disk error. DCA ERRFLG / Set to -2 for TIME-OUT, -4 for DISK ERROR. / / TELLS THE MAIN PROGRAM TO DISPLAY THE SCREEN AND ALSO THAT THE STATUS IS / NOW ERROR FOUND AND WAITING / HSTRST, TAD (-4) DCA SENDFL AC7777 / ++++ DCA CNGSCF / RESET THE ENTIRE SCREEN JMP HSTJWT SNDPPK, MQL TAD (DOCNBF) / SET THE INPUT COMING FROM THIS BUFFER INSTEAD DCA TOKOFF / THE USUAL INPUT BUFFER INBUFA MQA SNDPP2, TAD (PMTTBL-1) DCA T1 TAD I T1 JMP MSGSET PMTTBL, TYPPAN TYPRCV TYPSND / / HLTEST - USED TO CHECK THE HALT FLAG TO BE SET DOES A NON-SKIP RETURN IF NOT / HLTEST, XX / TAKES NON-SKIP RETURN IF HALT FLAG SET CLA CIFSYS / ++++ JWAIT CDFSYS / ++++ TAD I HLTFLG / ++++ CDFMYF SNA CLA / ++++ ISZ HLTEST JMP I HLTEST / / GETNXT - GETS THE NEXT PACKET TO SEND IN A RETRANSMIT / GETNXT, XX TAD I GTNXPT SNA / ++++ JMP GETNXD ISZ GTNXPT ISZ GETNXT GETNXD, JMP I GETNXT GTNXPT, 0 CPYTIM, XX / Routine to copy the DATE & TIME string CDFMNU / Get address of DATE&TIME string in menu field. TAD I (DATESP) / ... CDFMYF / Back to our field. DCA CPYTM1 / Save for DXCOPY. JMS DXCOPY / Copy ASCIZ string CDFMNU / from menu field CPYTM1, XX / from here, CDFMYF / to our field DATSTR / to here. JMP I CPYTIM / Return to caller when done. /---------- PAGE / / THE HOST PROGRAM , THIS WILL HANDLE THE DATA FLOW FROM THE / HOST TO THE BUFFER AND FROM THE BUFFER TO THE HOST / HSFLAG, 0 / HSTPRG USES IT TO TELL THE MAINJOB THAT IT / RECEIVED THE SPFLAG CHANGE HSTEXT, CIFSYS / ++++ JEXIT HSTJWT, JMS CLAINF / WAIT BUT FIRST CLEAR THE INTFLG WHICH / LETS THE OTHER PROGRAM SEE WHAT HAS CHANGED / AND RETURNS BACK HSTWAT, CIFSYS / ++++ JWAIT HSTPRG, CLA TAD SPFLAG / SEE IF ANYTHING IS TO BE DONE / IF SPFLAG IS NOT ZERO DO NOTHING DCA HSFLAG / SET THE HOST FLAG TO THE SPFLAG / TO SHOW THE MAIN PROGRAM THATWE SAW IT TAD HSFLAG SPA / ++++ JMP HSTEXT SZA CLA / ++++ JMP HSTWAT / IF NOT ZERO THEN WAIT TAD INIFL2 / SEE IF THE LOW LEVEL HAS INITED SPA SNA CLA / ++++ JMP HSTWAT / NO TAD INIFL3 / NOW SEE OF THE HIGH LEVEL HAS SNA CLA / ++++ JMP RSTPRG TAD INIFLG / IF TRANSFER NOT IN PROGRESS SEE IF ANY TO REC SPA / ++++ JMP HSTPR2 SNA CLA / ++++ JMP HSTCKL TAD SENDFL / CHECK MODE SMA SZA / ++++ JMP SENDMD / IN SEND MODE SZA HSTCKL, AC0001 / IN SOME SORT OF A WAIT STATE SNA / ++++ TAD DLY6X / IN RECEIVE /M020 HSTRC2, JMS WAITDT / WAIT FOR SOMETHING TO BE SENT JMP CWTAGN HOSREC, TAD (HSTTBL-140) / USE THE TYPE FOR AN INDEX DCA T1 / TO GET THE ROUTINE TO JUMP TO TAD I T1 DCA T1 JMP I T1 HOSRBF, TAD HSTRAD / RELEASE THE PACKET BUFFER ITS NOT NEEDED JMS PUTBUF / ++++ FREEPT JMP HSTPRG HSTPR2, CLA TAD SENDFL / IF SEND MODE AND INIFLG IS NEGATIVE SEND FIRST PACKET SNA SPA CLA / ++++ JMP HSTPR3 JMS SETUPW / SET UP THE FIRST PACKET OF THE DOCUMENT AC7777 / TELL NORTN TO USE CANNED MESSAGE /A031 DCA NOFLAG / "NOT ENOUGH ROOM ON DISKETTE" /A031 JMS WTFRYN / WAIT FOR A RESPONSE JMP NORTN / RECEIVED THE "NO" PACKET /A031 /D031 JMP SNDNO2 / NO JMP SNDYE2 HSTPR3, AC0001 / ++++ DCA INIFLG JMP HSTJWT / / THIS HANDLES THE NO PACKET IT IS JUST LIKE A NORMAL MESSAGE ONLY A / FEW DIFFERENCES THAT IS WHY IT IS HERE THE CODE FALLS TO THE MESSAGE ROTUINE / NORTN, JMS CLDOC / CLOSE THE DOCUMENT / AC7777 / ++++ DCA CNGSCF / SET SCREEN FLAG TO CHANGE EVERYTHING DCA INIFLG / CLEAR THE INIT FLAG TO DKILL A TRNAFER IS STARTRD / TAD OPTREC / RESET THE OPTIONS DCA OPTFLG / / CK FOR TEXT IN THE "NO" PACKET AND DISPLAY / IF PRESENT /A031 JMS FILMBF / FILL MESSAGE BUFFER /A031 TAD INMBLK / LOOK FOR A CHARACTER /A031 SZA / SKIP IF EMPTY /A031 JMP PROBMS / A MESSAGE IS PRESENT - DISPLAY /A031 AC0001 / CK FOR SPECIAL CASES OF "NO" PACKET /A031 TAD NOFLAG / a) RESPONSE TO "SENT" PACKET /A031 SNA / b) RESPONSE TO "SOD" PACKET /A031 JMP SNDNO2 / DISKETTE FULL MESSAGE /A031 SPA / /A031 JMP RECNO1 / UNABLE TO CREATE MESSAGE /A031 JMP MESRTN / CONTINUE TO MESSAGE ROUTINE /A031 / TEXT IN THE "NO" PACKET /A031 PROBMS, DCA PRBSFG / SIGNAL - TEXT IN THE "NO" PACKET /A031 JMP HSTJWT / / HSTTBL- THE TABLE OF THE ROUTINES THAT ARE CALLED DEPENDING ON THE / PACKET TYPE. THE VALUE OF THE PACKET TYPE BYTE IS USED AS AN INDEX TO THE TABLE / RESERV=HOSRBF / IF NOT WANTED OR UNDEFINED HSTTBL, YESRTN / 140 - TYPYES MODRTN / 141 - TYPMOD MESRTN / 142 - TYPMES BYERTN / 143 - TYPBYE SODRTN / 144 - TYPSOD DTARTN / 145 - TYPDTA EOFRTN / 146 - TYPEOF HITRTN / 147 - TYPHIT RESERV / 150 SNDRTN / 151 - TYPSND RCVRTN / 152 - TYPRCV OPTRTN / 153 - TYPOPT RESERV / 154 RESERV / 155 RESERV / 156 RESERV / 157 RESERV / 160 RESERV / 161 RESERV / 162 RESERV / 163 NORTN / 164 - TYPNO RESERV / 165 RESERV / 166 RESERV / 167 RESERV / 170 RESERV / 171 RESERV / 172 RESERV / 173 RESERV / 174 PMTRTN / 175 - TYPPMT PNERTN / 176 - TYPPNE /----------- PAGE / / CHKSM1 - DOES A TOTALING JOB FOR CHKSUM / CHKSM1, XX DCA T1 DCA T2 / CLEAR THE TOTALER CHKSUJ, TAD I T1 SNA / ++++ JMP I CHKSM1 / 0= DONE TAD T2 DCA T2 ISZ T1 JMP CHKSUJ / / SENDMD - ROUTINE THAT WILL TAKE CARE OF SENDING A TEXT PACKET / SENDMD, JMS GETBUF / ++++ RECPT / SEE IF THE BUFFER IS EMPTY JMP SENDCB / YES JMS STOBUF / STORE THE VALUES JMP HOSREC SENDCR, TAD EOF / SEE IF THE LAST PACKET HAS BEEN QUEUED SNA CLA / ++++ JMP SENDCT TAD DSKBA2 / CHECK FOR EVERYTHING SENT TAD DSKBA4 SZA CLA / ++++ JMP HSTWAT / IF NOT WAIT JMP DSKTL2 / IF SO THEN QUIT SENDCT, TAD (-BUFSIZ) / SET THE CHARACTER COUNTER DCA SENTMP JMS DSKBUF / SEE IF THERE IS AN AVAILABLE BUFFER JMP HSTWAT / NO DCA SENT2 TAD SENT2 / STORE IN X1 DCA X1 DCA I X1 / CLEAR THE STATUS WORD AC0003 TAD X1 / SET UP FOR THE INSERT CHARACTERS DCA SENT3 AC7777 TAD SENT3 / SAVE THE ADDRESS OF THE FLAG CHARACTER DCA SENT4 SENDJ1, TAD INIFLG / IF DOCUMENT ABORTED STOP SENDING SNA CLA / ++++ JMP HSTPRG CIFBUF / ++++ JMS I REDSXA / GET NEXT 7-BIT CHARACTER SPA SNA / Skip if valid char returned. JMP ENDDOC / ... DCA I SENT3 ISZ SENT3 / UPDATE THE COUNTER ISZ SENTMP / INCREMENT THE CHARACTER COUNTER JMP SENDJ1 DCA I SENT3 TAD (TYPDTA) JMP SENDJ3 / CONTINUE ENDDOC, SZA CLA / Skip if END-OF-FILE detected. JMP DSKERR / Report DISK ERROR. DCA I SENT3 ISZ EOF / SET LAST PACKET FLAG TAD (TYPEOF) SENDJ3, DCA I SENT4 TAD SENT2 JMS PUTBUF / ++++ SENDPT JMP HSTPRG / / SNDNAK - SENDS A NAK TO THE OTHER SYSTEM / SNDNAK, TAD DXNONK / SEE IF A NAK CAN BE SENT SZA CLA / ++++ JMP DXIHJB JMS UPDTER / UPDATE THE ERROR COUNTER TAD (NAK) ISZ DXNONK / SET FLAG SO CANNOT SEND ANOTHER NAK / THIS WILL SEND THE CONTENTS IN THE AC AS A COMMAND /A017 DXIBDY, DCA CMDFLG /A017 JMS CLAINF / CLEAR THE EVENT FLAG /A017 JMP DXIHJB / DONE CONTINUE /A017 / / DXOCPK - CREATE THE COMMAND PACKET TO SEND / DXOCPK, XX DCA CMDBUF / PUT THE TYPE ON THE PACKET DCA CMDFLG / CLEAR THE FLAG TAD (CMDBUF) / SET THE BUFFER ADDRESS TO FILL DCA X1 TAD ISEQNO / PUT THE SEQUENCE NUMBER IN AND P77 JMS ADOFST DCA I X1 / / IF THE PACKET IS AN INIT OR INIT-ACK THEN THE BODY OF THE PACKET IS / / TYPE VERSION NULCNT / / TYPE TELLS THE TYPE OF PROTOCOL. THIS IS FOR FUTURE USE. RIGHT / NOW IT IS ALWAYS 40. COULD BE USED TO TELL THE HOST THE / DIFFERENCE BETWEEN A WS78 AND A WT78 ON THE SAME LINE. / / VERSION IS THE VERSION OF THE PROTOCOL SO THE TWO SYSTEMS ARE / ABLE TO ALLOW FOR THE DIFFERENCES OR JUST TELL THE USER THAT / THEY CANNOT EVER CONNECT BECAUSE OF THE DIFFERENT VERSIONS. / / NULCNT IS THE NUMBER OF NULLS THE OTHER SYSTEM WANTS SENT TO IT / AFTER THE CR THAT TERMINATES ALL PACKETS. THE FORMAT IS 40 OCTAL / PLUS THE NUMBER DESIRED. / TAD CMDBUF / SEE IF THE COMMAND IS A INIT OF SOME KIND TAD (-INIT) / IF SO SEND THE TYPE AND VERSION OF THE PROTOCOL SZA / ++++ TAD (INIT-INIACK) / ELSE JUST ADD THE ZERO TERMINATOR SZA CLA / ++++ JMP DXOSTR TAD (TYPE) DCA I X1 TAD (VERSIO) DCA I X1 TAD (ZERNUL) / THIS SOFTWARE DOESNT REALLY NEED NULLS DCA I X1 DXOSTR, DCA I X1 TAD (CMDBUF) / SET THE CHECK SUM JMS CHKSUM JMP I DXOCPK TRNCN6, AC7777 / SET FLAG TO LOCK OUT HOST JOB /A039 DCA DISTMP / /A039 JMP TRNCN7 / CONTINUE /A039 /---------- PAGE / / DSKBUF - GETS THE NEXT BUFFER FREE FOR TEXT / IF NONE ARE FREE IT GET TWO / DSKBUF, XX CLA TAD RESBFS / SEE IF 2 HAVE BEEN ALOCATED SZA CLA / ++++ JMP DSKBU2 JMS GETFRE / GET A FREE BUFFER JMP HSTWAT / ERROR RETURN SPFLAG SET DCA DSKBA1 DCA DSKBA2 / CLEAR THE WRITE FLAG JMS GETFRE JMP HSTWAT / ERROR RETURN SPFLAG SET DCA DSKBA3 / STORE ADDRESS DCA DSKBA4 / CLEAR THE FULL FLAG ISZ RESBFS DSKBU2, TAD DSKBA2 SZA CLA / ++++ JMP DSKBU3 / NOT BEING SENT AC0001 / ++++ DCA DSKBA2 TAD DSKBA1 ISZ DSKBUF JMP I DSKBUF DSKBU3, TAD DSKBA4 SZA CLA / ++++ JMP I DSKBUF AC0001 / ++++ DCA DSKBA4 ISZ DSKBUF TAD DSKBA3 JMP I DSKBUF RESBFS, 0 / / ORDER DEPENDENT / DSKBA1, 0 DSKBA2, 0 DSKBA3, 0 DSKBA4, 0 / / GETFRE - GET A FREE BUFFER / WILL WAIT CHECKING FOR SPFLAG SET AND RETURN IF SO. / ON ENTRY THE AC VALUE DOESNT MATTER ON RETURN IT IS THE ADDRESS OF / THE BUFFER. / / CALL / JMS GETFRE / ERROR RETURN / OK / GETFRE, XX JMP GETFR1 / JUMP TO TRY TO GET A BUFFER GETFR2, JMS INIWAT / CHECK SPFLAG JMP I GETFRE / ITS SET RETURN GETFR1, JMS GETBUF / ++++ FREEPT JMP GETFR2 ISZ GETFRE / GOT A BUFFER RETURN JMP I GETFRE / / SENDCB - FREES THE PACKETS THAT ARE SENT CORRECTLY AND ARE DATA / SENDCB, TAD DSKBA2 / SEE IF THE FIRST IS TO SEND SNA CLA / ++++ JMP SENDC2 TAD DSKBA1 IAC DCA T1 / SEE IFTHE BUFFER IS BEING SENT TAD I T1 SPA / ++++ JMP TIMEOU / SEE IF -1 THEN COULDNT SEND SNA CLA / ++++ JMP SENDC2 DCA DSKBA2 JMS BLKNM / UPDATE THE PACKET COUNTER SENDC2, TAD DSKBA4 SNA CLA / ++++ JMP SENDCR TAD DSKBA3 / SEE IF THE OTHER IS FULL IAC DCA T1 TAD I T1 SPA / ++++ JMP TIMEOU SNA CLA / ++++ JMP SENDCR DCA DSKBA4 JMS BLKNM / UPDATE THE PACKET COUNTER JMP SENDCR / / DTARTN - WILL RECEIVE A PACKET OF TEXT / EOFRTN, ISZ EOF / THE ONLY DIFFERENCE BETWEEN ANY OF THE TEXT AND THE LAST / IS SETTING THE LAST PACKET FLAG DTARTN, AC0003 / GET THE STARTING ADDRESS TAD HSTRAD DCA DTARTM / SAVE IN TEMP JMS BLKNM / INCREMENT THE BLOCK COUNT CLA DXRCLP, /D040 TAD INIFLG / CALLED FROM DTARTN WHICH RECEIVES A DOCUMENT /D040 SNA CLA / ++++ /D040 JMP HOSRBF / IF TRANSFER TERMINATED THEN THROW AWAY PACKET ISZ DTARTM TAD I DTARTM / STORE THE CHARACTER FIRST GET IT SNA / ++++ JMP DTARTJ / RELEASE THE BUFFER CIFBUF / ++++ JMS I WRISXA / WRITE CHARACTER JMP DXRCLP DTARTJ, TAD HSTRAD / RELEASE THE BUFFER JMS PUTBUF / ++++ FREEPT JMP DSKTLB / SEE IF IT IS THE LAST / / BYERTN HANDLES THE BYE MESSAGE THAT CAN BE SENT FROM THE OTHER / SYSTEM TO TERMINATE THE TRANSFER.IT ACTS LIKE A TIME OUT / BYERTN, JMS FILMBF / FILL THE MESSAGE BUFFER WITH THE TEXT SENT AC7777 / ++++ DCA CNGSCF AC0001 / ++++ DCA BYSETF / SET THE STOP EVERYTHING FLAG JMS STPTRN / STOP ANY TRANSFER AND RESET OPTIONS JMP HSTJWT / SIMILAR TO A JWAIT INSTEAD OF A WAIT / / STPRTN - STOP A TRANSFER IF ANY AND SET THE OPTIONS BACK TO THOSE RECEIVED / STPTRN, XX CLA JMS SETOPT /A017 TAD INIFLG / IF TRANSFER IN PROGRESS PUT INTO ABORT STATE SNA CLA / ++++ JMP I STPTRN TAD (-5) / ++++ DCA SENDFL DCA INIFLG JMP I STPTRN SETOPT, XX /A017 TAD OPTREC /A017 DCA OPTFLG /A017 JMP I SETOPT /A017 OPTREC, 0000 / /M023 SNDQT1, AC7777 / CLEAR OUTPUT BUFFER /A041 JMS HOSTOU / /A041 CLA / BUFFER FULL RETURN /A041 AC0003 / GET READY FOR TEST /A041 JMP SNDQT2 / CONTINUE /A041 /----------- PAGE / / OPTRTN - HANDLES THE OPTION PACKET THAT IS SENT FROM THE OTHER SYSTEM / GIVING THE SYSTEM ITS OPTIONS / OPTRTN, TAD AXFLG / IF IN AX DONT LET THE OPTIONS CHANGE SZA CLA / ++++ JMP HOSRBF AC0004 / GET THE ONE CHARACTER THAT WILL BE THE OPTION TAD HSTRAD DCA T1 TAD I T1 / TAD (-40) / SET THE INTERNAL FLAG DCA OPTREC / / TAD OPTREC /D017 / DCA OPTFLG /D017 JMS SETOPT /A017 / AC7777 / ++++ DCA CNGSCF / RESETTHE SCREEN JMS CLAINF JMP HOSRBF / RELEASE THE BUFFER / / THIS HANDLES THE INCOMING MESSAGES FOR BOTH THE SENDER AND THE / / THE RECEIVER / MESRTN, JMS FILMBF / FILL THE INPUT MESSAGE BUFFER WITH THE / MESSAGE SENT . NO FLAGS ARE SET BECAUSE / NOTHING AT THIS POINT SHOULD BE GOING ON / THAT WOULD AFFECT THE ACTION / AC0001 / ++++ DCA INMSFG / SET THE MESSAGE FLAG SO WHEN / THE SRCEEN IS UPDATED THE MESSAGE WILL / APPEAR TAD CNGSCF / SET THE FLAG TO DISPLAY THE SCREEN MESSAGE SNA CLA / ++++ ISZ CNGSCF / IF NOT ALREADY SET / JMP HSTJWT / INMSFG, 0 RCVRTN, TAD AXFLG / IS IN AX THEN HAVE TO TREAT SPECIAL SZA CLA / ++++ JMP AXRRTN TAD SENDFL / IF SET TO NOT WAIT THEN JUST INIT DONT SET PROMPT SMA CLA / ++++ JMP PMTOK JMP PMT002 SNDRTN, TAD AXFLG SZA CLA / ++++ JMP AXSRTN TAD SENDFL / IF SET DONT SET FOR PROMPT SMA CLA / ++++ JMP PMTOK JMP PMT003 PNERTN, TAD (-5) / Set PMTFLG to -1 for PROMPT NO ECHO. /M028 MODRTN, IAC / Set PMTFLG to 4 for MODIFY prompt. PMT003, IAC / Set PMTFLG to 3 for SEND. PMT002, IAC / Set PMTFLG to 2 for RECEIVE. PMTRTN, IAC / set PMTFLG to 1 for PROMPT. PMTRT2, DCA PMTFLG JMS FIL2BF / FILL THE BUFFER PMTRT3, JMP HSTJWT / CLEAR THE EVENT FLAG AND WAIT THIS ALOWS QUICK RESPONSE PMTOK, AC7777 / ++++ DCA INIFLG / SAY START SENDING DOCUMENT JMP HOSRBF / RELEASE THE BUFFER PMTFLG, 0 / / FIL2BF - FILLS THE SECOND MESSAGE BUFFER / FIL2BF, XX TAD (DOCNBF) JMS FILIBF JMP I FIL2BF / / FILLS THE MESSAGE BUFFER WHOSE ADDRESS IS IN THE AC / FILIBF, XX DCA FILIB2 / STORE THE ADDRESS TO COPY INTO AC0004 / GET THE STARTING ADDRESS OF THE STRING TO COPY TAD HSTRAD DCA FILIB1 JMS DXCOPY CDFMYF FILIB1, XX CDFMYF FILIB2, XX TAD HSTRAD JMS PUTBUF / ++++ FREEPT / FREE IT JMP I FILIBF / / THE ROUTINES USED FOR THE COPY TO GET THE HOST SPECIFIED / / OUTPUT / HOSTOU, XX DCA HOSTOT / ++++ TAD HOSTOT / SAVE THE CARACTER FOR HOSTO2 CIFSYS / ++++ HS2OU JMP I HOSTOU ISZ HOSTOU JMS HOSTO2 / CHECK FOR A CR AND IF SO SEND NULLS (PAD) JMP I HOSTOU HOSTOT, 0 / / THE INPUT ROUTINE / HOSTIN, XX HOSTIL, CIFSYS / ++++ HS2IN JMP I HOSTIN AND P177 / GET THE 7 -BITS SNA / ++++ JMP HOSTIL / SKIP A NULL TAD (-RUBOUT) / NOT ALLOW A RUBOUT SNA / ++++ JMP HOSTIL TAD (RUBOUT-40) / CHECK FOR A CONTROL CHARACTER SMA / ++++ JMP HOSTI2 / IF A CONTROL CHARACTER THEN CHECK FOR A CR TAD (40-CR) SZA / ++++ JMP HOSTIL / SKIP ALL BUT A CR TAD (CR-40) HOSTI2, TAD (40) / RETURN THE CHARACTER FOUND ISZ HOSTIN JMP I HOSTIN / / CLAINF - CLEAR THE EVENT FLAG IN THE SYSTEM. BY CLEARING THE FLAG / YOU TELL THE SYSTEM AN EVENT HAS HAPPENED. / CLAINF, XX CLA CDFSYS / ++++ DCA I (INTFLG) / ++++ CDFMYF JMP I CLAINF / / THIS ROUTINE IS USED THROUGHOUT THE MAIN JOB. THE ROUTINE IS / USED TO SET THE TOKEN POINTER THAT IS THE POINTER TO THE INPUT BUFFER / TO THE BEGINNING / INITKF, XX CLA TAD (INBUFA) / INITALIZE THE POINTER DCA TOKOFF JMP I INITKF /------------ PAGE / / DISBER - DISPLAYS THE ERROR MESSAGE THAT THE INPUT WAS BAD / DISBER, XX TAD (TOKBUF+1) / Set token pointer to token buffer DCA TOKOFF / (where the bad input is stored). AC0001 / now call menu A14 to report the bad input. JMS WTMARG / ... JMP I DISBER / return to caller. / / SETFLG - SETS ALL THE FLAGS NEEDED FOR EACH TRANSFER AND ALSO CLEARS THE / MESSAGE LINE. THIS LINE IS CLEARED INCASE AN ERROR IS DISPLAYED / SETFLG, XX JMS SETFLT / CLEAR FLAGS DCA TRNERC / CLEAR THE ERROR COUNTER. /A015 JMS CLAMSL / CLEAR MESSAGE LINE JMP I SETFLG / / RECEIVES THE INITAL MESSAGE / SODRTN, TAD SENDFL / SEE IF A START OF DOCUMENT CAN BE ACCEPTED SZA CLA / ++++ JMP HOSRBF / JMS FILMBF / THIS WILL FILL THE INPUT MESSAGE BUFFER / AND CHECK THE CHECK SUMS FOR IT CLA DCA INMSFG / CLEAR THE MESSAGE FLAG SO THE CONTENTS WILL NOT / APPEAR ON THE SCREEN / TAD ISGBK1 / GET THE BLOCK COUNT JMS SBOFST BSW DCA T1 / SAVE THE FIRST HALF TAD ISGBK2 / GET SECOND HALF JMS SBOFST TAD T1 / ADD IT TI THE OTHER HALF DCA DOCSIZ / TAD DOCSIZ CIA / AVAILABLE / MQL / SEE IF OVERWRITE OPTION IF SO ADD THE DOC SIZE TAD DOCMOD / IF -1 = OVERWRITE CLL RAL CLA MQA SNL / ++++ JMP INIREJ / CDFBUF / SEE IF THERE IS ROOM ON THE DISKETTE FOR THE FILE TAD I (SCHDR+5) / SUBTRACT THE FILE SIZE BECAUSE OVERWRITE INIREJ, CDFFIO / /M013 TAD I (SCFSPC) / SUBTRACT THE AMOUNT LEFT ON THE DISK / CDFMYF / ACDF FOR THIS FIELD (MY FIELD) / TAD (-10) / MAKE SURE THAT I WILL NOT OVERFLOW / SPA SNA CLA / ++++ JMP SENNO / / THE YES ANSWER / TAD (TYPYES) / SEND A YES DCA ANSBUF TAD (ANSBUF-1) / JMS INIBFS JMP HSTPRG JMP TIMEOU / IF NEGATIVE RESTART / JMS STRPRT / STORE THE RULER SETTINGS SNDYE2, AC0001 / ++++ DCA INIFLG / SET THE FLAG SO THE INITAL MESSAGE WILL / SENT WHEN IT CAN IF IN SEND / JMS DISAPX / CALCULATE THE APPOXIMATE NO OF PACKETS SNDYE4, / CALLED BY AXRRTN AND AXSRTN AC7777 / ++++ DCA CNGSCF / REPAINT THE SCREEN SNDYE3, JMP HSTJWT / CLEAR THE EVENT FLAG SO PROGRAM IS RETURNED TO QUICKER / / THE YES ROUTINE USE FOR THE YES RESPONSE FROM AX ON A COMMAND PACKET / YESRTN, AC7777 / ++++ DCA INIFLG / START THE ITRANSFER OF A DOCUMENT PROCESS JMP SNDYE3 / / THE NO RESPONSE / SENNO, DCA INIFLG / CLEAR THE INIT FLAG TAD (TYPNO) DCA ANSBUF / TAD (ANSBUF-1) JMS INIBFS / SEND THE RESPONSE JMP HSTPRG / GOLD HALT JMP TIMEOU / IF NEGATIVE THEN RESTART / SNDNO2, AC0001 / ++++ DCA ERRFLG DCA INIFLG JMP SNDNO3 / CLOSE DOCUMENT FIRST /C031 ANSBUF, ZBLOCK 2 / / THIS WILL PUT THE ESTIMATE ON THE SCREEN / DISAPX, XX CLA TAD DOCSIZ / TO SEE IF THE NUMBER OF BLOCKS EXCEED 200 TAD (-201) SMA CLA / ++++ JMP DISJMP / IF SO JUMP TAD DOCSIZ / FIRST MULTIPLY BY 8 JMP DISAP2 DISJMP, DCA T1 / CLEAR THE COUNTER FOR THE DIVIDE BY 10 TAD DOCSIZ TAD (5) / ROUND BY ADDING 5 TO TOTAL BEFORE DEVIDING DISLUP, TAD (-12) / DEVIDE BY 10 ISZ T1 / INCREMENT THE COUNTER FOR EACH DEVIDE SMA / ++++ JMP DISLUP / NOTE :THIS PROCESS ROUNDS UP AC7777 / THIS WILL GET THE RIGHT NUMBER FOR THE DIVIDE TAD T1 / NOW MULTIPLY BY 8 DISAP2, CLL RAL / ++++ CLL RAL / ++++ CLL RAL DCA DOCTMP JMP I DISAPX / / THE UPDATING OF THE ERRORS ON THE SCREEN / UPDTER, XX ISZ TRNERC / INCREMENT THE COUNTER TAD CNGSCF / IF NOT SET SET IT SNA CLA / ++++ ISZ CNGSCF JMP I UPDTER TRNERC, 0 /---------- PAGE / / WAITING FOR SOMETHING TO BE SENT (RECEIVER) / WAITDT, XX DCA DLYLIM JMP WAITLP WAITWT, TAD DLYLIM / IF POSITIVE THEN RETURN DONT JWAIT SMA CLA / ++++ JMP I WAITDT CIFSYS / ++++ JWAIT JMS GETTM SNA CLA / ++++ JMP WAITLP ISZ DLYLIM JMP WAITLP JMP I WAITDT WAITLP, TAD SPFLAG / SEE IF THE JOB SHOULD STOP SZA CLA / ++++ JMP HSTWAT JMS GETBUF / ++++ RECPT JMP WAITWT JMS STOBUF / STORE THE ADDRESS IN HSTRAD ISZ WAITDT JMP I WAITDT DLYLIM, 0 / / STOBUF - WILL STORE THE ADDRESS OF THE RECEIVED BUFFER IN HSTRAD / STOBUF, XX DCA HSTRAD AC0003 TAD HSTRAD DCA T1 TAD I T1 JMP I STOBUF / / UPDATE THE BLOCK COUNTER AND SET THE DISPLAY FLAG / BLKNM, XX CLA ISZ BLKTMP / THIS IS THE BLOCK COUNTER FOR THE -1000 TO 0 RANGE JMP BLKN1 / IF THERE IS NO OVERFLOW THEN PROCEED / DECIMAL TAD (-1000) / SET THE COUNTER ON OVERFLOW OCTAL / DCA BLKTMP ISZ BLKOVR / INCREMENT THE THOUSAND COUNTER BLKN3, TAD BLKTMP / SET THE TEMP TO A DISPLAYABLE NUMBER FOR IOA / DECIMAL TAD (2000) / 1000 FOR POSITIVE AND 1000 FOR THE ZEROS OCTAL / JMP BLKN4 BLKN1, TAD BLKOVR / SEE IF THE BLOCK COUNTER IS OVER 1000 SZA CLA / ++++ JMP BLKN3 / IF SO GO TO BLKN3 / DECIMAL TAD (1000) / GET THE REAL NUMBER TO DISPLAY OCTAL / TAD BLKTMP BLKN4, DCA BLKNUM / TAD CNGSCF / SEE IF ALREADY SET IF NOT SET IT SNA CLA / ++++ ISZ CNGSCF / JMS CLAINF JMP I BLKNM / RETURN / BLKNUM, 0 BLKTMP, 0 BLKOVR, 0 / / UPDATE THE SCREEN FOR THE BLOCK COUNT / BLKNMD, XX CIFMNU JMS I IOACAL 0 NUMDIS IFDEF ENGLSH < 1260 > IFDEF ITALIAN < 1276 > IFDEF DUTCH < 1265 > / Keep messages from being clobbered by blk counts IFDEF V30NOR < 1260 > / cursor position for "inviato - ricevuto" IFDEF V30SWE < 1260 > / cursor position for "inviato - ricevuto" BLKNUM / TAD BLKOVR / SEE IF THE BLOCK COUNT IS OVER 1000 SNA CLA / ++++ JMP I BLKNMD / IF SO IOA WILL NOT HANDLE IT SO A NOTHER CALL / HAS TO BE MADE TO WRITE OUT THE 1000 DIGIT / CIFMNU JMS I IOACAL 0 BLKDS2 IFDEF ENGLSH < 1260 > IFDEF ITALIAN < 1276 > IFDEF DUTCH < 1265 > / Keep messages from being clobbered by blk counts IFDEF V30NOR < 1260 > IFDEF V30SWE < 1260 > BLKOVR / JMP I BLKNMD / / GET THE TIME CHANGE USING THE SYSTEMS CLOCK / IT RETURNS A 1 IF A SECOND WENT BY AND A 0 IF NO CHANGE / GETTM, XX JMS GETCLK / SEE IF THE TIME CHANGED TAD TMPTME / COMPARE TO SEE IF THE CLOCK CHANGED SNA / ++++ JMP I GETTM / NO CHANGE CIA / ++++ TAD TMPTME / IF CHANGE STORE THE NEW ONE DCA TMPTME AC0001 JMP I GETTM TMPTME, 0 / / THE TIME ROUTINE FOR THE LINE / GETTM2, XX JMS GETCLK TAD TMPTM2 / CHECK FOR A CHANGE IN THE TEMP SNA / ++++ JMP I GETTM2 CIA / ++++ TAD TMPTM2 / STORE THE DIFFERENT VALUE IF THERE IS ANY DCA TMPTM2 AC0001 JMP I GETTM2 TMPTM2, 0 GETCLK, XX CLA CDFSYS TAD I (CLOCK+2) / ++++ CIA CDFMYF / ACDF FOR THIS FIELD (MY FIELD) JMP I GETCLK SNDNO3, JMS CLDOC / CLOSE DOCUMENT /A031 JMP HSTRST / NOW RESTART /A031 / / KBOUT - OUTPUT A CHARACTER TO THE SCREEN / KBOUT, XX JMP KBOUL KBOUW, CIF 0 / ++++ JWAIT KBOUL, CLA TAD I KBOUT / Get character to output. AND P177 / Isolate the character bits. CIFSYS / ++++ TTYOU JMP KBOUW TAD I KBOUT / Get character just output. ISZ KBOUT / Bump to return/next character. SPA CLA / Skip if we're done. JMP KBOUL / Jmp if there's another one. JMP I KBOUT / Return to caller. /------------ PAGE CWTAGN, CLA TAD INIFLG / IF A TRANSFER IS IN PROGRESS SPA SNA CLA / ++++ JMP HSTWAT TAD SENDFL / AND IN RECEIVE MODE THEN AN ERROR SZA CLA / ++++ JMP HSTWAT JMP TIMEOU / / THIS CHECKS FOR END OF FILE ENCOUNTERED. IT BELONGS ON THE LAST / PAGE WITH DSKPRG BUT DOESNT FIT / DSKTLB, CLA TAD EOF / SEE IF LAST PACKET SNA CLA / ++++ JMP HSTPRG JMS CLDOC / CLOSE THE DOCUMENT IF ANY OPEN /M026 TAD AXFLG / SEE IF AX MODE SNA CLA / ++++ JMP DSKTL2 CIFBUF JMS I AXDONA DSKTL2, AC7775 / ++++ DCA SENDFL / SET TO DONE JMS SETOPT / Reset the options to what they were before. AC7777 / ++++ DCA CNGSCF / SET THE RESET SCREEN FLAG TAD AXFLG / IF IN AX MODE INCREMENT THE COUNTER FOR NUMBER / OF DOCUMENTS PROCESSED. SZA CLA / ++++ ISZ DOCNCT DCA INIFLG / CLEAR THE TRANSFER FLAG JMP HSTJWT / WAIT FOR RESTART / / DXOHJB - THE OUTPUT ROUTINE TO THE HOST / DXOHEX, /D041 JMS SNDQIT / BEFORE DYING SEND A QUIT TO TELL THE OTHER SIDE /D041 / WHATS GOING ON HAS NO EFFECT IF AX JMP SNDQT1 / SEND QUIT PACKET /A041 DXOSQR, / RETURNS HERE /A041 AC7777 / ++++ DCA DXOFLG / SET TO NEGATIVE A SIGN THAT EXITED CIFSYS / ++++ JEXIT DXOHWT, CIFSYS / ++++ JWAIT DXOHJB, CLA TAD SPFLAG / SEE IF IT IS TIME TO STOP SPA CLA / ++++ JMP DXOHEX TAD CMDFLG / SEE IF THERE IS A COMMAND TO OUTPUT SNA / ++++ JMP DXOHJ1 / JMS DXOCPK / SET UP THE COMMAND PACKET AC = 0 WHEN CALL DXOCPK / TAD (CMDBUF) JMS SNDPCK JMP DXOHTO / ERROR IN TRANSFER / TAD CMDBUF / SEE IF INIT ACK SENT IF SO SET FLAG TAD (-INIACK) SZA CLA / ++++ JMP DXOHJB AC0001 / ++++ DCA INIFL2 JMP DXOHJB DXOHJ1, TAD NAKFL2 TAD TOFL2 SNA CLA / ++++ JMP DXOHJ2 TAD PUTPRC SNA CLA / ++++ JMP DXOHJ4 / TAD (PTRHED) / SET THE POINTERS FOR THE RESENDING DCA GTNXPT / DXOHJ5, JMS GETNXT / GET THE NEXT PACKET TO SEND JMP DXOHJ4 / TAD (2) / GET THE ADDRES FOR THE DATA / JMS SNDPCK / SEND IT JMP DXOHTO JMP DXOHJ5 DXOHJ4, CLA DCA TOFL2 / CLEAR THE ERROR FLAGS DCA NAKFL2 DXOHJ2, TAD INIFL2 / SEE IF THE LINE HAS BEEN INITALIZED YET SNA CLA / ++++ JMP DXOHWT JMS GETBUF / ++++ SENDPT / SEE IF THERE IS A PACKET TO SENT JMP DXOHWT / NOTHING TO DO SO WAIT / JMS DXSNBF / SEND IT JMP DXOHTO / ERROR IN SENDING IT JMP DXOHJB DXOHTO, CLA TAD TOFL2 / SEE WHY SNA CLA / ++++ JMP DXOHT2 DXOHT3, AC7777 JMS HOSTOU / CLEAR THE BUFFERS NOP DXOHT2, TAD (RESET) / SEND A RESET CAHRACTER TO TERMINAT THE PACKET JMS SNDCHR JMP DXOHT3 TAD (CR) / TERMINATOR JMS SNDCHR JMP DXOHT3 / JMP DXOHJB DXOFLG, 0 TOTM2, 0 INIFL2, 0 TOFL2, 0 / / / DISBLF - DISPLAY THE BOTTOM LINE AND CLEAR EVENT FLAG INTFLG /A017 / DISBLF, XX /A017 JMS DISBL /A017 JMS CLAINF /A017 JMP I DISBLF /A017 PAGE / / DXSNBF - SEND THE PACKET AND PUT IT INTO THE SENT BUFFER / DXSNBF, XX DCA DXSNBA / SAVE THE STARTING ADDRESS AC0002 / GET THE START OF TEXT TAD DXSNBA DCA SEQPSN / ISZ OSEQNO / INCREMENT THE SEQ NUMBER CLA TAD OSEQNO / INSERT THE SEQ AND P77 JMS ADOFST DCA I SEQPSN / TAD SEQPSN JMS CHKSUM / TAD DXSNBA / PUT THE PACKET IN THE SEND LIST JMS PUTPTR / TAD SEQPSN JMS SNDPCK / SEND THE PACKET JMP I DXSNBF / ISZ DXSNBF JMP I DXSNBF DXSNBA, 0 SEQPSN, 0 OSEQNO, 0 / / ADOFST - ADDS THE OFFSET TO THE AC / ADOFST, XX SNA / ++++ TAD (100) / IF ZERO ADD 137 ELSE ADD 37 TAD (37) JMP I ADOFST / / SBOFST - TAKE OFF THE OFFSET FROM THE CONTENTS OF THE AC / SBOFST, XX TAD (-137) / IF ZERO SUBTRACT A 137 ELSE A 37 SZA / ++++ TAD (100) JMP I SBOFST / / CHKSUM - COMPUTES THE CHECK SUM OF THE PACKET WHOSE ADDRESS IS / IN THE AC.IT THEN INSERTS ATHE CHECK SUM AT THE END OF THE PACKET AND / ENDS IT WITH A ZERO. / CHKSUM, XX JMS CHKSM1 / GET THE SUM OF THE BUFFER TAD T2 BSW / PUT IN THE FIRST HALF AND P77 JMS ADOFST DCA I T1 ISZ T1 TAD T2 / NOW THE SECOND HALF AND P77 JMS ADOFST DCA I T1 / ISZ T1 DCA I T1 / INSERT THE TRAILER JMP I CHKSUM / / SNDCHR - SEND CHARACTER ROUTINE / SNDCHR, XX DCA SNDCHT AC0002 / ++++ DCA SNDTMO / SET TIME OUT FOR EACH CHARACTER JMP SNDCHJ SNDCHW, CLA CIFSYS / ++++ JWAIT TAD SPFLAG / IF NOT TIMED OUT CHECK TO SEE IF THE OTHER SPA CLA / ++++ JMP DXOHEX / PROGRAMS ARE RUNNING TAD SNDTMO / ++++ SZA CLA / ++++ JMP SNDCHJ TAD TOFL2 / OR THAT THE INPUT ROUTINE TIMED OUT TAD NAKFL2 / OR THAT IT RECEIVED A NAK SZA CLA / ++++ JMP SNDCHE SNDCHJ, TAD SNDCHT JMS HOSTOU JMP SNDCHW ISZ SNDCHR SNDCHE, JMP I SNDCHR SNDCHT, 0 SNDTMO, 0 / / DXIHJB - HOST INPUT ROUTINE / DXIHEX, AC7777 / ++++ DCA DXIFLG / SET TO SAY I HAVE EXITED. CIFSYS / ++++ JEXIT DXIHWT, CIFSYS / ++++ JWAIT DXIHJB, CLA TAD SPFLAG / SEE IF THE OHTER JOBS ARE DONE IF SO STOP SPA CLA / ++++ JMP DXIHEX TAD RSTFLG / IF SET WAIT SZA CLA / ++++ JMP DXIHWT TAD INIFL1 / SEE IF THE LINE IS INITIATED SNA CLA / ++++ JMP DXIHIN JMS GETTM2 SZA CLA / ++++ ISZ DLYLM2 SKP CLA / ++++ JMP DXIHTO / TIME OUT PROCESS DXIHJ1, JMP DXIHGP / GET A PACKET DXIHJ2, TAD I DXGTPT / SEE WHAT IT IS TAD (-SPECHR) SMA CLA / ++++ JMP DXICMD / ACOMMAND TO LOW LEVEL DW AC0002 / DID WE TIMEOUT? /A017 TAD ERRFLG / (IS ERROR STATUS TIMEOUT?) /A017 SZA CLA / IF YES THEN DON'T ACK /A017 TAD INIFL2 / IF NOT SET DONT ACCEPT THE PACKET SNA CLA / ++++ JMP DXIHWT / WAIT UNTIL SET JMP DXIPKT DXIFLG, 0 DLYLM2, 0 / PAGE / / THIS IS THE TIME OUT CHECK / DXIHTO, TAD INIFL2 SNA CLA / ++++ JMP DXIHIN / IF NOT INITALIZED THEN RESET THE INIT TAD PUTPRC / SEE IF IT IS OK TO TIME OUT SNA CLA / ++++ JMP DXIHWT JMS CLAINF / CLEAR THE EVENT FLAG SO OHTER JOBS WILL NOTICE ISZ TOFL2 AC7777 / ++++ TAD SNDTMO / UPDATE THE TIME OUT COUNTER FOR A CHARACTER SMA / ++++ DCA SNDTMO CLA TAD DLY3X / ++++ /M020 DCA DLYLM2 JMS UPDTER / INCREMENT THE ERROR COUNTER ISZ TOTM2 JMP DXIHWT JMS DXIHKP / KILL THE SEND PACKETS IF THE TRANSFER FAILED AC7777 / ++++ JMS HOSTOU / CLEAR THE OUTPUT BUFFER CLA JMP DXIHWT / / DXIHKP - KILLS ALL PACKETS TO BE SENT AND WAITING / DXIHKP, XX AC7777 / ++++ JMS HOSTOU / CLEAR THE OUTPUT BUFFER AND MAKE SURE ITS XONED CLA JMS DXICLA / CLEAR THE START THE LOW INIT FLAGS / DXIHK2, JMS GETBUF / ++++ SENDPT / CHECK THE SEND LIST JMP DXIHKJ / JMS DXIHKR / SET THE CONDITION FLAG JMP DXIHK2 / CONTINUE UNTIL EMPTY DXIHKJ, JMS GETPTR / GET THE ONES IN THE WAIT LIST JMP I DXIHKP / JMS DXIHKR JMP DXIHKJ DXIHKR, XX IAC DCA T1 AC7777 DCA I T1 JMP I DXIHKR / / DXIHIN - SENDS THE LINE INIT / DXIHIN, AC0001 / ++++ DCA INIFL1 JMS DXIHKP / CLEAR EVERYTHING TAD AXFLG / CHECK FOR AX SZA CLA / ++++ JMP DXIHJ1 TAD DLY1X / ++++ /M020 DCA DLYLM2 TAD (INIT) JMP DXIBDY INIFL1, 0 / / DXIPKT - RETRUN A PACKET / DXIPKT, TAD I DXGTPT / GET THE SEQUENCE NUMBER JMS SBOFST CIA DCA T1 AC0001 TAD ISEQNO AND P77 TAD T1 SZA CLA / ++++ JMP DXIPK2 / TAD DXGTPA / GET THE STARTING ADDRESS JMS PUTBUF / ++++ RECPT / CLA DCA DXIHFP / KEEP PACKET DCA DXNONK / CLEAR THE DONT SEND A NAK FLAG / ISZ ISEQNO / ++++ NOP / UPDATE THE PACKET INPUT SEQUENCE NUMBER DXIPK2, TAD (ACK) / SEND A ACK JMP DXIBDY /A017 / / / THIS WILL SEND THE CONTENTS IN THE AC AS A COMMAND / /DXIBDY, / DCA CMDFLG / / JMS CLAINF / CLEAR THE EVENT FLAG / JMP DXIHJB / DONE CONTINUE ISEQNO, 0 CMDFLG, 0 / / DXICMD - HANDLES THE INCOMING COMMAND / DXICMD, TAD I DXGTPT TAD (-ACK) / CHECK FOR AN ACK SNA / ++++ JMP DXICKS TAD (ACK-NAK) / NOW A NAK SNA / ++++ JMP DXINAK TAD (NAK-INIT) / AND INIT SNA / ++++ JMP DXINIT TAD (INIT-INIACK) SNA / ++++ JMP DXIACI TAD (INIACK-QUIT) / IF A QUIT LOW LEVEL COMMAND AND IN DX LEAVE SNA CLA / ++++ JMP DXIQIT JMP DXIHJB / / DXINAK - CHECK FOR A VALID NAK / DXINAK, ISZ NAKFL2 JMS UPDTER / UPDATE THE ERROR COUNTER JMP DXICKS NAKFL2, 0 /------------ PAGE / / ********************************************************* / / THE NEXT TWO LOCATIONS ARE IMPORTANT TO AX SO IF MOVED TELL AX / SHOULD BE LOCATIONS 5200 AND 5201 / / ********************************************************* / IFNZRO .-5200 / GETBUF PUTBUF / / ********************************************************* / / / DXICKS - CHECK FOR A VALID COMMAND / DXICKS, AC0001 TAD DXGTPT / GET ADDRESS OF THE SEQUENCE DCA T1 TAD I T1 / GET THE SEQUENCE JMS SBOFST / CIA / GET THE NEGATIVE SEQUENCE NUMBER SENT TAD OSEQNO / COMPARE TO THE OUTPUT SEQUENCE NUMBER AND P77 / AND IT TO KEEP IT POSITIVE CIA / MAKE NEGATINE TO SEE IF THE NUMBER IS IN RANGE TAD PUTPRC / COMPARE TO THE NUMBER OF PACKETS IN THE WAIT LIST CIA DCA DXIAKT / IF NEGATIVE IT IS THE NUMBER OF PACKETS ACKED TAD DXIAKT / ++++ SMA CLA / ++++ JMP DXIHJB / FORGET IF NOT NEGATIVE / DXIAK3, JMS GETPTR / GET THE BUFFERS OUT OF THE LIST JMP DXIAKD / RETURN / IAC DCA DXIAK2 / SET THE STATUS TO DONE IAC / DONE IS 1 DCA I DXIAK2 / ISZ DXIAKT JMP DXIAK3 DXIAKD, TAD DLY3X /M020 DCA DLYLM2 JMP DXIHJB DXIAKT, 0 DXIAK2, 0 / / DXIHGP - GETS A PACKET IF ONE IS COMMING / DXIHGP, TAD DXIHFP / SEE IF A BUFFER IS ALOCATED TO INPUT SZA CLA / ++++ JMP DXIHGJ / IF SO FILL IT JMS GETBUF / ++++ FREEPT JMP DXIHWT DCA DXGTPA / SAVE THE BUFFER ADDRESS ISZ DXIHFP / DXIHG1, JMS DXIHGX / SET THE POINTERS TO THE BEGINING DXIHGJ, / SHOULD HAVE A GETCHR ROUTINE SO TO GET FRAMING JMS HOSTIN / GET A CHARACTER JMP DXIHWT / TAD (-CR) / SEE IF END OF PACKET SNA / ++++ JMP DXIHG2 TAD (CR) DXIHGZ, DCA I DXGTPS ISZ DXGTPS ISZ DXGTPC JMP DXIHGJ JMP DXIHG1 / TOO BIG DXIHG2, DCA I DXGTPS / INSERT A ZERO FOR THE END OF A PACKET / AC7776 TAD DXGTPS / GET THE ADDRESS OF THE CHECK SUM CIA TAD DXGTPT / GET DATA CNT SMA / ++++ JMP DXIHG1 / IGNORE IF TOO SMALL DCA T2 / AC7777 / SEE IF THE RESET CHARACTER IS PART OF THE TAD DXGTPS DCA T1 TAD I T1 TAD (-SPECHR) SMA CLA / ++++ JMP DXIHG1 / TAD DXGTPT DCA T1 DXIHG3, TAD I T1 / GET THE CONTENTS ISZ T1 ISZ T2 / ++++ JMP DXIHG3 DCA T3 / SAVE CHECK SUM TAD I T1 / GET THE SENT CHECK SUM JMS SBOFST / GET RID OF THE OFFSET BSW DCA T2 / DCA I T1 / CLEAR THE TERMINATOR / ISZ T1 TAD I T1 JMS SBOFST / STRIP THE OFFSET TAD T2 CIA / ++++ TAD T3 SNA CLA / ++++ JMP DXIHG4 / SEE WHAT WAS FOUND TAD I DXGTPT / CHECK THE SEQUENCES JMS SBOFST CIA / ++++ IAC TAD ISEQNO AND P77 SZA CLA / ++++ JMP DXIHG1 / FORGET TI TF THE SEQUENCES DONT MATCH JMS DXIHGX / RESET THE POINTERS JMP SNDNAK DXIHG4, JMS DXIHGX / RESET THE POINTERS JMP DXIHJ2 / DXIHGX, XX AC0002 TAD DXGTPA DCA DXGTPS / STORE ADDRESS OF START OF TEXT TAD DXGTPS DCA DXGTPT / TAD (-BUFSIZ-5) / COUNTER MINUS THE CR DCA DXGTPC JMP I DXIHGX DXIHFP, 0 DXGTPA, 0 DXGTPS, 0 DXGTPC, 0 / PAGE / / DXINIT - FOR THE INITAL MESSAGE / DXINIT, JMS DXICKV / CHECK FOR A VALID VERSION OF THE PROTOCOL JMP DXIER1 / TAD INIFL3 / SEE IF ALREADY CONNECTED SNA CLA / ++++ JMP DXINI2 / JMS DXIHKP / CLEAR EVERYTHING / AC0001 DXIER2, DCA RSTFLG / IF - THEN CANNOT CONNECT IF + RESTARTED / JMP DXIHWT DXINI2, TAD (INIACK) / ++++ DCA CMDFLG / SET THE COMMAND FLAG DXIACI, JMS DXICKV / CHECK FOR VALIN VERSION JMP DXIER1 / AC0001 DCA INIFL2 / SET THE LINE IS INITALIZED FLAG DXIAC3, JMS CLAINF JMP DXIHJB DXIER1, AC7777 / ++++ DCA CNGSCF / SET TO REPAINT THE SCREEN AC7777 JMP DXIER2 / / HOSTO2 - WILL SEND THE DESIRED NUMBER OF NULLS THAT THE HOST SYSTEM REQUESTED / TO BE SEND AS PAD CHARACTERS AFTER A CR. / HOSTO2, XX TAD HOSTOT / ++++ TAD (-CR) / SEE IF A CR WAS THE LAST CHARACTER SENT SZA CLA / ++++ JMP I HOSTO2 / IF NOT RETURN TAD NULCNT / IF YES THEN SEE IF THE NULL COUNTER IS NON ZERO SNA / ++++ JMP I HOSTO2 / IF ZERO THEN RETURN ALSO DCA HOSTM1 HOSTJ1, JMS HSTOU / OUTPUT NULLS ISZ HOSTM1 JMP HOSTJ1 JMP I HOSTO2 HOSTM1, 0 / / / PUTPTR - INSERTS THE ADDRESS IN THE AC INTO THE SEND LIST OF PACKETS / AND STARTS THE TIMERS / PUTPTR, XX DCA T1 / STORE THE ADDRESS OF THE BUFFER TAD (PTRHED-1) / GET THE START OF THE LIST TAD PUTPRC / USE COUNTER FOR THE OFFSET DCA IX0 TAD T1 / TACK THIS ONE TO THE END OF THE LIST DCA I IX0 DCA I IX0 / TAD (TOLIM) / ++++ DCA TOTM2 TAD DLY3X /M020 DCA DLYLM2 / SET THE TIMERS / ISZ PUTPRC / INCREMENT THE COUNTER JMP I PUTPTR PUTPRC, 0 PUTPRQ, 0 / / GETPTR - GETS THE MOST RECENT PACKET OUT OF THE BUFFER OF / MESSAGES SENT BUT UNANSWERED / GETPTR, XX CLA TAD PUTPRC / SEE IF STACK EMPTY SNA / ++++ JMP I GETPTR CIA DCA T2 TAD (PTRHED-2) DCA IX1 TAD (PTRHED-1) DCA IX0 GETPTL, TAD I IX0 / GET THE NEXT ENTRY DCA I IX1 ISZ T2 JMP GETPTL DCA I IX1 ISZ GETPTR AC7777 TAD PUTPRC / DECREMENT THE COUNTER DCA PUTPRC TAD PTRHED-1 / GET THE NEXT ADDRESS JMP I GETPTR / / GETBUF - GETS THE NEXT BUFFER ADDRES IF THERE IS ON IN THE REQUESTED CHAIN / CALL / JMS GETBUF / THE CHAIN STARTING ADDRESS (FREEPT,RECPT,SENDPT) / EMPTY RETURN / NORMAL RETURN / GETBUF, XX CLA RDF / READ THE DATA FIELD TO SEE WHERE IT CAME FROM TAD CIDF0 / MAKE THE RETURN INSTRUCTION DCA GETBUX TAD I GETBUF / GET THE ADDRESS CDFMYF ISZ GETBUF DCA T1 TAD I T1 / GET THE NEXT BUFFER IN THE CHAIN SNA / ++++ JMP GETBUX / RETURN ZERO IN BUFFER DCA T2 TAD I T2 / CHANGE THE POINTERS BECAUSE THIS ONE IS NOW IN USE T1 DCA I T1 / CUT FROM CHAIN TAD T2 / RETRUN THE BUFFER ADDRESS ISZ GETBUF GETBUX, XX JMP I GETBUF / / PUTBUF - ADD THE SPECIFIED BUFFER WHOSE ADDRESS ISIN THE AC IN THE LIST / DESIRED BY THE NEXT LOCATION / PUTBUF, XX DCA T2 / SAVE THE BUFFER RDF / READ THE DATA FIELD FOR THE RETURN TAD CIDF0 DCA PUTBUX TAD I PUTBUF / GET THE CHAIN STARTER ISZ PUTBUF DCA T1 CDFMYF PUTBUJ, TAD I T1 / GO TO THE END SNA / ++++ JMP PUTJ2 DCA T1 JMP PUTBUJ PUTJ2, TAD T2 DCA I T1 DCA I T2 PUTBUX, XX JMP I PUTBUF /------------ PAGE / / SNDPCK - SENDS A PACKET / THE ADDRESS OF THE TEXT PART OF THE BUFFER IS IN THE AC / SNDPCK, XX DCA SNDTP2 / SAVE THE STARTING ADDRESS SNDCMJ, TAD I SNDTP2 / GET THE FIRST CHARACTER SNA / ++++ JMP SNDCMD JMS SNDCHR JMP SNDCME ISZ SNDTP2 JMP SNDCMJ SNDCMD, TAD (CR) / SEND THE TRAILER JMS SNDCHR JMP SNDCME ISZ SNDPCK SNDCME, JMP I SNDPCK SNDTP2, 0 / / CLSCRL - CLOSES THE FILE IF HAS BEEN OPENED FOR SCROLL / CLSCRL, XX TAD DOCNO / SEE IF IT IS OPEN SNA CLA / ++++ JMP I CLSCRL CIFBUF / Call the SIX BIT routine so as to /A017 JMS I WRISXA / TERMINATE THE FILE PROPERLY /A017 CIFFIO / ++++ /M013 FILEIO / ++++ /M013 XDSKCL JMP I CLSCRL / / GETPRC - GETS THE PRINTER SETTING OUT OF THE BUFFER READ IN BY RDFIL INIT / GETPRC, XX DCA INISTT / SAVE THE ADDRESS FOR THE INSERT PRINTER CONTROLS DCA BYTCNT / INITALIZE THE BYTE COUNT TAD INISTT DCA X1 TAD (SETSIZ) / INITALIZE THE WORD COUNTER DCA SETCNT TAD (SETSND-1) / GET THE INITAL ADDRESS OF STRE THE SETTING DCA SETTMP / STORE THE INITAL ADDRES OF THE SETTINGS GETRLL, JMS GETPRB / GET A BYTE OF THE SETTINGS JMS ADOFST / ADD THE OFFSET DCA I X1 / STORE IN MESSAGE BUFFER JMS GETPRB JMS ADOFST / ADD THE OFFSET OFR THE LINE DCA I X1 ISZ SETCNT JMP GETRLL DCA I X1 JMP I GETPRC SETCNT, 0 INISTT, 0 / / GETRLB - GETS THE NEXT BYTE OF THE PRINTER SETTINGS / GETPRB, XX JMS GETBYT / FIND OUT WHICH HALF OF THE WORD TO RETURN JMP NOISZ / TOP HALF ISZ SETTMP / NEXT WORD TOP BYTE CDFBUF TAD I SETTMP BSW JMP GETCNT NOISZ, CDFBUF TAD I SETTMP GETCNT, CDFMYF AND P77 JMP I GETPRB SETTMP, 0 / / GETBYT - IF BYTCNT = 0 SET TO 1 AND SKIP RETURN / IF 1 THEN SET TO ZERO AND RETURN / GETBYT, XX CLA TAD BYTCNT SZA CLA JMP CLABYT AC0001 ISZ GETBYT CLABYT, DCA BYTCNT JMP I GETBYT BYTCNT, 0 / / STRPRT - STORES THE PRINTER SETTINGS INTO THE FILE HEADER THAT IS / RECEIVING THE DOCUMENT / STRPRT, XX CLA TAD (PRTOFF) / SEE IF THERE EXISTS ANY PRINTER SETTINGS CIFFIO / ++++ /M013 FILEIO / ++++ /M013 XHDRGT SZA CLA / ++++ JMP I STRPRT / THERE EXISTS PRINTER SETTINGS TAD (SETSIZ) / INITALIZE THE COUNTER FOR THE PRINTER SETTINGS DCA SETCNT TAD (SETSAV-1) / GET THE STARTING ADDRESS DCA X5 TAD (PRTOFF) / INITLAIZE THE OFFSET FOR SAVING THE VALUES DCA SETTM2 STRRLL, TAD I X5 JMS SBOFST / TAKE OFF THE OFFSET BSW MQL / STORE IT TAD I X5 JMS SBOFST MQA MQL / ++++ TAD SETTM2 CIFFIO / ++++ /M013 FILEIO / ++++ /M013 XHDRPT ISZ SETTM2 ISZ SETCNT JMP STRRLL JMP I STRPRT SETTM2, 0 / CLEAR STATUS LINE AND RESET FLAGS /A031 CLASTA, XX / CLEAR STATUS LINE /A031 JMS SETFLG / FIRST RESET FLAGS /A031 CIFMNU / MENU /A031 JMS I IOACAL / GO DISPLAY /A031 0 / /A031 CONSTM / "CONNECTION ESTABLISHED" /A031 0315 / SCREEN POSITION /A031 JMP I CLASTA / RETURN /A031 / / INIWAT - JWAITS AND CHECKS THE SPFLAG / IT DOES A SKIP RETURN IF NOTHING IS SET. / INIWAT, XX CIFSYS / ++++ JWAIT / CLA TAD SPFLAG SNA CLA / ++++ ISZ INIWAT / JMP I INIWAT / /------------- PAGE / / DXCOPY - SIMILAR TO CUCOPY BUT THIS COPY MAKES ASCIIZ STRINGS OUT OF THE / RECEIVING STRING AND NEEDS AN ASCIIZ STRING FOR THE BEGINNING STRING. THAT IS / WHY IT HAS TO COUNT / / CALL: / JMS DXCOPY / CDF TO FIELD OF START STRING / ADDRESS OF THAT STRING / CDF TO RECEIVING STRING / ADDRESS OF STRING / DXCOPY, XX CLA TAD DXBSIZ / SET A LIMIT FOR PROTECTION DCA T1 TAD I DXCOPY DCA DXCOP1 ISZ DXCOPY AC7777 TAD I DXCOPY DCA X1 ISZ DXCOPY TAD I DXCOPY DCA DXCOP2 ISZ DXCOPY AC7777 TAD I DXCOPY DCA X2 ISZ DXCOPY DXCOP1, XX TAD I X1 DXCOP2, XX SNA / ++++ JMP DXCOPX DCA I X2 ISZ T1 JMP DXCOP1 DXCOPX, DCA I X2 CDFMYF JMP I DXCOPY DXBSIZ, -BUFSIZ / / KBOUTC - CROSS FIELD ROUTINE THAT WILL OUTPUT A CHARACTER IF ECHO IS TURNED / ON ELSE OUTPUT A BOX TO THE SCREEN / KBOUTC, XX DCA OUTCHR / CHARACTER IS IN THE AC TO BE PRINTED WHEN CALLED RDF TAD CIDF0 DCA KBOUTX / SET THE RETURN FIELD CDFMYF TAD OUTCHR SNA CLA / ++++ JMP KBOUTX TAD I LPMTFL / IF NEGATIVE ECHO IS TURNED OFF SMA CLA / ++++ JMP KBOUTL JMS I LKBOUT ESC+4000 / ESC /M007 "(+4000 / ( /A007 060+4000 / '0' put in special graphics mode /M017 141+4000 / a (outputs a square box) /M007 ESC+4000 / ESC /M007 "(+4000 /A007 102 / 'B' put back in ascii character set /M017 JMP KBOUTX / RETURN WHEN THE STRING IS SENT KBOUTL, JMS I LKBOUT OUTCHR, 0 / Character to be output. KBOUTX, XX JMP I KBOUTC LPMTFL, PMTTMP LKBOUT, KBOUT / / THIS IS THE LIST OF FLAGS TO CLEAR AT THE STARTOF THE LOW LEVEL ROUTINES / TOCLST / TOCLST, DXOFLG / CLEAR THE FLAG FOR THE OUTPUT JOB TOTM2 / CLEAR THE TIME OUT FLAG TOFL2 / CLEAR THE TIME OUT COUNTER OSEQNO / CLEAR THE OUTPUT SEQUENCE NUMBER SNDTMO / CLEAR THE FLAG FOR THE SEND CHARACTER ROUTINE FOR TIME DXIFLG / CLEAR THE INPUT FLAG ISEQNO / CLEAR THE INPUT SEQUENCE NUMBER NAKFL2 / CLEAR THE NAK FLAG DXNONK / CLEAR THE DONT SEND A NAK ONE HAS BEEN SENT ALREADY FLAG 0 / TERMINATOR / / THE BUFFERS / CMDBUF, ZBLOCK 10 / THE COMMAND BUFFER PTRHE1, 0 / THE NEXT ADDRESS THAT WILL BE RETURNED BY GETPTR PTRHED, ZBLOCK BUFCNT+1 / THE LIST OF PACKETS SENT AND WAITING FOR AN ACK INMBLK, ZBLOCK BUFSIZ+1 / MINUS THE CHECK SUM DOCNBF, ZBLOCK BUFSIZ+2 / SECOND MESSAGE BUFFER USED FOR FILE NAME / AND COMMUNICATIONS BETWEEN THE HOST AND MAIN / / / THIS IS THE BUFFER POOL. BUFBL1 - 5 / / FORMAT: / ADDRESS +0 LINK TO NEXT ENTRY IN LIST / +1 STATUS: 0 = NOTHING, 1 = SENT, -1 = TIMED OUT / +2 - 64 TEXT OF PACKET ASCIIZ FORMAT / / THE USE OF THE POINTER IS TO LINK TOGETHER THE THREE LIST: FREE, SEND / AND RECEIVE. THE LISTS ARE TERMINATED BY A ZERO POINTER. THE STARTING / ADDRESS OF THE LISTS ARE FOUND IN FREEPT, SENDPT, AND RECPT. TO GET A BUFFER / FROM ANY LIST OR TO ADD TO THE LIST THER ARE ROUTINES FOR THIS CALLED / PUTBUF AND GETBUF. / / CALL: / JMS PUTBUF/GETBUF / ADDRESS OF POINTER TO LIST / / ON CALLING PUTBUF THE AC CONTAINS THE STARTING ADDRESS OF THE BUFFER. / / WHEN RETURNING FROM GETBUF THE STARTING ADDRESS OF THE NEXT BUFFER IS IN / THE AC. IF THERE ARE NO BUFFERS GETBUF DOES A NON-SKIP RETURN, ELSE A / SKIP RETURN. / BUFBL1, BUFBL2 / LINK BUFF 1 TO BUFF 2. /A023 ZBLOCK BUFSIZ+6 /M023 BUFBL2, BUFBL3 / LINK BUFF TO TO BUFF 3. /A023 ZBLOCK BUFSIZ+6 /M023 *BUFBL2+2 /LEAVE A COUPLE OF ZERO WORDS AT BEG OF BUFFER /A020 DLYBAS, -1 /BASE CONSTANT FOR DEVLOPING VARIABLE DELAYS /A020 XDLYCT, -1 /DEFAULT MULTIPLIER /A020 XDELAY, XX /A020 CDFMNU /NEED TO ACCESS MENU AREA FOR DELAY ENTRY /A020 TAD I IMNXDL /GET DELAY MULTIPLIER /A020 CDFMYF /A020 CIA /CONVERT TO NEG COUNT /A020 DCA XDLYCT /SET COUNTER /A020 TAD DLYBAS /GET BASE DELAY CONSTANT /A020 ISZ XDLYCT /SKIP WHEN DELAY IS BIG ENOUGH /A020 JMP .-2 /LOOP TILL DELAY MULTIPLIED X TIMES /A020 DCA I IDLY1X /SET NEW BASE DELAY (TIMES X) /A020 TAD I IDLY1X /GET BASE DELAY /A020 TAD I IDLY1X /DEVELOP 3X DELAY /A020 TAD I IDLY1X /A020 DCA I IDLY3X /SET 3X DELAY /A020 TAD I IDLY3X /GET PACKET SEND/RECV TIMEOUT DELAY /A020 TAD I IDLY3X /DOUBLE IT /A020 DCA I IDLY6X /SET 6X DELAY (HOST ACK TIME OUT /A020 TAD I IDLY6X /USE 6X DELAY TO DEVELOP 36X (180)DELAY /A020 TAD I IDLY6X /USE 6X DELAY TO DEVELOP 36X (180)DELAY /A020 TAD I IDLY6X /USE 6X DELAY TO DEVELOP 36X (180)DELAY /A020 TAD I IDLY6X /USE 6X DELAY TO DEVELOP 36X (180)DELAY /A020 TAD I IDLY6X /USE 6X DELAY TO DEVELOP 36X (180)DELAY /A020 TAD I IDLY6X /USE 6X DELAY TO DEVELOP 36X (180)DELAY /A020 DCA I IDLY18 /SET USER RESPONSE TIME DELAY /A020 AC7777 /MAKE SURE 1ST SECOND IS A WHOLE ONE /A020 TAD I IDLY1X /GET SHORT DELAY /A020 DCA I IDLY1X /PUT BACK ADJUSTED DELAY COUNT /A020 AC7777 /SAME PROCEDURE FOR 6X DELAY /A020 TAD I IDLY6X /GET IT /A020 DCA I IDLY6X /DON'T ADJUST 3X DELAY /A020 /D023; CLA /A020 /D023; TAD .-1 /GET A NOP INSTRUCTION /A020 /D023; DCA I ILYINT /OVERLAY JMS TO THIS ONCE ONLY ROUTINE /A020 XDLYEX, JMP I XDELAY /RETURN /A020 IMNXDL, MNXDLY+MUBUF /ADDRESS OF VARIABLE IN MENU AREA /A020 /D023;ILYINT, DLYINT /ADDRESS OF ENTRY JMS TO X DELAY /A020 IDLY1X, DLY1X /ADDRESS OF TIMES ONE CONSTANT /A020 IDLY3X, DLY3X /ADDRESS OF TIMES 3 CONSTANT /A020 IDLY6X, DLY6X /ADDRESS OF 6 etc. /A020 IDLY18, DLY180 /ESTIMATED AT 3 MIN. /A020 *BUFBL2+BUFSIZ+7 /CONTINUE WITH BUFFER DEFINITIONS /A020 BUFBL3, BUFBL4 / LINK BUFF 3 TO BUFF 4. /A023 ZBLOCK BUFSIZ+6 /M023 BUFBL4, BUFBL5 / LINK BUFF 4 TO BUFF 5. /A023 ZBLOCK BUFSIZ+6 /M023 BUFBL5, 0 / BUFF 5 IS GROUNDED BECAUSE IT'S LAST. /A023 ZBLOCK BUFSIZ+6 / / USED FOR THE INPUT ROUTINES FOR CHECKING FOR A VALID ENTRY / TOKOFF, 0 TOKBUF, -7 ZBLOCK 10 /D023;/ /D023;/ THIS IS THE BUFFER USED BY THE DOCUMENT LIST ROUTINE. DX IS ALOWED TO /D023;/ RECEIVE UP TO 8 DOCUMENTS FROM A AX SYSTEM ON REQUEST. THE LIST IS STORED /D023;/ HERE IN THE FORMAT: /D023;/ /D023;/ OPEN CODE -1 = OVERWRITE; 0 = TOP; 1 = BOTTOM /D023;/ /D023;DOCLSA, /D023; ZBLOCK LSTSIZ+1 / / MESSAGES / /THERE IS NO APPARENT REASON TO DO AN ERASE TO END OF LINE SO WE /CAN MAKE THESE TWO COMMAND STRINGS TO IOA THE SAME. ALSO, THIS LITTLE /CHANGE FIXES THE PROBLEM OF PACKET ERRORS WHEN THE 278 IS RECEIVING /A DOCUMENT AT GREATER THAN 600 BAUD. THERE IS STILL A PROBLEM AT 19200 /BAUD. SOMEONE SHOULD LOOK AT IOA TO SEE HOW IT IS DOING THE ERASE TO /END OF LINE AS IT IS THE CULPRIT. WE APPARENTLY LOOSE INPUT CHARACTERS /FROM THE HOST WHEN DOING THE ERASE TO END OF LINE IN A 278 /A009 NUMDIS,/TEXT '^P!L!D' /D009 BLKDS2, TEXT '^P!D' DRVSTR, TEXT /!D/ DATSTR, ZBLOCK 27 / filled in w/ the DATE & TIME string. OKSTMT, IFDEF ENGLSH < TEXT '^P - RECEIVED' > IFDEF ITALIAN < TEXT '^P - RICEVUTO' > IFDEF V30NOR IFDEF V30SWE / MESSTM, IFDEF ENGLSH < TEXT '^P!L&MESSAGE: ^A' > IFDEF ITALIAN < TEXT '^P!L&MESSAGGIO: ^A' > IFDEF V30NOR < TEXT '^P!L&MELDING: ^A' > IFDEF V30SWE < TEXT '^P!L&MEDDELANDE: ^A' > / CONSTM, IFDEF ENGLSH < TEXT '^P!L&CONNECTION ESTABLISHED'> /A031 IFDEF ITALIAN < TEXT '^P!L&CONNESSIONE IN CORSO' > IFDEF V30NOR < TEXT '^P!L&FORBINDELSE OPPRETTET'> IFDEF V30SWE < TEXT '^P!L&UPPKOPPLINGEN \DR KLAR'> PRBSTM, IFDEF ENGLSH < TEXT '^P!L&PROBLEM: ^A'> /A031 IFDEF ITALIAN < TEXT '^P!L&PROBLEMA: ^A' > IFDEF V30NOR IFDEF V30SWE BYESTM, IFDEF ENGLSH < TEXT '^P!L&BYE: ^A' > IFDEF ITALIAN < TEXT '^P!L&BYE: ^A' > IFDEF V30NOR IFDEF V30SWE / MSGPRG, IFDEF ENGLSH < TEXT '^P!L&MESSAGE SENT' > IFDEF ITALIAN < TEXT '^P!L&MESSAGGIO INVIATO' > IFDEF V30NOR < TEXT '^P!L&MELDING SENDT'> IFDEF V30SWE < TEXT '^P!L&ETT MEDDELANDE \DR S\DNT'> / PMTMES, TEXT '^P^A^P' / CLALIN, TEXT '^P!L' BTLINE, TEXT '^A' TIMSTR,/TEXT /^P^A!L/ OUTLN, TEXT '^P!L^A' INITYP, TYPHIT / HAS TO BE JUST BEFORE THE SYSTYP SYSTY1, 0 IFDEF ENGLSH < "Y-200 / Y "o-200 / o "u-200 / u " -200 / "a-200 / a "r-200 / r "e-200 / e " -200 / "c-200 / c "o-200 / o "n-200 / n "n-200 / n "e-200 / e "c-200 / c "t-200 / t "e-200 / e "d-200 / d " -200 / "t-200 / t "o-200 / o " -200 / "a-200 / a " -200 / > / End IFNDEF ENGLSH IFDEF ITALIAN < "C-200 "o-200 "n-200 "n-200 "e-200 "s-200 "s-200 "i-200 "o-200 "n-200 "e-200 " -200 > / End IFDEF ITALIAN IFDEF V30SWE < "K-200 / k "o-200 / o "p-200 / p "l-200 / l "e-200 / e "t-200 / t " -200 / "t-200 / t "i-200 / i "l-200 / l " -200 / "e-200 / e "t-200 / t " -200 / > / End IFDEF V30SWE IFDEF CONDOR < /A021 "D-200 / D CONNECTED TO /A036/M021/A008 "M-200 / M DECMATE /A036/M021/A008 > /END IFDEF CONDOR /A021 IFNDEF CONDOR < /A021 "V-200 / V SET UP MESSAGE /M021/A008 "T-200 / T SAYING THAT CONNECTED /M021/A008 "2-200 / 2 TO A "VT278" IN /A008 "7-200 / 7 AX OR DX MODE /M021/A008 "8-200 / 8 /M021/A008 > /END CONDOR NDEF /A021 " -200 / Space IFDEF ENGLSH < 151 / i 156 / n > IFDEF ITALIAN < "p-200 "e-200 "r-200 > IFDEF V30NOR < " -200 "i-200 / i " -200 > IFDEF V30SWE < " -200 "i-200 / i " -200 > / " -200 / Space / IFDEF ENGLSH < SYSTY2, "D-200 SYSTY3, "X-200 > IFDEF ITALIAN < SYSTY3, "T-200 SYSTY2, "D-200 " -200 "a-200 "t-200 "t-200 "i-200 "v-200 "a-200 > IFDEF V30NOR < SYSTY2, "D-200 SYSTY3, "X-200 > IFDEF V30SWE < SYSTY2, "D-200 SYSTY3, "X-200 > 0 / ENDFD1=. 0 / 1st word of KB: input buffer (INBUFA) /A023 / / USE OF THE AREA PAST ENDFD1 / INBUFA=ENDFD1 / THE END OF THE FIRST FIELD AT ASSEMBLY TIME (ENDFD1) / INPUT FROM THE KEYBOARD (INBUFA) INBUFM=100 / BUFFER MAX ENDINB=INBUFA+INBUFM / THE VALUE OF THE LAST WORD USED FOR THE INPUT BUFFER EXTSPC=ENDINB+1 / THE UNUSED AREA IN THE LAST BLOCK 7400 - 7777 / / THIS IS THE PART OF WPTRNS THAT IS IN THE AREA ENDFD1 TO 7777. THE REASON THAT / IT IS A SEPERATE AREA IS FOR ASSEMBLY REASONS. THIS AREA IS OCUPIED BY / OS-8 SO CANNOT USE WHEN LOADING OUT. FOR THIS REASON IT IS ASSEMBLED OUT / IN FIELD 2 BUT IS LOADED AT THE SAME TIME WPTRNS IS. / IFNDEF DECDEV < FIELD 2 > IFDEF DECDEV < FIELD 4 > *EXTSPC / VALUE FOR THE END OF THIS AREA USED BY BUFFERS / / / DOMENU - Displays the MENU following the point of call. If the menu is / being displayed because of a packet received then the prompt version of / the MENU is displayed. / / /CALL: JMS DOMENU / MENU block # to call. / GOLD MENU return / Normal return / DOMENU, XX CLA / Inititialize. TAD I DOMENU / Get MENU to call. DCA DOMEN2 / ... ISZ DOMENU / Bump to return address. TAD PMTTMP / TELL THE MENU IF CALLED BY A PROMPT CDFMNU DCA I (MUBUF+MNTMP1) TAD AXPMT / THIS SETS FOR A SPECIAL TYPE OF PROMPT NEEDED FOR AX DCA I (MUBUF+MNTMP2) DCA I (MUBUF+MNTMP3) / Initializing call. CDFMYF TAD TOKOFF / First time, use any prior input. DOMEN1, JMS CPYITM / ... JMS BUFSET / CHANGE BUFFER LENGTH TO 64 CHARS. /A032 CIFMNU JMS I MNUCAL DOMEN2, XX JMS BUFRST / RESTORE BUFFER LENGTH /A032 AC7776 / First we check for Gold:MENU return (2). CDFMNU / Map menu field. TAD I (MUBUF+MNTMP3) / Get return value. CDFMYF / Map our field. SNA / Skip if NOT GOLD:MENU. JMP DOMEN4 / JMP to take the GOLD:MENU return. SMA CLA / Skip if have to call menu again. JMP DOMEN3 / Jmp to do final return. TAD (DOCNBF) / 2nd time (& thereafter) use default filename. JMP DOMEN1 / Go process it. DOMEN3, JMS INITKF / init TOKBUF to start of INBUFA area. JMS DXCOPY / copy input CDFMNU / from menu MUBUF+MNIBUF / input area, CDFMYF / to our INBUFA / input area. ISZ DOMENU / Take normal return. DOMEN4, JMP I DOMENU / Return to caller. INITFN, XX / Entry point. TAD AXPMT / See if we're supposed to use 'remembered fnam'' TAD PMTTMP / If both 0 then yes. SZA CLA / Skip if both 0 (ie yes). JMP INIFN2 / Jmp to use current DOCNBF. TAD (DOCNBF) / Create ptr to where to put default filename. DCA SENXXX / Save in an temp. CDFMNU / We're supposed to use 'remembered filename' TAD I (MUBUF+MNDRV) / Get drive of remembered doc. DCA T1 / Save in temp. TAD I (MUBUF+MNFNAM) / Get menu pointer to file name. DCA INIFN0 / save for later. TAD I (MUBUF+MNFNO) / Now see if there is one available. CDFMYF / ... SNA CLA / Skip if yes. JMP INIFN1 / Jmp if no. Set 'NO DEFAULT'. AC7777 / See if drive is drive 1. /A029 TAD T1 / ... /A029 SNA CLA / Skip if no. We must convert & output it/A029 JMP INIFN3 / Don't output default drive 1. /A029 CIFMNU / Convert to ascii. JMS I IOACAL / ... MYROUT / DRVSTR / text string to convert drive number to ascii. T1 / pointer to where it is. INIFN3, JMS DXCOPY / Copy filename string CDFMNU / from menu area, INIFN0, MUBUF+MNFNAM / ... CDFMYF / to our input string area. SENXXX, XX / Address of where to copy filename to. AC7777 / Now to remove terminating space. TAD X2 / X2 was pointing to terminating null. DCA SENXXX / So now SENXXX points to previous character. TAD I SENXXX / See if that prior character is a blank space. TAD (-40) / ... SNA CLA / Skip if no. If yes, then zap it. INIFN1, DCA I SENXXX / Zap Default filename pointer. INIFN2, JMP I INITFN MYROUT, XX / XFLD callable from MENU IOA call. DCA T2 / Save char in our temp. RDF / Get calling field. TAD CIDF0 / Make into a return CDI instruction. DCA MYEXIT / save for exit. CDFMYF / Map our field. TAD T2 / Get character being output. SNA / Skip if not terminator. TAD (".&177) / Convert terminator to a period. DCA I SENXXX / Stuff in buffer. ISZ SENXXX / Bump pointer. MYEXIT, CDIMNU / Return to IOACAL processor. JMP I MYROUT / ... / / / SETSIX - sets the XFIELD call vector in page 0 to their appropriate / values. At startup, the list entries contain the address of the / address (in the BUF field) of the routine. The list starts with / location CLASXA & is terminated with a zero entry. / SETSIX, XX TAD (CLASXA) / get address of list. DCA T1 / Save in a temp. SETSX1, TAD I T1 / Get address of address. SNA / Skip if not done. JMP I SETSIX / Return when done. DCA T2 / Save. CDFBUF TAD I T2 / Get address of routine. CDFMYF DCA I T1 / Save address in vector table. ISZ T1 / Bump to next entry. JMP SETSX1 / Go process it. TRNCN7, JMS RESETS / DISPLAY FIRST SCREEN /A039 JMP MAINL3 / NOW GO TO KB LOOP /A039 /------------ PAGE / / IF SET FOR 102 THEN THE LOG DOCUMENT HAS TO BE UNLOCKED IF USED / /RTN102,XX / / CLA /D017 / CDFBUF / TAD I (AXLRT) / GET THE ADDRESS OF THE ROUTINE THAT WILL UNLOCK / CDFMYF / / DCA T1 / / CIFBUF / UNLOCK LOG FILE / JMS I T1 / / JMP I RTN102 / / / THE SEND AND RECEIVE PART OF AX / AXRRTN, AC0001 AXSRTN, DCA TEMP / ZERO =RECEIVE AND 1 = SEND JMS FIL2BF / FILL THE DOCNBF BUFFER AND RELEASE THIS ONE JMP AXRT3 / SEE IF THE KEYBOARD ROUTINE IS USEING THE MENU AXRT4, JMS INIWAT / DO A JWAIT AND THEN CHECK SPFLAG / HAVE TO CHECK SPFLAG TO AVOID AN INFINITE LOOP JMP HSTWAT / RETURN AND WAIT AT MAIN LOOP AXRT3, TAD DISTMP SZA CLA / ++++ JMP AXRT4 AC7777 / SET FLAG BEFORE ENTERING THIS SECTION /A039 DCA DISTMP / /A039 JMS CLASTA / CLEAR THE FLAGS FOR A TRANSFER /C031 TAD TEMP / TELL THE OTHER FIELD WHICH MODE TO GO TO CIFBUF JMS I AXSRA DOCNBF / THE ADDRESS OF THE POINTER TO THE BUFFER RECEIVED /D039 JMP HSTWAT / NO RETURN JMP AXRTNO / NO RETURN /A039 DCA DOCNO / SAVE THE DOCUMENT NUMBER MQA DCA DOCMOD / AND THE MODIFICATION VALUE AC0002 TAD TEMP / SET THE PROMPT FLAG SO WHEN THE ANSWER PAKCET IS / SENT THE TRANSFER WILL BE ACTIVATED / SINCE IT WILL NOW ACT LIKE THE ANSWER TO A / SEND OR RECEIVE PROMPT DCA PMTTMP TAD TEMP / IF SET FOR RECEIVE OR SEND SET THE CORRECT FLAG SNA CLA / ++++ JMP AXRT2 ISZ SNDAD / SET AX SEND FLAG /D039 JMP HSTWAT JMP AXRTNO / /A039 AXRT2, ISZ AXREC / SET AX RECEIVE FLAG AXRTNO, CLA / /A039 DCA DISTMP / CLEAR DISTMP BEFORE LEAVING /A039 JMP HSTWAT / RELEASE BUFFER / / MDRTN - THE ROUTINE WILL ASK THE DX USER HOW TO MODIFY THE DOCUMENT / ON THE AX SIDE. THE TYPMOD PACKET WILL ONLY BE SENT TO THE DX USER IF THE / DX USER IS SENDING A DOCUMENT TO AX AND THAT DOCUMENT ALREADY EXITS / ON THE AX SIDE. / / THE VALUE OF THE FIRST BYTE OF THE PACKET IS USED TO TELL WHICH / OPTIONS CAN BE CHOSEN. SINCE THE ONLY TWO THAT / MEAN ANYTHING RIGHT NOW IN THE PROGRAM IS TOB AND BOTTOM OR TOB BOTTOM AND / OVERWRITE, THESE TWO CHOICES ARE LOOKED FOR. / / ALL VALUES THAT COULD EXIST IN THE FIRST BYTE / / 40 NONE / 41 TOP / 42 BOTTOM / 43 TOP AND BOTTOM / 47 ALL / / THE VALUES RETURNED IN THE PROMPT ANSWER PACKET IS ALSO THE / FIRST CHARACTER USED. THE VALUES ARE: / / 40 GOLD MENU TYPED / 41 OVERWRITE / 42 TOP / 43 BOTTOM / MDRTN, TAD (-43) / IF NOT TOP AND BOTTOM (43) ASSUME ALL FOR NOW TAD DOCNBF SNA CLA / ++++ AC0001 / 1= TOP AND BOTTOM 0 = ALL JMS ASKMOD / DISPLAY THE OPTIONS DLMA15 / and get the choice. JMS SETOPT / RE-SET OPTIONS & CLA. GOLD MENU IS 40 /A017 TAD (40) / SEND THE RESPONSE PLUS 40 TO MAKE IT A VALID CHARACTER / TO SEND DOWN THE COM LINE. DCA INBUFA DCA INBUFA+1 DCA DOCNBF / Clear out DEFAULT filename. DCA PMTTMP / CLEAR THE FLAG DONT WANT TO ACT LIKE A NORMAL PROMPT AC0001 / SET VALUE FOR RETURN PACKET TYPE JMP SNDPP2 / GO AND SEND RESPONSE / / SNDQIT - WILL SEND A QUIT MESSAGE TO THE OTHER SYSTEM NOT CARING IF THE OTHER / SYSTEM GETS IT OR NOT . IT TELLS THE OTHER SYSTEM THAT THIS USER IS GOING TO / THE MAIN MENU. / /D041SNDQIT, XX /D041 AC7777 / ++++ /D041 JMS HOSTOU / CLEAR THE OUTPUT BUFFER IF THERE IS ANYTHING /D041 CLA / FOR THE SKIP RETURN SNDQT2, / TEST FOR TRANSFER COMPLETE /A041 TAD SENDFL / /A041 SNA CLA / 0 = TRANSFER COMPLETE /A041 JMP SNDQT3 / /A041 TAD (CR) / PACKET TERMINATOR /A041 JMS HOSTOU / SEND IT /A041 CLA / FOR THE SKIP RETURN /A041 SNDQT3, TAD (QUIT) JMS DXOCPK / GENERATE A COMMAND TAD (CMDBUF-1) / SEND IT DCA X1 SNDQIL, TAD I X1 SNA / ++++ JMP SNDQI2 / SEND THE CR JMS HOSTOU JMP DXOSQR / BUFFER FULL RETURN /M041 JMP SNDQIL SNDQI2, TAD (CR) JMS HOSTOU NOP JMP DXOSQR / RETURN TO DX OUTPUT ROUTINE /M041 / / ASKMOD - DISPLAY THE MENU FOR THE OPTIONS TO A DOCUMENT THAT ALREADY / EXISTS. IF MNTMP3 IS SET TO ZERO ALL OPTIONS ARE GIVEN, IF SET TO 1 / THEN ALL BUT OVERWRITE. THIS CAN BE EXPANDED TO DISPLAY ANY COMBINATION / DESIRED, BUT THE ONLY TWO THAT ARE USED ARE THESE. THE MENU IS ONLY SET / FOR THESE TWO OPTIONS BUT THE PROTOCOL CAN HANDLE ANY. / IT CAN BE ALSO CALLED FOR ANY OTHER MENU BESIDES DLMA15. THE MENU IS / FOLLOWS THE CALL AND THE AC CONTAINS THE VALUE TO SET MNTMP3. / THIS IS USEFUL WHEN CALLING DLMA15 BUT CAN BE USED BY ANYONE. / ASKMOD, XX CDFMNU DCA I (MUBUF+MNTMP3) CDFMYF TAD I ASKMOD / Get MENU to call. ISZ ASKMOD / Bump past argument. DCA ASKMO4 / STORE THE MENU TO CALL JMS BUFSET / LIMIT INPUT BUFFER TO 64 CHARS /A032 CIFMNU JMS I MNUCAL / Get option (Top, Bottom, Overwrite) ASKMO4, XX JMS BUFRST / RESTORE BUFFER LENGTH /A032 CDFMNU / Get MNTMP1 response. TAD I (MUBUF+MNTMP1) / ... CDFMYF / Back to our field. SZA / Skip if GOLD:MENU. Return the value. ISZ ASKMOD / OK RETURN JMP I ASKMOD / Return to caller. / / / / THIS ROUTINE WILL CHANGE THE MENU INPUT BUFFER LENGTH TO 64 CHARS. / THIS WORD AT (MNILEN) MUST BE RESTORED UPON RETURN FROM THE MENU CALL / BUFSET, XX / /A032 CLA / /A032 CDFMNU / /A032 TAD I (MUBUF+MNILEN) / FETCH PRESENT LENGTH /A032 CDFMYF / /A032 DCA BUFLEN / SAVE HERE /A032 TAD (-BUFSIZ-1) / A NEG 64 /A032 CDFMNU / /A032 DCA I (MUBUF+MNILEN) / INSTALL VALUE /A032 CDFMYF / /A032 JMP I BUFSET / /A032 / / / / THIS ROUTINE WILL RESTORE THE MENU BUFFER LENGTH THAT WAS / / CHANGED BY BUFSET / / BUFRST, XX / /A032 CLA TAD BUFLEN / FETCH OLD VALUE /A032 CDFMNU / /A032 DCA I (MUBUF+MNILEN) / BACK INTO MENU FIELD /A032 CDFMYF / /A032 JMP I BUFRST / /A032 BUFLEN, 0 / STORAGE FOR BUFFER LENGTH /A032 /------------- PAGE   / WPPARS--PARSER FOR SPECIFICATION OF SEARCH AND SELECT / / 018 RCME 03-Jul-85 Re-program comparison of keywords / to give greater flexibility in / changing text for foreign versions / 017 RCME 03-APR-85 Enable parsing of technical and / multinational characters. Fix dead / key blot substitution. / / ----------------------- All below refer to V2.0 and earlier -------------- / / 016 HLP 13-SEP-83 Delete PRLOCK, DECmate is single user / WPPARS CONSTANTS CR=15 / CARRIAGE RETURN LF=12 / LINE FEED CDFMYF=CDFEDT / This routine runs in the EDITOR FIELD FIELD 3 *100 / FIRST 100 LOCATIONS ARE USED FOR THE SYSTEM DCAGPB=JMS I .;XDCAGP / Routine to access the GPBUF in LP field/a017 TADGPB=JMS I .;XTADGP / Routine to access the GPBUF in LP field/a017 ORPTR, 0 TOEFLG, 0 ERRCNT, 0 DISDKY, 0 DISCNT, -121 NEGSPC, -40 /a017 PZERR, ERR / GENERAL ERROR MESSAGE PZNRM, NOROOM / NO MORE ROOM MESSAGE NUMFLD, 0 / NUMERICAL FIELD FLAG 0=NOT A NUMERIC FIELD / ELSE IS A NUMERIC FIELD X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE / PARSES A SPEC FILE AND LOADS THE RESULT INTO CORE. PARSE, XX CDFBUF / BUFFER FIELD HAS FILE NUMBERS CLA TAD I (FORMNO) / GET FORM FILE NUMBER CDFMYF / SET DATA FIELD SNA CLA / 0, MEANING JUST TEST SPEC SYNTAX? AC7777 / YES, SET FLAG TO TEST MODE DCA TOEFLG / SET OR CLEAR FLAG CIFMNU / OVERLAY THE SELCT PROGRAM JMS I OLAYCL / INTO FIELD 5 7 DCA ERRCNT / CLEAR ERROR COUNT DCA DISDKY / AND DEADKEY FLAG TAD (-121) / SET LINE COUNTER FOR DISPLAY ROUTINE DCA DISCNT JMS CLS / CLEARS SCREEN AND HOMES CURSOR CDFBUF / STORED IN BUFFER FIELD TAD I (SPCADR) / GET SPEC FILE NUMBER DCA ORPTR / STORE ANY PLACE LOCAL TAD I ORPTR / FOR INDIRECT CDFMYF / BACK HOME DCA SPECNO TAD SPECNO CIFFIO / OPEN FILE FOR READING FILEIO / XRDFIN TAD (SPECTB-1) / SET-UP SPEC TABLE PTR DCA SPCPTR TAD (SPCTBS+1) / AND COUNTER CIA DCA SPCCNT TAD (SYMTAB) / SET-UP SYMBOL TABLE PTR DCA SYTPTR TAD (SYTBSZ+1) / AND COUNTER CIA DCA SYTCNT TAD (CHRCOR-1) / SET-UP CHARACTER SPACE PTR DCA CHRPTR TAD (CHRCSZ+1) / AND COUNTER CIA DCA CRCNT JMS PSTSYM / STORE TRAILING 0 IN SYMBOL TABLE JMP I PZNRM / NO ROOM JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE IFDEF ENGLSH < TAD ("P-200) / SEE IF CHAR IS 'P' ? > IFDEF ITALIAN < TAD ("E-200) / SEE IF CHAR IS 'E' ? > JMS PCMPAR / COMPARE JMP PIF1 / NO, MUST START WITH 'IF' THEN JMP PTHEN1 / YES, FINISH PARSE PIF, JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE PIF1, IFDEF ENGLSH / SEE IF CHAR IS 'I' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE IFDEF ENGLSH / SEE IF CHAR IS 'F' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN TAD (4001) / STORE -1 FOR IF TYPE PAMLP, JMS PSTSPC JMP I PZNRM / NO ROOM JMS PRSFN / GO FIND AND STORE A FN IN THE SYM TAB JMP I PZERR / PROBLEMS!! AC0001 / STORE 1 FOR OR-COUNT JMS PSTSPC JMP I PZNRM / NO ROOM TAD SPCPTR / GET LOCATION OF OR-COUNT DCA ORPTR / AND SAVE IT POR, JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE TAD ("=-200) / SEE IF CHAR IS '=' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PRSTRG / GO STORE STRING (FIELD) JMP I PZERR JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE TAD ("O-200) / SEE IF CHAR IS 'O' ? JMS PCMPAR / COMPARE JMP PTHEN / NO MATCH RETURN, SEE IF THEN STATEMENT JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE / THE FOLLOWING 7 LINES WHERE MOVED HERE FROM ANOTHER PAGE IFDEF ENGLSH < TAD ("R-200) / SEE IF CHAR IS 'R' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN > CDFLP / ADD ONE TO OR-COUNT ISZ I ORPTR CDFMYF JMP POR / AND STORE STRING SPECNO, 0 / SPEC FILE NUMBER ERRMTB, S2NRM S1SYN S0NUM / 'ERROR IN NUMBER' X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE PTHEN, TAD THENST / GET THE FIRST CHARACTER TO COMPARE /A018 JMS PCMPAR / COMPARE /A018 JMP PBUTN / NO MATCH, SEE IF NOT COMMAND /A018 TAD (THENST+1) / GET THE START OF THE STRING /A018 DCA THENCT / SAVE IT IN THE COUNTER /A018 PTHENL, TAD I THENCT / GET THE NEXT CHARACTER TO COMPARE /A018 SNA CLA / IS THIS THE END OF THE STRING? /A018 JMP THENOK / YES, FINISHED COMPARE /A018 JMS PGTCHR / GET A CHARCTACTER /A018 JMP I PZERR / EOF /A018 MQL / SAVE FOR COMPARE /A018 TAD I THENCT / GET THE OTHER CHAR BACK /A018 JMS PCMPAR / NO, DO THE COMPARE /A018 JMP I PZERR / NO MATCH FOUND /A018 ISZ THENCT / INCRAMENT THE STRING POINTER /A018 JMP PTHENL / GO ROUND FOR THE NEXT CHARACTER /A018 THENOK, /D018 PTHEN, TAD ("T-200) / SEE IF CHAR IS 'T' ? /D018 JMS PCMPAR / COMPARE /D018 JMP PBUTN / NO MATCH, SEE IF BUT NOT /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("H-200) / SEE IF CHAR IS 'H' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("E-200) / SEE IF CHAR IS 'E' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("N-200) / SEE IF CHAR IS 'N' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("P-200) / SEE IF CHAR IS 'P' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN PTHEN1, TAD (ROCEST) / GET THE ADDRESS OF THE COMPARISON STRING/A018 DCA PROCCT / SAVE IT /A018 ROCESL, TAD I PROCCT / GET THE CHAR TO COMPARE AGAINST /A018 SNA CLA / IS THIS THE END OF THE COMPARISON? /A018 JMP PROCOK / YES, EXIT COMPARE /A018 JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE /M018 TAD I PROCCT / GET ORIGINAL CHARACTER BACK /A018 JMS PCMPAR / COMPARE /A018 JMP I PZERR / NO MATCH RETURN /A018 ISZ PROCCT / MOVE TO NEXT CHARACTER /A018 JMP ROCESL / AND LOOP /A018 /D018 TAD ("R-200) / SEE IF CHAR IS 'R' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("O-200) / SEE IF CHAR IS 'O' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("C-200) / SEE IF CHAR IS 'C' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("E-200) / SEE IF CHAR IS 'E' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("S-200) / SEE IF CHAR IS 'S' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("S-200) / SEE IF CHAR IS 'S' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("R-200) / SEE IF CHAR IS 'R' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("E-200) / SEE IF CHAR IS 'E' ? /D018 JMS PCMPAR / COMPARE /D018 /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("C-200) / SEE IF CHAR IS 'C' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("O-200) / SEE IF CHAR IS 'O' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("R-200) / SEE IF CHAR IS 'R' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("D-200) / SEE IF CHAR IS 'D' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN PROCOK, JMS PGTCHR / GET A CHAR JMP PARDN / EOF, DONE SPEC MQL / SAVE FOR COMPARE TAD (SPECTB-1) / SEE IF SPECTB IS EMPTY CIA TAD SPCPTR SNA CLA JMP I PZERR / NO, CAN ONLY HAVE 'PROCESS RECORD' JMP PORIF / YES, SEE IF 'OR IF' PROCCT, / COUNTER INTO ROCESS RECORD STRING /A018 THENCT, 0 / COUNTER INTO THEN STRING /A018 THENST, IFDEF ENGLSH < "T-200; "H-200; "E-200; "N-200; "P-200; 0> /A018 IFDEF ITALIAN< "A-200; "L-200; "L-200; "O-200; "C-200; "A-200; "E-200; 0> ROCEST, IFDEF ENGLSH < "R-200; "O-200; "C-200; "E-200; "S-200; "S-200; /A018 "R-200; "E-200; "C-200; "O-200; "R-200; "D-200; 0> /A018 IFDEF ITALIAN< "L-200; "A-200; "B-200; "O-200; "R-200; "A-200; "I-200; "L-200 "R-200; "E-200; "C-200; "O-200; "R-200; "D-200; 0> X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE PORIF, TAD ("O-200) / SEE IF CHAR IS 'O' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN IFDEF ENGLSH < JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE TAD ("R-200) / SEE IF CHAR IS 'R'? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN > JMP PIF / LOOP BACK TO BEGINNING PBUTN, IFDEF ENGLSH / SEE IF CHAR IS 'B' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP PAND / NO MATCH RETURN, SEE IF AND TYPE JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE IFDEF ENGLSH / SEE IF CHAR IS 'U' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE IFDEF ENGLSH / SEE IF CHAR IS 'T' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE IFDEF ENGLSH / SEE IF CHAR IS 'N' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE IFDEF ENGLSH / SEE IF CHAR IS 'O' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE IFDEF ENGLSH / SEE IF CHAR IS 'T' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE IFDEF ENGLSH / SEE IF CHAR IS 'I' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN IFDEF ENGLSH < JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE TAD ("F-200) / SEE IF CHAR IS 'F' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN > TAD (2003) / STORE 3 FOR BUT NOT IF TYPE JMP PAMLP PAND, IFDEF ENGLSH / SEE IF CHAR IS 'A' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN IFDEF ENGLSH < JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE TAD ("N-200) / SEE IF CHAR IS 'N' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE TAD ("D-200) / SEE IF CHAR IS 'D' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN > TAD (4002) / STORE -2 FOR AND TYPE JMP PAMLP / LOAD WORD IN AC INTO SPEC TABLE USING SPCPTR AS A PTR. / SKIP RETURNS IF STORED, JUST RETURNS IF NO ROOM PSTSPC, XX ISZ SPCCNT / ANY ROOM LEFT JMP .+2 JMP I PSTSPC / NO, ERROR RETURN CDFLP / GET TO RIGHT FIELD DCA I SPCPTR / STORE CDFMYF / BACK TO LEFT FIELD ISZ PSTSPC / MAKE RETURN SUCCESSFUL JMP I PSTSPC / RETURN SPCCNT, 0 / LOAD WORD IN AC INTO SYMBOL TABLE, DOES NOT INCREMENT SYTPTR / SKIP RETURNS IF STORED, JUST RETURNS IF NO ROOM PSTSYM, XX DCA PSYMCR / SAVE CHAR ISZ SYTCNT / ANY ROOM LEFT JMP .+2 JMP I PSTSYM / NO, ERROR RETURN TAD SYTPTR / YES, GET ADDR TO STORE INTO DCA PSYMTP / SAVE FOR INDIRECT TAD PSYMCR / GET BACK CHAR CDFLP / GET TO RIGHT FIELD DCA I PSYMTP / STORE CDFMYF / BACK TO LEFT FIELD PSTSYR, ISZ PSTSYM / MAKE RETURN SUCCESSFUL JMP I PSTSYM / RETURN PSYMCR, 0 PSYMTP, 0 SYTCNT, 0 / LOAD WORD IN AC INTO CHARACTER CORE USING CHRPTR AS A PTR. / SKIP RETURNS IF STORED, JUST RETURNS IF NO ROOM PSTCHR, XX ISZ CRCNT / ANY ROOM LEFT JMP .+2 JMP I PSTCHR / NO, ERROR RETURN CDFLP / GET TO RIGHT FIELD DCA I CHRPTR / STORE CDFMYF / BACK TO LEFT FIELD ISZ PSTCHR / MAKE RETURN SUCCESSFUL JMP I PSTCHR / RETURN CRCNT, 0 X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE / READS A FIELD NAME, CHECKS TO SEE IF IT IS ALREADY IN THE SYMBOL TABLE, LOADS / IT INTO THE SYMBOL TABLE AND STORES A PTR TO THE ENTRY IN THE SPEC TABLE. PRSFN, XX CLA JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE TAD ("<-200) / SEE IF CHAR IS '<' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN TAD (GPBUF-1) / SET-UP PTR IN AUTO-INDEX DCA GPPTR TAD (GPBSIZ+1) / SET-UP SIZE COUNTER CIA DCA GPCNT AC7777 JMS PGTCHR / GET NEXT CHAR JMP I PRSFN / EXIT IF END OF FILE DCA PFNCHR / SAVE IT TAD PFNCHR / IF CHAR=':' TAD (-":+200) / SNA CLA / AC0001 / THEN NUMFLD = 1 ( IS A NUMERIC FIELD) DCA NUMFLD / ELSE NUMFLD = 0 (NOT A NUMERIC FIELD) JMP LFNLP1 / CONTINUE WITH NEXT CHARACTER LFNLP, AC7777 / SET FLAG TO GET 'ALL' CHARS JMS PGTCHR / GET NEXT CHAR JMP I PRSFN / EOF DCA PFNCHR / SAVE IT LFNLP1, TAD PFNCHR TAD (-76) / SEE IF '>' SNA JMP LFNDN / YES, DONE FIELD TAD (2) / SEE IF '<' SNA CLA JMP ERR1 / YES, NOT ALLOWED TAD DISDKY / Check the dead key status /a017 SNA CLA / Are we processing a dead key sequence?/a017 ISZ GPCNT / NO, SEE IF ROOM JMP .+2 JMP ERR2 / NO, SO TELL USER TAD PFNCHR / GET BACK CHAR DCAGPB / AND STORE IN STRING JMP LFNLP / LOOP BACK FOR MORE LFNDN, TAD GPCNT / GET COUNT OF WORDS USED TAD (GPBSIZ+1) SNA JMP NULL / EOR, JUST '<>' FOUND DCA FNCNT / SAVE FN LENGTH DCAGPB / STORE TRAILING 0 TAD (SYMTAB-1) / GET SYMBOL TABLE ADR - 1 DCA SYTPTR / PUT IN AUTO-INDEX SYTBLK, CDFLP / GO TO WHERE THE TABLE IS TAD I SYTPTR / GET AN ENTRY CDFMYF / COME BACK SNA JMP PNFN / LAST ONE, SO MAKE A NEW ENTRY DCA SYTSRC / OTHERWISE, STORE FOR COMPARE TAD FNCNT / GET SIZE OF FN TO SEARCH JMS XSCMP / SEE IF MATCHES GPBUF SYTSRC, XX CDFLP / FIELD OF SYMTAB FOR COMPARE SZA CLA JMP POFN / YES, FOUND AN ENTRY ISZ SYTPTR / NOPE, BUMP PTR JMP SYTBLK / TRY NEXT ENTRY POFN, CDFLP / DON'T FORGET TO CHANGE FIELDS ! TAD I SYTPTR / GET ADDR FN POINTS TO CDFMYF / AND TO CHANGE FIELD BACK JMS PSTSPC / STORE LINK IN SPEC TAB JMP I PZNRM / NO ROOM TAD SPCPTR / GET ADDR OF SPEC ENTRY JMS PSTSYM / AND MAKE IT NEW FN PTR IN SYM TAB JMP I PZNRM / NO ROOM ISZ PRSFN / NO ERRORS, RETURN JMP I PRSFN PNFN, TAD (GPBUF-1) / RESET GP PTR DCA GPPTR AC0001 / GET ADDR THAT FN WILL BE TAD CHRPTR / IN CHR CORE JMS PSTSYM / AND STORE AS PTR TO FN JMP I PZNRM / NO ROOM ISZ SYTPTR / BUMP PTR PNFNLP, TADGPB / GET A CHAR SNA / LAST ONE? JMP PNFNDN / YES, STORE FINAL STUFF JMS PSTCHR / NO, STORE CHARACTER JMP I PZNRM / NO ROOM JMP PNFNLP / BACK FOR MORE PNFNDN, JMS PSTCHR / STORE TRAILING 0 JMP I PZNRM / NO ROOM JMS PSTSPC / STORE 0 LINK JMP I PZNRM / NO ROOM TAD SPCPTR / GET ADDR OF SPEC ENTRY JMS PSTSYM / STORE IN SYM TAB AS FN PTR JMP I PZNRM / NO ROOM ISZ SYTPTR / BUMP PTR AC7777 / DON'T COUNT TRAILING ZERO TAD SYTCNT / AS PART OF SYMBOL TABLE COUNTER DCA SYTCNT JMS PSTSYM / STORE FINAL 0 JMP I PZNRM / NO ROOM ISZ PRSFN / NO ERRORS RETURN JMP I PRSFN NULL, AC7777 / -1 FOR EOR JMP I PZERR ERR2, AC0001 / 2FOR FIELD NAME TOO LARGE ERR1, IAC / 1FOR '<' FOUND BEFORE '>' IN FN JMP I PZERR FNCNT, 0 GPCNT, 0 PFNCHR, 0 X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE / DOES A MATCH OF AN ASCII AND AN ASCIZ STRING. RETURNS AC OF 0 IF FAILED / AND -1 IF MATCHES. CALLED WITH AC EQUAL TO NUMBER OF CHARACTERS IN THE / 1ST STRING (ASCII) TO TRY TO MATCH / JMS XSCMP / ADDR OF 1ST STRING -ASCII (ALWAYS THSFLD) / ADDR OF 2ND STRING -ASCIZ / FIELD FOR 2ND STRING / RETURN (TO THSFLD) XSCMP, XX CIA / MAKE NEGATIVE NUMBER OF CHARS TO SEARCH DCA XSCNT AC7777 TAD I XSCMP / GET ADDR OF 1ST STRING DCA TAI1 / SET-UP AUTO-INDEX ISZ XSCMP / MOVE TO NEXT ARG AC7777 TAD I XSCMP / ADDR OF SECOND STRING DCA TAI2 ISZ XSCMP TAD I XSCMP / GET CDF FOR STRINGS /m017 DCA XSCLP / SET-UP TO EXECUTE TAD XSCLP / Also for 1st string /a017 DCA XS1CLP / /a017 ISZ XSCMP / MAKE SURE WE RETURN TO THE RIGHT PLACE TAD XSCLP / GET THE CDF BACK DCA XSCLP1 / AND STORE CAUSE WE'LL NEED IT AGAIN XSCLP, XX / FOR THE CDF TAD I TAI2 / CHAR FROM 2ND STRING CDFMYF / BACK TO HOME FIELD SNA / SEE IF END OF STRING JMP I XSCMP / YES, SO RETURN WITH 0 IN AC CIA / NO, NEGATE XS1CLP, XX / For the CDF /a017 TAD I TAI1 / CHAR FROM 1ST STRING CDFMYF / Back to home field /a017 SZA CLA / ARE THEY THE SAME? JMP I XSCMP / NOPE, RETURN WITH A 0 IN AC ISZ XSCNT / DID WE LOOK AT ENOUGH CHARS? JMP XSCLP / NO, COMPARE SOME MORE XSCLP1, XX / YES, DO THE CDF TAD I TAI2 / MAKE SURE WE'RE AT THE END CDFMYF / BACK TO HOME FIELD SNA CLA / 0, FOR NOT AT THE END OF STRING AC7777 / -1 FOR SUCCESS JMP I XSCMP / RETURN XSCNT, 0 / READS IN A CHARACTER AND RETURNS IT IN THE AC / IF AC=0 THEN IGNORES ALL BLANKS, TABS, RULERS, ETC. / IF AC= -1 THEN ONLY DELETES RULERS, FUNNY SPACES AND LINE FEEDS / CALLED BY: / JMS PGTCHR / EOF RETURN (AC UNDEFINED) / REGULAR RETURN (AC CONTAINS CHAR) PGTCHR, XX DCA PGTDLA / SAVE FLAG PGTLP, JMS RDNXCH / GET A CHAR JMP I PGTCHR / EOF, GIVE RETURN DCA SSCHAR / SAVE CHAR TAD SSCHAR AND P177 / NO CONTROLS TAD (-41) / SEE IF PRINTING CHAR SPA JMP SSPCHR / NOPE, SPECIAL TAD (41) / YES, GET CHAR BACK JMS DISCHR / SHOW CHAR ON SCREEN ISZ PGTCHR / MAKE RETURN NORMAL JMP I PGTCHR / AND RETURN SSPCHR, TAD (25) / NO, SEE IF A FF (14) SNA JMP SSCPC / YES, NOW CHECK IF SPECIAL TAD (-2) / NO, WHAT ABOUT START OF RULER (16) SNA CLA JMP SSDLRR / YES, GO DELETE RULER TAD SSCHAR / NO, GET CHAR BACK AND (7600) / SEE IF HIGH PART ON SZA CLA JMP PGTLP / YES, SO IGNORE IT TAD SSCHAR / NO, GET CHAR ONCE MORE TAD (-7) / SEE IF ^G (MODIFIED FLAG) ? SNA CLA JMP PGTLP / YES, JUST IGNORE PGTCRR, TAD SSCHAR / GET CHAR TO RETURN WITH JMS DISCHR / SHOW CHAR ON SCREEN MQL / SAVE CHAR TAD PGTDLA / CHECK DELETE 'ALL' FLAG SNA CLA JMP PGTLP / YES, IGNORE CHARACTER MQA / NO, GET CHAR BACK ISZ PGTCHR / BUMP RETURN JMP I PGTCHR / RETURN SSCPC, TAD SSCHAR / SEE IF START OF PRINTER CONTROL TAD (-1014) SZA CLA / YES, GO SKIP ENTIRE THING JMP PGTCRR / NO, MUST HAVE BEEN NORMAL FF SSCPC1, JMS RDNXCH / GET A CHAR JMP I PGTCHR / ERROR, EOF TAD (-1414) / SEE IF END YET SZA CLA JMP SSCPC1 / NO, KEEP LOOKING JMP PGTLP / YES, BACK TO NORMAL PROCESSING SSDLRR, JMS RDNXCH / GET A CHAR JMP I PGTCHR / ERROR TAD (-17) / END OF RULER? SZA CLA JMP SSDLRR / NO, KEEP LOOKING JMP PGTLP / YES, BACK TO NORMAL PROCESSING SSCHAR, 0 PGTDLA, 0 RDNXCH, XX / SIMULATE RDFIL CLA CIFFIO / FILEIO / XRDFNC SZA ISZ RDNXCH JMP I RDNXCH OUTCHR, XX / OUTPUTS THE CHAR IN THE AC TO THE SCREEN AND P377 JMP OUTCH2 OUTCH1, CIFSYS / ++++ JWAIT OUTCH2, CIFSYS / ++++ TTYOU JMP OUTCH1 CLA JMP I OUTCHR IFDEF FRENCH < FS1SYN, / a"GRAV A" appears between the above and the below in french TEXT " PARTIR DE CE POINT" /L.A.E, L.G.A > IFDEF CANADA < CS1SYN, / aL.G.A appears before this string (pretend) TEXT " PARTIR DU SIGNE ^." > X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE / The GPBUF has been moved to Field 5 (the LP field) to allow /a017 / space to handle multinational and technical characters in field /a017 / names. /a017 / /d017 GPBUF, ZBLOCK GPBSIZ+1 DISCHR, XX / DISPLAYS CHAR IN AC ON SCREEN (WITH CR, LF SEQUENCES) DCA DISSCR / SAVE CHAR TAD DISSCR / CHECK FOR CR RIGHT AWAY TAD (-15) SNA CLA JMP DISLIV / YES, END OF DEADKEY TAD DISDKY / SEE IF IN MIDDLE OF DEADKEY SEQUENCE SZA CLA JMP INDEAD / YES, DEAL WITH CHARACTER /M017 TAD DISSCR TAD (-10) / BACKSPACE ? SNA JMP DISDOA / YES, START OF DEADKEY TAD (10-12) / SEE IF LF SZA CLA JMP DISCH1 / NO JMS DISCLF / YES, OUTPUT A CR-LF DISCH3, TAD DISSCR / GET CHAR BACK JMP I DISCHR / AND RETURN DISCH1, ISZ DISCNT / END OF LINE ANYWAY ? JMP DISCH2 / NO JMS DISCLF / YES, OUTPUT CR-LF AND RESET COUNTER JMP DISCH1 / TRY AGAIN DISCH2, TAD DISSCR / GET CHAR DISOAL, JMS OUTCHR / OUTPUT IT /M017 JMP DISCH3 / AND RETURN DISDOA, AC7777 / SET THE DEAD KEY FLAG DCA DISDKY /D017 JMS OSTRG / GOTO OUTPUT STRING ROUTINE /D017 ESC / START ESCAPE SEQUENCE TO SCREEN /D017 "[-200 / NEED "[" ONLY IN ANSI MODE /D017 "F-200 / "F" MEANS GOTO GRAPHIC CHARACTER SET /D017 "G-140 / DEADKEY SYMBOL /D017 ESC / GO BACK TO ANSI CHARACTER SET /D017 "[-200 / NEAD "[" ONLY IN ANSI MODE /D017 "G-200+4000 / G (+4000 MEANS END OF STRING) JMP DISCH3 / GET CHAR BACK AND RETURN DISLIV, DCA DISDKY / TURN OFF DEADKEY FLAG TAD (17) / OUTPUT SI IF DEAD KEY FINISHED TO /A017 / CLEAN UP AFTER LINE DRAWING SET MODE /A017 JMP DISOAL / CHAR BACK AND RETURN /M017 DISCLF, XX / OUTPUTS A CR-LF AND RESETS DISCNT BACK TO A FULL LINE JMS OSTRG / OUTPUT STRING ROUTINE CR / CARRIAGE RETURN LF+4000 / LINE FEED (4000 MEANS END OF STRING) TAD (-121) / RESET LINE COUNTER DCA DISCNT JMP I DISCLF / AND RETURN DISDCH, CLL RAL / Check that this is the 3rd character /a017 SNA CLA / Is this 3rd character? /a017 JMP DISCH2 / Yes, output it. /a017 JMP DISCH3 / No, accept and ignore it as is /a017 / trailing rubbish. /a017 GLDSPC, AC4000 / Deal with GOLD spaces. Is not dead key/a017 DCA DISDKY / sequence, so set flag to ignore rest. /a017 JMP DISCH2 / Display the space. /a017 /**************************************************************************** / / The following code handles dead key sequences found in the /a017 / list processing document. Technical and multinational /a017 / characters are now displayed using the correct character sets /a017 / and user dead key sequences are depicted by the conventional /a017 / blot rather than the +/- symbol previously used. /a017 / /**************************************************************************** INDEAD, ISZ DISDKY / This piece of code is used for each /a017 / character within the dead key sequence/a017 / Is this the first character in sequence?/a017 JMP INDNOT1 / No, deal with others /a017 ISZ DISDKY / Yes, set the dead key flag again /a017 TAD DISSCR / Get the character /a017 TAD NEGSPC / Test for space character /a017 SNA CLA / Is it a space? /a017 JMP DISCH3 / Yes, accept and forget it /a017 JMS OSTRG / Output the escape sequence to send a /a017 ESC / blob to the screen. /a017 "[-200 / ESC [ F puts us into graphics mode /a017 "F-200 / /a017 "a-200 / "a" in line drawing set is blob /a017 ESC / ESC [ G returns us to ASCII mode /a017 "[-200 / /a017 "G-200+4000 / +4000 is the end of string marker /a017 AC4000 / Set top bit of the dead key flag to /a017 DCA DISDKY / indicate a user dead key that requires/a017 JMP DISCH3 / no further processing /a017 INDNOT1,TAD DISDKY / Check the top bit of the flag for user/a017 SPA / Is this a user dead key sequence? /a017 JMP DISCH3 / Yes, ignore all further characters. /a017 CLL RTR / No, test for the 2nd char in sequence /a017 SZA / Is this the 2nd character? /a017 JMP DISDCH / No, its a later one. /a017 TAD DISSCR / Yes, get it. /a017 TAD NEGSPC / Test for a GOLD space /a017 SNA / Is it a GOLD space? /a017 JMP GLDSPC / Yes, deal with it /a017 TAD (-23) / No, test character set specifier /a017 SNA / Is it a technical character? /a017 JMP DISDTC / Yes, go send a SS3 /a017 IAC / Test for multinational character set /a017 SNA CLA / Is it multinational? /a017 JMP DISDMC / Yes, output a SS2 /a017 JMP DISDLC / No, is line drawing, so output SO /a017 DISDTC, AC0001 / Build value 217 for technical char /a017 DISDMC, TAD (200) / Build value 216 for multinational char/a017 DISDLC, TAD (16) / Build value 16 for a line drawing char/a017 JMP DISOAL / Output the built value to the screen /a017 DISSCR, 0 PARDN, JMS PSTSPC / STORE FINAL 0 IN SPEC TABLE JMP I PZNRM / NO ROOM TAD TOEFLG / TEST MODE? SZA CLA JMP NOERRT / YES, RETURN TO MAIN MENU TAD PARSE / NO, STORE AWAY RETURN ADDR CDFBUF DCA I (RETADR) CDILP / NOW GET TO RIGHT FIELD JMP I (SELINI) / AND JUMP TO START OF SELECT PROGRAM XDCAGP, XX / Routine to store AC to GPBUF in LP field/a017 CDFLP / Change to LP data field /a017 DCA I GPPTR / Save at the word pointed to /a017 CDFMYF / Back to home field /a017 JMP I XDCAGP / And return /a017 XTADGP, XX / Routine to add word in GPBUF to AC /a017 CDFLP / Change to LP data field /a017 TAD I GPPTR / Add word pointed to by GPPTR /a017 CDFMYF / Back to home field /a017 JMP I XTADGP / Return /a017 X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE / STORES A STRING IN CHAR CORE / CALLED BY: / JMS PRSTRG / EOF RETURN / REGULAR RETURN PRSTRG, XX AC0001 / GET PTR TO STRING IN CHR CORE TAD CHRPTR JMS PSTSPC / AND STORE IN STRING PTR WORD OF SPEC JMP I PZNRM DCA PSCNT / INIT S-COUNT DCA PMCNT / M-COUNT DCA PECNT / AND E-COUNT TAD (ISZ PSCNT) / INIT ISZ WORD DCA PCNTWD AC7775 / AND NUMBER OF <*> ALLOWED DCA PRWCNT PRSTLP, AC7777 / SET FLAG TO GET 'ALL' CHARS JMS PGTCHR / GET A CHAR PRSTRT, JMP I PRSTRG / EOF, GIVE ERROR RETURN TAD (-12) / SEE IF NEWLINE SNA JMP PRSTDN / YES, END OF STRING TAD (-62) / NO, SEE IF '<' ? SNA JMP PRSTWC / YES, PARSE WILD CARDS AND NUMBERS TAD (12+62) / NO, GET CHAR BACK PRSTL1, JMS PSTORE / AND STORE IT AWAY JMP I PZNRM / NO ROOM JMP PRSTLP / BACK FOR MORE PRSTWC, AC7777 / SET FOR 'ALL' CHARS JMS PGTCHR / GET CHAR JMP I PRSTRG / EOF, ERROR RETURN TAD (-52) / SEE IF '*' ? SNA JMP PRSTW1 / YES, BUMP TO NEXT COUNT WORD TAD (-25) / NO, SEE IF '?' ? SZA JMP PRSTNM / MUST BE A NUMBER PRSTW3, AC7777 JMS PGTCHR / GET CHAR JMP I PRSTRG / EOF, RETURN TAD (-77) / SEE IF ANOTHER '?' ? SNA JMP PRSTW2 / YES, GO STORE IT IAC / NO, BETTER BE '>' SZA CLA JMP I PZERR / NO, ERROR AC7777 / YES, STORE CODE FOR ? WILD CARD JMP PRSTL1 PRSTW1, ISZ PRWCNT / BUMP WILD CARD COUNT JMP .+2 JMP I PZERR / TOO MANY <*> WILD CARDS AC7777 JMS PGTCHR / GET CHAR JMP I PRSTRG / EOF, RETURN TAD (-76) / BETTER BE '>' SZA CLA JMP I PZERR / NO, ERROR ISZ PCNTWD / MOVE COUNTER TO NEXT WORD JMP PRSTLP / PROCESS REST OF LINE PRSTW2, AC7777 / STORE CODE FOR ? WILD CARD JMS PSTORE JMP I PZNRM / NO ROOM JMP PRSTW3 / LOOK FOR MORE '?' PRSTDN, AC0001 / SEE IF ANY WILD CARDS TAD PRWCNT SZA JMP PRSTD1 / 0OR 1, GO HANDLE PRSTD4, TAD PSCNT / 3, GET S-COUNT CIA / NEGATE CAUSE ALPHANUMERIC PRSTD2, JMS PSTSPC / AND STORE IN SPEC S-COUNT JMP I PZNRM / NO ROOM TAD PMCNT / SAME FOR M-COUNT CIA JMS PSTSPC JMP I PZNRM TAD PECNT / GET E-COUNT CIA PRSTD5, JMS PSTSPC / AND STORE IT JMP I PZNRM ISZ PRSTRG / NORMAL RETURN JMP I PRSTRG PRSTD1, IAC / DETERMINE IF ANY WILD CARDS SNA CLA JMP PRSTD3 / YES, 1, GO SWITCH COUNTS TAD PSCNT / 0IF NULL SEARCH, COUNT IF PLAIN SEARCH DCA PECNT / STORE IN E-COUNT AC0002 / STORE -2 IN M-COUNT DCA PMCNT AC0001 / STORE +1 IN S-COUNT JMP PRSTD2 / GO STORE PRSTD3, TAD PMCNT / DON'T REALLY WANT THIS IN M-COUNT DCA PECNT / SO MOVE TO E-COUNT DCA PMCNT / AND CLEAR M-COUNT JMP PRSTD4 / GO STORE COUNT WORDS PSTORE, XX / STORE CHAR AND BUMP THE RIGHT COUNTER PCNTWD, XX / FOR ISZ OF S, M, OR E COUNT JMS PSTCHR / STORE CHAR JMP I PZNRM / NO ROOM, ERROR RETURN ISZ PSTORE / BUMP RETURN JMP I PSTORE / RETURN PRWCNT, 0 PSCNT, 0 / ORDER IMPORTANT PMCNT, 0 PECNT, 0 X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE / READS IN A CHARACTER FROM THE CURRENTLY OPEN FILE IGNORING ALL CHARACTERS / LESS THAN ASCII 41, EXCEPT FOR NEWLINE (ASCII 12). / CALLED BY: / JMS PGTNMC / EOF RETURN / REGULAR RETURN (AC=0 MEANS NEWLINE / ELSE CHAR RETURNED IN AC) PGTNMC, XX AC7777 / GET ALL CHARS JMS PGTCHR JMP I PGTNMC / EOF RETURN TAD (-12) / SEE IF NEWLINE SNA JMP PGTNM1 / YES, RETURN WITH AC = 0 TAD (-27) / NO, LESS THAN 41 ASCII ? SPA JMP PGTNMC+1 / YES, IGNORE CHAR TAD (12+27) / NO, GET CHAR BACK PGTNM1, ISZ PGTNMC / AND RETURN WITH IT JMP I PGTNMC PRSNLP, JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YEP ! PRSNL1, TAD (-76) / SEE IF '>' ? SNA JMP PRSNXT / YES, PARSE REST OF NUMBER TAD (2) / NO, SEE IF '<' ? SNA JMP I PZERR / YES, NOT ALLOWED TAD (2) / NO, SEE IF ASCII 9 OR LESS SMA JMP PRSNLP / NO, SKIP IT TAD (12) / YES, SEE IF ASCII 0 OR MORE PRSNSZ, XX / MODIFIED TO IGNORE LEADING ZEROES JMP PRSNLP / SKIP CHAR TAD (60) / MAKE ASCII AGAIN ISZ NUMSIZ / SEE IF TOO LARGE JMP .+2 JMP I PZERR / YES JMS PSTORE / NO, STORE CHAR JMP I PZNRM / NO ROOM TAD (SPA) / TURN OFF ZERO SUPRESSION DCA PRSNSZ JMP PRSNLP / GET ANOTHER CHAR NUMSIZ, 0 PRSNXT, JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP PRNMDN / YES, GO FINISH UP MQL / SAVE FOR COMPARE TAD PRWCNT / SEE IF SECOND PART OF 'THRU' SZA CLA JMP I PZERR / YES, SHOULDN'T BE HERE TAD ("O-200) / NO, SEE IF CHAR IS 'O' ? JMS PCMPAR / COMPARE JMP PTHRU / NO MATCH, SEE IF THRU IFDEF ENGLSH < JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE TAD ("R-200) / SEE IF CHAR IS 'R' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN > JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE TAD MOREST / SEE IF CHAR IS 'M' ? JMS PCMPAR / COMPARE JMP PLESS / NO MATCH, SEE IF LESS TAD (MOREST+1) / GET THE START OF THE MORE STRING /A018 DCA MORECT / SAVE IT IN THE COUNTER /A018 MORELP, TAD I MORECT / GET THE NEXT CHAR TO COMPARE AGAINST /A018 SNA CLA / IS THIS THE END OF THE COMPARE? /A018 JMP MOREOK / YES, ALL DONE /A018 JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE /M018 TAD I MORECT / GET THE COMPARISON CHAR BACK /A018 JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN ISZ MORECT / INCRAMENT THE COMPARISON STRING COUNT /A018 JMP MORELP / AND GET THE PREVIOUS CHARACTER /A018 /D018 JMS PGTNMC / GET A CHAR /D018 JMP PRSTRT / EOF /D018 SNA / SEE IF NEWLINE ? /D018 JMP I PZERR / YES, OUT OF SYNC /D018 MQL / SAVE FOR COMPARE /D018 TAD ("R-200) / SEE IF CHAR IS 'R' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTNMC / GET A CHAR /D018 JMP PRSTRT / EOF /D018 SNA / SEE IF NEWLINE ? /D018 JMP I PZERR / YES, OUT OF SYNC /D018 MQL / SAVE FOR COMPARE /D018 TAD ("E-200) / SEE IF CHAR IS 'E' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN MOREOK, JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SZA CLA / SEE IF NEWLINE ? JMP I PZERR / NO JMP PRNMD1 / YES, GO FINISH UP MORECT, 0 / POINTER INTO MORE STRING /A018 MOREST, IFDEF ENGLSH < "M-200; "O-200; "R-200; "E-200; 0 > IFDEF ITALIAN< "M-200; "A-200; "G-200; "G-200; "I-200; "O-200; "R-200; "E-200; 0 > X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE PLESS, TAD LESSST / SEE IF CHAR IS 'L' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN TAD (LESSST+1) / GET THE START OF THE MORE STRING /A018 DCA LESSCT / SAVE IT IN THE COUNTER /A018 LESSLP, TAD I LESSCT / GET THE NEXT CHAR TO COMPARE AGAINST /A018 SNA CLA / IS THIS THE END OF THE COMPARE? /A018 JMP LESSOK / YES, ALL DONE /A018 JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE /M018 TAD I LESSCT / GET THE COMPARISON CHAR BACK /A018 JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN ISZ LESSCT / INCRAMENT THE COMPARISON STRING COUNT /A018 JMP LESSLP / AND GET THE PREVIOUS CHARACTER /A018 /D018 JMS PGTNMC / GET A CHAR /D018 JMP PRSTRT / EOF /D018 SNA / SEE IF NEWLINE ? /D018 JMP I PZERR / YES, OUT OF SYNC /D018 MQL / SAVE FOR COMPARE /D018 TAD ("E-200) / SEE IF CHAR IS 'E' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTNMC / GET A CHAR /D018 JMP PRSTRT / EOF /D018 SNA / SEE IF NEWLINE ? /D018 JMP I PZERR / YES, OUT OF SYNC /D018 MQL / SAVE FOR COMPARE /D018 TAD ("S-200) / SEE IF CHAR IS 'S' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTNMC / GET A CHAR /D018 JMP PRSTRT / EOF /D018 SNA / SEE IF NEWLINE ? /D018 JMP I PZERR / YES, OUT OF SYNC /D018 MQL / SAVE FOR COMPARE /D018 TAD ("S-200) / SEE IF CHAR IS 'S' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN LESSOK, JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SZA CLA / SEE IF NEWLINE ? JMP I PZERR / NO TAD PECNT / YES, MOVE E-COUNT TO M-COUNT DCA T1 DCA PECNT / AND ZERO E-COUNT TAD T1 JMP PRNMD1 / GO FINISH UP PTHRU, TAD THROST / SEE IF CHAR IS 'T' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN TAD (THROST+1) / GET THE START OF THE MORE STRING /A018 DCA THROCT / SAVE IT IN THE COUNTER /A018 THROLP, TAD I THROCT / GET THE NEXT CHAR TO COMPARE AGAINST /A018 SNA CLA / IS THIS THE END OF THE COMPARE? /A018 JMP THROOK / YES, ALL DONE /A018 JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE /M018 TAD I THROCT / GET THE COMPARISON CHAR BACK /A018 JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN ISZ THROCT / INCRAMENT THE COMPARISON STRING COUNT /A018 JMP THROLP / AND GET THE PREVIOUS CHARACTER /A018 /D018 JMS PGTNMC / GET A CHAR /D018 JMP PRSTRT / EOF /D018 SNA / SEE IF NEWLINE ? /D018 JMP I PZERR / YES, OUT OF SYNC /D018 MQL / SAVE FOR COMPARE /D018 TAD ("H-200) / SEE IF CHAR IS 'H' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTNMC / GET A CHAR /D018 JMP PRSTRT / EOF /D018 SNA / SEE IF NEWLINE ? /D018 JMP I PZERR / YES, OUT OF SYNC /D018 MQL / SAVE FOR COMPARE /D018 TAD ("R-200) / SEE IF CHAR IS 'R' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN THROOK, IFDEF ENGLSH < JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE TAD ("U-200) / SEE IF CHAR IS 'U' ? JMS PCMPAR / COMPARE JMP POUGH / NO MATCH,SEE IF OTHER WAY TO SPELL THRU > JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE TAD ("<-200) / SEE IF CHAR IS '<' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN PTHRU1, AC7777 / MOVE COUNT WORD BACK TAD PCNTWD / TO ADD INTO M-COUNT DCA PCNTWD ISZ PRWCNT / SET FLAG FOR DONE 1ST HALF OF THRU TAD (-GPBSIZ-1) / RE-INIT NUMBER SIZE COUNTER DCA NUMSIZ TAD NUMFLD / IF NUMERIC FIELD SZA CLA / JMP PTHRU2 / THEN USE NEW NUMERIC ROUTINE TAD (SPA SNA) / ELSE SET FOR LEADING ZERO SUPRESSION DCA PRSNSZ / JMP PRSNLP / AND GET 2ND HALF OF THRU PTHRU2, TAD (TOKVAL-1) / SET UP POINTER TO TOKVAL IN MATH FIELD DCA TAI1 / JMP PRSNL3 / IFDEF FRENCH < / FSPECL / Routine to process a special French string FSPECL, XX CLA / Clear the AC (insurance) TAD ERRMES / Get the error message TAD (-S1SYN) / Get the special message SZA CLA / Is it the special message? JMP I FSPECL / No, continue as usual. TAD (16) / Shift out (to alternate graphics) JMS OUTCHR TAD (141) / Print an "GRAV A" JMS OUTCHR TAD (17) / Shift back (to base character set) JMS OUTCHR JMS OUTSTR / Print the rest of the special string FS1SYN JMP I FSPECL / Return to mainline > / END IFDEF FRENCH IFDEF CANADA < / FSPECL / Routine to process a special CANADA string FSPECL, XX CLA / Clear the AC (insurance) TAD ERRMES / Get the error message TAD (-S1SYN) / Get the special message SZA CLA / Is it the special message? JMP I FSPECL / No, continue as usual. TAD (16) / Shift out (to alternate graphics) JMS OUTCHR TAD (141) / Print an "GRAV A" JMS OUTCHR TAD (17) / Shift back (to base character set) JMS OUTCHR JMS OUTSTR / Print the rest of the special string CS1SYN JMP I FSPECL / Return to mainline > / END IFDEF CANADA THROCT, / POINTER INTO THRO STRING LESSCT, 0 / POINTER INTO LESS STRING /A018 LESSST, IFDEF ENGLSH < "L-200; "E-200; "S-200; "S-200; 0 > IFDEF ITALIAN< "M-200; "I-200; "N-200; "O-200; "R-200; "E-200; 0 > THROST, IFDEF ENGLSH < "T-200; "H-200; "R-200; 0 > IFDEF ITALIAN< "F-200; "I-200; "N-200; "O-200; "A-200; 0 > X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE POUGH, TAD ("O-200) / SEE IF CHAR IS 'O' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE TAD ("U-200) / SEE IF CHAR IS 'U' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE TAD ("G-200) / SEE IF CHAR IS 'G' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE TAD ("H-200) / SEE IF CHAR IS 'H' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE TAD ("<-200) / SEE IF CHAR IS '<' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMP PTHRU1 / MATCHED, GO SET WORDS CORRECTLY PRNMDN, TAD PRWCNT / SEE IF SECOND PART OF 'THRU' ? SZA CLA JMP PRNMD2 / YES, GET RIGHT WORD AC7777 / NO, STORE -1 IN M-COUNT FOR PLAIN SEARCH PRNMD1, JMS PSTSPC / STORE M-COUNT WORD IN SPEC JMP I PZNRM / NO ROOM TAD PECNT / GET E-COUNT JMP PRSTD5 / STORE AND RETURN PRNMD2, TAD PMCNT / GET M-COUNT JMP PRNMD1 / AND STORE IT PRSTNM, IAC / MAKE SURE IT WASN'T JUST AN IMMEDIATE '>' SNA JMP I PZERR / NOT ALLOWED TAD (25+52-1) / GET CHAR BACK DCA T1 / AND SAVE IT AC0003 / SEE IF ANY * WILD CARDS YET ? TAD PRWCNT SZA CLA JMP I PZERR / YES, CAN'T DO DCA PRWCNT / SET COUNT TO 0 TAD PSCNT / MAKE SURE NO CHARS ALREADY STORED TAD PMCNT TAD PECNT SZA CLA JMP I PZERR / CAN'T HAVE CHARS STORED YET AC0001 / STORE +1 IN S-COUNT JMS PSTSPC JMP I PZNRM / NO ROOM ISZ PCNTWD / SET TO BUMP E-COUNT ISZ PCNTWD TAD T1 / GET CHAR BACK TAD (-12) / MAKE SURE IT'S NOT A NEWLINE SNA CLA JMP I PZERR / SHOULDN'T BE TAD NUMFLD / IF NUMERIC FIELD NAME SPECIFIED SZA CLA JMP PRSTN1 / THEN SCAN FOR A REAL NUMBER / COME HERE FOR NON-NUMERIC FIELD TAD (SPA SNA) DCA PRSNSZ / SET FOR LEADING ZERO SUPPRESSION TAD (-GPBSIZ-1) DCA NUMSIZ / SET MAX NUMBER SIZE ALLOWED TAD T1 / GET BACK AGAIN JMP PRSNL1 / COME HERE FOR NUMERIC FIELD PRSTN1, TAD (TOKVAL-1) / INITIALIZE POINTER INTO TOKVAL IN MATH DCA TAI1 / FIELD FOR ASCII NUMBER TAD T1 JMP PRSNL2 PRSNL3, JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YEP ! PRSNL2, TAD (-76) / SEE IF '>' ? SNA JMP PRSNL4 / CALL ASCBCD ROUTINE TAD (2) / NO, SEE IF '<' ? SNA JMP I PZERR / YES, NOT ALLOWED TAD (74) / MAKE ASCII AGAIN ISZ NUMSIZ / SEE IF TOO LARGE JMP .+2 JMP I PZERR / YES CDFMTH / NO, STORE CHARACTER IN DCA I TAI1 / TOKVAL IN MATH FIELD CDFMYF JMP PRSNL3 / GET ANOTHER CHAR X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE / HERE WE CALL ASCBCD ROUTINE IN MATH FIELD THEN MOVE PACKED BCD TO OUR / SYMBLE TABLE FOR LATER USE BY WPSELC.PA PRSNL4, CDFMTH DCA I TAI1 / STORE TRAILING ZERO IN TOKVAL CDFMYF CIFMTH JMS ASCBCD / CONVERT TO PACKED BCD TOKVAL / ASCII INPUT IS AT TOKVAL IN MATH FIELD RESULT / PACKED BCD OUTPUT GOES TO RESULT IN / MATH FIELD JMP BADNUM / ERROR RETURN TAD (RESULT-1) / GET ADDRESS OF PACKED BCD DCA TAI1 / AND PUT IN AUTO-INDEX COUNTER TAD (-6) / GET SIZE OF PACKED BCD VALUE DCA T1 / AND USE T1 AS COUNTER PRSNL5, CDFMTH / LOOP TAD I TAI1 / | GET PACKED BCD VALUE CDFMYF / | JMS PSTORE / | PUT IN SYMBLE TABLE JMP I PZNRM / EXIT IF NO ROOM ISZ T1 / | JMP PRSNL5 / END_LOOP JMP PRSNXT / LOOK FOR 'OR MORE' / 'OR LESS' / 'THROUGH' / OR 'THRU' / OUTPUT A SIXBIT STRING (TERMINATED WITH A ZERO BYTE) TO THE SCREEN. / Code will lowercase all alphabetic characters and perform the following / character mapping if FORIN is defined: / open square bracket to open curly bracket / backslash to close square bracket / close square bracket to close curly bracket / / CALLED WITH: / JMS OUTSTR / ADDR OF STRING / RETURN (AC= 0) / / MAPCON defines which of the first "x" characters, starting with SIXBIT "A" / whould be mapped into lowercase. / / LCMAP is the mapping constant for the above mapping function. It should be / set to 140 to map UPPER to lower case and set to 0 to disable this mapping. / MAPCON=33 / Last SIXBIT character mapped into UPPERCASE /IFNDEF ENGLSH < MAPCON=36 > / Foreign includes the square brackets IFNDEF GERMAN < LCMAP=140 > / Map UPPER into lower case IFDEF GERMAN < LCMAP=100 > / If German, do not perform this mapping OUTSTR, XX / return address AC7777 / GET STRING ADDR - 1 TAD I OUTSTR DCA TAI1 / AND LOAD IN AUTO-INDEX ISZ OUTSTR / BUMP FOR RETURN OTSTLP, TAD I TAI1 / GET A WORD DCA IOTMP / SAVE IT TAD IOTMP BSW / GET LEFT BYTE AND (77) SNA / ZERO BYTE? JMP I OUTSTR / YES, RETURN TAD (-MAPCON) / NO, SEE IF needs mapping SPA / NO, LEAVE ALONE TAD (LCMAP) / YES, Map it into lowercase (or whatever) TAD (MAPCON) / GET CHAR BACK JMS OUTCHR / AND OUTPUT IT TAD IOTMP / GET WORD BACK AND (77) / GET RIGHT BYTE SNA / ZERO? JMP I OUTSTR / YES, RETURN TAD (-MAPCON) / NO, SEE IF needs mapping SPA / NO, LEAVE ALONE TAD (LCMAP) / YES, Map it into lowercase (or whatever) TAD (MAPCON) / GET CHAR BACK JMS OUTCHR / AND OUTPUT JMP OTSTLP / GET NEXT WORD IOTMP, 0 / THIS ROUTINE OUTPUTS ASCII CHARACTERS STORED IN THE WORDS FOLLOWING THE CALL / LAST ENTRY SHOULD BE NEGATIVE (I.E. AND 4000 TO LAST CHARACTER) OSTRG, XX CLA OSTRGL, TAD I OSTRG / PICK UP CHAR JMS OUTCHR / OUTPUT CHAR TAD I OSTRG / GET CHARACTER BACK ISZ OSTRG / BUMP FOR NEXT SPA CLA / CHECK FOR END JMP I OSTRG / END - RETURN JMP OSTRGL / DO NEXT CHAR / THIS ROUTINE COMPARES THE CHARACTER IN THE AC WITH MQ AFTER CONVERTING THE / CHARACTER IN THE MQ TO UPPER CASE IF NECESSARY. SKIP RETURNS ON MATCH. PCMPAR, XX CIA / NEGATE FOR COMPARE DCA PCMTMP / AND SAVE IN TMP MQA / GET THE MQ TAD (-173) / SEE IF >173 SMA JMP PCUOK / YES, DON'T CHANGE TAD (173-141) / SEE IF LOWER CASE SMA TAD (-40) / YES, MAKE UPPER TAD (141-173) / GET CHAR BACK PCUOK, TAD (173) TAD PCMTMP / SEE IF CHARS EQUAL SNA CLA ISZ PCMPAR / YES, SKIP RETURN JMP I PCMPAR / RETURN PCMTMP, 0 X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE BADNUM, AC0002 / BAD NUMBER IN A NUMERIC FIELD <:NAME> JMP ERRR / NOROOM, AC0000 / NO ROOM LEFT JMP ERRR / ERR, AC0001 / NOT UNDERSTOOD AT THIS POINT ERRR, DCA ERRTYP ISZ ERRCNT / BUMP ERROR COUNT JMS OSTRG / OUTPUT A STRING BELL / RING BELL LF / LINE FEED 10 / BACK SPACE "^-200 / UP ARROW CR / CARRIAGE RETURN LF / LINE FEED IFDEF ENGLSH < "E-200 "R-200 "R-200 "O-200 "R-200+4000 / +4000 MEANS END OF STRING > IFDEF ITALIAN < "E-200 "R-200 "R-200 "O-200 "R-200 "E-200+4000 / +4000 MEANS END OF STRING > IFDEF CANADA < "E "R "R "E "U "R+4000 / +4000 MEANS END OF STRING > IFDEF FRENCH < "E "R "R "E "U "R+4000 / +4000 MEANS END OF STRING > IFDEF GERMAN < "F "E "H "L "E "R+4000 / +4000 MEANS END OF STRING > IFDEF DUTCH < "F "O "U "T+4000 / +4000 MEANS END OF STRING > IFDEF NORWAY < "F "E "I "L+4000 / +4000 MEANS END OF STRING > IFDEF SWEDSH < "F "E "L+4000 / +4000 MEANS END OF STRING > IFDEF DANISH < "F "E "J "L+4000 / +4000 MEANS END OF STRING > TAD (ERRMTB) / GET ADDR OF MESSAGE TAD ERRTYP DCA T1 TAD I T1 DCA ERRMES JMS OUTSTR / DISPLAY TYPE OF ERROR MESSAGE ERRMES, XX IFDEF FRENCH < JMS FSPECL / Special french processing > IFDEF CANADA < JMS FSPECL / Special Canadian processing > MENRET, JMS OSTRG / OUTPUT STRING CR / CARRIAGE RETURN LF / LINE FEED LF+4000 / ANOTHER LINE FEED, 4000 MEANS END OF STRING JMS OUTSTR / GOLD MENU MESSAGE SPACE IFDEF ENGLSH < TAD ("P-200) > IFDEF ITALIAN< TAD ("P-200) > IFDEF CANADA < TAD ("A) > IFDEF FRENCH < TAD ("A) > IFDEF GERMAN < TAD ("M) > IFDEF SCANDI < TAD ("T) > IFNDEF DUTCH < / "Press" not used in dutch JMS OUTCHR JMS OUTSTR RESS > IFNDEF ITALIAN IFDEF ITALIAN JMS OUTCHR JMS OUTSTR OLD TAD ("M-200) JMS OUTCHR IFDEF ENGLSH < / In english this is all UPPERCASE TAD ("E-200) JMS OUTCHR TAD ("N-200) JMS OUTCHR TAD ("U-200) JMS OUTCHR > IFDEF ITALIAN < TAD ("E-200) JMS OUTCHR TAD ("N-200) JMS OUTCHR TAD ("U-200) JMS OUTCHR > IFDEF SCANDI < TAD ("E) JMS OUTCHR TAD ("N) JMS OUTCHR IFDEF NORWAY < TAD ("Y) > IFDEF SWEDSH < TAD ("Y) > IFDEF DANISH < TAD ("U) > JMS OUTCHR > / END IFDEF SCANDI IFNDEF ENGLSH < / In Foreign languages this is only Capitalized IFNDEF SCANDI < IFNDEF ITALIAN< JMS OUTSTR ENU >>> JMS OUTSTR TORECA IFNDEF CANADA < IFNDEF FRENCH < / If not french then "MAIN MENU" IFNDEF ITALIAN< IFDEF ENGLSH < TAD ("M-200) > IFDEF DUTCH < TAD ("H) > IFDEF GERMAN < TAD ("H) > JMS OUTCHR JMS OUTSTR AIN IFDEF ENGLSH < TAD ("M-200) > IFDEF DUTCH < TAD ("M) > IFDEF GERMAN < TAD ("M) > IFDEF SCANDI < TAD ("H) > >>> / End IFNDEF FRENCH, CANADA, ITALIAN IFDEF CANADA < TAD ("M) > IFDEF FRENCH < TAD ("M) > IFDEF ITALIAN< TAD ("M-200) > JMS OUTCHR JMS OUTSTR ENU IFDEF CANADA < JMS OUTSTR AIN > IFDEF FRENCH < / Else "MENU MAIN" JMS OUTSTR / "principal" not capitalized AIN > IFDEF ITALIAN < JMS OUTSTR AIN > JMS OSTRG / CALL OUTPUT STRING ROUTINE ESC / START DIRECT CURSOR ADDRESS "[ / ESC [ PL ; PC H "2 / LINE 23 "3 "; / 1 IS DEFAULT "H+4000 / 4000 INDICATES END OF STRING JMP INPUT / WAIT FOR GOLD MENU WAIT, CIFSYS / ++++ JWAIT INPUT, CIFSYS / ++++ XLTIN / ++++ JMP WAIT TAD (-EDMENU) SNA CLA JMP XIT TAD (7) / OUTPUT BELL JMS OUTCHR JMP INPUT / AND KEEP LOOKING ERRTYP, 0 CLS, XX / ROUTINE TO PUT CURSOR HOME AND CLEAR / THE SCREEN JMS OSTRG / OUTPUT STRING ESC / ESCAPE "[ / NEED [ IF ANSI "H / HOME THE CURSOR ESC / ESCAPE "[ / NEED [ IF ANSI "J+4000 / CLEAR TO END OF SCREEN (4000 MEANS / END OF STRING JMP I CLS / RETURN / This message only comes up when there is an error in a numeric field / number, i.e. <:name> S0NUM, IFDEF ENGLSH IFDEF ITALIAN X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE S1SYN, IFDEF ENGLSH < TEXT '-- SPECIFICATION NOT UNDERSTOOD STARTING AT THIS POINT.' > IFDEF ITALIAN< TEXT '-- SPECIFICA NON COMPRESSA A PARTIRE DA QUESTO PUNTO.' > IFDEF CANADA < TEXT "-- SP[CIFICATION INCOMPRISE " > IFDEF FRENCH < TEXT "-- SP[CIFICATION INCOMPR[HENSIBLE " > IFDEF DUTCH < TEXT "-- SPECIFICATIE NIET BEGREPEN VANAF DIT PUNT." > IFDEF GERMAN < TEXT "-- SPEZIFIKATION AB DIESEM PUNKT UNVERST[NDLICH" >/L.U.A IFDEF NORWAY < TEXT "-- SPESIFIKASJONEN IKKE FORST]TT FRA DETTE PUNKT." /L.D.A > IFDEF SWEDSH < TEXT "-- SPECIFIKATIONEN F\RST]S INTE FR]N DENNA PUNKT." /L.U.O, L.D.A, L.D.A > IFDEF DANISH < TEXT "-- SPECIFIKATION IKKE FORST]ET FRA DETTE PUNKT." /L.D.A > S2NRM, IFDEF ENGLSH < TEXT '-- SPECIFICATION TOO LARGE.' > IFDEF ITALIAN< TEXT '-- TROPPE CONDIZIONI NELLA SPECIFICA DI SELEZIONE.' > IFDEF CANADA < TEXT "-- SP[CIFICATION TROP LONGUE" > /L.A.E IFDEF FRENCH < TEXT "-- SP[CIFICATION TROP LONGUE" > /L.A.E IFDEF DUTCH < TEXT "-- SPECIFICATIE TE GROOT." > IFDEF GERMAN < TEXT "-- SPEZIFIKATION ZU LANG" > IFDEF NORWAY < TEXT "-- SPESIFIKASJONEN FOR STOR." > IFDEF SWEDSH < TEXT "-- SPECIFIKATIONEN F\R STOR." > /L.U.O IFDEF DANISH < TEXT "-- SPECIFIKATION FOR STOR." > SPACE, IFNDEF DUTCH < TEXT ' ' > IFDEF DUTCH < TEXT ' ' > RESS, IFDEF ENGLSH < TEXT 'RESS ' > IFDEF ITALIAN< TEXT 'REMERE ' > IFDEF CANADA < TEXT "PPUYER SUR " > IFDEF FRENCH < TEXT "PPUYER SUR " > IFDEF DUTCH <> / Not used in the Dutch IFDEF GERMAN < TEXT "IT " > IFDEF NORWAY < TEXT "RYKK " > IFDEF SWEDSH < TEXT "RYCK P] " > /L.D.A IFDEF DANISH < TEXT "RYK " > OLD, IFDEF ENGLSH < TEXT 'OLD ' > IFDEF ITALIAN< TEXT 'RO ' > IFDEF CANADA < TEXT "OLD " > IFDEF FRENCH < TEXT "OLD " > IFDEF DUTCH < TEXT "OUD " > IFDEF GERMAN < TEXT "OLD " > IFDEF NORWAY < TEXT "UL " > IFDEF SWEDSH < TEXT "UL " > IFDEF DANISH < TEXT "UL " > TORECA, IFDEF ENGLSH < TEXT ' TO RECALL THE ' > IFDEF ITALIAN< TEXT ' PER RICHIAMARE IL ' > IFDEF CANADA < TEXT "POUR RAPPELER LE " > IFDEF FRENCH < TEXT "POUR RAPPELER LE " > IFDEF DUTCH < TEXT " INTOETSEN VOOR " > IFDEF GERMAN < TEXT " ZUR]CK ZUM " > /L.U.U IFDEF NORWAY < TEXT " FOR ] F] " > /L.D.A, L.D.A IFDEF SWEDSH < TEXT " F\R ATT F] " > /L.U.O, L.D.A IFDEF DANISH < TEXT " FOR AT F] " > /L.D.A AIN, IFDEF ENGLSH < TEXT 'AIN ' > IFDEF ITALIAN< TEXT 'PRINCIPALE.' > IFDEF CANADA < TEXT "PRINCIPAL." > IFDEF FRENCH < TEXT "PRINCIPAL" >/Not capitalized in French IFDEF DUTCH < TEXT "OOFD " > IFDEF GERMAN < TEXT "AUPT " > IFDEF NORWAY < TEXT "OVED" > IFDEF SWEDSH < TEXT "UVUD" > IFDEF DANISH < TEXT "OVED" > ENU, IFDEF ENGLSH < TEXT 'ENU.' > IFDEF ITALIAN< TEXT 'ENU ' > IFDEF CANADA < TEXT "ENU " > IFDEF FRENCH < TEXT "ENU " > IFDEF DUTCH < TEXT "ENU" > IFDEF GERMAN < TEXT "EN]" >/L.U.U IFDEF NORWAY < TEXT "MENYEN." > IFDEF SWEDSH < TEXT "MENYN." > IFDEF DANISH < TEXT "MENUEN." > XIT, TAD PARSE / GET RETURN ADDR DCA T1 / MAKE IT LOCAL CDIMNU / AND GET THE RIGHT FIELD JMP I T1 / BYE, BYE NOERRT, TAD (15) / CR JMS OUTCHR TAD (12) / LF JMS OUTCHR TAD (12) / LF JMS OUTCHR JMS OUTSTR SPACE IFDEF ENGLSH < TAD ("N-200) JMS OUTCHR > IFDEF ITALIAN < > IFDEF CANADA < TAD ("A) JMS OUTCHR > IFDEF FRENCH < TAD ("P) JMS OUTCHR > IFDEF GERMAN < > / All of the message is in OERR IFDEF DUTCH < TAD ("G) JMS OUTCHR > IFDEF SCANDI < TAD ("I) JMS OUTCHR > JMS OUTSTR OERR JMP MENRET OERR, IFDEF ENGLSH < TEXT 'O ERRORS IN SPECIFICATION' > IFDEF ITALIAN< TEXT 'ERRORI NELLA SPECIFICA: 0' > IFDEF CANADA < TEXT "UCUNE ERREUR DANS LA SP[CIFICATION" > /L.A.E IFDEF FRENCH < TEXT "AS D'ERREUR DANS LA SP[CIFICATION" > /L.A.E IFDEF DUTCH < TEXT "EEN FOUTEN IN SPECIFICATIE." > IFDEF GERMAN < TEXT "KEINE FEHLER IN DER SPEZIFIKATION" > IFDEF NORWAY < TEXT "NGEN FEIL I SPESIFIKASJONEN" > IFDEF SWEDSH < TEXT "NGA FEL I SPECIFIKATIONEN" > IFDEF DANISH < TEXT "NGEN FEJL I SPECIFIKATION" > X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE   / XLIST /WPSELC.PA /WPSELC.PA / / COPYRIGHT (C) 1980 / DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754 / / THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED / ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE / INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER / COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY / OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY / TRANSFERRED. / / THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE / AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT / CORPORATION. / / DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS / SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. / /++ / FACILITY: / / ABSTRACT: / / ENVIRONMENT: / / AUTHOR: CREATION DATE: / / MODIFIED BY: / / / , : VERSION / / 044 RCME 12-APR-85 Fix parsing of tech & multinational / characters in field names / / ------------------- All below refer to V2.0 and earlier --------------- / / 043 HLP 13-SEP-83 Delete PRLOCK since DECmate is single user / 042 WCE 06-MAY-83 Fixed L.P. to work with numbers to 4095 / 041 HLP 02-MAY-83 Delete JSTRTs on PRJOB,extra DCA PRSTTS / 040 GDH 1-Feb-83 Fixed =<*> selection. / 039 GDH 16-DEC-82 Fixed match logic when dealing w/ big recrds. / 038 DRH 2-15-81 FIXED TYPO IN CODE NOTICED BY G.HOSLER / ALSO ADDED PSUEDO-CODE TO "CNTROL" RTN / 037 DAO 26-OCT-81 ADDED WTSELC.PA TO TOP OF THIS FILE / SINCE NO MORE ROOM IN MASTER.INF / (ONLY NINE FILES ALLOWED PER LINE) / 036 EH 22-OCT-81 report error if illegal number in LP / 035 AIB 22-Oct-81 changes to accomodate editor math / error reporting, at REPORT et seq / 033 DRH 21-OCT-81 STRIP OUT SOFT RETURN (WITH HYPHEN) / 032 GDH 20-OCT-81 Deimplemented LOCK/UNLOCK. / 031 DRH 14-SEP-81 SET MATH INIT CALL FROM WPSELC TO ALSO / SET FLAG SAYING IN LP MATH / 030 DAO 19-AUG-81 Added changes for selectin on / numeric fields / 029 DAO 23-JUL-81 FIXED LP TO PRINTER BUG IN PRNQUE / 028 DRH 31-JUL-81 SET UP "ERRHAN" TO BYPASS "DOMATH" / 027 DRH 31-JUL-81 MADE CHECK MATH ACTIVE SUBRTN GENERAL / 026 JRF 28-JUL-81 Add CIF,CDF equates for menu field / 025A DRH 24-JUL-81 HANDLE MATH LINE BUFFER OVERFLOW ERROR / 025 JRF 23-JUL-81 Make modifications for error reporting / thru MN1 / 024 JRF 22-JUL-81 Corrected count of max. numeric chars. / allowed in a field value in LDFLD / 023 DRH 22-JUL-81 FIX TO DUMP CTRL BLOCK IF NOT MATH / 022 DRH 22-JUL-81 SCREEN OUT WRAPS & SOFT SPACES BEFORE / CHAR SENT TO MATH LINEBUFFER (LNEBUF) / 021 DRH 21-JUL-81 HANDLE END OF CTRL BLOCK SPECIAL CASES / 020 DRH 21-JUL-81 UNBUNDLED LIST PROCESSING MATH / 019 JRF 09-JUL-81 Added calls to IOA / 018 DAO 9-JUL-81 Added changes for LP math / 017 DAO 08-JUL-81 Changes to move LP to field 5 / 0016 TT 07-JUL-81 Removed superfluous conditionals / 0015 JM 01-APR-81 Changes for CANADA / 0014 JM 10-MAR-81 Added CANADIAN text / 0013 JM 09-MAR-81 Added DUTCH text / 0012 JM 06-MAR-81 Added FRENCH text / 0011 LDB 20-NOV-80 Add error for full diskette / 0010 GR,DAO 17-OCT-80 CONDITIONALIZED ESCAPE SEQUENCES / 0009 DIM 23-SEPT-80 Merge with x3.5 / 0007 DIM,JM 15-SEPT-80 Merged Scandi and Europe/English / 0006 REG 12-AUG-80 INSERTED THIS STANDARD HEADER / 0005 DSS 09-JUL-80 MODIFIED FOR ENGLISH/FRENCH-CANADIAN / 0004 CMW 05-MAY-80 ENTERED CANADA TRANSLATIONS / 0003 DSS 17-APR-80 ENTERED DUTCH FIXES / 0002 GLT 10-Apr-80 Add LCMAP value to control the mapping constant / / that gets added to an ASCII value to change it from / / UPPER to lower case. This allows the programmer / / to disable the case changing at will. Presently / / German disables the case value. / 0001 GLT 08-Feb-80 Add French German and Dutch translations / / and did amazing things with angle brackets and accented / / characters. By adding the value MAPCON. MAPCON / / defines the first "x" characters that will be mapped / / into lowercase starting with SIXBIT "A". For English / / MAPCON=33 (base 8, 26 base 10) to capitalize A-Z. / / In FORIN systems MAPCON=36 (base 8, 29 base 10) to / / capitalize A-Z plus the three special foreign / / characters. (See OUTSTR for current values). / / French diacritical substitutions: / / "["-L.A.E, "]"-L.G.E / / German diacritical substitutions: / / "["-L.U.A, "\"-L.U.O, "]"-L.U.U / 2.4D+ RLT 10/17/77 UNDERLINED SPACE (ETC) BUG IN GETCHAR / 2.Q-1 RLT 09/24/77 NOP'D PRNQUE ROUTINE FOR WT78 / 2.P-4 KEE ADD CODE TO UNLOCK FILES FOR 102 SYSTEMS / /-- / /WTSELC APPENDED TO TOP OF WPSELC TO CUT DOWN ON NUMBER OF FILES /A037 /ASSEMBLED FROM 10 TO 9 WHICH IS PALS LIMIT /A037 /WTSELC - WRITES OUT LIST PROCESSING SELECT PROGRAM /MODIFICATIONS /003 RCME 07-Aug-85 /allow MNC's in numeric fields / /******************* all below refer to v2.0 or earlier ************************ / /OO2 DAO 21-AUG-81 /DELETED WRITE OUT CODE FOR /SECOND OVERLAY NOT USED ANYMORE /001 DAO 26-JUN-81 /CHANGES TO MOVE LP TO FIELD 5 FIELD 0 *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLOSEL; 200;CDF 20;-DSOSEL /WRITE OUT WPSELC /M001 DLOSOV;2200;CDF 30;-DSOSOV /WRITE OUT AN OVERLAY /MOO1 0 CDFMYF=CDFLP /M017 CDFBUF=CDF BUFFLD /M017 MNUFLD=20 /A026 CDFMNU=CDF MNUFLD /A026 CIFMNU=CIF MNUFLD /A026 CDIMNU=CIF CDF MNUFLD /A026 CDFMNU=CDF 20 /A020 FIELD 2 *200 /M017 / SELCT AND SELCTX ARE BOTH INITIALLY SET BY START ROUTINE. THIS WAS /A019 / DONE SO THAT A MATH ERROR ENCOUNTED WITHIN A MATH CONTROL BLOCK /A019 / PREVIOUS TO THE READING OF THE FIRST RECORD COULD BE REPORTED. /A019 / SELCT *** MUST *** RESIDE AT ADDRESS ZERO OF A PAGE. /A019 / IF MATH DETECTS AN ERROR, IT WILL MAKE A RETURN TO SELCTX. /A042 / THIS ROUTINE IS CROSS FIELD CALLABLE BECAUSE OF AN EDITOR CALL /A042 SELCT, 0 /MAIN ROUTINE TO MATCH AND SELECT RECORDS /CALLED BY: /CIFLP /M017 /JMS I (SELCT) /RETURN (AC =0 IF RECORD FOUND, AC = -1 IF NO MORE RECORDS) CLA RDF /GET FIELD FROM WHENCE I CAME TAD CIDF0 /MAKE CIF, CDF CDFMYF /SET DATA FIELD RIGHT DCA SELCTX /STORE INSTRUCTION TAD RECNUM /SEE IF FIRST TIME CALLED ? SNA CLA JMP SLTSFD /YES, DON'T BOTHER TO GET INITIAL '<' RECLP, JMS DISREC /SHOW REC NO. BEING PROCESSED SLBLP, JMS GETCHR /GET 1ST 'REAL' CHAR OF RECORD JMP SELDNX /EOF, GO FINISH UP AND P177 /LOSE CONTROL TAD (-41 /NON-PRINTING CHAR ? SPA JMP SLBLP /YES, KEEP LOOKING FOR '<' TAD (-33 /NO, SEE IF A '<' SZA CLA JMP REVCRBR / ERROR - TEXT BETWEEN RECORDS /M025 SLTSFD, JMS SINFLG /YES, INITIALIZE MATCH FOUND FLAGS JMS LRCBUF /LOAD A RECORD INTO EDIT BUFFER FIELD JMS CHKREC /CHECK FROM - TO RECORD NUMBER /M042 JMP SLBLP /SKIP RECORD, AND LOOK FOR NEXT RECORD /M042 JMP SELDNX /DONE ALL RECORDS OR HALT FLAG DETECTED /M042 JMS INCNUM /COUNT RECORD BEING PROCESSED /A042 RECPRO /POINTER TO RECORD BEING PROCESSED /A042 TAD (RECBUF /RESET PTR IN AUTO-INDEX DCA RCBPTR /AFTER FIRST '<' FNLP, JMS LFLDNM /LOAD INTO GPBUF JMP CHKMAT /EOR, GO CHECK RECORD MATCH TAD (SYMTAB-1 /GET SYMBOL TABLE ADR - 1 DCA SYTPTR /PUT IN AUTO-INDEX SYTBLK, TAD I SYTPTR /GET AN ENTRY SZA /ANY LEFT ? JMP SYTBL1 /YES JMS GFDEND /NO, GET TO END OF FIELD JMP FNLP /GET NEXT FIELD SYTBL1, DCA SYTSRC /STORE FOR COMPARE TAD FNCNT /GET SIZE OF FN TO SEARCH JMS XSCMP /SEE IF MATCHES GPBUF SYTSRC, 0 CDFMYF /FIELD OF SYMTAB FOR COMPARE SZA CLA JMP FNLP1 /YES, FOUND AN ENTRY ISZ SYTPTR /NOPE, BUMP PTR JMP SYTBLK /TRY NEXT ENTRY CKTRU, DCA SFFLG /SET FOR SUCCESSFUL MATCH /MJOE SSMAT, TAD SFFLG /SEE IF RECORD MATCHED SZA CLA JMP RECLP /NO, KEEP TRUCKING JMS INCNUM /COUNT THIS RECORD AS A SELECTED RECORD /A042 SUCREC /POINTER TO MERGED RECORD COUNT /M042 SKP /SKIP EOF FLAG SELDNX, AC7777 JMS DOMATH /DO MATH ON THIS RECORD /A018 SELCTX, 0 /FOR CIF CDF (DON'T FORGET - INITIALLY /A019 /SET BY START ROUTINE. SEE NOTE ABOVE /A019 JMP I SELCT /RETURN CHKMAT, AC7777 /SET FLAG FOR NO MATCH DCA SFFLG TAD (SPECTB /GET 1ST LOC OF SPEC TABLE DCA SPCSCN /AND SAVE IT TAD I (SPECTB /GET FIRST TYPE WORD SNA JMP CKTRU /0 TYPE, PROCESS ALL RECORDS SPA CLA /SEE IF 'TRUE' (POS.) JMP CKNG2 /NO, LOOK FOR A 'TRUE' ENTRY JMP CHKML /YES, GO GET NEXT TYPE CHKML1, DCA SFFLG /SET FOR MATCH CHKML, JMS GTYPE /GET A TYPE WORD SNA JMP CKTRU /0 TYPE, RECORD MATCHED, ALL DONE SPA /SEE IF 'TRUE' JMP CKNEG /PROBABLY NOT, GO MAKE SURE AND P177 /GET RID OF FLAGS TAD (-1 /SEE IF 'OR IF' FOUND SNA CLA JMP CHKML1 /YES, SUCCESS JMP CHKML /NO, BUT THAT'S O.K. CKNEG, AND P177 /GET RID OF FLAGS TAD (-1 /SEE IF FALSE 'OR IF' (-1) SNA CLA DCA SFFLG /YES, SET FOR RECORD MATCHED AND CONTINUE CKNG2, JMS GTYPE /LOOK FOR A 1 (OR IF) SNA JMP SSMAT /NOTHING LEFT, GO CHECK MATCH SPA JMP CKNG2 /'FALSE' DOESN'T HELP AND P177 /GET RID OF FLAGS TAD (-1 SNA CLA JMP CHKML /FOUND IT, START LOOKING AGAIN JMP CKNG2 /NOPE, KEEP LOOKING RECNUM, 0 / RECORD NUMBER /M025 RECPRO, 0 / RECORDS PROCESSED /A025 SUCREC, 0 / SUCCESSFULLY MERGED RECORDS /M025 SFFLG, -1 FNCNT, 0 NXTMCT, XX / Routine to test for MCS char in field /a003 SZA / Is this a Start of Dead? /a003 JMP I NXTMCT / No, skip the squish call /a003 CIFMTH / Yes, call the blaster in the maths code/a003 JMS MBHOOK / This is its address, as given in WPF1 /a003 SQUISH / This is the blast number of the 7 to /a003 / 8 bit squish routine. /a003 ISZ NXTMCT / Make skip return with result of dead /a003 JMP I NXTMCT /-------------- PAGE FNLP1, AC0001 /SAVE A PTR TAD RCBPTR /TO 1ST CHAR IN FIELD DCA FDSTRT DCA LDNMFL /CLEAR NUMBER LOADED FLAG JMS GFDEND /GET TO END OF FIELD AC7777 /PICK UP SPEC ADDR TAD I SYTPTR FNLP2, DCA SPCPTR /SAVE IN AUTO-INDEX TAD SPCPTR /GET PTR TO TYPE WORD DCA PTYWD /AND SAVE IT TAD I SPCPTR /GET FN LINK WORD DCA NXTSPR /AND SAVE TAD I SPCPTR /GET OR-COUNT IAC /PLUS 1 CIA DCA ORCNT /AND MAKE INTO A COUNTER ORLP, CLA /MAKE EVERYTHING CLEAR ISZ ORCNT /SEE IF ANY OR-GROUPS LEFT JMP .+2 JMP NXTSPC /NO, GET NEXT SPEC TAD FDSTRT /YES, SET UP SEARCH DCA RECSTR /THE RECORD PTR TAD I SPCPTR /AND THE SPEC PTR DCA SPCSTR TAD I SPCPTR /GET S-LENGTH DCA SLEN /AND SAVE IT TAD I SPCPTR /GET M-LENGTH DCA MLEN TAD I SPCPTR /GET E-LENGTH DCA ELEN TAD SLEN /SEE IF S-LENGTH IS POSITIVE SMA SZA CLA JMP SSPRC /YES, MEANS SPECIAL PROCESSING REQUIRED TAD SLEN /Test for existance test. /A040 TAD MLEN / ... /A040 TAD ELEN / .... /A040 SNA CLA / skip if some other test. /A040 JMP SSRCH / test was for existance. so succeed! /A040 AC7777 /NO, SEE IF TAD FDSTRT /THE LENGTH OF THE FIELD CIA TAD FDEND /IS LONGER THAN CLL / Reset overflow indicator. Record length/A039 / can be up to 2500 (4704) characters. /A039 TAD SLEN / S + TAD MLEN / M + TAD ELEN / E ? SNL / skip if no overflow. ie didn't have /A039 / to borrow. /A039 JMP ORLP /NO, FAIL IMMEDIATELY SSRCH, IAC /YES, ADD ONE CIA /AND MAKE INTO A COUNTER DCA RCRLFT /OF CHARS LEFT FOR M SEARCH TAD SLEN /GET LENGTH TO SEARCH SNA /ANYTHING? JMP ESRCH /NO, CHECK E JMS SRCH /YES, DO COMPARE SNA CLA JMP ORLP /FALSE, TRY NEXT OR-GROUP ESRCH, TAD SLEN /POINT TO RIGHT PLACE IN SPEC STR TAD MLEN CIA TAD SPCSTR DCA SPCSTR /AND MAKE NEW SPEC STR PTR TAD ELEN /GET E-LENGTH SNA /ANYTHING? JMP MSRCH /NO, CHECK M TAD FDEND /YES, GET TO END OF FIELD - ELEN IAC DCA RECSTR /AND MAKE NEW RECORD STR PTR TAD ELEN /GET BACK E-LENGTH JMS SRCH /DO COMPARE SNA CLA JMP ORLP /FALSE, TRY NEXT OR-GROUP MSRCH, TAD MLEN /TRUE, GET M-LENGTH SNA /ANYTHING? JMP TRUE /NO, SO MUST BE TRUE TAD SPCSTR /YES, MAKE NEW SPEC PTR DCA SPCSTR /BY SUBTRACTING M-LENGTH TAD SLEN /ADD S-LENGTH TO CIA TAD FDSTRT /ADDR OF START OF STRING DCA RECSTR /AND MAKE INTO NEW REC STR PTR MSRLP, TAD MLEN /GET M-LENGTH FOR SEARCH JMS SRCH /DO COMPARE SZA CLA JMP TRUE /MATCHED, SET RECORD MATCH ISZ RCRLFT /FALSE, SEE IF ROOM LEFT TO SHIFT SKP JMP ORLP /NO, TRY NEXT OR-GROUP ISZ RECSTR /YES, BUMP REC STR PTR JMP MSRLP /AND TRY TO MATCH AGAIN SSPRC, AC0002 TAD MLEN /NUMERIC COMPARE NEEDED ? SZA CLA JMP NUM /YES, GO FIGURE OUT WHICH TYPE AC7777 /NO, COMPUTE RECORD FIELD LENGTH TAD FDSTRT CIA TAD FDEND TAD ELEN /MINUS E-LENGTH, HAS 0 FOR NULL SEARCH AND LENGTH FOR EXACT SEARCH SZA CLA /EQUAL TO 0 ? JMP ORLP /NO, FAIL IMMEDIATELY TAD ELEN /OTHERWISE, GET BACK E-LENGTH SNA /NULL SEARCH ? JMP TRUE /YES, SET RECORD MATCH JMS SRCH /NO, DO EXACT SEARCH SNA CLA JMP ORLP /FALSE, TRY NEXT OR-GROUP JMP TRUE /TRUE, SET FLAG NXTSPR, 0 ORCNT, 0 FDSTRT, 0 FDEND, 0 SLEN, 0 MLEN, 0 ELEN, 0 RCRLFT, 0 /-------------- PAGE SSRBRD, 0 /READS A CHARACTER FROM THE EDIT BUFFER /FIELD INTO THE AC USING RCBPTR AS AN /AUTO-INDEX REGISTER CLA CDFBUF /CHANGE FIELDS TAD I RCBPTR /GET CHAR CDFMYF /BACK TO HOME FIELD AND P177 /NO CONTROLS TAD (-10) /Test for Start of Dead marker /a044 SNA /Is it SOD? /a044 ISZ DEADKEY /Yes, set dead key flag /a044 TAD (10-15) /No, test for End of Dead /a044 SNA /Is this End of Dead? /a044 DCA DEADKEY /Yes, reset dead key flag /a044 TAD (15) /Restore character value /a044 JMP I SSRBRD /RETURN DEADKEY,ZBLOCK 1 /Dead key sequence flag /a044 LRCBUF, XX / THIS ROUTINE LOADS A RECORD INTO THE EDIT /M025 / BUFFER FIELD FROM AFTER THE FIRST '<' USING /M025 / THE GETCHR ROUTINE. /M025 /CALLED BY: (AC MUST = 0) /M025 /JMS LRCBUF /REGULAR RETURN IF NO ERRORS ELSE ERROR EXIT /M025 DCA SSLBFD /SET LEFT BRACKET FLAG /M025 LRBLP5, TAD (RECBUF-1) /SET-UP PTR IN AUTO-INDEX DCA RCBPTR TAD (RECSIZ-1) /SET-UP COUNTER DCA SSCNT TAD ("<-200 /STORE THE INITIAL '<' DCA T1 / IN T1 /A025 JMS SSRBST LRBLP, JMS GETCHR /READ A CHAR JMP REVPEOF / ERROR - END OF FILE /M025 DCA T1 /SAVE CHAR TAD T1 AND P177 /STRIP OFF CONTROLS TAD (-74 /SEE IF A '<' SZA JMP LRBLP1 /NOPE DCA SSLBFD /YES, SET FLAG JMP LRBLP3 /AND STORE CHAR AWAY LRBLP1, TAD (-2 /IS IT A '>' SZA CLA JMP LRBLP2 /NO, CLEAR FLAG TAD SSLBFD /YES, IS FLAG SET? /M025 SNA CLA / SKIP IF: FLAG NOT SET FOR LEFT ANGLE /M025 / BRACKET LAST CHAR. READ /A025 ISZ SSLBFD /YES, SET FOR END OF RECORD LRBLP3, JMS SSRBST / STORE CHARACTER IN T1 /M025 TAD SSLBFD /SEE IF A '<>' HAS BEEN FOUND SPA SNA CLA JMP LRBLP /NO, KEEP LOOKING CDFBUF /YES, STORE TRAILING 0 DCA I RCBPTR CDFMYF JMP I LRCBUF /RETURN HOME NO ERRORS /M025 LRBLP2, AC7777 /CLEAR FLAG DCA SSLBFD JMP LRBLP3 /GO STORE CHAR SSCNT, 0 /COUNTER FOR RECORD SIZE SSLBFD, 0 /END OF RECORD FLAG /(-1 CLEAR, 0 LEFT BRACKET, 1 EOR) SSRBST, XX / STORES THE CHAR IN T1 INTO THE EDIT BUFFER /M025 / FIELD. RETURNS IF CHAR STORED. ERROR EXIT IF /M025 / NO MORE ROOM FOR CHAR. /M025 ISZ SSCNT /SEE IF ANY ROOM LEFT JMP SSRBS1 JMP REVLGRC / ERROR - NO ROOM LEFT - RECORD EXCEEDS /M025 / 2500 CHARACTERS /A025 SSRBS1, TAD T1 / GET THE CHARACTER IN T1 /M025 CDFBUF /NOW TAKE A TRIP DCA I RCBPTR /TO STORE IT AWAY CDFMYF /THEN COME HOME JMP I SSRBST /AND RETURN SOMEDAY GETCHR, XX /THIS ROUTINE READS CHARS FROM A FILE. /M025 / IT REMOVES ALL RULERS, PRINTER CONTROLS, AND /'FUNNY' SPACES AND LINE FEEDS. /CALLED BY: /JMS GETCHR /EOF RETURN /REGULAR RETURN (AC CONTAINS CHAR) CLA GTCHLP, JMS RDNXCH /GET NEXT CHAR SPA SNA JMP I GETCHR /EOF (RETURN IS ZERO) DCA T1 /SAVE CHAR TAD T1 AND P177 /IGNORE HIGHS FOR NOW TAD (-41 /SEE IF SPECIAL CHARACTER SPA JMP SSPCHR /MAYBE, LOOK DEEPER CLA TAD T1 /GET CHAR BACK ISZ GETCHR /BUMP RETURN RTNCHR, JMP I GETCHR /RETURN /M018 SSPCHR, TAD (25 /SEE IF A FF (14) SNA JMP SSCPC /YES, NOW CHECK IF SPECIAL TAD (-2 /NO, WHAT ABOUT START OF RULER (16) SNA CLA JMP SSDLRR /YES, GO DELETE RULER TAD T1 /GET CHAR BACK AND (2000 /HIGH PART ON? SZA CLA JMP GTCHLP /YES, IGNORE CHARACTER GTCHRT, TAD T1 /NO, MUST HAVE BEEN O.K. AFTER ALL ISZ GETCHR /BUMP RETURN JMP I GETCHR /AND GO SSCPC, TAD T1 /SEE IF START OF CONTROL BLOCK /M018 TAD (-1014 /GET NEGATIVE OF CONTROL BLOCK CHARACTER/M018 SZA CLA /IS IT THE START OF A CONTROL BLOCK? /M018 JMP GTCHRT / NO: MUST HAVE BEEN NORMAL FF /M018 /A018 /***** HOOK MADE HERE TO CHK AND SERVE MATH CONTROL BLOCK ***** /A018 /A018 JMP CNTROL / YES: CHECK IF MATH CONTROL BLOCK /A018 /A018 /***** END OF HOOK ********************************************* /A018 /A018 SSCPC1, JMS RDNXCH /GET A CHAR SPA SNA JMP I GETCHR /ERROR, EOF (RETURN IS NOT POSITIVE) TAD (-1414 /SEE IF END YET SZA CLA JMP SSCPC1 /NO, KEEP LOOKING JMP GTCHLP /YES, BACK TO NORMAL PROCESSING SSDLRR, JMS RDNXCH /GET A CHAR SPA SNA JMP I GETCHR /ERROR (RETURN IS NEGATIVE) TAD (-17 /END OF RULER? SZA CLA JMP SSDLRR /NO, KEEP LOOKING JMP GTCHLP /YES, BACK TO NORMAL PROCESSING /-------------- PAGE /**************************************************************************** / / W A R N I N G /a003 / /a003 / THIS AREA BLASTED FOR MCS CHARACTERS IN NUMERIC FIELDS /a003 / See WPMTHL, maths hole, for code /a003 / /**************************************************************************** LPHOLE=. NUMFLD, 0 / NUMERIC FIELD FLAG /A030 / 0= NOT A NUMERIC FIELD () /A030 / 1= A NUMERIC FIELD (<:NAME>) /A030 LFLDNM, XX /THIS ROUTINE LOADS A FIELD NAME FROM AFTER THE /M025 / '<' UNTIL THE FIRST '>' INTO THE GENERAL /M025 / PURPOSE BUFFER. IT DOES A SKIP RETURN IF ALL /M025 / O.K., AND A REGULAR RETURN IF AT END OF /M025 / RECORD. IF ERROR TAKE ERROR EXIT. THIS /M025 / ROUTINE MUST BE ENTERED WITH AC = 0! /M025 TAD (GPBUF-1 /SET-UP PTR IN AUTO-INDEX DCA GPPTR TAD (-GPBSIZ-1 /SET-UP SIZE COUNTER /M030 DCA SSCNT DCA FNCNT /Zero the absolute string length /a040 JMS SSRBRD /GET FIRS CHAR /A030 DCA T1 / STORE /A030 TAD T1 / GET BACK /A030 TAD (-":+200 / /A030 SNA CLA /IF ":" /A030 AC0001 /THEN NUMFLD = 1 /A030 DCA NUMFLD /ELSE NUMFLD = 0 /A030 JMP LFNLP1 /CONTINUE PROCESSING FIRST CHAR /A030 LFNLP, JMS SSRBRD /GET NEXT CHAR DCA T1 /SAVE IT LFNLP1, TAD T1 /M030 TAD (-76 /SEE IF '>' SNA JMP LFNDN /YES, DONE FIELD TAD (2 /SEE IF '<' SNA CLA JMP REVLBFN / ERROR - '<' IN FIELD NAME /M025 ISZ FNCNT /Incrament the absolute string length /a044 TAD DEADKEY /Check dead key status /a044 SNA CLA /Are we processing a dead key sequence? /a044 ISZ SSCNT /NO, SEE IF MORE THAN 30 PRINTING CHARS /m044 JMP .+2 JMP REVLGFN / ERROR - FIELD NAME EXCEEDS 30 CHARS. /M025 TAD T1 /GET BACK CHAR DCA I GPPTR /AND STORE IN STRING JMP LFNLP /LOOP BACK FOR MORE LFNDN, TAD SSCNT /GET COUNT OF WORDS USED TAD (GPBSIZ+1 SNA CLA /m044 JMP NULL /EOR, JUST '<>' FOUND /d044 DCA FNCNT /SAVE FN LENGTH DCA I GPPTR /STORE TRAILING 0 ISZ LFLDNM /DO A SKIP RETURN NULL, JMP I LFLDNM /RETURN XSCMP, 0 /DOES A MATCH OF AN ASCII AND AN ASCIZ STRING /RETURNS AC OF 0 IF FAILED AND -1 IF MATCHES /CALLED WITH AC EQUAL TO NO. OF CHARS. IN THE 1ST STRING (ASCII) /TO TRY TO MATCH. POSITIVE TO MAKE SURE MATCHED TO END /OF 2ND STRING, NEG. FOR DON'T CARE /JMS XSCMP /ADDR OF 1ST STRING -ASCII (ALWAYS THSFLD) /ADDR OF 2ND STRING -ASCIZ /FIELD FOR 2ND STRING /RETURN (TO THSFLD) SMA /CHECK FOR TRAILING 0 ? JMP XSCM1 /YES DCA XSCNT /NO, JUST STORE COUNT DCA XSZFLG /AND RESET FLAG /m044 JMP XSCM2 XSCM1, CIA /NO. OF CHARS TO SEARCH DCA XSCNT AC7777 /a044 DCA XSZFLG /SET FLAG TO CHECK FOR TRAILING 0 XSCM2, AC7777 TAD I XSCMP /GET ADDR OF 1ST STRING DCA TAI1 /SET-UP AUTO-INDEX ISZ XSCMP /MOVE TO NEXT ARG AC7777 TAD I XSCMP /ADDR OF SECOND STRING DCA TAI2 ISZ XSCMP TAD I XSCMP /GET CDF FOR 2ND STRING DCA XSCLP /SET-UP TO EXECUTE ISZ XSCMP /MAKE SURE WE RETURN TO THE RIGHT PLACE TAD XSCLP /GET THE CDF BACK DCA XSCLP1 /AND STORE CAUSE WE'LL NEED IT AGAIN XSCLP, 0 /FOR THE CDF TAD I TAI2 /CHAR FROM 2ND STRING CDFMYF /BACK TO HOME FIELD SNA /SEE IF END OF STRING JMP I XSCMP /YES, SO RETURN WITH 0 IN AC AND P177 /NO, GET RID OF ALL CONTROL /d044 IAC /MAKE CHAR ONE LESS CMA /AND NEGATE /m044 DCA T1 /STORE IN TMP AC0001 /SET UP TO TEST FOR WILD CARD TAD I TAI1 /GET CHAR FROM 1ST STRING SNA /WILD CARD CHAR ? JMP XSCLP2 /YES, DO MATCH FOUND CODE TAD T1 /NO, SUBTRACT 2ND STRING CHAR - 1 SZA CLA /ARE THEY THE SAME? JMP I XSCMP /NOPE, RETURN WITH A 0 IN AC XSCLP2, ISZ XSCNT /DID WE LOOK AT ENOUGH CHARS? JMP XSCLP /NO, COMPARE SOME MORE ISZ XSZFLG /YES, CHECK ASCIZ FLAG /m044 /d044 SZA CLA JMP XSCM3 /NOPE, JUST SET FOR SUCCESS XSCLP1, 0 /YES, DO THE CDF TAD I TAI2 /MAKE SURE WE'RE AT THE END CDFMYF /BACK TO HOME FIELD SNA CLA /0, FOR NOT AT THE END OF STRING XSCM3, AC7777 / -1 FOR SUCCESS JMP I XSCMP /RETURN XSCNT, 0 XSZFLG, 0 / THIS ROUTINE IS USED TO INSURE THAT THE RECORD NUMBER COUNT (RECNUM), / THE RECORD PROCESSED COUNT (RECPRO), AND THE MERGED RECORD COUNT (SUCREC) / DOES NOT EXCEED THE LIMIT OF THE NUMBER OF RECORDS THAT WE CAN PROPERLY / DISPLAY (4095 DECIMAL, 7777 OCTAL). IOA'S ABILITY TO PRINT DECIMAL NUMBERS / FROM OCTAL HAS A RANGE OF 0 - 4095 DECIMAL (0 - 7777 OCTAL). THUS IF RECNUM / RECPRO, OR SUCREC REACH A VALUE OF 4095 DECIMAL (7777 OCTAL) WE WILL KEEP / IT AT THAT COUNT WITH OUT INCREMENTING IT TO ZERO. INCNUM, XX / INCREMENT NUMBER BUT NOT PAST 7777 /A042 TAD I INCNUM / PICK UP THE POINTER TO THE WORD /A042 DCA T2 / TO BE INCREMENTED AND THEN INCREMENT /A042 ISZ I T2 / THE WORD POINTED TO BY T2 /A042 JMP INCDON / IT'S OK, GO RETURN TO CALLER /A042 CMA / INCREMENT FAILED /A042 DCA I T2 / RESET THE COUNT BACK TO MINUS ONE /A042 INCDON, ISZ INCNUM / BUMP RETURN ADDRESS OVER POINTER /A042 JMP I INCNUM / RETRUN TO CALLER /A042 / WHEN CALLING ANY OF THE REV???? ERRORS YOU MUST ENTER WITH AC = 0! /A025 REVLGNM,TAD (EVLGNM-EVRBFD) / FIELD VALUE NUM. EXCEEDS 30 CHARS. /A025 REVRBFD,TAD (EVRBFD-EVLGFN) / '>' IN A FIELD /A025 REVLGFN,TAD (EVLGFN-EVLBFN) / FIELD NAME EXCEEDS 30 CHARACTERS /A025 REVLBFN,TAD (EVLBFN-EVCRBR) / '<' IN FIELD NAME /A025 REVCRBR,TAD (EVCRBR-EVPEOF) / TEXT BETWEEN RECORDS /A025 REVPEOF,TAD (EVPEOF-EVLGRC) / END OF FILE ERROR /A025 REVLGRC,TAD (EVLGRC) / RECORD EXCEEDS 2500 CHARACTERS /A025 ERRHAN, DCA ERRNUM /SAVE ERROR NUMBER /M025 AC7777 /GET -1 INTO THE AC /A028 JMP SELCTX /BYPASS "DOMATH" IF ERROR ENCOUNTERED BY LP /A028 ERRNUM, 0 /M025 ERRXIT, CIFMNU / CALL REPORTER /A025 JMS I OLAYCL /A025 11 JMP REPORT / GO REPORT RESULTS /A025 /-------------- PAGE /DISPLAY THE RECORD NO. BEING PROCESSED /M019 DISREC, XX /M019 AC0001 / SET RECORD NUMBER FOR OUTPUT /A019 TAD RECNUM DCA DISRE1 / STORE NUMBER FOR OUTPUT /A019 CIFMNU /A019 JMS I IOACAL /A019 0 /A019 DISMSG / ADDRESS OF TEXT STRING TO OUTPUT /A019 0000 / ^P - POSITION CURSOR TO HOME /A019 DISRE1, .-. / ^D - RECORD NUMBER TO OUTPUT /A019 / ^L - ERASE TO END OF LINE /A019 0100 / ^P - POSITION CURSOR (LINE 1, COL. 0) /A019 / ^L - ERASE TO END OF LINE /A019 2700 / ^P - POSITION CURSOR (LINE 27, COL. 0)/A042 JMP I DISREC /RETURN /A019 DISMSG, IFDEF ENGLSH < TEXT '^P&RECORD BEING PROCESSED: ^D^L^P^L^P' > /M042 IFDEF ITALIAN< TEXT '^P&RECORD IN ELABORAZIONE: ^D^L^P^L^P' > IFDEF CANADA < TEXT "^P&ENR. EN COURS DE TRAITEMENT: ^D^L^P^L^P" > /M042 IFDEF FRENCH < TEXT "^P&ENREGISTREMENT EN COURS : ^D^L^P^L^P" > /M042 IFDEF DUTCH < TEXT "^P&GEGEVENSGROEP VERWERKT: ^D^L^P^L^P" > /M042 IFDEF GERMAN < TEXT "^P&VERARBEITETER SATZ: ^D^L^P^L^P" > /M042 IFDEF NORWAY < TEXT "^P&FOREKOMSTER BEHANDLET: ^D^L^P^L^P" > /M042 IFDEF SWEDSH < TEXT "^P&BEHANDLADE F\REKOMSTER: ^D^L^P^L^P" > /L.U.O /M042 IFDEF DANISH < TEXT "^P&FOREKOMSTER BEHANDLET: ^D^L^P^L^P" > /M042 /SUBROUTINE TO HANDLE UNBUNDLING - CHECK IF MATH FEATURE IS ACTIVATED /A020 /THIS ROUTINE IS CALLED WHEN A CONTROL BLOCK IS FOUND IN LIST /A020 /PROCESSING. IF THE MATH FEATURE IS ON THEN THE BLOCK IS PROCESSED, /A020 /AND IF IT IS NOT THEN AN EXIT IS DONE FROM "CHKMTH" TO THROW OUT THE /A020 /CONTROL BLOCK AND CONTINUE NORMAL LIST PROCESSING /A020 /ROUTINE IS CALLED FROM INSIDE "CNTROL" ROUTINE /A020 IFDEF UNBUND < /A020 CHKMTH, XX /CHECK MATH FEATURE ROUTINE /A020 CDFMNU /SET TO MENU DATA FIELD /A020 TAD I (MUBUF+MNOPTC /GET ACTIVE FEATURES CONTROL WORD /A020 CDFMYF /RETURN TO LIST PROCESSING FIELD /A020 AND (MABIT /GET ACTIVATED MATH FEATURE CONTROL WORD /A020 SZA CLA /IS THE MATH FEATURE ACTIVATED? /M027 ISZ CHKMTH / YES: SKIP RETURN TO PROCESS LP CONTROL BLOCK /M027 JMP I CHKMTH / NO: NORMAL RETURN TO DUMP CTRL BLOCK &.... /M027 / ...RETURN TO REGULAR LP /M027 > /END IFDEF UNBUND /A020 /SUBROUTINE USED IN CONJUNCTION WITH LP MATH INTERFACE ROUTINE "CNTROL" /A021 /CHECKS FOR END OF CONTROL BLOCK CHAR. AND TREATS IT ACCORDINGLY /A021 /THIS RTN CAN ONLY BE UNDERSTOOD WITHIN THE CONTEXT OF "CNTROL" /A021 /NOTE: IN THIS ROUTINE THE "JMP EXITCB" TO EXIT VARIES WITH THE /A038 / PSUEDO-CODE FOR "CNTROL". THIS IS DONE TO SAVE ON LOCATIONS /A038 / SPACE AND EXECUTION TIME. NORMALLY WOULD SAY THE FOLLOWING IN /A038 / PLACE OF "JMP EXITCB". /A038 / ------------- / ------------- /A038 / JMP EXITC1 (THIS WOULD REPLACE "JMP EXITCB") /A038 / ------------- /A038 / EXITC1, DCA ENDCBF (THIS WOULD BE ADDED AT END OF "CHKEOB" /A038 / JMP NXCTRL (THIS WOULD BE ADDED AT END OF "CHKEOB" /A038 CHKEOB, XX /"END OF BLOCK" CHAR SERVICE ROUTINE /A021 TAD T1 /GET BACK CHAR JUST READ IN FROM CTRL BLOCK /A021 TAD (-1414 /GET NEGATIVE OF END OF CONTROL BLOCK CHAR /A021 SZA CLA /IS IT THE END OF THE CONTROL BLOCK? /A021 JMP I CHKEOB / NO: GO CONTINUE NORMAL PROCESSING OF BLOCK /A021 TAD STRTLN / YES: GET "START OF NEW LINE" FLAG /A021 SNA CLA /IS IT THE START OF A NEW LINE? /A021 JMP EXITCB / YES: GO EXIT CONTROL BLOCK PROCESSING /A021 JMP CTLOVR / NO: GO CONVERT CHAR, SET FLAG, & PROCESS /A021 /SUBROUTINE TO TAKE JUSTIFIED SPACE (ECJSPC) AND WRAPPED LINE (ECWWLN) /A022 /CHARACTERS AND STRIP THEM OUT BEFORE PUTTING CONTROL BLOCK CHARACTERS /A022 /INTO LINEBUFFER (LNEBUF) IN MATH FIELD. THIS ROUTINE UNDERSTOOD IN /A022 /CONTEXT OF "CNTROL" L.P./MATH INTERFACE ROUTINE /A022 STRPCH, XX /STRIP WRAPS & SOFT SPACES ROUTINE /A022 TAD (-ECWWLN /GET NEGATIVE OF SOFT RETURN /A022 TAD T1 /GET CONTROL BLOCK CHAR READ FROM FILE /A022 SNA /IS IT A WRAPPED RETURN? /A022 JMP CATCH1 / YES: DUMP IT & GO READ IN NEXT CHAR /A022 TAD (ECWWLN-ECJSPC / NO: RESET CHAR & GET SOFT SPACE /A022 SNA /IS IT A JUSTIFIED SPACE? /A022 /M033 JMP CATCH1 / YES: DUMP IT & GO READ IN NEXT CHAR /A022 TAD (ECJSPC-ECHYLN / NO: RESET & GET SOFT RTN WITH HYPHEN /A033 SNA CLA /IS IT A SOFT RETURN WITH HYPHEN? /A033 JMP CATCH1 / YES: DUMP IT & GO READ IN NEXT CHAR /A033 JMP I STRPCH / NO: RETURN TO CALLER TO ENTER CHAR IN LNEBUF /A022 /SUBROUTINE USED TO THROW OUT A CONTROL BLOCK IF IT IS NOT MATH. /A023 /UNDERSTOOD IN THE CONTEXT OF "CNTROL" L.P./MATH INTERFACE ROUTINE /A023 JNKBLK, XX /DUMP NON-MATH CONTROL BLOCK - ROUTINE /A023 CLA /CLEAR AC /A023 TAD ENDCBF /GET "END OF CONTROL BLOCK" FLAG /A023 SNA CLA /IS IT THE END OF THE BLOCK? /A023 JMP EXTJNK / YES: GO EXIT /A023 ENDBLK, JMS RDNXCH / NO: GO READ IN NEXT CHAR /A023 SPA SNA /IS IT AN "END OF FILE" CHAR? /A023 JMP RTNCHR / YES: RETURN TO CALLER WITH EOF ERROR /A023 TAD (-ECPCT2 / NO: ADD NEGATIVE OF "END OF CTRL BLOCK" CHAR /A023 SZA CLA /IS IT THE END OF THE CONTROL BLOCK? /A023 JMP ENDBLK / NO: DUMP CHAR & GO GET ANOTHER CHAR /A023 EXTJNK, JMP I JNKBLK / YES: GO EXIT TO CONTINUE NORMAL L.P. /A023 NUMCMP, 0 /COMPARES TWO NUMBERS OF EQUAL LENGTH /AND DETERMINES IF THEY ARE EQUAL OR WHICH IS LARGER. /FIRST NUMBER (IN ASCII) IS POINTED BY SPCSTR. /SECOND NUMBER (ASCIZ) IS IN THE GPBUF BUFFER. /CALLED BY: /JMS NUMCMP /RETURN (AC = 0 MEANS NUMBERS EQUAL, / AC = +1 MEANS NUMBER 2 > NUMBER 1, / AC = -1 MEANS NUMBER 2 < NUMBER 1) AC7777 /SET UP PTR TO FIRST NUMBER TAD SPCSTR /IN AUTO-INDEX DCA TAI1 TAD NUMFLD / IF NUMERIC COMPARE ( <:NAME> ) /A030 SZA CLA / THEN /A030 JMP NUMCM1 / USE BCD COMPARE ROUTINE /A030 TAD (GPBUF-1 /SET UP PTR TO NUMBER 2 DCA TAI2 /IN AUTO-INDEX NMCMLP, TAD I TAI2 /GET A CHAR SNA / NULL ? JMP I NUMCMP /YES, RETURN WITH NUMBERS EQUAL CIA /NO, SUBTRACT FROM TAD I TAI1 /FIRST NUMBER SNA /SAME ? JMP NMCMLP /YES, KEEP GOING SMA CLA /NO, SET AC AC7776 /-1 FOR LESS THAN IAC /+1 FOR GREATER THAN JMP I NUMCMP /AND RETURN /THIS IS FORM COMPARING NUMBERS THAT ARE IN NUMERIC FIELDS LIKE <:A> /A030 / AS OPPOSED TO /A030 NUMCM1, TAD (BCDAR2-1 /GET ADDRESS OF PLACE FOR BCD IN MATH FIELD /A030 DCA TAI2 / AND PUT IN AUTO INCREMENT REGISTER /A030 TAD (-6 / GET SIZE OF PACKED BCD WORD /A030 DCA T1 / AND INITIALIZE LOOP COUNTER /A030 NUMCM2, TAD I TAI1 / LOOP; GET BCD VALUE FORM SPEC TABLE /A030 CDFMTH / /A030 DCA I TAI2 / AND PUT IN MATH FIELD /A030 CDFMYF / /A030 ISZ T1 / /A030 JMP NUMCM2 / END_LOOP /A030 CIFMTH / NOW CALL ARITHMETIC COMPARE ROUTINE IN MATH /A030 JMS BCDCOM / FIELD /A030 BCDAR1 / ADDRESS OF NUMBER FROM SPEC DOC /A030 BCDAR2 / ADDRESS OF NUMBER FROM LIST /A030 JMP I NUMCMP /RETURN (AC = 0 MEANS NUMBERS EQUAL, /A030 / AC = +1 MEANS NUMBER 2 > NUMBER 1, /A030 / AC = -1 MEANS NUMBER 2 < NUMBER 1) /A030 /-------------- PAGE /THIS ROUTINE CHECKS TO SEE IF THE RECORD NUMBER IS WITHIN /A042 /THE RANGE OF THE FROM - TO SETTINGS. IT ALSO CHECKS TO SEE /A042 /IF THE HALT FLAG IS SET BY THE USER PRESSING GOLD-HALT /A042 / CALLED BY: /A042 / JMS CHKREC /A042 / SKIP RECORD RETURN /A042 / DONE ALL RECORDS RETURN OR HALT FLAG SET RETURN /A042 / PROCESS RECORD RETURN /A042 CHKREC, XX /A042 CDFSYS / CHANGE TO THE SYSTEM FIELD /A042 TAD I HLTFLG / PICK UP THE HALT FLAG /A042 CDFMYF / CHANGE BACK TO OUR FIELD /A042 SZA CLA / SKIP IF HALT FLAG IS NOT SET /A042 JMP CHKPRC / SET, RETURN WITH NO MORE RECORDS /A042 TAD FRREC / PICK UP THE FROM RECORD COUNT /A042 CIA STL / NEGATE IT AND SET THE LINK /A042 TAD RECNUM / COMBINE WITH CURRENT RECORD NUMBER /A042 SZL CLA / SKIP IF ABOVE LOWER RANGE /A042 JMP CHKXIT / TOO LOW, SKIP THIS RECORD /A042 ISZ CHKREC / BUMP RETURN ADDRESS /A042 TAD TOREC / GET THE RECORD NUMBER TO PROCESS UP TO/A042 SNA / IS TO-RECORD NUMBER ZERO ? /A042 JMP CHKPRC / YES, GO TO PROCESS RECORD RETURN /A042 CIA CLL / NEGATE IT AND CLEAR THE LINK /A042 TAD RECNUM / COMBINE WITH CURRENT RECORD NUMBER /A042 SNL CLA / IF LINK IS SET, THEN WE ARE ALL DONE /A042 CHKPRC, ISZ CHKREC / BUMP RETURN PAST ALL DONE RETURN /A042 CHKXIT, JMS INCNUM / BUMP THE RECORD COUNT TO NEXT RECORD /A042 RECNUM / POINTER TO THE RECORD NUMBER /A042 JMP I CHKREC / RETURN TO CALLER /A042 TOREC, 0 FRREC, 0 NUM, /LOADS A STRING FROM RECBUF INTO GPBUF REMOVING /M025 /ALL NON-NUMERIC CHARS. AND ALL LEADING ZEROES. /M025 CLA TAD LDNMFL /HAVE WE BEEN HERE BEFORE ? SZA CLA JMP NUM1 / YES - SO GET OUT! /M025 ISZ LDNMFL /NO, MAKE SURE WE DON'T COME AGAIN TAD (GPBUF-1 /SET UP AUTO-INDEX PTR DCA GPPTR TAD (GPBSIZ+1 /AND COUNTER CIA DCA NUMSIZ AC7777 /RESET REC BUFFER PTR TO BEGINNING OF FIELD TAD FDSTRT DCA RCBPTR TAD (SPA SNA) /SET TO IGNORE LEADING ZEROES DCA NUM4 /M025 TAD NUMFLD /IF NUMERIC FIELD ( <:NAME> ) /A030 SZA CLA /A030 JMP NUM6 /THEN HANDLE REAL NUMBER /A030 NUM3, JMS SSRBRD /GET A CHAR /M025 TAD (-74 /SEE IF '<' ? SNA JMP NUM5 /YES, ALL DONE /M025 TAD (-2 /NO, SEE IF '>' ? SNA / SKIP IF: NOT A '<' /M025 JMP REVRBFD / ERROR - '>' IN A FIELD /M025 TAD (4 /NO, SEE IF ASCII 9 OR LESS SMA JMP NUM3 /NO, SKIP IT /M025 TAD (12 /YES, SEE IF ASCII 0 OR MORE NUM4, XX /MODIFIED TO IGNORE LEADING ZEROES /M025 JMP NUM3 /SKIP CHAR /M025 TAD (60 /MAKE ASCII AGAIN ISZ NUMSIZ /SEE IF ROOM FOR CHAR JMP NUM2 CLA CLL /A025 JMP REVLGNM / ERROR - FIELD VALUE NUMBER EXCEEDS 30 /M025 / CHARACTERS /A025 NUM2, DCA I GPPTR /STORE CHAR TAD (SPA /TURN OFF ZERO SUPRESSION DCA NUM4 /M025 JMP NUM3 /GET ANOTHER CHAR /M025 NUM5, TAD NUMSIZ /CALCULATE SIZE OF NUMBER TAD (GPBSIZ+1 DCA NUMSIZ /AND SAVE IT DCA I GPPTR /STORE TRAILING ZERO NUM1, JMP ENUM / GO SEE IF EXACT COMPARE /M025 NUM6, JMS LDFLD / LOAD NUMBER INTO TOKVAL BUFFER IN /A030 / MATH FIELD /A030 JMP ORLP / NO NUMBER IN FIELD SO FAIL ON MATCH /A030 JMS TOKOUT / OUTPUT TRAILING ZERO IN TOKVAL /A030 CIFMTH / CALL ASCII TO BCD ROUTINE IN MATH FLD /A030 JMS ASCBCD / /A030 TOKVAL / ADDRESS OF ASCII (IN MATH FIELD) /A030 BCDAR1 / ADDRESS OF BCD OUTPUT (IN MATH FLD) /A030 JMP ABERR / INVALID NUMBER SO FAIL MATCH /A036 / CHECK NEXT OR GROUP /A030 AC0006 / MAKE NUMBER SIZE = LENGTH OF PACKED/A030/M036 DCA NUMSIZ / SO IT IS SAME AS MLEN AND ELEN /A030 JMP ENUM / NOT GO DO COMPARES /A030 NUMSIZ, 0 LDNMFL, 0 TRUE, TAD I PTYWD /TRUE, GET TYPE WORD CLL RTL /SEE WHICH WAY TO SET SIGN BIT SZL JMP TRUFLS /MUST WANT IT SET TO FALSE (1) RAR /OTHERWISE, GET IN POSITION CLL RAR /AND SET SIGN BIT TO TRUE (0 - POSITIVE) TRUE1, DCA I PTYWD /AND STORE BACK NXTSPC, TAD NXTSPR /GET PTR TO NEXT SPEC SNA /LAST ONE? JMP FNLP /YES, NEXT FIELD TAD (-1 /NO, MAKE THIS SPEC JMP FNLP2 TRUFLS, RAR /GET IN POSITION STL RAR /AND SET SIGN BIT TO FALSE (1 - NEGATIVE) JMP TRUE1 /AND STORE IT PTYWD, 0 /-------------- PAGE /++ / LIST PROCESSING CONTROL BLOCK EVALUAION CODE / /FUNTIONAL DESCRIPTION: "CNTROL" / / PSUEDO-CODE DESCRIPTION: / / SET END_OF_CONTROL_BLOCK FLAG = FALSE / IF MATH FEATURE NOT ACTIVE / THEN DUMP CONTROL BLOCK / RETURN TO NORMAL L.P. PROCESSING / ELSE SET CONTROL_BLOCK_FIRST_LINE FLAG = TRUE / DO WHILE END_OF_CONTROL_BLOCK FLAG = FALSE / SET START_OF_NEW_LINE FLAG = TRUE / INIT INPUT LINE BUFFER IN MATH FIELD / DO WHILE START_OF_NEW_LINE = FALSE / GET CHAR FROM RECORD / IF CHAR = EOF / THEN RETURN TO CALLER WITH EOF ERROR / ELSE SAVE CHAR / CASE OF CHAR = / / SPECIAL "END OF CTRL BLOCK" CHARACTERS: / IF START_OF_NEW_LINE = FALSE / THEN SET END_OF_CONTROL_BLOCK FLAG = FALSE / ELSE SET "END OF CTRL BLOCK" CHAR = HARD RETURN / ENDIF / / START OF RULER CHAR: / DUMP RULER CHARACTERS / RETURN TO GET NEXT CHAR / / SPECIAL CHAR: / IF START_OF_NEW_LINE = TRUE / THEN DUMP SPECIAL CHAR / RETURN TO GET NEXT CHAR / ENDIF / / SOFT WRAP OR JUSTIFIED SPACE: / DUMP CHARACTER / RETURN TO GET NEXT CHAR / / END PARAGRAPH OR CENTERED LINE: / SET CHAR = HARD RETURN / / END CASE / / PUT CHAR INTO INPUT LINE BUFFER / CASE RETURN FROM MATH = / / SINGLE SKIP RETURN: / PASS RETURNED ERROR NUMBER TO ERROR HANDLER / / DOUBLE SKIP RETURN: / THROW OUT CONTROL BLOCK BECAUSE IT IS NOT MATH BLOCK / / TRIPLE SKIP RETURN: / IF LAST CHAR PUT IN INPUT LINE BUFFER = HARD RETURN / THEN GO TO MATH & PROCESS LINE / CASE RETURN FROM MATH = / / REGULAR RETURN: / SET START_OF_NEW_LINE FLAG = TRUE / / SINGLE SKIP RETURN: / PASS RETURNED ERROR NUMBER TO ERROR HANDLER / / DOUBLE SKIP RETURN: / THROW OUT BLOCK CAUSE NOT MATH / / END CASE / ENDIF / END CASE / ENDIF / END DO / END DO / RETURN TO NORMAL LP PROCESSING / END PSUEDO-CODE / /CALLING SEQUENCE: . / /NOTE; THE HOOK IS MADE FROM LIST PROCESSING WITHIN THE "GETCHR" RTN /WHERE THE CODE CHECKS FOR A PRINT CONTROL BLOCK. THE FOLLOWING SHOWS /EXACTLY WHERE THIS IS DONE: / /GETCHR,0 . /THIS ROUTINE READS CHARS FROM A FILE / . / . /RTNCHR,JMP I GETCHR / . / . / . /SSCPC, TAD TI /SEE IF START OF CONTROL BLOCK / TAD (-1014 /GET NEGATIVE OF CONTROL BLOCK CHARACTER / SZA CLA /IS IT START OF CONTROL BLOCK? / JMP GTCHRT / NO: MUST HAVE BEEN NORMAL FF /*******JMP CNTROL******/ YES: HOOK MADE HERE TO CONTROL BLOCK PROCESSING *** / . / /INPUT PARAMETERS: FSTLNE,MNOPTC,MABIT,T1 / /IMPLICIT INPUT: ENDCBF, STRTLN, CALLS TO RTRN1, RTRN2, RTRN3, RDNXCH / /OUTPUT PARAMETERS: (TO THE MATH MODULE) / /IMPLICIT OUTPUT: ENDCBF,STRTLN, / /COMPLETION CODE: / / "JMP RTNCHR" - RETURN THRU GETCHR TO CALLER IN CASE OF EOF ERROR / "JMP ERRHAN" - PASSES ENCOUNTERED MATH ERRORS BACK THRU ERROR HANDLER / "JMP GTCHLP" - RETURN TO GETCHR RTN TO CONTINUE NORMAL PROCESSING ONCE / BLOCK PROCESSING COMPLETED. / /SIDE EFFECTS: SET UP OF DATA STRUCTURES & PARAMETERS IN THE MATH / MODULE; "CNTROL" INTERACTS DIRECTLY AND INDIRECTLY WITH / THE MATH. / THIS CODE IS USED IN LIST PROCESSING TO PARSE THE / CONTROL BLOCKS IN A LIST. IT CHECKS WHETHER IT IS A / MATH CONTROL BLOCK AND, IF SO, WHAT CONTROL WORDS ARE / USED IN THE BLOCK. IT ALSO MAKES USE OF THE COMMAND / PARSER AND TRANSLATOR TO PERFORM THIS PROCESSING. / /-- /LIST PROCESSING MATH CONTROL BLOCK PROCESSING CODE. /THIS CODE HANDLES ONLY CHARACTERS WITHIN THE CONTROL BLOCK /VALUES USED IN CONTROL BLOCK EVALUATION CODE ENDCBF, 0 /"END OF CONTROL BLOCK" FLAG STRTLN, 0 /"START OF NEW LINE" FLAG /CONTROL BLOCK MATH EVALUATION CODE /NOTE: WITHIN THE LIST PROCESSING CONTROL BLOCK CODE, "CIF'S" MADE TO THE MATH /FIELD ARE HANDLED IN THE CALLED MATH FIELD ROUTINE SO AS TO AUTOMATICALLY /RETURN PROGRAM CONTROL TO THE LIST PROCESSING FIELD ONCE THE CALLED MATH /FIELD ROUTINE HAS BEEN EXECUTED. /FIRST SET "END OF CONTROL BLOCK" FLAG ACCORDINGLY CNTROL, AC0001 /PUT 1 IN THE AC DCA ENDCBF /SET "END OF CONTROL BLOCK" FLAG = FALSE /BEFORE PROCESSING CONTROL BLOCK SEE IF UNBUNDLING IS DEFINED /A020 IFDEF UNBUND < /A020 JMS CHKMTH /IF UNBUNDLING DEFINED THEN GO SEE IF MATH /A020 /FEATURE IS ACTIVATED. IF IT IS THEN ROUTINE /A020 /WILL SKIP RETURN HERE TO PROCESS CONTROL BLOCK /M027 /IF NOT THEN THE BLOCK IS DUMPED AND A RETURN /A020 /IS DONE TO NORMAL LIST PROCESSING /A020 JMP ENDPCB /RETURN HERE FROM "CHKMTH" IF NOT MATH - DUMP /A027 /...BLOCK & GO BACK TO NORMAL LIST PROCESSING /A027 > /END IFDEF UNBUND /A020 /SKIP RETURN HERE FROM "CHKMTH" IF MATH ACTIVATED /A027 /GO INITIALIZE "CONTROL BLOCK FIRST LINE" FLAG CDFMTH /CHANGE DATA FIELD REGISTER TO MATH FIELD DCA I (FSTLNE /GO SET "CONTROL BLOCK FIRST LINE" FLAG = TRUE CDFMYF /RESET TO LP DATA FIELD /CHECK FOR END OF CONTROL BLOCK. IF NOT END OF BLOCK THAN /INITIALIZE "START OF NEW LINE" FLAG AND MATH FIELD INPUT /LINE BUFFER POINTER NXCTRL, TAD ENDCBF /GET "END OF CONTROL BLOCK" FLAG SNA CLA /IS IT THE END OF THE CONTROL BLOCK? JMP EXITCB / YES: GO EXIT CONTROL BLOCK PROCESSING CODE DCA STRTLN / NO: SET "START OF NEW LINE" FLAG = TRUE CIFMTH /CHANGE PROGRAM CONTROL TO MATH FIELD JMS RTRN1 /INITIALIZE INPUT LINE BUFFER POINTER IN MATH FIELD /PROCESS CHARACTERS WITHIN THE CONTROL BLOCK CATCH1, JMS RDNXCH /GET A CHARACTER FROM THE FILE SPA SNA /IS THE CHARACTER RETURNED AN END OF FILE? JMP RTNCHR / YES: RETURN TO CALLER WITH EOF ERROR DCA T1 / NO: SAVE IT /THE FOLLOWING CALL IS MADE TO "CHKEOB" AS A SUBROUTINE TO /A021 /HANDLE SPECIAL CASES OF "END OF CTRL BLOCK" CHAR /A021 /A RETURN IS DONE BACK HERE IF NONE OF THE SPECIAL CASES /A021 /WERE MET. OTHERWISE THEY WILL BE TREATED DIRECTLY FROM THAT /A021 /ROUTINE. (DONE THAT WAY DUE TO LACK OF SPACE ON THIS PAGE) /A021 JMS CHKEOB /CHECK ON SPECIAL "END OF CTRL BLOCK" CASES /A021 /RETURN TO CONTINUE PROCESSING IF ALL IS WELL /A021 /CHECK FOR RULERS IN THE BLOCK TAD T1 /GET CHARACTER BACK TAD (-16 /GET NEGATIVE OF START OF RULER SNA CLA /IS IT THE START OF A RULER? JMP ENDRUL / YES: GO DUMP RULER CHARACTERS / NO: THEN CHECK FOR START OF NEW LINE TAD STRTLN /GET "START OF NEW LINE" FLAG SZA CLA /IS IT THE START OF A NEW LINE? JMP INPCHK / NO: THEN CONTINUE TO PROCESS CHARACTER /A022 /SCREEN OUT LEADING SPECIAL CHARACTERS FROM INPUT LINE TAD T1 / YES: GET INPUT CHAR BACK AND P177 /SCREEN OUT HIGH BITS TAD (-41 /GET NEGATIVE OF UPPER LIMIT OF SPECIAL CHARACTERS SPA /IS IT A SPECIAL CHARACTER? JMP CATCH1 / YES: DUMP IT AND READ IN NEXT CHARACTER DCA STRTLN / NO: SET "START OF NEW LINE" FLAG = FALSE /GO STRIP OUT ANY SOFT RETURNS AND/OR SOFT SPACES /A022 INPCHK, JMS STRPCH /GO DUMP WRAPS & JUSTIFIED SPACES /A022 /PUT CHARACTER READ IN FROM FILE INTO INPUT LINE BUFFER IN MATH FIELD INPCHR, TAD T1 /GET CHARACTER BACK INTO AC DCA PASOVR /SAVE IT IN LOCATION AFTER CALL TO MATH FLD TO PASS IT CIFMTH /SET PROGRAM CONTROL TO MATH FIELD JMS RTRN2 /AND GO PUT INPUT CHARACTER INTO INPUT LINE BUFFER PASOVR, 0 /CONTAINS INPUT CHAR TO PASS TO RTRN2 RTN IN MATH FLD JMP ERRHAN /SKIP RETURN TO HERE FROM RTRN2 IF THERE WAS A /A025A /MATH FIELD INPUT LINE BUFFER OVERFLOW WITHIN /A025A /THE CONTEXT OF A MATH CONTROL BLOCK /A025A /THE AC CONTAINS THE PASSED ERROR NUMBER /A025A JMP ENDPCB /DOUBLE SKIP RETURN DONE HERE FROM "RTRN2" IF /INPUT LINE BUFF OVERFLOW AND NOT A MATH CONTROL BLOCK / - PROCEED TO THROW OUT THE CONTROL BLOCK. TAD T1 /TRIPLE SKIP RETURN FROM "RTRN2" DONE HERE IF INPUT /CHARACTER PLACED INTO INPUT LINE BUFFER WITHOUT AN /OVERFLOW. CONTINUE TO SEE IF LAST CHAR READ IN IS A /LINEFEED (I.E. HARD RETURN). TAD (-ECNWLN /GET NEGATIVE OF NEW LINE (HARD RETURN) SZA CLA /IS IT THE END OF THE LINE BEING READ IN? JMP CATCH1 / NO: GO GET NEXT CHARACTER CIFMTH / YES: GO TO MATH FIELD TO PROCESS INPUT LINE JMS RTRN3 /PROCESS STRING OF CHAR JUST READ INTO INPUT LINE BUFF JMP NXCTRL /GO START NEW INPUT LINE /NOTE: IF AN ERROR IS ENCOUNTERED IN THE MATH CODE WHILE PROCESSING /THE MATH CONTROL BLOCK THEN A SKIP RETURN IS DONE FROM "JMS RTRN3" /WITH ERROR NUMBER IN THE AC. JMP ERRHAN /GO PROCESS ERROR RETURNED FROM THE MATH MODULE /NOTE: IF THE ABOVE "JMS RTRN3" ROUTINE FINDS NO MATCH UP IN THE /SYMBOL TABLE WITH THE INPUTTED CONTROL WORD, AND IT IS THE FIRST LINE /OF CHARACTERS OF THE CONTROL BLOCK THAN, WHEN RETURNING TO /LIST PROCESSING, A DOUBLE SKIP RETURN IS DONE /TO THE FOLLOWING CODE IN ORDER TO PROCESS AS NOT BEING A "MATH" /CONTROL BLOCK. /THROW OUT CONTROL BLOCK IF IT IS NOT MATH, THEN RETURN TO L.P. ENDPCB, JMS JNKBLK /M023 /A NORMAL RETURN IS DONE FROM "ENDPCB" IF NO PROBLEM /M023 /IS ENCOUNTERED WHILE STRIPPING OUT NON-MATH CTRL BLOCK /M023 /OTHERWISE SPECIAL CASE OF EOF HANDLED FROM "JNKBLK" /M023 EXITCB, JMP GTCHLP /GO BACK TO CONTINUE NORMAL PROCESSING /RTN TO PROCESS END OF CONTROL BLOCK CHAR IN CONTROL BLOCK. THIS IS /DONE IN THE CASE WHERE AN "END OF CONTROL BLOCK" CHAR TERMINATES /THE BLOCK WHILE NOT PRECEDED BY A "LINE FEED" (I.E. HARD RETURN) /CHAR. IT IS REPLACED BY A HARD RETURN TO ACCOMODATE THE "LEXIC" /ROUTNE IN THE MATH AREA. CTLOVR, TAD (ECNWLN /GET ASCII FOR LINEFEED (HARD RETURN) CHARACTER /CHANGE END OF CONTROL BLOCK CHAR WITH A HARD RETURN /CHAR TO MAKE INPUT LINE COMPATIBLE WITH LEXIC SCANNER DCA T1 /REPLACE END OF CONTROL BLOCK CHAR WITH IT DCA ENDCBF /SET "END OF CONTROL BLOCK" FLAG = TRUE JMP INPCHR /GO PUT LINEFEED CHAR INTO INPUT BUFFER & PROCESS LINE /THIS CODE THROWS OUT ANY RULERS IN THE PRINT CONTROL BLOCK ENDRUL, JMS RDNXCH /READ IN NEXT CHARACTER FROM FILE SPA SNA /IS THERE AN ERROR CONDITION? JMP RTNCHR /ABOVE "JMP GETCHR" SHOULD BE AN INDIRECT. BUT /A038 /THIS WOULD CAUSE AN ERROR SINCE "GETCHR" IS OFF/A038 /PAGE. THEREFORE THE RETURN HAS BEEN DONE THRU A/A038 /LABEL ON THE SAME PAGE AS "GETCHR" /A038 TAD (-17 / NO: GET NEGATIVE OF END OF RULER CHARACTER SZA CLA /IS IT THE END OF THE RULER? JMP ENDRUL / NO: TRY AGAIN JMP CATCH1 / YES: GO GET A CHARACTER FROM THE FILE / GET_FIELD_VALUE / (NOTE: THIS ROUTINE IS EXITED FROM NXTCHR IN NORMAL CIRCUMSTANCES ) / (* THIS ROUTINE WILL PUT THE FIRST CONTIGUOS STRING OF PRINTABLE CHARACTERS / FROM THE FIELD VALUE INTO A BUFFER TO BE USED IN CALLING THE ASCII TO / BCD ROUTINE *) LDFLD, XX TAD (TOKVAL-1 / INITIALIZE POINTERS DCA TAI2 / INIT POINTER TO OUTPUT IN MATH FIELD TAD (-GPBSIZ-1 /M024 DCA T1 / INIT COUNTER TO MAX. CHARS ALLOWED LDFLD1, JMS NXTCHR / WHILE NEXT_CHAR NOT PRINTABLE DO JMP LDFLD1 / GET NEXT_CHAR / END_WHILE ISZ LDFLD / SET UP SKIP RETURN TO SHOW WE DON'T HAVE / A NULL FIELD VALUE JMS TOKOUT / OUTPUT FIRST PRINTABLE CHARACTER ISZ T1 / INCREMENT COUNTER LDFLD2, JMS NXTCHR / LOOP GET_CAHR JMP LDFLD3 / EXIT IF NEXT_CHAR NOT PRINTABLE JMS TOKOUT / PUT CHARACTER INTO TOKVAL ISZ T1 / EXIT IF TOO MANY CHARACTERS JMP LDFLD2 / END-LOOP JMP REVLGNM / ERROR - FIELD VALUE NUMBER EXCEEDS 30 /M025 / CHARACTERS LDFLD3, JMS GFDEND / READ TO END OF CURRENT FIELD VALUE JMP I LDFLD / EXIT ROUTINE NXTCHR, 0 / READS CHAR FROM EDIT BUFFER, STRIPS MODE BITS / REGULAR RETURN IF UNPRINTABLE CHARACTER (I.E. LESS / THAN 41 OCTAL) / SKIP RETURN IF A PRINTABLE CHARACTER / EXITS LDFLD IF '<' (END OF FIELD) FOUND JMS SSRBRD / CALL GET_CHAR ROUTINE (MODE BITS ARE STRIPED) TAD (-74 / IS IT A '<'? SNA JMP I LDFLD / YES SO EXIT LDFLD ROUTINE (NOTE: LDFLD CALLED US) TAD (74-76 / NO, IS IT A '>' SNA JMP REVRBFD / ERROR - '>' FOUND IN FIELD /d003 TAD (76-41 / NO, IS IT A PRINTABLE CHARACTER? TAD (76-ECSTOV) / Test for start of dead key sequence /a003 JMS NXTMCT / Test for a multi-national character /a003 TAD (ECSTOV) / Returns here if not dead key sequ. /a003 TAD (-41) / Test for non-printable character /a003 SMA ISZ NXTCHR / ITS PRINTABLE SO DO A SKIP RETURN TAD (41 / RESTORE CHARACTER JMP I NXTCHR / RETURN /-------------- PAGE / LP - PROCESS RECORD / THIS CODE WILL INTEGRATE WITH WPSELC.PA TO DO THE MATH ON ALL / RECORDS THAT ARE SELECTED AND TO SET UP A NEW RECORD CONSISTING / OF THE RESULTS OF ALL FORMULAE AFTER THE LAST RECORD IS PROCESSED. / MAJOR ROUTINES/MODULES TO INTEGRATE WITH: / / 1) SELCT- ROUTINE IN WPSELC.PA. GETS NEXT RECORD / SELCT WILL CALL THIS ROUTINE JUST / BEFORE IT RETURNS TO ITS CALLER / 2) LFLDNM- ROUTINE IN WPSELC.PA. GETS FIELD NAME / JMS LFLDNM / BUFFER_ADDRESS (TOKVAL IN OUR CASE) / ON RETURN / AC=0 OK / AC=-1 END OF RECORD / AC=+ ERROR / AC=1 '<' BEFORE '>' / AC=2 FIELD NAME TOO LARGE / / 3) ASCBCD- ROUTINE TO CONVERT A RAW ASCII NUMBER TO PACKED BCD / CDFMYF / MAKE SURE CDF IS SET TO MY FIELD SO ASCBCD KNOWS / / WHERE TO RETURN / CIFMTH / CHANGE TO MATH INSTRUCTION FIELD / JMS ASCBCD / CALL CROSS-FIELD CALLABLE ROUTINE / ASCII_INPUT_ADDRESS / BCD_OUTPUT_ADDRESS / ON RETURN / AC=0 OK / AC=+ ERROR, NUMBER OF ERROR IN AC / / 4) BCDASC- ROUTINE TO CONVERT PACKED BCD TO ASCII USING CORRECT FORMAT / CDFMYF / MAKE SURE CDF IS SET TO MY FIELD SO BCDASC KNOWS / / WHERE TO RETURN / CIFMTH / CHANGE TO MATH INSTRUCTION FIELD / JMS BCDASC / CALL CROSS-FIELD CALLABLE ROUTINE / BCD_INPUT_ADDRESS / IN MATH FIELD / ASCII_OUTPUT_ADDRESS / IN ANY FIELD / CDF TO ASCII_OUTPUT_ADDRESS FIELD / ON RETURN / AC=POINTER TO FIRST LOCATION AFTER LAST CHAR IN OUTPUT / / 5) SYMCHK- ROUTINE IN MATH FIELD TO LOOK UP A SYMBLE IN THE MATH / SYMBLE TABLE / CDFMYF / MKE SURE CDF IS SET TO MY FIELD / CIFMTH / CHANGE TO MATH INSTRUCTION FIELD / JMS SYMCHK / CALL CROSS-FIELD CALLABLE ROUTINE / RETURN HERE IF SYMBLE NOT FOUND / RETURN HERE IS SYMBLE FOUND AC=POINTER TO VALUE IN TABLE / / / ON ENTRY / AC=0 NEED TO DO MATH ON RECORD STORED IN EDIT BUFFER AND ADD / FIELDS TO RECORD IN EDIT BUFFER FROM RESULTS LIST. / / AC=-1 NO MORE RECORDS. NEED TO CREATE A RECORD IN EDIT BUFFER / OUT OF THE RESULTS LISTS. / / ON EXIT / RECORD IN EDIT BUFFER CREATED OR MODIFIED AS ABOVE / AC UNCHANGED / / PSUEDO-CODE / / PROCESS_RECORD (* CALLED BEFORE SELCT EXITS *) / / IF AC=0 (* A RECORD HAS BEEN SELECTED AND IS IN EDIT BUFFER *) / THEN DO_MATH_ON_CURRENT_RECORD / ELSE CREATE_RECORD_FROM_RESULTS / / / DO_MATH_ON_CURRENT_RECORD / / INITIALIZE / LOOP / CALL LFLDNM (* TO GET NEXT FIELD NAME *) / (* ON EXIT: AC=+ ERROR / AC=0 OK / AC=-1 END OF RECORD *) / EXIT IF END OF RECORD / SET_UP_TOKVAL (*PUT LENGTH OF FN INTO TOKVAL, ADD 4000 TO LAST CHAR *) / CALL SYMCHK (* LOOKS UP SYMBOL IN TOKVAL IN THE SYMBOL TABLE *) / IF FOUND / THEN GET_FIELD_VALUE / CALL ASCBCD (* ASCII TO BCD CONVERSION ROUTINE *) / ELSE READ_PAST_FIELD_VALUE / END-LOOP / / / (* AT THIS POINT WE EITHER HAVE AN END OF RECORD OR AN ERROR *) / IF END_OF_RECORD / THEN CALL ROUTINE TO EXECUTE THE FORMULAE / INSERT_RESULTS_INTO_EDIT_BUFFER / ELSE (* MUST BE AN ERROR *) / AC := 0 (* AS IT WAS WHEN WE TOOK CONTROL FORM SELCT *) / END DO_MATH_ON_CURRENT_RECORD / CREATE_RECORD_FROM_RESULTS / INSERT_RESULTS_INTO_EDIT_BUFFER / INSERT 0 (* RECORD TERMINATOR *) INTO EDIT BUFFER / INSERT_RESULTS_INTO_EDIT_BUFFER / INITIALIZE / WHILE NOT END OF RESULTS LIST / INSERT '<' INTO EDIT BUFFER / INSERT FIELD NAME EDIT BUFFER / INSERT '>' INTO EDIT BUFFER / CALL BCDASC (* TO CONVERT NUMBER TO FORMATTED ASCII *) / INSERT ASCII NUMBER INTO EDIT BUFFER / GET NEXT ENTRY IN RESULTS LIST / END-WHILE /DESCRIPTION OS NAMPTR (USED BELOW) /NAMPTR, 0 / POINTS TO AN ENTRY IN THE MATH SYMBLE TABLE. / FORMAT OF SYMBLE TABLE ENTRY IS AS FOLLOWS: / N / A / M / E+4000 (LAST CHAR OF NAME HAS SIGN BIT SET) / FORMAT WORD (INDICATES HOW USER WANTS OUTPUT TO APPEAR) / 1ST BCD WORD / 2ND BCD WORD / 3RD BCD WORD / 4TH BCD WORD / 5TH BCD WORD / 6TH BCD WORD DOMATH, 0 SNA CLA / WERE THERE ANY MORE RECORDS? JMP DMOCR / YES, DO MATH ON CURRENT RECORD / NO, CREATE RECORD FROM RESULTS JMS INSRST / PUT RESULTS IN RECORD BUFFER AC7777 / RESTORE AC TO WHAT IT WAS JMP I DOMATH / RETURN TO SELCT (WHO CALLED US) / Do_Math_On_Current_Record DMOCR, TAD (RECBUF / INITIALIZE POINTERS ETC. DCA RCBPTR / INIT AUTO-INCR POINTER TO READ RECORD / TO AFTER FIRST LEFT ANGLE BRACKET DMNXT, JMS LFLDNM / LOOP PUT NEXT FIELD NAME INTO GPBUF JMP DMEOR / EXIT IF END OF RECORD JMS DMXFER / TRANSFER GPBUF TO TOKVAL IN MATH FIELD / CALL SYMBLE TABLE LOOKUP ROUTINE IN MATH FIELD CIFMTH / CHANGE TO MATH FIELD JMS SYMCHK / CALL SYMBLE TABLE LOOKUP ROUTINE JMP NOTFND / (RETURNS HERE IF FIELD NOT FOUND) DCA BCDPTR / IF FOUND (AC=POINTER TO VALUE) / THEN SET UP ARGUMENT TO ASBCD JMS LDFLD / LOAD FIELD VALUE INTO TOKVAL (IN MATH FIELD) JMP UNDEF / IF NOT A NULL FIELD VALUE JMS TOKOUT / THEN OUTPUT TRAILING ZERO AS TERMINATOR CIFMTH / CHANGE TO MATH FIELD JMS ASCBCD / CONVERT VALUE TO PACKED BCD TOKVAL / 1ST ARG: POINTER TO VALUE (IN MATH FIELD) BCDPTR, 0 / 2ND ARG: POINTS TO DESTINATION OF PACKED / BCD (IN MATH FIELD) JMP ABERR / ERROR RETURN, GO HANDLE IT /M025 JMP DMNXT / NOTFND, JMS GFDEND / ELSE (NOT FOUND) SKIP PAST FIELD VALUE JMP DMNXT / END-LOOP (GET NEXT FIELD NAME) / ADD OFFSET TO ASCBCD ERROR FOR PROPER REPORTING BY ERROR HANDLER /A025 ABERR, TAD (NSEBE1-NSEBEN) / ADD OFFSET TO ERROR NUMBER FROM ASCBCD/A025 JMP ERRHAN / GO REPORT THE ERROR /A025 / COMES HERE ON A NULL FIELD VALUE, SET VALUE IN MATH SYMBLE TABLE TO UNDEFINED UNDEF, AC2000 /PUT UNDEFINED BIT IN AC CDFMTH DCA I BCDPTR /PUT INTO FIRST WORD OF VALUE CDFMYF / JMP DMNXT /END-LOOP (GET NEXT FIELD NAME) / COME HERE TO HANDLE END OF RECORD. NEED TO CALL ROUTINE TO EXECUTE THE / MATH FORMULA THEN ADD RESULTS TO RECORD IN EDIT BUFFER DMEOR, CIFMTH / JMS EXECUT / CALL ROUTINE TO EXECUTE MATH FORMULAE SZA / WERE THERE ANY ERRORS? JMP ERRHAN / YES, GO TO ERROR HANDLING ROUTINE JMS INSRST / NO, INSERT RESULTS TO RESULT BUFFER JMP I DOMATH / RETURN WITH AC=0 TO SELC / ROUTINE TO TRANSFER FIELD NAME IN GPBUF TO TOKVAL (IN MATH FIELD) / FIRST LOCATION IN TOKVAL NEEDS TO HAVE THE CHARACTER COUNT AND THE / LAST CHARCTER IN THE FIELD NAME NEEDS TO HAVE ITS SIGN BIT SET. DMXFER, XX TAD (GPBUF-1 / INIT POINTERS AND COUNTER DCA TAI1 /INIT POINTER TO SOURCE TAD (TOKVAL-1 DCA TAI2 /INIT POINTER TO DESTINATION TAD FNCNT / FNCNT WAS SET UP BY LFLDNM TAD (-GPBSIZ / Take a maximum symbol length of /a044 SMA / GPBSIZ /a044 CLA / /a044 CIA / We want to use it as a counter /a044 TAD (-GPBSIZ / This gives us a counter no larger than/a044 DCA T1 / GPBSIZ /m044 TAD T1 / Get it back to store in TOCVAL /a044 CIA /d044 TAD FNCNT / GET COUNT OF CHARACTERS AGAIN DMLOOP, JMS TOKOUT / REPEAT; OUTPUT CHARARACTER TAD I TAI1 / GET NEXT CHAR IN FIELD NAME ISZ T1 / UNTIL LAST CHARACTER JMP DMLOOP / DMLAST, TAD (4000 / SET SIGN BIT JMS TOKOUT / OUTPUT LAST CHARCTER JMP I DMXFER / RETURN / OUTPUT A CHAR TO TOKVAL IN MATH FIELD USING TAI2 AS AUTO-INCREMENT REG. TOKOUT, XX CDFMTH / CHANGE TO MATH FIELD DCA I TAI2 / OUTPUT CHAR CDFMYF / CHANGE BACK TO MY DATA FIELD JMP I TOKOUT / RETURN / INSERT RESULTS INTO RECORD (EDIT) BUFFER INSRST, 0 TAD (RESBUF / INITIALIZE DCA RESPTR / INIT AUTO INCREMENT POINTER TO RESULTS TAD (RESULT / DCA NXTPTR / INIT POINTER TO RESULTANT POINTER LIST INS1, / LOOP CDFMTH / CHANGE DATA FIELD TO MATH FIELD TAD I NXTPTR / GET POINTER TO NEXT 'RESULT' FIELD NAME CDFMYF / CHANGE BACK TO BY FIELD / EXIT IF NO MORE RESULTS SNA / ARE WE ALL DONE (NO MORE RESULTS)? JMP INSEXT / YES, SO EXIT ROUTINE DCA NAMPTR / INITIALIZE POINTER TO FIELD NAME TAD ("<-200 / OUTPUT "<" TO RECORD BUFFER JMS RCBOUT / / OUTPUTS FIELD NAME POINTED TO BY NAMPTR TO RECORD BUFFER NAMOU1, CDFMTH / REPEAT TAD I NAMPTR / GET CHARACTER CDFMYF AND P177 / JMS RCBOUT / OUTPUT THE CHAR CDFMTH TAD I NAMPTR / GET CHARACTER AGAIN (TO SEE IF LAST ONE) CDFMYF / (LAST ONE HAS SIGN BIT SET) ISZ NAMPTR / INCREMENT POINTER SMA CLA / WAS IT LAST ONE? JMP NAMOU1 / NO, DO THE NEXT ONE / UNTIL-SIGN BIT SET (ON LAST CHAR OF NAME) TAD (">-200 / OUTPUT ">" TO RECORD BUFFER JMS RCBOUT / / NOW CALL ROUTINE IN IN THIS FIELD TO CONVERT BCD TO ASCII JMS BCDASC / CALL BCD TO ASCII ROUTINE WITH THREE PARAMETERS: NAMPTR, 0 / POINTS TO AN ENTRY IN THE MATH SYMBLE TABLE. RESPTR, 0 / POINTER TO RESULT LIST CDFMYF / INSTRUCTION FOR BCDASC TO USE TO GET TO / CORRECT DATA FIELD FOR RESULTS DCA RESPTR / BCDASC RETURNS WITH POINTER TO END OF ASCII STRING / WHICH BECOMES MY UPDATED POINTER INTO RESBUF ISZ NXTPTR / INCREMENT NEXT RESULT POINTER JMP INS1 / END-LOOP INSEXT, TAD ("<-200 / OUTPUT TRAILING <> FOLLOWED BY A ZERO JMS RCBOUT TAD (">-200 JMS RCBOUT JMS RCBOUT / OUTPUT TRAILING ZERO JMP I INSRST / RETURN / OUTPUTS CHARACTER IN AC TO RESULT BUFFER IN THIS FIELD / CHECKS FOR OVERFLOW RCBOUT, 0 DCA I RESPTR / OUTPUT CHARACTER ISZ RESPTR / INCREMENT POINTER JMP I RCBOUT / NXTPTR, 0 / POINTS TO THE NEXT ENTRY IN THE RESULT POINTER LIST. (EACH / ENTRY POINTS TO A NAME IN THE MATH SYMBLE TABLE) /-------------- PAGE /GPBUF has been moved from here to the same area as the other buffers /a044 /to extend it and make room for multinational and technical characters /a044 /in field names. /a044 / /d044 GPBUF, *SELINI /START OF SELECT PROGRAM START, CIFMNU /M017 JMS I OLAYCL /CALL IN THE EDITOR (MERGE) 2 DCA RECPRO / INIT RECORDS PROCESSED /A025 DCA RECNUM /INIT RECORD COUNTER = 0 /M025 DCA SUCREC /INIT NO. OF MATCHED RECORDS = 0 /M025 DCA ERRNUM /INIT ERROR COUNT = 0 /M025 / THIS ROUTINE SETS PARAMETERS IN THE SELCT ROUTINE SO THAT A MATH /A019 / ERROR WITHIN A CONTROL BLOCK CAN BE REPORTED PREVIOUS TO THE READING /A019 / OF THE FIRST RECORD OF THE LIST. AFTER THE FIRST RECORD IS READ /A019 / THESE PARAMETERS ARE CHANGED BY SELCT ROUTINE AS NORMAL. /A019 TAD (5600) / GET INSTRUCTION JMP I, CURRENT PAGE, /A019 / ADDRESS ZERO /A019 DCA SELCTX / INSTALL IN SELCTX /A019 TAD (ERRXIT) / GET THE ADDRESS OF ERROR HANDLER /A019 DCA SELCT / INSTALL IN SELCT /A019 /CALL MADE FROM HERE TO MATH FIELD TO INITIALIZE MATH DATA STRUCTURES /A018 /FLAGS, ETC., USED IN PROCESSING OF MATH CONTROL BLOCKS. /A018 /NOTE - THIS CALL NOW SET UP TO ALSO SET "TYPMTH" FLAG IN MATH FIELD /A031 / THE VALUE TO SET THE FLAG IS PASSED TO "RTRN4" VIA THE AC /A031 / IN THIS CASE THE FLAG IS SET TO ZERO TO INDICATE THAT LP MATH /A031 / IS BEING USED. SINCE THE AC IS ZERO COMING INTO THE CALL NO /A031 / FURTHER CODE ENHANCEMENTS ARE NECESSARY /A031 CIFMTH /CHANGE PROGRAM CONTROL TO MATH FIELD /A018 JMS RTRN4 /GO INITIALIZE MATH MODULE VALUES /A018 CDFBUF /STORED IN BUFFER FIELD AC0001 /GET FROM RECORD NUMBER TAD I (SPCADR) DCA T1 / THE FROM RECORD COUNT RANGES FROM 1 TO 4095. A FROM COUNT OF /A042 / ZERO MEANS START AT THE FIRST RECORD. IN ORDER TO FACILATE THE /A042 / COUNTING OF RECORDS AND THE RANGE CHECKS, THE FROM COUNT HAS /A042 / SHIFTED DOWN BY ONE UNIT TO ALLOW FOR THE MAXIMUN OF 4095. /A042 TAD I T1 /PICK UP THE FROM RECORD COUNT CDFMYF SZA /OK IF ZERO START RECORD /A042 TAD (-1 /DECREMENT THE COUNT /A042 /D042 CIA /NEGATE DCA FRREC /AND STORE IT AWAY ISZ T1 /GET TO RECORD NUMBER CDFBUF TAD I T1 CDFMYF /D042 CIA /NEGATE DCA TOREC /AND STORE CDFBUF TAD I (OTFIL) /GET OUTPUT FILE NUMBER DCA OUTFIL /AND SAVE IT TAD I (LSTFIL) /GET LIST FILE NAME CDFMYF /BACK TO MY FIELD JMS RDINIT /OPEN FILE TAD FRREC /PICK UP THE FIRST RECORD TO PROCESS /A042 IAC /PUT BACK INTO CORRECT FORMAT /A042 JMS SEARCH /DISPLAY MESSAGE - SEARCHING FOR RECORD /A042 TITLP, CDFSYS /SEE IF HALT FLAG ON ? TAD I HLTFLG CDFMYF SZA CLA JMP FINUP /YES, FINISH UP JMS GETCHR /NO, GET A CHAR JMP FINUP /EOF RETURN, FINISH UP AND P177 /LOSE CONTROL TAD (-74 /SEE IF '<' SZA CLA JMP TITLP /NO, KEEP LOOKING JMS SELCT /GET FIRST MATCHED RECORD /M017 SZA CLA JMP FINUP /NO RECORDS SO TELL USER TAD OUTFIL /OTHERWISE, SEE IF TO PRINTER SNA CLA JMS PRNQUE /YES, QUEUE IT CIFEDT /CHANGE TO EDITOR FIELD /A017 JMS I (MERGE) /AND CALL MERGE PROGRAM SZA CLA /EDITOR RETURNS NON-ZERO IF DISK IS FULL/A0011 JMP DSKFUL /A0011 FINUP, JMP ERRXIT /YES, GIVE MESSAGE DSKFUL, TAD (EVFULL) / ERROR - DISK FULL /A0011/M025 DCA ERRNUM /A0011 JMP ERRXIT /GIVE MESSAGE /A0011 OUTFIL, 0 SINFLG, XX /THIS ROUTINE INITS THE SUCCESS FLAGS TO FALSE /M025 AC4000 /INIT THE MQ WITH A FALSE AND SET MQL /TO TRUE ON MATCH FLAG TAD (SPECTB /GET 1ST LOC OF SPECIFICATION TABLE DCA SPCSCN /SAVE AS PTR TAD I SPCSCN /GET TYPE WORD INFGLP, SNA JMP I SINFLG /0 TYPE, ALL DONE AND P177 /GET RID OF OLD FLAGS TAD (-3 /SEE IF IT'S A 3 (BUT NOT) SNA JMP INBNI /YES, NEEDS DIFFERENT FLAGS TAD (3 /NO, GET TYPE BACK MQA /OR IN FLAGS INFGL1, DCA I SPCSCN /STORE IT BACK JMS GTYPE /GET NEXT TYPE WORD JMP INFGLP /GO SET IT INBNI, TAD (2003) /INIT TO TRUE AND SET TO FALSE ON MATCH FLAGS JMP INFGL1 /STORE IT SPCSCN, 0 GTYPE, XX /GETS THE NEXT TYPE WORD AND RETURNS IT IN THE /M025 /AC USING SPCSCN AS A PTR. /M025 CLA ISZ SPCSCN /ADD TWO TO PTR. ISZ SPCSCN TAD I SPCSCN /TO GET OR-COUNT CLL RTL / * 4 IAC /PLUS 1 TO MOVE ALONG TAD SPCSCN /ADD IN ADDR. DCA SPCSCN /SHOULD GET NEXT TYPE WORD TAD I SPCSCN JMP I GTYPE /RETURN SRCH, 0 /JUST DOES AN EXACT COMPARE JMS XSCMP SPCSTR, 0 RECSTR, 0 CDFBUF JMP I SRCH /-------------- PAGE GFDEND, XX /READS UNTIL THE END OF THE CURRENT FIELD /M025 /USING RCBPTR AND RETURNS A PTR TO THE LAST /LOC. IN THE FIELD IN FDEND, EXCLUDING THE LAST CHAR /LESS THAN 41 IF ONE IS PRESENT. /CALLED BY: /JMS GFDEND / EXIT IF ERROR /REGULAR RETURN (AC 0) GFDLP, JMS SSRBRD /GET A CHAR TAD (-74 /SEE IF '<' ? SNA JMP GFDDN /YES, END OF FIELD TAD (-2 /NO, SEE IF '>' ? SZA CLA JMP GFDLP /NO, KEEP LOOKING JMP REVRBFD / ERROR - '>' FOUND IN FIELD /M025 GFDDN, AC7777 /GET LAST CHAR IN FIELD TAD RCBPTR DCA T1 CDFBUF TAD I T1 CDFMYF AND P177 /WITHOUT CONTROLS TAD (-15 /If last char is End Dead, do not ignore/a044 SZA /Is it End Dead? /a044 TAD (15-41 /NO, SEE IF LESS THAN 41 /a044 SPA CLA AC7777 /YES, DON'T TRY TO MATCH LAST CHAR TAD T1 /STORE PTR TO LAST CHAR TO MATCH DCA FDEND JMP I GFDEND /RETURN ENUM, TAD MLEN SMA CLA /SEE IF EXACT NUMERIC COMPARE ? JMP MNUM /NO TAD ELEN /YES, CHECK LENGTH CIA TAD NUMSIZ SZA CLA /EQUAL ? JMP ORLP /NO, FAIL JMS NUMCMP /YES, DO CHAR BY CHAR COMPARE SNA CLA /EQUAL ? JMP TRUE /YES, SET MATCHED FLAG JMP ORLP /NO, FAIL AND TRY NEXT OR-GROUP MNUM, TAD ELEN /NUMBER OR MORE COMPARE ? SNA JMP LNUM /NO CIA /YES, CHECK LENGTH TAD NUMSIZ SPA /LARGER JMP ORLP /NO, FAIL SZA CLA /YES, SEE IF SAME SIZE ? JMP TNUM /NO, SEE IF THRU COMPARE JMS NUMCMP /YES, DO CHAR BY CHAR COMPARE SPA CLA /CHECK IF GREATER THAN OR EQUAL TO ? JMP ORLP /NO, GET NEXT OR-GROUP TNUM, TAD MLEN /YES, NUMBER THRU NUMBER COMPARE ? SNA CLA JMP TRUE /NO, SET MATCH FOUND FLAG TAD ELEN /YES, MOVE SPEC STRG PTR TO NEXT NUMBER TAD SPCSTR DCA SPCSTR LNUM, TAD MLEN /CHECK IF SMALLER ? CIA TAD NUMSIZ SMA SZA JMP ORLP /NO, FAIL IMMEDIATELY SZA CLA /YES, SEE IF SAME SIZE JMP TRUE /NO, SET MATCH FOUND FLAG JMS NUMCMP /YES, DO CHAR BY CHAR COMPARE SMA SZA CLA /CHECK IF LESS THAN OR EQUAL TO ? JMP ORLP /NO, GET NEXT OR-GROUP JMP TRUE /YES, SET MATCH FOUND FLAG PRNQUE, 0 /QUEUES THE FORM FILE TO THE PRINTER /M029 CDFMNU /M029 TAD I (PQADDR) /GET PRINT QUEUE ADDRESS /M029 CDFMYF / IN COMMAND FIELD /M029 DCA T2 /STORE TO INDIRECT THROUGH /M029 CDFPRT /M029 AC0001 /M029 DCA I (PRIRFD) /SET FLAG IN PRINT FIELD TO SAY WE ARE DOING /LIST PROCESSING /M029 CDFBUF / /M029 TAD I (FORMNO) /GET FORM FILE NUMBER IN BUFFER FIELD /M029 CDFMNU / /M029 DCA I T2 /PUT AS FIRST ENTRY IN PRINT QUEUE /M029 ISZ T2 /NOW POINT TO NEXT LOCATION AND /M029 DCA I T2 / STORE A TERMINATING ZERO IN THE QUEUE /M029 TAD I (PQADDR) /M029 DCA I (PQFRST) /SET UP PRINT QUEUE FIRST AND LAST POINTERS TAD I (PQADDR) /TO POINT TO SAME PLACE TO INDICATE ONLY DCA I (PQLAST) /ONE ENTRY IN THE PRINT QUEUE /M029 CDFMYF /M029 /D041 TAD (PRJOB) /GET ADDRESS OF PRINTER STATUS BLOCK /M029 /D041 CIFSYS; JSTRT /START UP PRINTER JOB /M029 JMP I PRNQUE /RETURN /M029 / CLEAR SCREEN, HOME CURSOR AND OUTPUT SEARCH FOR RECORD MESSAGE /A042 SEARCH, XX /A042 DCA SRCREC /SAVE RECORD NUMBER TO BE SEARCH FOR /A042 CIFMNU /SET TO MENU FIELD /A042 JMS I IOACAL /CALL IOA TO DISPLAY A MESSAGE /A042 0 /USED FOR DEFAULT OUTPUT ROUTINE /A042 SRCMSG / MESSAGE ADDRESS /A042 0000 / ^P - POSITION CURSOR HOME /A042 / ^E - ERASE SCREEN /A042 SRCREC, 0 / ^D - RECORD NUMBER /A042 JMP I SEARCH / RETURN TO CALLER /A042 SRCMSG, IFDEF ENGLSH /A042 IFDEF ITALIAN /-------------- PAGE /THIS IS WHERE THE TABLES, ETC. GO FIELD 3 *SELINI / IT IS THROUGH THIS OVERLAY THAT WE CAN EITHER REPORT AN ERROR /A025 / CONDITION AND OR PLACE THE RESULT DATA OF THE LIST PROCESSING /A025 / OPERATION /A025 / REPORT, / DELETED CODE TO CHECK PRLOCK--DECMATE IS A SINGLE USER SYSTEM /A043 / DELETED CODE TO CLEAR PRSTTS. LEAVE IT IN CASE HAVE ERROR /A041 / WHILE PRINTER'S BUFFER IS EMPTYING /A041 / WE NO LONGER NEED TO START THE PRINTER JOB SINCE IT ALWAYS RUNS /A041 CDFMYF TAD RECNUM /M025 DCA T1 / HOLD UPDATED RECORD NUMBER IN T1 /M025 TAD RECPRO / GET # OF RECORD PROCESSED /A025 DCA T2 / HOLD NO. OF RECORDS PROCESSED /M025 TAD ERRNUM / GET ERROR NUMBER. IF ERRNUM = 0 THEN /A025 / THERE WAS NO ERROR SO WE'LL JUST /A025 / PRINT THE RECORD SUMMARY. /A025 REPOR2, DCA T3 / HOLD IT IN T3 /M035 / REPOR2 WILL SET UP THE LOCATIONS IN MNUFLD AS FOLLOWS: /A025 / MNTMP1 = 0, MEANING "LIST PROCESSING ERRORS" /A035 / MNTMP2 = NO. OF RECORDS PROCESSED /A025 / MNTMP3 = NO. OF RECORDS SELECTED /A025 / MNTMP4 = CURRENT RECORD COUNT /A025 / MNTMP5 = ERROR OR CONTROL NUMBER /A025 TAD SUCREC / GET NUMBER OF RECORDS SELECTED /M035 CDFMNU /A025 DCA I (MUBUF+MNTMP3) / STORE IT IN MENU FIELD /A025 TAD T1 / CURRENT RECORD COUNT /A025 DCA I (MUBUF+MNTMP4) / STORE IT IN MENU FIELD /A025 TAD T2 / NUMBER OF RECORDS PROCESSED /A025 DCA I (MUBUF+MNTMP2) / STORE IT IN MENU FIELD /A025 TAD T3 / GET ERROR NUMBER (OR CONTROL VALUE) /A025 DCA I (MUBUF+MNTMP5) / STORE IT IN MENU FIELD /A025 DCA I (MUBUF+MNTMP1) / SET FLAG TO INDICATE LIST PROCESSING /A035 CDFMYF /A025 CIFMNU /A025 JMS I MNUCAL / REPORT VIA MENU /A025 DLMLP5 /A025 CDFMNU / HAVE WE RETURNED HERE TO PRINT MATH /A025 / CONTROL BLOCK ERROR? /A025 TAD I (MUBUF+MNTMP5) / MNTMP5 IS EITHER SET OR UNCHANGED IN /A025 / MENU DEPENDING ON THE ERROR NUMBER. /A025 / IF MNTMP5 = 0 THEN EXIT ELSE PRINT /A025 / MATH CONTROL BLOCK LINE THAT /A025 / CONTAINS THE ERROR THEN RETURN TO /A025 / MENU TO PRINT RECORDS SELECTED /A025 / AND PROCESSED. /A025 CDFMYF /A025 SNA CLA / SKIP IF: NEED TO PRINT ERROR LINE /A025 JMP LEAVLP / WE'RE DONE. EXIT LIST PROCESSING /A025 TAD (600 / TELL PELINE TO PRINT ON LINE 7 /A035 CIFMTH / CHANGE INSTRUCTION FIELD TO MATH FIELD/A025 JMS PELINE / PRINT LINE IN CONTROL BLOCK THAT /A025 / CONTAINS THE ERROR AND POINT TO /A025 / ERROR /A025 AC0001 / CONTINUE FROM PRINTING ERROR MESSAGE /A025 JMP REPOR2 / SET CONTROL = CONTINUE FROM PRINTING /A025 / ERROR MESSAGE /A025 / TO EXIT WE MUST RETURN TO THE ROUTINE WHICH CALLED WPPARSE. THE /A017 / ADDRESS IS IN THE BUFFER FIELD (PUT THERE BY WPPARS) BUT THE ROUTINE /A017 / IS IN THE MENU FIELD /A017 LEAVLP, CDFBUF / CHANGE TO BUFFER FIELD /M025 TAD I (RETADR / GET RETURN ADDRESS (OF ROUTINE WHICH /A017 / ORIGINALLY CALLED WPPARS) /A017 DCA T3 / PUT INTO PLACE /M025 CDIMNU / CHANGE TO MENU FIELD /A017 JMP I T3 / AND RETURN /M025 FIELD 2 *RDFIL /THIS IS WHERE RDFILP GOES / WPCX - CHARACTER-ORIENTED COMMUNICATION PROGRAM / / / 059 EMcD 4-Sep-85 8 bit to 7 bit NRC conversion / support / 058 MART 09-JUL-85 RESTART ON RETURN FROM GRAPHICS / 057 EMcD 27-Jun-85 Stop CX with Printer while / Print Screen going / 051-056 EMcD 02-Apr-85 Patches for 8 bit and hole blaster / 050 EMCD 28-FEB-85 Add DECDEV switch / 049 DFB 29-NOV-84 Fix DS, DH, DP problems when Gold Halt / 048 ECH 30-AUG-84 ALLOW GOLD HALT TEST IN HP AND DP MODES / MOVED KBTICH AND KBTOCH TO WPCOM / 047 ECH 17-AUG-84 CHANGES BECAUSE OF MOVING DSKGCH FROM / WPCOM PHICS / 045 DFB 20-APR-84 FIX TO LOAD PAGE 0 PRTFLD VT125 MODE / 044 DFB 27-MAR-84 CHANGE GRAPHICS TO LOAD EVERY TIME / 043 WJY 17-FEB-84 IMPLEMENT DMIIV1.5 FUNCTIONALITY ON DMI / 042 SBB 20-JAN-84 STOP CRASH IN VT52 HD DOC ALMOST FULL / 041 SBB 26-SEP-83 CHANGES FOR VT125 EMULATION / 040 HLP 13-SEP-83 DELETE PRLOCK SINCE DECMATE / IS SINGLE USER / 039 GDH 20-JUL-83 CHANCE DECMATE / IS SINGLE USER / 039 GDH 20-JUL-83 CHANGES TO ACCOMODATE LOGON ENTRY TO / NOT CLEAR SCREEN WHEN ENTRING. / 038 HLP 10-JUN-83 CHANGE PRINTER PAGE SIZE FROM CT TO / SIZE OF LAST DOCUMENT PRINTED / 037 DFB 31-MAY-83 FIX TO HALT WHEN CX TD / 036 GDH 18-MAY-83 MOVED LARGE BUFFER TO FIELD 6. / 035 GDH 14-APR-83 ALTER RETURN TO MAIN MENU CODE TO / CALL COMM CLEANUP CODE. / 034 GDH 1-APR-83 FIX SO THAT HD REMEMBERS DOC NAME. / 033 HLP 25-FEB-83 PRASF NOW PART OF LPONLN / IN PRINTER FIELD / 032 GDH 10-JAN-83 SET TERMINAL TO NUMERIC KEYPAD & CURSOR / TO CURSOR MODE ON START UP. / 031 HLP 16-DEC-82 REMOVE JSTRT ON PRJOB WHEN EXIT CX / 030 HLP 02-DEC-82 FIX NO SHEETS FED TO LQPSE BUG #273 / 029 GJP 15-OCT-82 FIX WPCRE BUG / 028 SBB 15-OCT-82 CORRECTLY INITIALIZE TERMINAL MODES / 027 HLP 14-OCT-82 REWORKED HANDLING OF PRSTTS AND PRLOCK / ON ENTERING AND LEAVING BLANK SCREEN / (THIS FIXED DM-II BUG #152) / DELETED REFERENCES TO USERNO / 026 MJS 07-OCT-82 MOVED THE CALL TO "DLMCX2" TO "CONFG2" / (THIS MENU CALL WILL BE EXECUTED BEFORE / THE "AC7777; HS2OU" WHICH DOES AN "XON") / THEREFORE THE "XON" WILL BE ISSUED / AFTER THE USER SELECTS OPTIONS / 025 HLP 01-OCT-82 DO DCA PRSTTS ONLY IF "BUSY" / 024 HLP 29-SEP-82 RESET PRLOCK WHEN EXIT CX / 023 HLP 23-SEP-82 DELETED DCA PRSTTS SO PRINTER ERRORS / WILL NOT BE ERASED WHEN RETURN TO MENU / 022 HLP 09-SEP-82 CONDOR CONDITIONALIZED EDIT 021 / 021 HLP 03-SEP-82 FURTHER TERMINAL MODE CHANGES / 0020 HLP 29-JUL-82 APPARENT BUG AT CONFG2 FIXED / ELIMINATE EXTRA DEFINITIONS OF IO CALLS / 0019 GJP 16-JUN-82 DURING CX, USER CHOSE GOLD MENU, HUNG / SYSTEM BUG FIXED. / 0018 GDH 25-MAR-82 ALLOW CX TO RUN W/O HARDWARE BUT MAKE / SURE HARDWARE IS PRESENT FOR HOST. / 0017 GDH 15-MAR-82 FIXED CONDITIONAL FOR WPMAG. / 0016 GDH 08-MAR-82 CLEAR DOC TRANSFER "WAIT" FLAG. / 0015 GDH 24-DEC-81 RETRIEVE CXTMOD INTO VTMODE ON STARTUP. / 0014 GDH 17-NOV-81 DETECT NON-EXISTENT PRINTER FOR XP. / 0013 GDH 19-OCT-81 MERGED SOME BUG FIXES FROM THE WS200 / SYSTEM (V4.4). / 0012 GDH 18-OCT-81 REMOVED WS102 CONDITIONALS. / 0011 GDH 17-OCT-81 ADDED TM OPTION SUPPORT FOR DWORD. / ALSO BUG FIX FOR USER ESC SEQS. / 0010 GDH 13-OCT-81 DE-IMPLEMENTED LOCK/UNLOCK. / 0007 GDH 5-OCT-81 AUTO PAGINATION FOR ASF PRINTERS. / 0006 GDH 23-SEP-81 ELIMINATED PAGE ZERO CIF/CDF STUFF. / 0005 GDH 26-AUG-81 WPFILS CALLING SEQ CHANGES. / 0004 GDH 21-AUG-81 REMOVED SUPERFLUOUS CONDITIONALS. / ADDED VT52 EMULATION. / 0003 JM 17-JUN-81 ADDED WS80 TERMINAL MODE / 0002 JM 02-JUN-81 RESTORE TERMINAL ATTRIBUTES AFTER / GOLD MENU (FOR WS80 AND VT278) / AND SET TERMINAL TO VT100 MODE AFTER / \R (FOR WS80) / 0001 JM 12-MAY-81 CHANGES TO ALLOW COM TO WS80 / SERIAL LQP / / 3.0 MB 8-AUG-78 ADD FORMATABLE SEND DOCUMENT FEATURE / QA3.4 KEE 13-APR-78 FIX CX BUG WHEN DISKETTE OVERFLOWS / III.C KEE 27-FEB-78 REMOVE COMM SETTINGS STUFF AND FIX SO / THAT MAGCRD HAS SEPARATE BINARIES / FROM CX / III.3 KEE 3/7/78 CHANGE TRANSFER LOCATION FOR MAGCRD / 2.7-3 KEE 1/14/78 FIXES FOR MAG CRD INSTALATION / 2.7-2 KEE 1/5/78 MOVE CLEAR SCREEN AFTER OPTIONS / SPECIFIED / 2.5.1 KEE 11/9/77 FIX BUG IN \R PROCESSING WHEN ONLY / AN INPUT FILE AND NO OUTPUT FILE / IS SPECIFIED. / 2.5.1 KEE 11/7/77 PUT IN DISK OVERFLOW TESTS / 2.4B KEE 10/10/77 CLEAN UP CODE / 2.P-5 RLT 9/23/77 FIX FOR WT ASM / 2.P-4 KEE 9/21/77 PUT CX MENU DISPLAYS INTO 'MN' / 2.K-1 RLT 8/31/77 CHANGE PAGINATION TO ASSEMBLE FOR WS78 / 2.J KEE ADD 4-FLOPPY SPECIFICATIONS / 2.G-1 MB GET IT FROM THE 78 PACK 8/8/77 /WTXBAR - WRITES OUT XBAR *200 JMP I .+3 JMP I .+1 7605 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLOCX1 100 IFNDEF DECDEV < CDF 20 /M050 > IFDEF DECDEV < CDF 30 /A050 > -DSOCX1 /WRITE OUT NORMAL CX DLOCX2 100 IFNDEF DECDEV < CDF 30 /M050 > IFDEF DECDEV < CDF 40 /A050 > -DSOCX2 /M004 DLCX2C CX2BFA IFNDEF DECDEV < CDF 30 /M050 > IFDEF DECDEV < CDF 40 /A050 > -DSCX2C DLCX2D CX2BFA IFNDEF DECDEV < CDF 30 /M050 > IFDEF DECDEV < CDF 40 /A050 > -DSCX2D DLCXHL /Start at block /A055 CXHOLE /From address /A055 CDF 60 /Resides in field 6 /A055 -DSCXHL /Size of CX Hole /A055 0 /WPCX - CHARACTER-ORIENTED COMMUNICATION PROGRAM /PATCH WRITE OUT ROUTINE FOR DISKETTE LOAD IFNDEF DECDEV < FIELD 2 > IFDEF DECDEV < FIELD 3 > ADRASM=1 /INHIBIT CREATE ERROR MESSAGES /RE-CONFIGURE THE SWITCHES BKSPAC=10 LF=12 CR=15 BS=10 TAB=11 SRULER=16 ERULER=17 BLANK=40 SPACE=BLANK SPC=SPACE SP=SPC QUEST="?-200 RUBOUT=177 CNTRLG=7 ESC=33 BELL=7 FF=14 VT=13 NPAGE=14 GPAGE=2014 PARAGH=1012 CREATE=3 CUB1=6400 /THE BUFFER ADDRESS USED FOR THE CREATE *100 /THE FIRST 100 LOCATIONS ARE USED FOR THE SYSTEM CIFOTH=CIFEDT /OTHER FIELD. /A005 CDFOTH=CDFEDT /"" "" /A005 CIFMYF=CIFBUF /WE RUN IN THE EDT FIELD. CDFMYF=CDFBUF /WE RUN IN THE EDT FIELD. IFDEF VT125R < /FOR VT125 /A041 RGFLD=10 /REGIS RUN-TIME FIELD=1 /C046 PRMFLD=50 /PRIMITIVES RUN TIME FIELD=5 /C046 PRGFLD=60 /PRIM/REGIS COMBO FIELD=6 /C046 PRIM= 200 /CALLING ADR FOR PRIMITIVES /A041 REGIS=177 /CALLING ADR FOR REGIS /A041 > /END IFDEF VT125R /A041 /HERE ARE SOME FLAGS AND IMPORTANT LOCATIONS USED BY THE ROUTINES /THE NEXT 4 LOCATIONS MUST BE IN THIS ORDER FOR MAGCRD ASSEMBLIES - THEY /ARE COPIED TO THE OTHER FIELD PRIOR TO CALLING THE COMM ROUTINES /ACTION FLAGS, WITH VALUES AS FOLLOW /THE FLAG WORD IS NONZERO WHEN THERE THERE IS SOMETHING COMING FROM /THE CORRESPONDING DEVICE. FOR EXAMPLE, THE KEYBOARD, OR A DISK FILE /TO BE READ. /THE BIT(S) WHICH ARE NONZERO CORRESPOND TO WHERE THE SOMETHING IS TO BE /PUT. FOR INSTANCE, TO THE PRINTER, THE SCREEN, ETC. DKTFLG, 0 /DISK INPUT H2TFLG, 0 /INPUT FROM THE HOST KBTFLG, 0 /KEYBOARD INPUT LPTCNT, 0 /# OF LINES LEFT ON THE PRINTER PAGE /A007 /THE BITS WHICH CAN BE SET ARE - CRT=1 /TO THE SCREEN LQP=2 /TO THE PRINTER HST=4 /TO THE SECONDARY COMMUNICATIONS LINE H2T=10 /PRIMARY COMMUNICATIONS LINE (H2T) IBM=H2T DOC=20 /WITH OUTPUT FILE (DISK) ERFLG, 0 /NONZERO CORRESPONDING TO TYPE OF ERROR DETECTED /(LAST OF THE 4 CRITICAL LOCATIONS) EXITFL, 0 /TIME TO EXIT WHEN SET! /A035 /THE KEYBOARD PROGRAM CRLFFL, 0 KBTCHR, 0 K2HCHR, 0 /TTY CHAR W/ 200 BIT (FOR USER ESC). /A011 KBTFL1, 0 KBTOXL, 0 /SOME VALUES USED BY HOST2 H2TCHR, 0 H2TOXL, 0 H2TFLX, 0 /LOCATIONS USED FOR THE DOCUMENT NUMBERS FOR READ AND WRITE /WHEN BOTH ARE NON-ZERO, THE DISK JOB IS ACTIVE AND THE CORRESPONDING /DOCUMENTS ARE OPEN. WHEN BOTH ARE ZERO, NO ASSUMPTIONS CAN BE MADE ABOUT /THE DISK JOB. OTFILE, 0 ITFILE, 0 /LOCATIONS CONTAINING THE FILE NUMBERS FOR UNOPENED FILES WHICH HAVE BEEN /SPECIFIED. IT IS ASSUMED THAT THE CORRESPONDING FILE NUMBERS (OTFILE AND /ITFILE) ARE ZERO WHEN THESE ARE NON-ZERO. OTFIL2, 0 ITFIL2, 0 /FLAG FOR THE PRINTER CNGPFG, 0 /THE FLAG THAT SAYS THAT THERE IS SOMETHING WORTH DOING NONBNK, 0 DKACTF, 0 /THE ACTION FLAG BETWEEN THE DISK ROUTINE /TO THE MAIN PROG. TSTFLG, 0 /FLAG INDICATING TEST MODE EXRLR, 0 /FLAG USED BY DSKJOB TO TELL IF IN A RULER RSNFLG, 0 /IF NON ZERO THIS TELLS DSKJOB TO PAUSE AND /WAIT FOR HT2JOB TO FINISH USING THE HOST /LINE FOR SENDING. TSTACF, 0 /SET WHEN THE TEST JOB IS RUNNING. /A013 HSTACF, 0 /SET WHEN THE HOST JOB IS RUNNING. /A013 DSKACF, 0 /SET WHEN THE DISK JOB IS RUNNING. /A013 EZLINK, 0 /SET WHEN TM=EZLINK. /A035 PLDADR, PRTLOD /Address of print load routine /A051 PRFLBK, 0 /Print Fallback flag /A051 PRTREQ, 0 / Printer requested flag /A051 / / N O T E ...... / / The "Options" tables TAB1 to TAB4 which used to reside in WPCOM /A059 / have been moved here for space reasons /A059 / TAB1, IFDEF ENGLSH < "K-200 /A059 "H-200 /A059 "T-200 /A059 "D-200 /A059 > IFDEF ITALIAN < "T-200 /A059 "O-200 /A059 "C-200 /A059 "D-200 /A059 > IFDEF V30NOR < "T-200 "V-200 "K-200 "D-200 > IFDEF V30SWE < "T-200 "A-200 "D-200 "X-200 > -1 /A059 TAB2, KBTFLG /A059 H2TFLG /A059 TSTFLG /A059 DKTFLG /A059 -1 /A059 TAB3, IFDEF ENGLSH < "S-200 /A059 "P-200 /A059 "H-200 /A059 "D-200 /A059 > IFDEF ITALIAN < "V-200 /A059 "S-200 /A059 "O-200 /A059 "D-200 /A059 > IFDEF V30NOR < "B-200 /A059 "S-200 /A059 "V-200 /A059 "D-200 /A059 > IFDEF V30SWE < "B-200 "S-200 "A-200 "D-200 > -1 /A059 TAB4, CRT / Screen /A059 LQP / LQP Printer /A059 H2T / Primary Host /A059 DOC / Output Document /A059 /------------------ PAGE /CX XBSTRT, XX /CALLED BY JMS FROM CVOVRL CLA RDF TAD CIDF0 DCA RTNCER CDFMYF JMS XBSBUF /SET THE BUFFERS UP FOR CX IN EDITOR /FIELD FOR CX2 AND SET UP TERMINAL /MODE FROM CXTMOD /A021 JMP CONFG1 /SKIP GOLD-HALT STUFF /CONFIG IS THE ENTRY POINT WHEN WE RETURN TO THE CX MENU /A021 /FROM A \R OR \H, OR FROM A GOLD HALT /A021 CONFIG, IFDEF CONDOR < /A022 JMS CFGXXX /SAVE TERMINAL MODE & STOP DISK JOB /C021 > /IFDEF CONDOR /A022 IFNDEF CONDOR < /A022 JMS DKACTS /STOP THE DISK JOB /A002 > /NDEF CONDOR /A022 CONFG0, CIFSYS TTYIN JMP CONFG1 /READ CHARACTERS UNTIL EMPTY BUFFER JMP CONFG0 CONFG1, JMS CLRFLG /CLEAR FLAGS /M003 /D049 DCA RSNFLG /A048 /D049 DCA HSTACF /A048 /D049 DCA DSKACF /A048 CONFG2, CLA / Clear out Rubbish /A057 TAD PRTREQ / Check if Print required flag was set /A057 SNA CLA / /A057 JMP CNFG2A / Wasn't set so forget it /A057 DCA PRTREQ / Was , so Unset it /A057 CDFMNU / Point to Menu field /A057 TAD I (MUBUF+MNPULD) / Get "Non Printer Printer Busy" Flag /A057 AND (3777) / Strip of the 4000 bit /A057 DCA I (MUBUF+MNPULD) / And replace it /A057 CDFMYF / Point back here /A057 CNFG2A, CIFMNU /CALL COMMUNICATIONS MENU /A026 JMS I MNUCAL /A026 DLMCX2 /A026 AC7777 CIFSYS HS2OU CLA TAD (CNLINE-1) DCA X2 CON1, TAD I X2 SNA JMP CON2 /DONE IF 0 JMS KBTOCH JMP CON1 CON2, JMS KBTICH /GET EDIT INPUT TAD (-EDMENU) /M057 SNA /M057 JMP RTNSY /GOLDM /M057 / / The "stuff" to handle most of the input cosmetics is now /A057 / Blasted in /A057 / JMS CLRPAN / clear panel if VT125 /a058 JMS BHOOK / Call Blaster /A057 CXKBIN /A057 JMP CONCR1 / End of Input seen /A057 JMS RESPAN / restore panel if /a058 JMP CON2 / Go try for more /A057 CONCR1, JMS RESPAN / restore panel if vt125 /a058 JMP CONCR / end of inpt screen /a058 /***********************************************************************/a058 / CLRPAN Clear out the first block of panel memoryry before / blaSTING IF it is a VT125 GRAPHICS term emulator /***********************************************************************/a058 CLRPAN, XX / return address /a058 DCA RESPAC / save ac /a058 JMS CHK125 / ARE WE A VT125? /A058 SKP / yes /a058 JMP CLRPN1 / NO JUST RETURN /A058 JMS BHOOK / CALL BLASTR /A058 -MVSWEN / MOVE OUT SWAP AREA TABLES /A058 CLRPN1, /A058 TAD RESPAC / restore ac /a058 JMP I CLRPAN / RETURN /***********************************************************************/a058 / RESPAN restore the fisrst block of panel memory once we have blasted /a058 / if it is a VT125 emulator /a058 /***********************************************************************/a058 RESPAN, XX / RETURN ADDRESS /A058 DCA RESPAC / save ac /a058 JMS CHK125 / ARE WE A VT125? /A058 SKP / yes /a058 JMP RESPN1 / NO JUST RETURN /A058 JMS BHOOK / CALL BLASTR /A058 MVSWEN / MOVE BACK SWAP AREA GRAPHICS TABLES /A058 RESPN1, /A058 TAD RESPAC / restore ac /a058 JMP I RESPAN / RETURN /A058 RESPAC, 0 /a058 /**************************************************************************** / TSTJB2 moved here from WPCOM because of the lake of the space /***********************************************************************/a058 TSTJB2, /a058 JMS BHOOK / call the blastr /a058 CXHLTB / run testst from blastr /a058 JMP TSTJB1 / return 1 go restore the swap if VT125 /a058 JMS RESPAN / restore here if return 2 /a058 JMP TSTXIT / and exit /a058 TSTJB1, JMS RESPAN / restore swap /a058 JMP TSTJOB / cont /a058 /**************************************************************************** CKCOMM, XX /ROUTINE TO SEE IF HOST IS REQUESTED /A018 TAD (H2T) /IF SO VALIDATE HARDWARE IS PRESENT. /A018 /SEE IF HOST IS ANY /A018 JMS CHKFLG /OF THE DESTINATIONS. /A018 SKP /SKIP IF NO. SEE IF IT IS A SOURCE. /A018 JMP CKHDWR /HOST IS A DESTINATION. CHECK HARDWARE. /A018 TAD H2TFLG /SEE IF HOST IS A SOURCE. /A018 SNA CLA /SKIP IF YES. VALIDATE THE HARDWARE. /A018 JMP I CKCOMM /HST NOT SRC & NOT DST SO OK TO RETURN. /A018 CKHDWR, AC0001 /LOAD THE HARDWARE PRESENT BIT MASK /A030 CDFMNU /C030 AND I (MUBUF+MNOPTC) /C030 CDFMYF /SEE IF COMM HARDWARE IS PRESENT /A018 SZA CLA /SKIP IF NO. REPORT ERROR. /A018 JMP I CKCOMM /HARDWARE IS PRESENT SO OK TO RETURN. /A018 JMP PTERM5 /PUT OUT ERROR MESSAGE /A030 RTNCER, XX /EXIT CIDF /MOVED /M041 JMP I XBSTRT /RETURN TO CALLER /MOVED /M041 / Moved here on edit 057 for space reasons CLRSCN, TEXT '^P!E' /M044 / / Moved here on edit 07 for space reasons /A057 / LPRINT, XX JMP LPTTSF LPTTSE, CIFSYS JWAIT LPTTSF, CIFSYS LPTOU JMP LPTTSE /NOT READY, WAIT JMP I LPRINT /------------------ PAGE /RELOAD PRINTER FOR VT125 MODE CXHOLE, /---------------------------------------------------------------/a055 / N.B. /A055 / THIS Page is used by Blaster as an overlay area for /A055 / dumping into (and restoring of course ) /A055 / /A055 /---------------------------------------------------------------/A055 PRTLOD, 0 /D058 DCA QUQBLK+RXQDRV /SET SYSTEM DRIVE /A044 /D058 TAD (DLFD1) /START BLOCK NUMBER /A044 /D058 DCA QUQBLK+RXQBLK /A044 /D058 TAD (-DSFD1) /BLOCK COUNT /A044 /D058 DCA QUQBLK+RXQRS1 /A044 /D058 TAD PRTFLD /PRINTER FIELD /A044 /D058 DCA QUQBLK+RXQBFD /PUT IT IN QBLK /A044 /D058 TAD (PRBOTM) /START OF BUFFER /A044 /D058 DCA QUQBLK+RXQBAD /PUT IT IN QBLK /A044 /D058 TAD (RXERD) /NO RETURN MUST REBOOT /A044 /D058 DCA QUQBLK+RXQFNC /FUNCTION CODE /A044 /D058 JMS QURX /DO IT /A024 /D058 CLA /MUST REBOOT ON ERROR AS PRINT FIELD /D058 /NOT IN MEM. /A044 /D058 TAD (PRJOB) /STATUS BLOCK POINTER /A044 /D058 CIFSYS /A044 /D058 JSTRT /RESTART JOB /A044 /D058 JMP I PRTLOD /RETURN /A044 /D058PRTFLD, CDFPRT /PRINTER FIELD /A044 /************************************************ / NOW RESTART THE SYSTEM /************************************************ /A058 / HLT CDFSYS / system field /a058 TAD I WRMSTR / get date for start /a058 CMA / make neg /a058 DCA I WRMSTR / and store /a058 JMS BHOOK / call BLASTR /a058 -GRESEN / to restore restart code from panel /a058 IOF / don't allow interrupts /a058 CLA / AC4000 / Get system type /a058 / CDFFIO / /a058 / TAD I PTR7 / /a058 CDISYS / call restart in sys /a058 DCA I VFYPTR / save type first /a058 JMP I RESPTR / now restart /a058 RESPTR, RXDRIN+1 / address of restart /a058 VFYPTR, SVFVFY-CLOCK+RANDOM /a058 WRMSTR, DAMNTH / date for restart /a058 CONCR, TAD (CR) JMS KBTOCH TAD (LF) JMS KBTOCH CNMERG, TAD (CNLINE-1) DCA X2 CNSCAN, TAD I X2 /ANOTHER FIELD THEN REINSERT IT SNA JMP CNDONE TAD (-BLANK) SNA JMP CNSCAN TAD (BLANK) MQL TAD (TAB1-1) JMS LOOKUP JMP CNERR TAD (TAB2-TAB1-1) DCA X3 TAD I X3 DCA CNLOC TAD I X2 SNA JMP CNERR MQL TAD (TAB3-1) JMS LOOKUP JMP CNERR TAD (TAB4-TAB3-1) DCA X3 TAD I X3 MQL TAD I CNLOC MQA DCA I CNLOC TAD DKTFLG AND (20) SZA CLA JMP CNERR TAD TSTFLG AND (20) SZA CLA JMP CNTDOC /TEST A DOCUMENT FOR VALID CX /PRINT CONTROLS AC0001 DCA NONBNK JMP CNSCAN CNERR, AC7777 TAD X2 DCA X2 TAD (QUEST) DCA I X2 DCA I X2 JMP CONFIG CNLOC, 0 /CHECK FOR A TRANSFER TO A DOCUMENT CNDONE, TAD NONBNK /IF ZERO DON'T CONTINUE SNA CLA JMP CONFIG JMS CKCOMM /CHECK FOR HOST I/O BUT NO HARDWARE. /A018 TAD (DOC) /SET THE MQ FOR DOCUMENT JMS CHKFLG /SEE IF A FLAG IS SET FOR OUTPUT TO A DOCUMENT JMP CHKREQ /NO TAD OTFILE /YES IS THE FILE ALREADY OPENED ? SNA CLA /SKIP IF YES. CONTINUE. /A035 JMS PMESFN /NO OPEN IT JMP CNTNUE CHKREQ, JMS CXSKCL /CLOSE THE FILE /CHECK FOR FILE NEEDED TO BE READ CNTNUE, TAD DKTFLG SNA CLA JMP CNTU1 /IF NOTHING FROM AN INPUT DOCUMENT JMS RDOCMS JMP CNTNU CNTU1, JMS CXRDCL /CLOSE IF OPEN FOR READ /IN THE NEW SYSTEM THE COM FLAG IS SET BEFORE ENTERING CX /BY CU3COM IN WPCU3 CNTNU, JMS PRTTST /SEE IF INITIALIZATION TO PRINTER TO BE DONE JMP CNTN6 / / The code below was moved here on edit 059 to free up a few /A059 / words in WPCOM and allow easier changing of NRC on term reset /A059 / / RESNRC, XX / Restore terminal NRC /A059 JMS DMTOSC / Output an escape seq /A059 ESC / /A059 "(&177 / /A059 RESNRX, "B&177 / /A059 ESC / /A059 ")&177 / /A059 "0&177 / /A059 0 / /A059 JMP I RESNRC / And return /A059 /------------------ PAGE /*********** MOVED HERE VER 044 ***********SPACE WARS LOOKUP, XX DCA X3 MQA CIA DCA LOOKC LOOKC1, TAD I X3 SPA JMP I LOOKUP TAD LOOKC SZA CLA JMP LOOKC1 TAD X3 ISZ LOOKUP JMP I LOOKUP LOOKC, 0 /CHKFLG - CHECKS FOR THE VALUE IN THE MQ TO THE FLAGS CHKFLG, XX MQL TAD (TAB2-1) /GET STARTING ADDRESS DCA CHKFLT CHKFLJ, ISZ CHKFLT TAD I CHKFLT DCA T1 TAD T1 SPA CLA JMP I CHKFLG /IF -1 THEN END OF STRING MQA AND I T1 SNA CLA JMP CHKFLJ ISZ CHKFLG JMP I CHKFLG CHKFLT, 0 /ROUTINES FOR ACCESSING DOCUMENTS PMESFN, XX CIFMNU /INSERT A CDF TO THE MENU FIELD JMS I MNUCAL /CALL MENU DLMCM1 AC7776 CDFMNU TAD I (MUBUF+MNTMP1) /GET TEMP 1 TO SEE ABOUT GOLD-M CDFMYF /A CDF FOR THIS FIELD /WILL BE INSERTED AT RUN TIME SNA JMP CONFIG /IF 2 RETURN TO MENU TAD (2-CREATE) /ELSE SEE IF THE DOCUMENT HAS TO BE CREATED SZA /NEED TO CREATE? JMP PMESF1 /NO, JUMP DCA OPFLOP /WILL OVERWRITE THE DOCUMENT JMS ADRCRT /CREATE THE FILE JMP CRTERR /ERROR ENCOUNTERED CDFMNU /SET "REMEMBERED" FILE NUMBER. /A034 DCA I (MUBUF+MNFNO) /A034 TAD I (MUBUF+MNFNO) /GET DOC NUMBER. /A034 AND P377 /A034 DCA I (MUBUF+MNDOCN) /STORE IT TOO. /A034 JMP PMESF2 PMESF1, TAD (CREATE) DCA OPFLOP /STORE THE VALUE CDFMNU /INSERT A CDF FOR THE MENU FIELD /TO PICK UP AN ARG. PMESF2, TAD I (MUBUF+MNFNO) CDFMYF CIA TAD ITFIL2 /ASSUME AT MOST ONE OF ITFILE AND ITFIL2 /ARE NON-ZERO TAD ITFILE /COMPARE TO WHAT WAS THERE LAST SNA JMP FLERR /CAN'T READ AND WRITE TO SAME FILE CIA TAD ITFIL2 TAD ITFILE DCA OTFIL2 JMS CXSKOP /OPEN SCROLL FILE. /A013 SKP /IF ERROR SET ERFLG. /A013 JMP I PMESFN /RETURN /A013 AC0001 DCA ERFLG /SET RETURN ERROR FLAG. /A013 JMP I PMESFN /RETURN TO CALLER. OPFLOP, 0 RDOCMS, XX /TAKES CARE OF THE READ FILE CIFMNU /CALL THE MENU JMS I MNUCAL /MENU CALL DLMSO2 /M034 AC7776 /TEST FOR GOLD-M CDFMNU /GET AN ARGUEMENT FROM THE MENU FIELD TAD I (MUBUF+MNTMP1) CDFMYF /A CDF FOR THIS FIELD /WILL BE INSERTED AT RUN TIME SNA CLA JMP RDOCM2 /IF 2 START AGAIN CDFMNU /GET TO THE MENU FIELD TAD I (MUBUF+MNFNO) /GET FILE NUMBER WITH DRIVE NUMBER CDFMYF /A CDF FOR THIS FIELD /WILL BE INSERTED AT RUN TIME CIA TAD OTFIL2 /ASSUME THAT AT LEAST ONE /OF OTFIL2 AND OTFILE IS ZERO TAD OTFILE SNA JMP FLERR /CHECK FOR R &W TO SAME FILE CIA TAD OTFIL2 TAD OTFILE DCA ITFIL2 JMP I RDOCMS CHK125, 0 /CHECK VT125 MODE /A044 CDFMNU /A044 AC7775 /CHECK FOR VT125 MODE(=3) /A044 TAD I (MUBUF+CXTMOD) /MODE SW /A044 CDFMYF /A044 SZA CLA /=VT125? /A044 ISZ CHK125 /NOT VT125 MODE..NO GRAPHICS LOADED /A044 JMP I CHK125 /RET /A044 /Moved here on edit 51 to make space at ID routine to check if fallback /A051 /required on printer (LA100 non PC etc) /A051 /MOVED HERE FROM NEXT PAGE TO MAKE ROOM /A041 /PRSTTS SHOULD BE NOT BE RESET WHEN LEAVING CX. /A030 /PRTID NO LONGER SETS IT TO 1 (BUSY) SO IT REMAINS (0) AS LONG /A030 /AS NO ERROR OCCURS. IF AN ERROR DOES OCCUR, IT WILL BE SEEN /A030 /WHEN THE USER RETURNS TO MAIN MENU /A030 /THE PRINTER JOB DOES NOT NEED TO BE STARTED WHEN WE LEAVE CX /A031 /SINCE IT CANNOT BE RUNNING. WE HAVE ELIMINATED THE WINDOW ON /A031 /PRSTTS BETWEEN JOBS, SO CX TO THE PRINTER CAN NOT BE UNLESS THE /A031 /PRINTER JOB IS NOT RUNNING. /A031 XPRTPT, XX IFDEF VT125R < /A044 JMS CHK125 /CHECK VT125 MODE /A044 SKP /IS VT125 MODE /A044 JMP I XPRTPT CIFEDT /CALL IN WPCX2 /A045 JMS I (SETPG0) /DO IT /A045 JMS I PLDADR /LOAD PRINTER CODE FIELD 1 /A044 > /END IFDEF VT125R /A044 JMP I XPRTPT /------------------ PAGE /WHEN A GOLD-M WAS ISSUED, MAKE SURE THAT ANY PREVIOUSLY SPECIFIED /(BUT NOT OPENED) OUTPUT FILE IS UNLOCKED. /THIS ASSUMES THAT, SHOULD BOTH AN INPUT AND AN OUTPUT FILE BE NEEDED AT /THE SAME TIME, THE MENU PROMPT FOR THE OUTPUT FILE WILL BE ISSUED FIRST. RDOCM2, DCA OTFIL2 TAD DSKACF /IS THE DISK JOB CURRENTLY ACTIVE? /A013 SZA CLA /SKIP IF NOT ACTIVE /A019 JMP CONFIG /TELL DSK JOB, KILL ITSELF & CLOSE FILE /A013 JMS CXSKCL /CLOSE ANY OPEN SCROLL FILE. /A013 JMP CONFG0 /SET UP FOR CX MENU. /A013 /PRTTST - checks for cx using the printer and if the printer is in use... PRTTST, XX TAD (LQP) /SET THE MQ FOR PRINTER JMS CHKFLG /SKIP IF PRINTER REQUESTED JMP PRTTSN /NO REQUEST FOR THE PRINTER JMS CHK125 /CHECK VT125 MODE /A044 JMP I PRTTST /YES SKIP BUSY CHECK(ALREADY DONE) /A044 CDFMNU / Point to Menu field /A057 AC4000 / Test for bit 0 /A057 AND I (MUBUF+MNPULD) / Check "Non-Printer Print Busy Flag" /A057 SZA CLA / /A057 JMP PTERM7 / Print Screen must be active /A057 CDFPRT TAD I (PRSTTS) /SEE IF THE STATUS IS ZERO SZA CLA JMP PTERM2 /NO, CX CANNOT BE DONE /C027 PRTTSC, ISZ CNGPFG /SET THE CHANGE FLAG /A025 TAD I (PRTID) /GET PRINTER ID ROUTINE ADDRESS. /A007 CDFMYF /BACK TO THE FUNNY FARM! /A007 CIFPRT /MAP SPOOLER. /A007 DCA T1 /SAVE ROUTINE ADDRESS. /A007 AC0001 /SAY THAT WE WANT TO TRAP THE ERROR!!! /A014 JMS I T1 /CHECK THE PRINTER ID. /A007 SKP /SUCCESS RETURN. /A014 JMP PTERM3 /NON-EXISTENT PRINTER RETURN. /A014 /PRTID WILL SET PRSTTS TO SOMETHING /A027 / / References to printing fallback for 8 bit (with 8 bit terminal /A056 / type) has been dropped since Martyn now gets the print driver to/A056 / handle 8 bit stuff to LQP's /A056 / /d056 TAD I (LPONLN) /Get printer status /A051 /d056 AND (MNMSK) /Has it got multinational capability? /A051 /d056 SZA CLA / /A051 /d056 JMP PRCKASF /Yes , check sheet feeder /A051 /d056 AC0001 / /A051 /d056 DCA PRFLBK /Set print fallback flag /A051 PRCKASF,CDFPRT /MAP PRINTER /A007 TAD I (LPONLN) /GET PRINTER ASF STATUS. /A007 AND (ASFMSK) /A033 SZA CLA /SKIP IF NOT ASF. /A007 TAD (FF) /SET FF IF ASF. /A007 DCA PRTSTS /DO INITIAL FF FOR ASF PRINTERS. /A007 CDFPRT /GET DEFAULT PAGE SIZE /A007 /C038 TAD I (PRQPSZ) /A007 /C038 CDFMYF CIA /COMPUTE THE NUMBER OF PAGES. /A007 DCA LPTCNT /SAVE. /A007 CDFMNU / Point to menu field /A057 AC4000 / Now set the flag /A057 TAD I (MUBUF+MNPULD) / to say the printer is busy /A057 DCA I (MUBUF+MNPULD) / and put it back /A057 AC0001 / Set Printer requested flag /A057 DCA PRTREQ / On /A057 CDFMYF / Back to this field /A057 /SEND EITHER NOTHING OR A FORM FEED TO PRINTER TAD PRTSTS /GET CHR /C038 SNA JMP I PRTTST /NOTHING, RETURN. /D057 JMP PRTTSF PRTTSE, JMS LPRINT /PRINT CHAR IN AC /A057 JMP I PRTTST /FF ACCEPTED, DONE /C038 PRTTSN, DCA CNGPFG /CLEAR THE CHANGE FLAG JMP I PRTTST PTERM7, TAD (2) / Print screen and printer requested /A056 PTERM5, TAD (2) /NO HARDWARE /A030 PTERM3, IAC /NON EXISTENT /A024 PTERM2, TAD (2) /BUSY /A024 PTERMS, CDFMNU DCA I (MUBUF+MNTMP1) /SAVE ERROR CODE FOR MENU CDFMYF CIFMNU JMS I MNUCAL /DISPLAY THE MESSAGE DLMAD7 JMP RTNSY /M013 PRTSTS, 0 /TABLE OF CHARACTERS TO SEND TO THE PRINTER /FF INSERTED HERE FOR ASF PRINTERS. /A007 FLERR, CLA JMP ERROUT INTERR, CDFMYF AC0001 TAD ERFLG /ADD INTERNAL ERROR TYPE (1 FOR BAD BLOCK, /2 FOR OVERFLOW. JMP ERROUT /PUT THE ERROR TYPE INTO A TEMP TO CALL THE MENU. /THEN, CLEAN UP AS FOLLOWS - /CLEAR ALL ACTION FLAGS TO STOP ALL NON-DISK JOBS /CLEAR ERROR INDICATION FLAG (ERFLG) /CLOSE ANY DISK INPUT FILE (CALL DKACTS ONCE) /FINALLY, CALL THE ERROR MENU TO DISPLAY THE ERROR. CRTERR, AC0001 ERROUT, CDFMNU DCA I (MUBUF+MNTMP1) CDFMYF /CLEAR ALL ACTION FLAGS AND -ERFLG- JMS CLRFLG /M003 /CLOSE INPUT FILE TAD DSKACF /IS THE DISK JOB ACTIVE? /A013 SNA CLA /SKIP IF YES. TELL IT TO CLOSE UP SHOP. /A013 JMP ERROU1 /CLOSE THE OPENED FILES. /A013 DCA DSKCNT /DISK JOB WILL CLOSE FILE ONLY WHEN NO /CHAR TO OUTPUT JMS DKACTS JMP ERROU2 /MERGE BELOW TO DISPLAY ERROR MESSAGE. /A013 ERROU1, JMS CXRDCL /CLOSE ANY OPENED READ FILE (PROBABLY /A013 /NONE OPENED AT THIS POINT!) /A013 JMS CXSKCL /CLOSE THE OPENED SCROLL FILE (WHICH /A013 /MAY BE OPENED AT THIS POINT). /A013 /DISPLAY ERROR MENU ERROU2, JMS DMTOSC /OUT PUT STRING TO SET ANSI MODE /A042 ESC;74;0 /IS ESCAPE ANGLE BRACKET /A042 CIFMNU JMS I MNUCAL DLMCX1 JMP CONFG2 /DISPLAY COMMUNICATIONS MENU /THIS IS THE CROSS FIELD CALL FOR THE CX PRINT CONTROL TEST ROUTINE CNTDOC, AC0001 /SINCE THE ROUTINE CAN BE CALLED BY SO AND CX /THE 1 TELLS THE ROUTINE THAT CX IS CALLING CIFEDT JMS I (DBTDOC) NOP /A037 JMP CONFIG CXRDCL, XX CLA DCA ITFILE JMP I CXRDCL /------------------ PAGE /SEE IF THERE ARE DOCUMENTS TO BE OPENED CXRDOP, XX TAD ITFIL2 SNA JMP I CXRDOP /IF THERE IS NO INPUT FILE TO OPEN, JUMP DCA ITFILE DCA ITFIL2 CDFEDT /A047 DCA I (DSKRLF) /CLEAR THE FLAG USED BY DSKGCH THAT /A047 /SAYS IT IS IN THE MIDDLE OF A RULER /A047 DCA I (DSKSTF) /CLEAR THE FLAG IN DSKGCH THAT SAYS TO /GET INPUT FROM A BUFFER AND NOT RDFILL /A047 AC7776 DCA I (DSKSOD) /SET FOR FIRST TIME THROUGH DSKGCH /A047 DCA I (DSKBAK) /CLEAR THE TEMP CHAR WHEN LOOKIN FOR SOD/A047 DCA I (DSKSOL) /CLEAR THE START OF LINE FLAG /A047 CDFMYF /A047 TAD ITFILE CIFFIO FILEIO XRDFIN JMP I CXRDOP /OPEN THE OUTPUT FILE IF THERE IS ONE WAITING TO OPEN CXSKOP, XX TAD OTFIL2 SNA JMP XSKOP3 /NOBODY TO OPEN, RETURN. MQL TAD OPFLOP /PICK UP TYPE OF OPEN (TOP, BOTTOM, OVERWRITE) CIFFIO FILEIO XDSKIN SZA CLA /ERROR? JMP I CXSKOP /YES, JUMP TAD OTFIL2 DCA OTFILE DCA OTFIL2 /INITIALIZE THE OUTPUT BUFFER AND PUT AN INITIAL WORD-WRAP INDICATION IN /FOR THE EDITOR. TAD (DSKBUF) DCA DSKPT1 TAD (DSKBUF) DCA DSKPT2 DCA DSKCNT TAD (200+CNTRLG) JMP XSKOP2 XSKOP1, CIFSYS JWAIT XSKOP2, JMS DSKPUT JMP XSKOP1 XSKOP3, ISZ CXSKOP /SKIP OVER ERROR RETURN JMP I CXSKOP CXSKCL, XX CLA TAD OTFILE /CHECK THE INPUT FLAG FOR A FILE OPEN SNA CLA JMP I CXSKCL DCA OTFILE /CLOSE IT AND CLEAR FLAG CIFFIO FILEIO XDSKCL JMP I CXSKCL /FOLLOWING CODE MADE INTO A SUBROUTINE TO SAVE SPACE /A003 CLRFLG, XX /CLEAR FLAGS /A003 CDFEDT /CLEAR THE DOC XFR "WAIT" FLAG. /A016 AC7777 /SAY NOT "WAITING". /A016 DCA I (WATFLG) /A016 IFDEF VT125R < /VT125 ONLY /A041 DCA I (GRAFON) /SO HS CHARS GO TO SCREEN (NOT REGIS) /A041 > /END IFDEF VT125R /A041 CDFMYF /BACK TO OUR FIELD. /A016 DCA NONBNK /CLEAR THE SOMETHING TO DO FLAG /A003 DCA KBTFLG /CLEAR OUR FLAGS /A003 DCA EXRLR /A003 DCA H2TFLG /A003 DCA TSTFLG /A003 DCA DKTFLG /A003 DCA ERFLG /A003 JMP I CLRFLG /A003 /THIS IS THE RETURN LOGIC (GOLD MENU) RTNSY, JMS RESTOR /RESET TERMINAL CHARACTERISTICS /A002 JMS CXSKCL /CLOSE ANY OPEN SCROLL FILE. /A013 RTNCE1, TAD DSKACF /SEE IF ANY JOBS STILL RUNNING. /A013 TAD HSTACF /A013 TAD TSTACF /A013 SNA CLA /SKIP IF YES. /A013 JMP RTNCE2 /RETURN TO MAIN-MENU. /A013 CIFSYS /WAIT FOR JOBS TO FINISH-UP. /A013 JWAIT JMP RTNCE1 /CHECK AGAIN. /A013 RTNCE2, JMS XPRTPT /RETURN THE PRINTER /M044 CDFMNU /GET LINKAGE FLAG. /A035 TAD I (MUBUF+MNTMP6) /(IE, THE EZ-LINK FLAG). /A035 CDFMYF /BACK TO OUR FIELD. /A035 SZA CLA /SKIP IF NORMAL EXIT. (IE BACK TO MM) /A035 JMP RTNCER /JMP TO HANDLE CHAIN CALL TO AX/DX. /A035 IFDEF VT125R < JMS CHK125 /IS VT125 GRAPHICS MODE /A044 JMP CLRGRF /AVOID JUMPING TO NON EXISTING BUFFER /A041 >/END IFDEF VT125R /A041 CIF 60 /MAP COMM BUFFER FIELD. /A036 JMS I (COMXIT) /CALL COMM CLEAN-UP CODE. /A036 NOBUFF, CDFSYS DCA I (CMADSX) CDFMYF /CLEAR SYSTEM COMM FLAG JMP RTNCER /NEED TO EXIT ON SAME PAGE CALLED /A041 IFDEF VT125R /END IFDEF VT125R /A041 / / The code below is from H2TIO area moved here to give some space /A059 / / NRCTRN, CDFEDT / /A059 TAD I (NRCREP) / Get replaced char /A059 CDFBUF / Point back here /A059 JMP NRCRPD / and rejoin main code /A059 /------------------ PAGE / WPAX 3.3- AUTOMATIC DOCUMENT RECEIVE / / 037 CPH 19-SEP-85 Add Norwegian translations conditional / 036 EMcD 28-Feb-85 Add DECDEV switch / 036 TCW 30-AUG-84 Change var. ref. from abs. to relative / 035 WCE 11-MAY-84 Remove all occurances of USERNO / 034 TCW 24-JAN-84 Limit menu input to 64 chars. / 033 TCW 16-JAN-84 Add new label for menu display / 032 GDH 4-JAN-84 Don't display comm settings for EZLINK. / 031 TCW 30-DEC-83 ADD CK FOR PASSWORDS WITH EXTRA CHARS. / 030 TCW 16-MAY-83 ADD THE FETCH OF "LOGNO" WHEN TRUNCAT- / ING LD NAME / 029 EH 14-JAN-83 Modifications to 028 / 028 EH 04-JAN-83 Modifications to 027 / 027 EH 29-DEC-82 After trunc. AX LD to 64, check to see / if file already exists / 026 EH 21-DEC-82 Install missing CDF within AXRT7 / 025 EH 17-DEC-82 More work on 024 / 024 EH 14-DEC-82 Limit length of AX LD name to 64 chars / 023 AIB 22-OCT-82 fixed log doc entry for add to / bottom from "A" to "B" / 022 AIB 22-OCT-82 fixed wording in / "identification message" msgs / 021 EH 05-OCT-82 Check for leading space in Log Document / 020 MJS 21-NOV-81 big fix enabling 'settings' to be saved / at 'YES' prior to the start of sequence / 019 EH 9-NOV-81 modified text statement for AX menu / 018 EH 29-OCT-81 Merged differences from 78,1 into here / 017 GDH 23-OCT-81 Allow AX to send (but not recieve) LOG / 016 GDH 21-OCT-81 Merged some bug fixed from WS200 V4.4 / 015 GDH 21-OCT-81 Removed phoney CIF/CDF routines. Bug fix / to MNLOCK log document lock support. / 014 GDH 14-OCT-81 Removed log file lock/unlock code and / implemented menu lock word in it's place / 013 GDH 26-Aug-81 WPFILS calling seq changes. / 012 TT 07-JUL-81 Removed superfluous conditionals / 011 JM 01-APR-81 Changes for CANADA / 010 JM 19-FEB-81 Conditionalized PLCKFI for WS102 / 007 DRH 4-DEC-80 CLEAR AX LOG # & NAME IF CANNOT CREATE / 006 DM,JM 15-SEPT-80 Merged Scandi and Europe/English / 005 DSS 09-JUL-80 MODIFIED FOR ENGLISH/FRENCH-CANADIAN / 004 CMW 6-MAY-80 ENTERED CANADA TRANSLATIONS / 003 DSS 17-APR-80 ENTERED DUTCH FIXES / 002 3/20/80 GLT Changed LOCDOC to stop overwriting literals when / loading WPCRE. / 001 2/6/80 CMW GLT ADDED FRENCH,DUTCH,GERMAN TRANSLATIONS / French diacritical substitutions: / "["=L.A.E, "]"=L.G.E; "&" does not capitalize / German diacritical substitutions: / "["=L.U.A, "\"=L.U.O, "]"=L.U.U; "7" usable / 2.7+ MB PUT IN THE NEW AX INSTEAD OF ADR / 2.4B KEE REMOVE DEAD CODE FROM CREATE / 2.J 8/26/77 KEE PUT IN 4-FLOPPY SUPPORT / 2.G-2 8/10/77 MB PUT IN CHANGE FOR MENU AREA MOVE / 2.G-1 8/9/77 MSB PUT WT78 AND MASTER VERSIONS TOGETHER / / WTAX.PA - WRITES OUT SECOND FIELD OF THE DX, AX, SD COMM. / *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLOAX / ++++ 100 / ++++ IFNDEF DECDEV < CDF 20 / ++++ /M036 > IFDEF DECDEV < CDF 30 / ++++ /A036 > -DSOAX DLDCOM / ++++ DFCOMA / ++++ IFNDEF DECDEV < CDF 20 / ++++ /M036 > IFDEF DECDEV < CDF 30 / ++++ /A036 > -DSDCOM / INITALIZE THE SETTING TO ZEROS 0 / / THE SECOND FIELD OF DX AND AX / IFNDEF DECDEV < FIELD 2 > IFDEF DECDEV < FIELD 3 > / / SET UP CONSTANTS FOR THE PROGRAM / BUFSIZ=100 / THE STANDARD BUFFER SIZE NAKLM=-41 / THE IS THE NUMBER OF RETRNANSMITS IT WILL DO TOLIM=-5 / THE NUMBER OF TIMES YOU RESEND AFTER A TIME OUT SPECHR=140 / THE CODE FOR SPECIAL CHARACTERS CR=15 / SEND AFTER A TRANSFER OF ANY KIND SO T-S CAN DETECT EOT SPACE=40 / / THE TIME OUT CONSTANTS / / SEC1=-2 /D018 / SEC3=-4 /D018 / SEC60=-75 /D018 / SEC5=-6 /D018 MIN3=-265 / / THE START OF TEXT CHARACTERS / ACKM=174 ACK=170 ACKY=140 NAK=160 NAKN=164 / / THE FLAG CHARACTERS FOR THE PACKET TYPE AND THE COMMANDS FOR THE LOW LEVEL / IF THE VALUES CHANGE TELL HSTTBL BECAUSE USE THEN AS OFFSETS / THEY ALL HAVE THE SAME PACKET FORMAT / TYPYES=140 / THE OK PACKET TYPE TYPMOD=141 / DOCUMENT OPTIONS PACKET RESPONDED WITH AN ANSWER TO PROMPT TYPMES=142 TYPSOD=144 / FIRST PACKET OF A DOCUMENT CONTAINING SIZE AND PRINTER SETTINGS TYPDOC=154 / PAKCET SENT BY AX TO DX TO ASK IF THE DOCUMENT SHOULD BE SENT. / THIS NAME IS AN ENTRY IN THE LIST DOCUNET DX PICKED / TYPHIT=147 / HIGH LEVEL INITALIZE PACKET THAT HAS THE TERMINAL MESSAGE IN IT / TYPHAK=150 / THE HIGH LEVEL ACK / TYPEOF=146 / LAST PACKET OF A DOCUMENT. CONTAINS THE LAST 64 BYTES OR LESS TYPBYE=143 / BYE MESSAGE PACKET, WILL TERMINATE A TRANSFER TYPDTA=145 / NORMAL TEXT PACKET OF A DOCUMENT TYPHLO=156 TYPNO=164 / ANO RESPONSE TO A PACKET TYPFLE=171 TYPPSW=172 TYPPMT=175 / PROMPT PACKET TYPPAN=172 / ANSWER TO PROMPT CONTAINS WHAT THE USER TYPED TYPPNE=176 / PROMPT WITH NO ECHO TYPOPT=153 / THE OPTION PACKET TYPRCV=152 / WANT TO RECEIVE A DOCUMENT TYPSND=151 / WANT TO SEND A DOCUMENT / / SOME CONSTANTS FOR THE DATA BUFFERS / BUFSTX=-1 / LOCATION OF THE STX FOR THE BUFFER CSLOC=BUFSIZ / THE FIRST HALF OF THE CHECK SUM CSLO1=CSLOC+1 / THE SECOND HALF WFLOC=CSLO1+1 / THIS TELLS IF THE BUFFER IS FULL (1) OR EMPTY (0) / / THE NUMBER OF TRYS BEFORE THE USER IS DECLARED INVALID / TRYPSW=-3 / / CONSTANT FOR THE CREATE / CUB1=6400 / / ADDRESS USED FOR THE GETBUF AND PUTBUF FOR OTHER FIELD / FREEPT=174 RECPT=FREEPT+1 SENDPT=RECPT+1 / GETBUA=5200 PUTBUA=GETBUA+1 / / ASSUME THAT THE SPFLAG IS IN EDITOR FIELD AT 173 / SPFLAG=173 / / THE OPTIONS THAT ARE SET TO THE DX SYSTEM WHEN SNEDING AND DOCUMENT / EXISTS THAT IS TO RECEIVE / TBOPT=43 / / VALUES FOR THE OPTIONS / OPTNUL=40 / NOTHING OPTBYE=41 / JUST BYE MESSAGE OPTBM=42 / BYE AND NORMAL MESSAGE OPTBMS=43 / BYE, NORMAL, AND SEND OPTALL=44 / EVERYTHING / / VALUE DEFINED TO GET THE CORRECT VERSION OF CREATE WPCRE ASSEMBLED / ADRASM=1 / / THESE CONSTANTS ARE USED BY THE CHECK LIST COMMAND / THE SYMBOLS ARE THE SAME AS DELETE SINCE THAT IS WHERE THE CODE WAS TAKED / DELIMB=-400 / THE SIZE OF THE BLOCK BUFFER DEBUF=4000 / ADDRESS OF THE RECORD BUFFER / TAB=11 / THE TAB VALUE LF=12 / VALUE FOR A LINE FEED CR=15 / CARRIGE RETURN BLANK=40 / ASPACE / RECLIM=-1000 / NEGATIVE THE LIMIT OR CHARACTERS IN A RECORD / DESTRP=1014 / THE START OF PRINTER CONTROL DENDP=1414 / END OF PRINTER CONTROL DESTRR=16 / START OF RULER DENDR=17 / END OF RULER / / / THE STARTING ADDRESSES OF THE BUFFERS / THIS IS THE AREA THAT IS USED FOR THE DEFAULT SETTINGS. THEY ARE STORED / FROM 5000 TO ABOUT 6000 MOST OF THE UNUSED PORTION IS USED FOR OTHER / BUFFERS AND INFORMATION IT IS ALWAYS IN COREAND WRITTEN OUT IF THERE IS A / MODIFICATION TO THE AREA. / / ADDRESS OF THE COMMUNICATIONS SETTINGS STARTING ADDRESS / DFCOMA=5000 / X=DFCOMA / DLNO=X / ++++ X=X+1 / DEFAULT LIST DOCUMENT DLSTAD=X / ++++ X=X+BUFSIZ+1 / THE LIST NAME / IDSTAD=X / ++++ X=X+BUFSIZ+1 / THE ID MESSAGE / LOGNO=X / ++++ X=X+1 / THE LOG DOCUMENT NUMBER LOGMOD=X / ++++ X=X+1 / HOW TO MODIFY IT LDSTAD=X / ++++ X=X+BUFSIZ+1 / THE LOG DOCUMENT NAME / WPSTAD=X / ++++ X=X+BUFSIZ+1 / WRITE ONLY PASSWORD BPSTAD=X / ++++ X=X+BUFSIZ+1 / READ/WRITE PASSWORD / AXIDB=X / ++++ X=X+BUFSIZ+1 / THIS IS THE DX USER'S ID TYPED. HERE TO USETHE ROOM / AXSNDA=X / ++++ X=X+11 / THE LIST OF DOCUMENTS TO SEND DX / INMBLK=X / ++++ X=X+BUFSIZ+1 / THE INPUT BUFFER FOR PACKETS RECEIVED / AXTIM=X / ++++ X=X+27 / BUFFER USED BU AXDON ROUTINE TO STORE THE TIME FOR LOG / / STARTING ADDRESS FOR THE LIST CHECK / LSTAD=6000 / THIS IS ALSO USED BY SCROLL / *100 / THE FIRST 100 LOCATIONS ARE USED FOR THE SYSTEM / CDFMYF=CDFBUF / WE'RE IN THE BUFFER FIELD. /M015 / / THE FLAGS FOR AX / OPTFLG, 0 / THIS CONTAINS THE VALUE OF THE OPTIONS THAT THE CONNECTING / SYSTEM HAS AXFLG, 0 ERFLAG, 0 GETBUF, 0 PUTBUF, 0 AXDCF, 0 AXPCN, 0 AXSNT, 0 AXSNS, 0 AXST2, 0 / TOKOFF, 0 / POINTER TO THE INPUT THAT IS BEING LOOKED AT / SNDLST, 0 / IF SET TO 1 THEN JUST SEND THE LIST DONT DISPLAY / ERRORS USED WHEN CALLING CHKLST AXSNDL, 0 / THE POINTER TO THE NEXT AVAILABLE LOCATION IN THE / THE LIST OF DOCUMENTS TO SEND TO DX / PAGE / / THESE ADDRESSES HAVE TO BE IN THIS ORDER AND IN THESE LOCATIONS / ALL ENTRYS TO THIS VECTOR CHOULD NEVER BE CALLED IF ITS ENTRY IS NOTDEF / IF CALLED THE PROGRAM JUMPED INTO RANDOM CODE SO HALT / AXDIS / SET UP AX / AXEC / THIS ASKS THE DX USER FOR THE INFO NEEDED AT CONNECTION / AXDON / THIS IS CALLED TO CHECK TO SEE IF THE LOG DOCUMENT IS / SET AND IF IN AX AND A DOCUMENT HAS / BEEN TRANSFERRED THEN PUT THE ENTRY INTO THE LOG. / ADRCRT / CREATE A DOCUMENT / / AXLRT / RETURN LOG FILE /D018 0 /A018 / AXSR / THE SEND /RECEIVE PART OF AX / REDSIX / READS THE SPECIAL SEVEN BIT AND RETURNS IT FROM THE / SIX BIT READ ROUTINE / WRISIX / WRITES THE SEVEN BIT RECEIVED TO THE DOCUMENT / CLASIX / INITALIZES THE REDSIX AND WRISIX ROUTINES / / ARDPRG - WILL SET THE NEEDED VARIABLES FOR AUTOMATIC / DOCUMENT RECEIVE. / AXDIS, XX CDFMYF DCA AXDCF / CLEAR THE WWRITE OUT SETTINGS FLAG / AC0001 / ++++ DCA AXFLG / TELL THE FIELD THAT IT IS IN AX / / READ IN THE DX SETTINGS / TAD (RXERD) / READ IN THE SETTINGS. IF A DISK ERROR DONT RETURN JMS AXDST / /D032; JMS LOCDOC / LOCK THE DOCUMENTS THAT ARE TO BE USED /D014; JMP AXGLD / COULD NOT LOCK THE DOCUMENTS ALREADY IN USE AXDS2, DCA MNUFLG / IF ZERO PUT FIRST MENU /A033 / CIFMNU / CLEAR THE SCREEN JMS I IOACAL 0 CLASCR 0 / CDFMNU / See if we're in ezlink (from CX) /A032 TAD I (MUBUF+MNTMP6) / ... /A032 CDFMYF / ... /A032 SNA CLA / Skip if yes. Don't display comm setngs/A032 JMP AXDS2A / DISPLAY MENUS /A033 / / THE RETURNS FROM AXDIS / AXRTX, TAD (RXEWT+2000) / write out the settings /a020 JMS AXDST / /A020 TAD LOGNO / SEE IF A LOG DOCUMENT IS SET AND IF SO DOES IT EXIST SNA CLA / ++++ JMP AXRT7 / JMS CUCOPY / BEFORE CONTINUING MAKE SURE THE LOG DOCUMENT EXISTS LDSTAD / COPY NAME TO THE MENU AREA AND LET FILNAM DECIDE CDFMYF MUBUF+MNIBUF CDFMNU BUFSIZ / CDFMNU /A025 DCA MUBUF+MNIBUF+BUFSIZ / TERMINATE THE FILE NAME /A025 / TAD (MUBUF+MNIBUF) / TELL FILNAM WHERE TO LOOK CDFMNU DCA I (MUBUF+MNPOS / /M036 AC0001 DCA I (MUBUF+MNTMP1) CDFMYF / CIFMNU JMS I MNUCAL DLMAD6 / CDFMNU TAD I (MUBUF+MNTMP1) CDFMYF / SMA CLA / ++++ JMP AXRT2 / FILE EXISTS IF +1 AND DOESNT IF -1 / CIFMNU JMS I IOACAL / PUT UP ERROR MESSAGE 0 LOGER1 0 1205 / USE MULTIPLE LINES SO WE CAN SEE /A034 1405 / COMPLETE DOC. NAME /A034 LDSTAD 1605 / /A034 / CIFMNU JMS I IOACAL 0 LOGER2 2005 / /A034 / JMP AXRT4 AXRT3, CIFSYS / ++++ JWAIT AXRT4, CIFSYS / ++++ XLTIN JMP AXRT3 / TAD (-EDNWLN) SNA CLA / ++++ JMP AXGLD / ACT IF A GOLD MENU RETURN - GO TO MAIN TAD (7) JMP AXRT5 AXRT6, CIFSYS / ++++ JWAIT AXRT5, CIFSYS / ++++ TTYOU JMP AXRT6 JMP AXRT4 AXRT2, CDFMNU / COPY THE DOCUMENT NUMBER TAD I (MUBUF+MNFNO) CDFMYF / DCA LOGNO AXRT7, TAD LOGNO / GET THE LOG DOC #. /A015 CDFMNU / STICK LOG FILE # INTO MENU FIELD. THIS/A015 DCA I (MUBUF+MNLOCK) / WILL EFFECTIVLY LOCK IT FROM UPDATE! /A015 CDFMYF / BACK TO MY FIELD /A026 ISZ AXDIS / OK SKIP RETURN MEANS CONTINUE AXGLD, CLA / IF USER TYPED GM TAD (RXEWT+2000) / DO A WRITE JMS AXDST / CDIEDT JMP I AXDIS / / AXLRT - UNLOCK THE LOG FILE / /AXLRT, XX /D018 /D014;/ /D014; IFDEF WS102 < /D014; CDFMYF /D014; CIFPRT /D014; JMS I (ULKFIL) /D014; LOGNO /D014; USERNO /D014;/ /D014; > /D014;/ / CLA /D018 /D015; CDFMNU / CHANGE TO MENU FIELD. /A014 /D015; DCA I (MUBUF+MNLOCK) / CLEAR MENU LOCK WORD. /A014 / CDIEDT /D018 / JMP I AXLRT /D018 / PAGE / / THE VALUES RETURNED BY THE MENU / DLVAL=1 IDVAL=DLVAL+1 LDVAL=IDVAL+1 WPVAL=LDVAL+1 BPVAL=WPVAL+1 / / THIS WILL DISPLAY THE MAIN AX MENU AXDS2A, / NEW LABEL /A033 / JMS AXDIL / DISPLAY THE LIST / MESFT2 0305 0405 IDSTAD / MESFT3 0605 0705 LDSTAD / MESFT4 1105 1205 WPSTAD / MESFT5 1405 1505 BPSTAD / MESFT1 1705 2005 DLSTAD / 0 / / / THE MENUS THAT ARE USED FOR THE COMMUNICATIONS SETTINGS / JMS A19SET / LIMIT INPUT TO 64 CHARS. /A034 CIFMNU / DISPLAY THE MENU PORTION JMS I MNUCAL DLMA19 / AXDS7, TAD T1 / RESTORE INPUT BUFFER LENGTH /A034 CDFMNU DCA I (MUBUF+MNILEN) / /A034 /D034 CDFMNU TAD I (MUBUF+MNTMP1) CDFMYF / DCA AXDT6 / SAVE THE VALUE OF TEMP1 / TAD AXDT6 / USE THE VALUE TO GET THE ACTION / TAD (JMP I AXTBL) / USE THE VALUE IN MNTMP1 FOR AN INDEX TO THE DCA .+1 XX / ROUTINE TO CALL / AXDS4, CLA TAD AXDT6 TAD (AXPBA-1) DCA AXDT4 / COPY THE INPUT INTO THE CORRECT AREA TAD I AXDT4 DCA AXDT4 / CDFMNU / WANT TO COPY THE INPORTANT INFORMATION ONLY TAD I (MUBUF+MNPOS / /M036 CDFMYF / DCA AXDT5 / AXDJ2, CDFMNU TAD I AXDT5 / STRIP ANY LEADING SPACES CDFMYF / TAD (-40) SZA CLA / ++++ JMP AXDJ1 ISZ AXDT5 JMP AXDJ2 / AXDJ1, JMS CUCOPY AXDT5, XX CDFMNU AXDT4, XX CDFMYF BUFSIZ+1 / COPY THE LARGEST PLUS 1 / AC0100 / BUT A ZERO WORD ON THE END INCASE THE STRING TAD AXDT4 / TOO BIG DCA T1 DCA I T1 / AC0001 / ++++ DCA AXDCF / SET THE MODIFY FLAG / AXDS5, TAD MNUFLG / IF SET TO NOT ZERO DISPLAY THE SECOND MENU SNA CLA / ++++ JMP AXDS2 AXDS9, AC0001 / ++++ DCA MNUFLG / JMS A19SET / LIMIT INPUT TO 64 CHARS. /A034 CIFMNU JMS I MNUCAL DLMA20 / JMP AXDS7 / SEE WHAT WAS RETURNED AXMDL, CDFMNU / THE DEFAULT LIST TAD I (MUBUF+MNTMP2) CDFMYF / SNA SPA CLA / ++++ JMP AXMD1 / IF MINUS OR ZERO NOTHING THERE / CDFMNU TAD I (MUBUF+MNFNO) CDFMYF / AXMD1, DCA DLNO JMP AXDS4 / COPY THE NAME AXDGM, TAD MNUFLG / IF GM TYPED FROM THE SECOND MENU THEN DISPLAY THE FIRST SNA CLA / ++++ JMP AXGLD / IF IN THE FIRST RETURN TO MAIN MENU JMP AXDS2 / / THESE ADDRESS ARE THE LIST OF ROUTINES THAT CAN BE CALLED BY USING THE / VALUE IN MNTMP1 FOR AN OFFSET FOR THE LIST / AXTBL, AXRTX / 0START THE COMMUNICATIONS AXMDL / 1DEFAULT LIST DOCUMENT AXDS4 / 2ID MESSAGE AXDLG / 3LOG DOCUMENT AXDS4 / 4WRITE PASSWORD AXDS4 / 5READ/WRITE PASSWORD AXDS3 / 6TEST LIST AXDS5 / 7RE-DISPLAY THE MENU AXDGM / 10 GOLD MENU TYPED FROM THE MAIN COM MENUS AXDS9 / 11 NO RESPONSE TO FIRST COM MENU / / THIS IS THE TABLE OF ADDRESS FOR THE COMMUNICATIONS SETTINGS. THAT ARE / USED BY THE COPY COMAND USING THE POSITIVE NON ZERO VALUE FROM MENU IN TMP1 / AXPBA, DLSTAD IDSTAD LDSTAD WPSTAD BPSTAD / MNUFLG, 0 / IF ZERO DISPLAY THE FIRST MENU IF 1 THEN THE SECOND AXDT6, 0 / TEMP FOR TEMP1 FORM MENU / PAGE / / DISPLAY THE DEFAULT SETTINGS / / CALL: / JMS AXDIL / IOA TEXT STRING ADDRESS / AX1 / ARG2 / ADDRESS OF BUFFER IF CONTENTS IS ZERO THEN NOT DISPLAYED / TERMINATOR = 0 / / THE ROUTINE CAN BE CALLED WITH TRIPPLES ENDING WITH A 0. / AXDIL, XX AXDLP, TAD I AXDIL / GET THE FIRDT ARG AND CHECK FOR TERMINATOR ISZ AXDIL SNA / ++++ JMP I AXDIL DCA AXDT1 / TAD I AXDIL / GET THE SECOND ARG ISZ AXDIL DCA AXDT2 / TAD I AXDIL / THE THIRD ARG ISZ AXDIL DCA AXDT3 / TAD I AXDIL / GET THE BUFFER ADDRESS IF CONTENTS IS ZERO DONT DISPLAY ISZ AXDIL DCA AXDT7 / TAD I AXDT7 / SEE IF IT IS TO BE DISPLAYED / SNA CLA / ++++ JMP AXDLP / CIFMNU JMS I IOACAL 0 AXDT1, XX AXDT2, XX AXDT3, XX AXDT7, XX / JMP AXDLP / / PROCESS THE LOG DOCUMENT / AXDLG, CDFMNU TAD I (MUBUF+MNPOS / GET POINTER TO STRING /M036 DCA AXDLT / CAN ONLY BE DONE SINCE ON THE SAME PAGE / / The following check removes the leading space if the Log Document / name is entered using the short form (ie LD DOCUMENT) TAD I AXDLT / GET FIRST CHAR IN INPUT STRING /A021 TAD (-40 / IS IT A SPACE (40)? /A021 SNA CLA / SKIP IF: NOT A SPACE /A021 ISZ AXDLT / FIRST CHAR IS A SPACE, BUMP /A021 / POINTER TO FIRST VALID CHAR /A021 / TAD I (MUBUF+MNFNO) / GET THE DOCUMENT NUMBER CDFMYF / DCA LOGNO / JMS CUCOPY / FIRST COPY OVER THE NAME TYPED IN AXDLT, XX CDFMNU LDSTAD CDFMYF BUFSIZ+1 / DCA LDSTAD+BUFSIZ / THIS MAKES SURE OF A ASCIIZ STRING / CDFMNU / CHECK THE STATUS MNTMP2 TAD I (MUBUF+MNTMP2) / IF + = DOCUMENT EXISTS, 0 = CREATE, - = NOTHING CDFMYF / SMA SZA / ++++ JMP AXDL2 SZA CLA / ++++ JMP AXDL3 / JMS AXDL5 / BEFORE CREATING THE DOCUMENT, CHECK /A024 / THAT THE NAME IS .LT. OR .EQ. TO 64 /A024 / CHARACTERS /A024 / AXDL3, DCA LOGNO JMP AXDS5 AXJ1E, /ROUTINE CLEARS LOG # & NAME IF CANNOT CREATE /D021 CLA /CLEAR AC /A007 AC0004 / PUT UP CANNOT CREATE MESSAGE CDFMNU DCA I (MUBUF+MNTMP1) CDFMYF / / The following 2 instructions were moved from AXJ1E to here in order / that the CLA could be removed to save room /M021 DCA LOGNO /CLEAR LOG DOCUMENT NUMBER /A007 DCA LDSTAD /CLEAR LOG DOCUMENT NAME /AOO7 / CIFMNU JMS I MNUCAL DLMAD7 / JMP AXGLD AXDL2, AC0002 / DOCUMENT EXISTS SO PUT UP THE HOW TO MODIFY MENU / CDFMNU DCA I (MUBUF+MNTMP1) CDFMYF / JMS A19SET / LIMIT INPUT BUFFER TO 64 CHARS /A034 CIFMNU JMS I MNUCAL DLMAD6 / TAD T1 / RESTORE INPUT BUFFER LENGTH /A034 CDFMNU DCA I (MUBUF+MNILEN) / /A034 AC7776 / FIRST CHECK FOR GOLD MENU TAD I (MUBUF+MNTMP1) CDFMYF / SNA CLA / ++++ JMP AXDL4 / CDFMNU TAD I (MUBUF+MNTMP2) / GET THE OPEN TYPE CDFMYF / DCA LOGMOD / SAVE THE VALUE / JMP AXDS5 / AXDL4, DCA LOGNO / CLEAR THE NUMBER DCA LDSTAD / AND THE DISPLAY / / Need room - now fall through and use same return as does AXDS3 /M021 /D021 JMP AXDS2 / / AXDS3 - CHECKS THE LIST DOCUMENT FOR VALID ENTRYS / AXDS3, JMP AXDS2 / NORMAL RETURN MESFT1, IFDEF ENGLSH < TEXT '^P&THE DEFAULT LIST IS:^P^A' > / / CHANGED FOR ROOM / IFDEF CANADA < TEXT "^P&LA LISTE ATTRIBU[E PAR D[FAUT:^P^A" > /L.A.E, L.A.E / IFDEF ITALIAN< TEXT /^P&LISTA STANDARD:^P^A/ > IFDEF CANADA < TEXT "^P&FAUTE DE LISTE:^P^A" > IFDEF FRENCH < TEXT "^P&FAUTE DE LISTE :^P^A" > IFDEF DUTCH < TEXT "^PAANNAME L[ST :^P^A" > IFDEF GERMAN < TEXT "^P&ANGENOMMENE &LISTE:^P^A" > IFDEF NORWAY < TEXT '^P"&DEFAULT"-LISTEN ER:^P^A' > IFDEF SWEDSH < TEXT '^P"&DEFAULT"-LISTAN [R:^P^A' > /L.U.A IFDEF DANISH < TEXT '^P"&DEFAULT"-LISTEN ER:^P^A' > IFDEF V30SWE < TEXT '^P&SK\VNSV\DRDESLISTAN \DR: ^P^A'> / / PAGE / / ERROR MESSAGES FOR THE LOG DOCUMENT ERROR DISPLAY IN AXDIS / LOGER2, IFDEF ENGLSH < TEXT '^P&PRESS &R&E&T&U&R&N FOR THE &MAIN &MENU.' > IFDEF ITALIAN< TEXT /^P&PREMERE !&RITORNO PER TORNARE AL &MENU &PRINCIPALE./> IFDEF CANADA < TEXT "^P&APPUYER SUR &RETOUR POUR RAPPELER LE &MENU." > IFDEF FRENCH < TEXT "^P&APPUYER SUR &RETOUR POUR RAPPELER LE &MENU" > IFDEF DUTCH < TEXT "^P&RETURN INTOETSEN VOOR &HOOFD &MENU" > IFDEF GERMAN < TEXT "^P&MIT &RETURN ZUR]CK ZUM &HAUPT &MEN]" > /L.U.U, L.U.U IFDEF NORWAY < TEXT "^P&TRYKK &RETUR FOR ] F] &HOVEDMENYEN." > /L.D.A, L.D.A IFDEF SWEDSH < TEXT "^P&TRYCK P] &RETUR F\R ATT F] &HUVUDMENYN." > /L.D.A, L.U.O, L.D.A IFDEF DANISH < TEXT "^P&TRYK &RETUR FOR AT F] &HOVEDMENUEN." > /L.D.A IFDEF V30SWE < TEXT "^P&TILLBAKA TILL HUVUDMENYN: ANV\DND GULD MENY"> / LOGER1, IFDEF ENGLSH < TEXT '^P!E^P&LOG &DOCUMENT^P^A^PDOES NOT EXIST,' > IFDEF ITALIAN< TEXT /^P!E^P&PROCEDURA DI COLLEGAMENTO^P^A^PNON ESISTE,/> IFDEF CANADA < TEXT "^P!E^P&LE DOCUMENT-R[PERTOIRE ^A N'EXISTE PAS," > IFDEF FRENCH < TEXT "^P!E^P&LE DOCUMENT ^A N'EXISTE PAS," > IFDEF DUTCH < TEXT "^P!E^P&LOGBOEK ^A BESTAAT NIET," > IFDEF GERMAN < TEXT "^P!E^P&LOG &DATEI ^A EXISTIERT NICHT,"> IFDEF NORWAY < TEXT '^P!E^P"&LOG"-DOKUMENT ^A EKSISTERER IKKE.' > IFDEF SWEDSH < TEXT '^P!E^P"&LOG"-DOKUMENT ^A EXISTERAR INTE.' > IFDEF DANISH < TEXT '^P!E^P"&LOG"-DOKUMENT ^A EKSISTERER IKKE.' > IFDEF V30SWE < TEXT '^P!E^P"&INLOGGNINGSDOKUMENTET ^P^A^P FINNS INTE'> / / / CLASIX - INITALIZE THE VALUES IN REDSIX AND WRISIX / CLASIX, XX CLA RDF / IF CROSS FIELD CALLED MAKE SURE RETURNS CORRECTLY TAD CIDF0 DCA CLASXX / CDFMYF DCA WRSHIF / WRITE SHIFT FLAG DCA WRIVBF / VERTICAL BAR ESCAPE FLAG DCA WRIBES / ESCAPE / DCA REDNXT / BUFIF RETURNING A 2 CHARACTER ESCAPE THE SECOND CHARACTER / IS STORED HERE FOR NEXT CALL DCA REDESF DCA REDSHF DCA REDSXC / CLASXX, XX JMP I CLASIX / / AXCRT - CREATE THE DOCUMENT TO RECEIVE / AXCRT, CLA TAD AXSRT2 / IF RECEIVE RETURN ERROR SZA CLA / ++++ JMP AXSNO JMS ADRCRT JMP AXSNO / DCA AXSRNO DCA AXSRMO / TAD ("C-200) / SET THE MOD VALUE FOR LOG DOCUMENT IF SET FOR / AX AND LOG IN AFFECT DCA CUPMOD / JMP AXSROK / RETURN / / THE ROUTINE WILL SEND THE CHARACTER IN THE AC TO THE SCREEN / DELDIS, XX JMP DELDI2 DELDI1, CIF 0 / ++++ JWAIT DELDI2, CIF 0 / ++++ TTYOU JMP DELDI1 CLA JMP I DELDIS / / SPTEST - SEE IF THE SPFLAG IS SET WHICH MEANS TO RETURN / SPTEST, /M018 XX CLA CDFEDT TAD I (SPFLAG) CDFMYF / SNA CLA ISZ SPTEST JMP I SPTEST / / PART OF WRISIX / WRSEND, /A018 XX /A018 CLA /A018 TAD T1 / IF ZERO THEN ENO OF FILE /A018 SZA CLA /A018 JMP I WRSEND /A018 TAD (74) / END OF DOCUMENT IN UPPER CASE /A018 CIFFIO /A018 FILEIO /A018 XPUTSB /A018 CLA /A018 JMP I WRSEND /A018 PAGE / / AXDST - WILL READ OR WRITE THE COMMUNICATIONS SETTINGS DEPENDING ON THE / VALUE IN THE AC. THE AC CONTAINS THE FUNCTION TO EXECUTE. / AXDST, XX DCA QUQBLK+RXQFNC / SET THE FUNCTION / CDFMYF TAD .-1 / SET THE BUFFER FIELD DCA QUQBLK+RXQBFD / /D035 TAD USERNO / SET THE DRIVE /D035 TAD USERNO DCA QUQBLK+RXQDRV / TAD (DLDCOM) / SET THE BLOCK TO READ DCA QUQBLK+RXQBLK / TAD (DFCOMA) / SET THE BUFFER TO READ INTO DCA QUQBLK+RXQBAD / JMS QURX / GET THE BLOCK CLA / ISZ QUQBLK+RXQBLK / GET THE NEXT BLOCK / TAD (DFCOMA+400) DCA QUQBLK+RXQBAD / JMS QURX CLA / JMP I AXDST / / AXSNO - SENDS THE NO RESPONSE / THIS IS PART OF AXSR ROUTINE / AXSNO, JMS AXSRPK NOANS TYPNO / JMP AXSNOX / / / AXSRPK - SENDS A PACKET USING AXSNP. IT USES THE SAME CALL MINUS THE ERROR RETURNS / THIS ROUTINE CAN ONLY BE CALLED BY THE AXSR ROUTINE / / CALL / JMS AXSRPK / ADDRESS OF TEXT PART / TYPE OF PACKET / AXSRPK, XX TAD I AXSRPK ISZ AXSRPK DCA AXSRP1 / TAD I AXSRPK ISZ AXSRPK DCA AXSRP2 / JMS AXSNP AXSRP1, XX AXSRP2, XX / JMP AXSNOX / SPFLAG RETURN JMP AXSNOX / TIMED OUT / JMP I AXSRPK / / AXSNO2 - SEND LIST NOT IMPLEMENTED YET MESSAGE IF THE USER TRIES TO USE / ALIST SPECIFICATION. / AXSNO2, JMS AXSRPK NOEXST TYPNO / JMP AXSNOX / NOEXST, IFDEF ENGLSH < "L-200 / L "I-200 / I "S-200 / S "T-200 / T " -200 / Space "D-200 / D "O-200 / O "C-200 / C "U-200 / U "M-200 / M "E-200 / E "N-200 / N "T-200 / T " -200 / Space "O-200 / O "P-200 / P "T-200 / T "I-200 / I "O-200 / O "N-200 / N " -200 / Space "N-200 / N "O-200 / O "T-200 / T " -200 / Space "I-200 / I "M-200 / M "P-200 / P "L-200 / L "E-200 / E "M-200 / M "E-200 / E "N-200 / N "T-200 / T "E-200 / E "D-200 / D 0000 > IFDEF ITALIAN < "O-200 / O "P-200 / P "Z-200 / Z "I-200 / I "O-200 / O "N-200 / N "E-200 / E " -200 / SPACE "D-200 / D "O-200 / O "C-200 / C "U-200 / U "M-200 / M "E-200 / E "N-200 / N "T-200 / T "O-200 / O " -200 / SPACE "L-200 / L "I-200 / I "S-200 / S "T-200 / T "A-200 / A " -200 / SPACE "N-200 / N "O-200 / O "N-200 / N " -200 / "I-200 / I "M-200 / M "P-200 / P "L-200 / L "A-200 / A "M-200 / M "E-200 / E "N-200 / N "T-200 / T "A-200 / A "T-200 / T "A-200 / A 0000 > / / THIS ROUTINE WILL CHANGE THE BUFFER LENGTH IN THE MENU FIELD /A034 / AND SAVE THE OLD VALUE IN T1. /A034 / UPON RETURN FROM THE MENU CALL THE OLD VALUE MUST BE RESTORED /A034 / A19SET, XX / /A034 CLA / /A034 CDFMNU / /A034 TAD I (MUBUF+MNILEN) / FETCH VALUE USED BY THE SYSTEM /A034 CDFMYF / /A034 DCA T1 / SAVE HERE /A034 TAD (-BUFSIZ-1 / THIS WILL LIMIT INPUT TO 64 CHARS. /A034 CDFMNU / /A034 DCA I (MUBUF+MNILEN) / INTO MENU AREA /A034 CDFMYF / /A034 JMP I A19SET / /A034 / PAGE / / AXEC - WILL CONNECT THE DX USER TO THE AX SYSTEM. IT / WILL PROMPT FOR THE INFORMATION NEEDED TO CONNECT. / AXEC, XX CLA / CDFEDT TAD I (GETBUA) / GET THE ADDRESS OF GET AND PUT BUFFER / DCA GETBUF / TAD I (PUTBUA) DCA PUTBUF CDFMYF / TAD (OPTALL) / SET THE OPTIONS TO ALL INITALLY DCA OPTFLG / /D016; CIFMNU /D016; JMS I IOACAL / PUT UP THE MESSAGE OF CONNECTION /D016; 0 /D016; TRYCON /D016; 505 /D016; 2700 / AXSG2, TAD IDSTAD / SEE IF THERE IS AN ID MESSAGE TO SEND SNA CLA / ++++ JMP AXECJ / JMS AXSPK / SEND THE MESSAGE IDSTAD TYPMES / CLA JMP AXECJ AXECX, CLA TAD OPTFLG / RETURN THE DX USER OPTIONS / CDIEDT ISZ AXEC / A2- SKIP RETURN IF OK ISZ AXEC JMP I AXEC AXSP, ISZ AXEC / GO AND WAIT FOR SOMETHING TO DO BUT DONT CONTINUE / THE CONNECTION SEQUENCE AXTO, CLA CDIEDT / RESTART AFTER A TIME OUT / JMP I AXEC AXFLE, 0 / / AXSPK - SENDS A PACKET AND TAKES CARE OF ALL THE ERROR RETURNS / FOR AXEC ROUTINE. IT CALLS AXSNP / AXSPK, XX CLA / Clear the AC TAD I AXSPK / Get the pointer to the message list ISZ AXSPK / Set to skip it on return DCA AXSPK1 / Store the argument / TAD I AXSPK / Get the Next argument ISZ AXSPK / Set to skip it on return DCA AXSPK2 / Store this argument too / JMS AXSNP / Send the packet AXSPK1, XX / Message address AXSPK2, XX / Second parameter / JMP AXSP / MAIN MENU SAID RETURN JMP AXTO / TIMED OUT TRYING TO SEND / JMP I AXSPK / Return / / / AXEJC - CLEARS THE DX USERS SCREEN AFTER A BAD PASSWORD TYPED / AXEJC, CLA TAD (-TRYPSW) / SEE IF THERE WAS A MISTAKE MADE TAD AXPCN SNA CLA / ++++ JMP AXEJ3 / JMS AXSPK CLAMES TYPMES / JMP AXEJ3 / / USED AXSR TO GET THE NAME OF THE DOCUMENT AND THE DRIVE NUMBER / AXSRFD, XX CLA CDFMNU TAD I (MUBUF+MNDRV) CDFMYF / DCA CUPDRV / JMS CUCOPY / NOW THE NAME MUBUF+MNIBUF CDFMNU CUPFNM CDFMYF BUFSIZ+1 / JMP I AXSRFD / / THIS ROUTINE CHECKS TO MAKE SURE THAT THE LD NAME TO BE CREATED IS / .LT. OR .EQ. TO 64 CHARACTERS IN LENGTH. IF LONGER, TRUNCATE THE / NAME TO BE 64 CHARACTERS IN LENGTH, AND THEN CHECK TO SEE IF THIS / FILE ALREADY EXISTS. AXDL5, /A024 XX / RETURN ADDRESS /A024 CDFMNU / /A029 TAD (MUBUF+MNIBUF) / POINTER TO THE INPUT STRING /A029 CIA / MAKE NEG FOR COMPARE /A029 CDFMYF / /A029 TAD AXDLT / TO START OF LOG DOC NAME /A029 TAD (100) / POINT TO 65TH CHAR /A028 CDFMNU / /A028 TAD (MUBUF+MNIBUF) / IN THE INPUT STRING (LD NAME) /A028 DCA TEMP / AND SAVE THE POINTER /A028 TAD I TEMP / GET THE 65TH CHAR /A028 SPA SNA CLA / SKIP IF: NON-VALID TERMINATOR /A028 JMP AXDL6 / VALID TERMINATOR /A028 DCA I TEMP / INSERT THE LD TERMINATOR /A028 AC0001 / /A027 CDFMNU / MENU FIELD /A027 DCA I (MUBUF+MNTMP5) / SIGNIFIES MENU TO CHECK FILENAME /A027 DCA I (MUBUF+MNTMP3) / CLEAR TMP3 /A028 CDFMYF / MY DATA FIELD /A027 CIFMNU / /A027 JMS I MNUCAL / /A027 DLMDU7 / CHECK TO SEE IF FILE EXISTS /A027 CDFMNU / RESULT OF CHECK /A027 TAD I (MUBUF+MNTMP3) / IS IN MNTMP3 /A027 CDFMYF / BACK TO MY FIELD /A027 SMA CLA / SKIP IF: DOCUMENT DOES NOT EXISTS /A027 /D030 JMP AXDL2 / DOCUMENT EXISTS, ASK HOW TO MODIFY /A027 JMP AXDL7 / DOC. EXISTS, FETCH LOGNO /A030 AXDL6, CDFMYF / BACK TO MY FIELD /A027 JMS ADRCRT / CREATE THE DOCUMENT /M024 JMP AXJ1E / ERROR /M024 JMP I AXDL5 / RETURN TO CALLER /A024 / TEMP, 0 / POINTER TO LD NAME /A024 AXDL7, CLA / .... /A030 CDFMNU / MENU FIELD /A030 TAD I (MUBUF+MNFNO) / FETCH LOGNO /A030 CDFMYF / THIS FIELD /A030 DCA LOGNO / SAVE THE DOC. NUMBER /A030 JMP AXDL2 / NOW ASK HOW TO MODIFY /A030 PAGE / / AXECJ - WILL CHECK FOR A VALID PASSWORD / AXECJ, TAD BPSTAD / SEE IF EITHER PASSWORD IS SET TAD WPSTAD SNA CLA / ++++ JMP AXEJ3 / TAD (TRYPSW) / ++++ DCA AXPCN / SET THE LIMIT ON PASSWORD TYRS / AXEJ1, JMS AXSPK / ASK FOR THE PASSWORD PASPMT TYPPNE / AXEJ2, JMS WAITDT / WAIT FOR A STX JMP AXSP / RETURN THE MAIN PROGRAM SAYS TO JMP AXTO / TIMED OUT WAITENG / TAD (-TYPPAN) / CHECK FOR PASSWORD SZA CLA / ++++ JMP AXEJ2 / JMS AXSAM / CHECK FOR EQUAL JMP AXDNO / JMP AXEJC / AXDNO, ISZ AXPCN JMP AXEJ5 / JMS AXSPK / ILLEGAL USER ILLUSE TYPMES / JMP AXSP AXEJ5, JMS AXSPK / TELL THE USER HE TYPED THE WRONG PASSWORD BADPAS TYPMES / JMP AXEJ1 / / AXEJ3 - ASKS FOR IDENTIFICATION / AXEJ3, CLA TAD LOGNO / SEE IF IT IS NEEDED SNA CLA / ++++ JMP AXECX / JMS AXSPK / SEND THE PROMPT IDPMT TYPPMT AXEJ4, JMS WAITDT / WAIT FOR A LEGAL STX JMP AXSP / RETURN SINCE SPFLAG IS SET JMP AXTO / TIMED OUT / TAD (-TYPPAN) / LOOKING FOR AN ANSWER TO THE PROMPT SENT SZA CLA / ++++ JMP AXEJ4 / JMS CUCOPY / STORE THE ID INMBLK+1 CDFMYF AXIDB CDFMYF BUFSIZ / JMP AXECX / DONE FOR NOW RETURN TO WPTRNS / / AXSNP - SENDS A PACKET . / / CALL / JMS AXSNP / TYPE VALUE / ADDRES OF THE TEXT PART / / SPFLAG SET RETURN / TIMED OUT / / OK / AXSNP, XX CLA TAD I AXSNP / GET THE STARTING ADDRESS OF THE MESSAGE ISZ AXSNP / Set to skip it on return DCA AXST2 / Store it for send / JMP AXSNG AXSNW, CIFSYS / ++++ JWAIT JMS SPTEST / SEE IF THE MAIN PROGRAM SAID STOP JMP I AXSNP / SPFLAG SET MUST RETURN AXSNG, CIFEDT JMS I GETBUF / ++++ FREEPT / GET A BUFFER JMP AXSNW DCA AXSNT / SAVE THE STARTING ADDRESS / TAD AXSNT / CLEAR A FEW LOCATIONS DCA X1 CDFEDT DCA I X1 / THE STATUS DCA I X1 / THE SEQ. CDFMYF / TAD I AXSNP / GET THE TYPE CHARACTER ISZ AXSNP / CDFEDT DCA I X1 CDFMYF AXSNL, TAD I AXST2 / GET A CAHRACTER ISZ AXST2 SNA / ++++ JMP AXSNZ CDFEDT DCA I X1 CDFMYF JMP AXSNL AXSNZ, CDFEDT DCA I X1 / INSERT THE TRAILER CDFMYF / TAD AXSNT / SEND THE BUFFER CIFEDT JMS I PUTBUF / ++++ SENDPT / AC0001 TAD AXSNT DCA AXSNS / GET THE STATUS POSITION JMP AXSNB / TEST IT AXSNJ, CIFSYS / ++++ JWAIT JMS SPTEST / ++++ JMP AXSN2 AXSNB, CDFEDT TAD I AXSNS / CHECK FOR DONE CDFMYF SNA / ++++ JMP AXSNJ DCA AXST2 AXSN2, / TAD AXSNT / RELEASE THE BUFFER CIFEDT JMS I PUTBUF / ++++ FREEPT JMS SPTEST / ++++ JMP I AXSNP / SEE IF HAVE TO RETURN TAD AXST2 SMA CLA / ++++ ISZ AXSNP / TIMED OUT ISZ AXSNP JMP I AXSNP / PAGE / / THIS IS THE SEND/RECEIVE PART OF AX. THE AC IS = 0 FOR RECEIVE AND 1 = SEND / ON RETURN THE AC = DOCUMENT NUMBER AND THE MQ = MOD TYPE / / CALL / CIFBUF / JMS I AXSR / ADDRESS OF THE POINTER TO THE PACKET RECEIVED / / NO RETURN / YES / AXSR, XX / DCA AXSRT2 / STORE THE VALUE OF THE ROUTINE CALLED IF 0 = RECEIVE / AND 1 = SEND / TAD I AXSR / GET THE BUFFER ISZ AXSR / THE DATA FIELD IS STILL SET FOR THE CALLING FIELD / CDFMYF / DCA AXSRT3 / SAVE THE ADDRESS OF THE DOCUMENT NAME DCA AXSRNO / CLEAR THE DOCUMENT NUMBER DCA AXSRMO / AND THE MODIFICATION CODE FOR RECEIVE DCA CUPMOD / CLEAR FOR LOG DOCUMENT SO NO OLD INFO IS LEFT AROUND DCA CUPDRV DCA CUPFNM / JMS CUCOPY / COPY THE NAME PART TO SEE IF VALID NAME AXSRT3, XX CDFEDT MUBUF+MNIBUF CDFMNU BUFSIZ+1 / TAD (MUBUF+MNIBUF) / SET THE MENU'S POINTERS FOR THE BUFFER / CDFMNU DCA I (MUBUF+MNPOS / /M036 DCA I (MUBUF+MNTMP1) TAD AXSRT2 / GET AXRS MODE (0/1) /A017 DCA I (MUBUF+MNTMP2) / SAVE FOR MENU TO ALLOW SEND LOG /A017 CDFMYF / / IF TRIES TO RECEIVE A LIST TAD (MUBUF+MNIBUF-1) DCA X1 / AXSRL8, CDFMNU TAD I X1 CDFMYF / TAD (-40) / SKIP LEADING SPACES SNA / ++++ JMP AXSRL8 TAD (40-"@+200) SNA CLA / ++++ JMP AXSNO2 / CIFMNU JMS I MNUCAL / LET THE MENU CHECK FOR A VALID NAME DLMAD6 / JMS AXSRFD / GET THE NAME AND DRIVE / CDFMNU TAD I (MUBUF+MNTMP1) / GET THE RETURN VALUE CDFMYF / SNA / ++++ JMP AXCRT / SEE IF RECEIVE CREATE IT TAD (-1) SZA CLA / ++++ JMP AXSNO / IF ANYTHING BUT EXITST THEN SEND A NO / CDFMNU TAD I (MUBUF+MNFNO) / GET THE DOCUMENT NUMBER CDFMYF DCA AXSRNO / TAD AXSRT2 SZA CLA / ++++ JMP AXSROK TAD (TBOPT) / IF EXISTS THEN SEND A OPTION PACKET IF RECEIVE DCA ANSBUF / JMS AXSRPK / SEND THE PACKET ANSBUF / STARTING ADDRES OF TEXT PART TYPMOD / TYPE / JMS WAITDT / WAIT FOR A RESPONSE JMP AXSNOP / NO RETURN /M018 JMP AXSNOP / TIMED OUT /M018 / TAD (-TYPPAN) / WAIT FOR RESPONSE IF GET SOMETHING ELSE SEND NO SZA CLA / ++++ JMP AXSNOP /M018 / TAD INMBLK+1 / GET THE RESPONSE TAD (-40) / CHECK FOR GOLD MENU SNA / ++++ JMP AXSNOP /M018 TAD (-2) / 40 = GM;41 = -1(OVERWRITE);42 = 0(TOP);43 = 1 (BOTTOM) / DCA AXSRMO / TAD AXSRMO / SET THE VALUE FOR THE LOG DOCUMENT OF MODIFY SNA CLA / ++++ IFDEF ENGLSH < TAD ("T-"B) /M023 TAD ("B-200) /M023 > IFDEF ITALIAN < TAD ("I-"F) /M023 TAD ("F-200) /M023 > IFDEF V30SWE < TAD ("T-"B) /M023 TAD ("B-200) /M023 > DCA CUPMOD AXSROK, CLA TAD AXSRNO / SEE IF DOC REQUESTED IS LOG DOC /A018 CIA /A018 TAD LOGNO /A018 SNA CLA /A018 / JMP AXSRO2 / JUMP IF OK /A018 / JMS CLFILE /A018 JMP AXSNO / SAY NO /A018 AXSRO2, /A018 TAD AXSRMO MQL TAD AXSRNO / THE AC = DOCUMENT NO AND THE MQ THE MODIFICATION / CDIEDT ISZ AXSR JMP I AXSR / RETURN AXSNOX, CLA CDIEDT JMP I AXSR AXSRT2, 0 / HAS TO BE ON THIS PAGE / ANSBUF, ZBLOCK 2 AXSRNO, 0 AXSRMO, 0 AXINDF, 0 / / MOVED TO ANOTHER PAGE /M018 / / SPTEST - SEE IF THE SPFLAG IS SET WHICH MEANS TO RETURN / /SPTEST, / XX / CLA / CDFEDT / TAD I (SPFLAG) / CDFMYF / / SNA CLA / ++++ / ISZ SPTEST / JMP I SPTEST / AXSNOP, CLA / CLOSE FILE (IT'S CURRENTLY OPEN) /A018 JMP AXSNOX / SEND 'NO' /A018 / PAGE / / AXSAM - COMPARES THE INPUT BUFFER TO THE PASSWORD / AXSAM, XX TAD BPSTAD / FIRST SEE IF THE READ/WRITE PWASSWORD IS SET SNA CLA / ++++ JMP AXSA2 / JMS AXCMP / COMPARE WHAT WAS SET TO WHAT IT IS BPSTAD INMBLK+1 / JMP AXSA2 / DOESNT MATCH / AC0001 / DOES MATCH SET THE OPTFLG / JMP AXSRT AXSA2, TAD WPSTAD / CHECK FOR WRITE PASSWORD SNA CLA / ++++ JMP I AXSAM / JMS AXCMP WPSTAD INMBLK+1 / JMP I AXSAM / DOESNT MATCH EITHER AXSRT, TAD (OPTBMS) / SET TO 43 TO NOT ALLOW READ DCA OPTFLG / 44 MEANS READ /WRITE ABILITY / ISZ AXSAM JMP I AXSAM / / AXCMP - COMPARES THE TEXT IN THE FIRST STRING WITH THE SECOND / IT RETURNS A MATCH IF THE SECOND ONE MATCHES THE FIRST. IT IS / NOT CASE DEPENDENT / CALL / JMS AXCMP / ADDRESS OF STRING ONE THE ONE IT HAS TO MATCH / ADDRESS OF THE STRING TO COMPARE / / DOESNT MATCH RETURN / MATCH RETURN / AXCMP, XX AC7777 TAD I AXCMP / GET THE FIRST STRINGS ADDRESS ISZ AXCMP DCA X1 / AC7777 TAD I AXCMP / GET THE STRING TO COMPARE ISZ AXCMP DCA X2 AXCPL, TAD I X1 SNA / ++++ JMP AXCPJ / JMS CNVUPR / CONVERT THE STRING TO CAPS CIA DCA AXCPT / TAD I X2 JMS CNVUPR TAD AXCPT SNA CLA / ++++ JMP AXCPL JMP I AXCMP AXCPJ, TAD I X2 / CK FOR EXTRA CHAR /A031 SNA CLA / IF PRESENT IT DOES NOT MATCH /A031 ISZ AXCMP JMP I AXCMP AXCPT, 0 / / CNVUPR - IF THE CHARACTER IN THE AC IS LOWER CASE IT IS CONVERTED TO UPPER / CNVUPR, XX TAD (-140) SPA / ++++ TAD (40) TAD (100) JMP I CNVUPR / / THE ROUTINE THAT MODIFIES THE FILE THAT KEEPS THE LOG IF WANTED / AXDON, XX CDFMYF CLA TAD LOGNO / SEE IF THE LOG IS WANTED SNA CLA / ++++ JMP AXDDN TAD LOGNO / OPEN THE LOG DOCUMENT MQL TAD LOGMOD CIFFIO / ++++ /M013 FILEIO / ++++ /M013 XDSKIN CLA / CDFMNU TAD I (DATESP) / GET THE ADDRESS OF THE DATE CDFMYF / DCA DATEAD / CIFMNU JMS I TIMCAL / SEE IF THE TIME HAS CHANGED NOP / JMS CUCOPY / COPY THE TIME TO THIS FIELD DATEAD, 0 CDFMNU AXTIM CDFMYF 26 / JMS CUPSH2 / SKIP OVER THE HEADER AND RULER STUFF / TAD AXSRNO / BREAK OUT FILE AND DRIVE NUMBERS AND P377 DCA CUPDAT CIFMNU JMS I IOACAL CUPOTD AXDMS CUPOS1 AXIDB CUPOS1 AXTIM CUPOS1 CUPFNM CUPOS3 CUPDRV CUPDAT, 0 CUPOS3 CUPMOD CUPOS3 CUPOS4 / CIFFIO / ++++ /M013 FILEIO / ++++ /M013 XDSKCL / AXDDN, TAD LOGMOD SPA CLA DCA LOGMOD CDIEDT JMP I AXDON CUPMOD, 0 / ++++ 0 / PAGE / / WAITING FOR SOMETHING TO BE SENT (RECEIVER) / WAITDT, XX CLA TAD (MIN3) / ++++ DCA DLYLIM JMP WAITDG / SEE IF THERE IS ANYTHING WAITDW, CIFSYS / ++++ JWAIT JMS SPTEST / ++++ JMP I WAITDT / SEE IF THE SPFLAG IS SET JMS GETTM SNA CLA / ++++ JMP WAITDG / NO CHANGE IN THE TIME CONTINUE ISZ DLYLIM / SECOND WENT BY CHOW OT JMP WAITDG ISZ WAITDT JMP I WAITDT / WAITED TOO LONG WAITDG, CIFEDT / SEE IF A PACKET HAS BEEN RECEIVED JMS I GETBUF / ++++ RECPT JMP WAITDW / DCA WAITDA / KEEP THE VALUE / AC0003 TAD WAITDA / GET THE START TO MOVE DCA WAITT1 / JMS CUCOPY / COPY THE BUFFER FOUND WAITT1, XX CDFEDT INMBLK CDFMYF BUFSIZ+1 / TAD WAITDA / DONE WITH THE BUFFER RETURN IT CIFEDT JMS I PUTBUF / ++++ FREEPT / TAD INMBLK ISZ WAITDT ISZ WAITDT / JMP I WAITDT / RETURN WITH THE FLAG CHARACTER WAITDA, 0 DLYLIM, 0 / / GET THE TIME CHANGE USING THE SYSTEMS CLOCK / IT RETURNS A 1 IF A SECOND WENT BY AND A 0 IF NO CHANGE / GETTM, XX CLA CDFSYS TAD I (CLOCK+2) / ++++ CIA CDFMYF / ACDF FOR THIS FIELD (MY FIELD) TAD TMPTME / COMPARE TO MY TIME FOR ANY CHANGE SNA / ++++ JMP I GETTM / NO CHANGE CIA / ++++ TAD TMPTME / IF CHANGE STORE THE NEW ONE DCA TMPTME AC0001 JMP I GETTM TMPTME, 0 / RDSIX1, TAD (74-41) / CHECK IF ALPHA SMA RDSIX3, TAD REDSHF / ADD IN SHIFT TAD (41+37) / CONVERT TO ASCII RDSIX2, DCA REDSXC / STORE IT JMP RDSIX4 / CLEAR ESCAPE FLAG AND RETURN / WRDWSF, TAD (40) / SHIFT TO LOWERCASE WRUPSF, DCA REDSHF / STORE NEW CASE JMP RDSIX4 / AND RETURN / REDSHF, 0 / SHIFT WORD REDSXC, 0 / TEMP THAT HOLDS THE CHARACTER TO RETURN / / THIS IS A CLOSE COPY OF THE WT78 REDSIX ROUTINE WHICH TOOK 6-BIT / INPUT AND STORED IT AS 7-BIT DATA. THIS ROUTINE WILL READ 6-BIT DATA FROM DISK / AND RETURN 7-BIT. / REDSIX, XX / CLA RDF TAD CIDF0 / MAKE CROSS FIELD CALLABLE DCA REDS2X DCA REDSXC / CLEAR THE CHARACTER TO RETURN BUFFER / CDFMYF / REDSIL, TAD REDNXT / SEE IF THERE IS A CHARACTER WAITING TO BE / RETURNED SNA / ++++ JMP REDSI2 / IF ZERO GET A CHAR IF NOT OUTPUT IT DCA T1 DCA REDNXT / CLEAR FLAG OUTPUT IT TAD T1 JMP RDSIX2 REDSI2, CIFFIO / ++++ /M013 FILEIO / ++++ /M013 XRDFNB / GET A CHAR SNA SPA / ++++ JMP REDS2X / DONE OR AN ERROR SO RETURN DCA T1 / STORE UNTIL KNOW WHAT TO DO WITH IT TAD REDESF / SEE IF MIDDLE OF ESCAPE SZA CLA / ++++ JMP REDESC / YES TAD T1 TAD (-74) / SEE IF SPECIAL SPA / ++++ JMP RDSIX1 / NO, NORMAL SIXBIT CHAR SNA / ++++ JMP WRUPSF / SHIFT TO UPPERCASE TAD (74-75) / 75 ? SNA / ++++ JMP RDSIX4 / ILLEGAL, RETURN 0 TAD (75-76) / 76 ? SNA CLA / ++++ JMP WRDWSF / SHIFT TO LOWERCASE AC7777 / MUST BE ESCAPE RDSIX4, DCA REDESF / SET FLAG REDSXX, TAD REDSXC / IF CHARACTER IS ZERO THEN GET ANOTHER SNA / ++++ JMP REDSIL REDS2X, XX JMP I REDSIX / AND RETURN / REDESF, 0 / ESCAPE FLAG / PAGE / / THIS IS THE WT78 READ ROUTINE THAT READS 7-BIT CHARACTERS FROM THE DISK AND / TRANSLATES THEM TO 6-BIT. WHAT IT IS DOING HERE IS TAKING THE / 7-BIT INPUTAND STORING IT AS 6-BIT FOR THE WS SYSTEMS / WRISIX, XX DCA T1 / STORE CHARACTER RDF TAD CIDF0 DCA WRSI2X / CDFMYF TAD WRIVBF / SEE IF THE VERTICAL BAR FLAG IS SET SZA CLA / ++++ JMP WRIVB2 TAD WRIBES / NOW CHECK FOR LAST CHAR WAS A LEFT BRACKET ESCAPE CHAR SZA CLA / ++++ JMP WRIBE2 WRSIXE, CLA TAD WRICHR / SEE IF ANYTHING WAITING AROUND SZA / ++++ JMP WRSIX1 / YES GO PROCESS IT TAD T1 / NO, GET CHAR SNA / ++++ JMP WRSIXX / RETURN ON EOF TAD (-173) / CHECK IF ESCAPE SEQUENCE SPA / ++++ JMP WRSIX5 / NO, NORMAL CHAR SNA CLA / WHICH TYPE ? JMP WRSIX2 / {ESCAPE AC0001 / ++++ DCA WRIVBF / SET FLAG JMP WRSIXX / RETURN WRIVB2, DCA WRIVBF / CLEAR FLAG TAD T1 SNA / ++++ JMP WRSIXX / RETURN ON EOF TAD (-76) / SEE IF JUST SUPPOSED TO BE 173 - 176 SMA SZA / ++++ JMP WRSIX3 / NO, LOOK IN TABLE TAD (76+100) / MAKE INTO REAL ASCII JMP WRSIX1 / AND PROCESS AS NORMAL / WRSIX2, AC0001 / ++++ DCA WRIBES / SET FLAG FOR ESCAPE SEQUENCE JMP WRSIXX / RETURN WRIBE2, DCA WRIBES / CLEAR FLAG THAT GOT US HERE TAD T1 / GET THE NEXT CHARACTER OF ESCAPE SEQUENCE SNA / ++++ JMP WRSIXX / RETURN ON EOF TAD (-53) / MAKE SURE IT'S LEGIT SMA SZA / ++++ JMP WRSIXE / ERROR TAD (53-42) SPA / ++++ JMP WRSIXE / ERROR TAD (WRITA2) / COMPUTE TABLE ADDR JMP WRSIX4 / WRSIX3, TAD (76-117) / CHECK IF VALID TABLE ENTRY SMA SZA / ++++ JMP WRSIXE / ERROR TAD (117-107) SPA / ++++ JMP WRSIXE / ERROR TAD (WRITAB) / COMPUTE TABLE ADDR WRSIX4, DCA T1 TAD I T1 / PICK UP ENTRY WRSIX6, DCA WRICHR / SAVE AS NEXT CHAR TAD (77) / AND RETURN AN ESCAPE WRSIXX, SNA / ++++ JMP WRSI3X CIFFIO / ++++ /M013 FILEIO / ++++ /M013 XPUTSB / STORE CHARACTER WRSI3X, TAD WRICHR / SEE IF ANOTHER TO STORE SZA CLA / ++++ JMP WRSIXE JMS WRSEND / END OF DOC. SO SHIFT TO UPPER /A018 WRSI2X, XX JMP I WRISIX / WRIVBF, 0 WRIBES, 0 WRICHR, 0 / WRSIXA, DCA WRICHR / CLEAR HOLD CHAR MQA / ++++ TAD (-37) / CONVERT TO SIXBIT JMP WRSIXX / AND RETURN / WRSIXC, TAD (61) JMP WRSIX6 WRSIX5, TAD (173) WRSIX1, MQL / ++++ MQA / SAVE CHAR IN MQ AND (100) / SEE IF SHIFTABLE SNA CLA / ++++ JMP WRSIXA / NO, CONVERT AND RETURN MQA / ++++ AND (40) / GET SHIFT BIT CIA / ++++ TAD WRSHIF / COMPARE WITH STATE WE'RE IN CLL SNA CLA / ++++ JMP WRSIXB / DIDN'T CHANGE MQA / ++++ AND (40) / STORE NEW STATE (SHIFT BIT) SZA / ++++ CML DCA WRSHIF RAL / FIGURE OUT IF NEED UPSHIFT OR DOWNSHIFT SZA / ++++ IAC TAD (74) DCA T1 / SAVE FOR A MINUTE MQA / ++++ DCA WRICHR / GET CHAR BACK AND SAVE FOR NEXT TIME TAD T1 / RETURN WITH SHIFT CODE JMP WRSIXX / WRSHIF, 0 / PAGE / / THESE TABLES ARE USED BY THE GET SEVEN BIT AND PUT SEVEN BIT ROUTINES / WRITAB, 66 46 45 52 66 / ILLEGAL 53 47 67 70 / WRITA2, 42 / ++++ 41 44 / ++++ 43 51 / ++++ 50 55 / ++++ 54 57 / ++++ 56 / REDTAB, 7343 / ++++ 7342 / TABLE TO CONVERT SIXBIT TO WPW 7-BIT 7345 / ++++ 7344 7411 7410 7415 7347 / ++++ 7346 7412 7414 7351 / ++++ 7350 7353 / ++++ 7352 7407 / ILLEGAL 133 134 135 136 137 7407 7416 7417 / / MESSAGES / CLASCR, TEXT '^P!E' / MESFT2, IFDEF ENGLSH < TEXT '^P&IDENTIFICATION MESSAGE IS:^P^A' > /M022 IFDEF ITALIAN< TEXT /^P&MESSAGGIO IDENTIFICAZIONE SISTEMA:^P^A/ > IFDEF CANADA < TEXT "^P&IDENTIFICATION DU TERMINAL:^P^A" > IFDEF FRENCH < TEXT "^P&IDENTIFICATION EST :^P^A" > /L.A.E IFDEF DUTCH < TEXT "^P&INDENTIFICATIE BERICHT IS:^P^A" > IFDEF GERMAN < TEXT "^P&TERMINAL &KENNUNG:^P^A" > IFDEF NORWAY < TEXT '^P&TERMINAL-&I&D ER:^P^A' > IFDEF SWEDSH < TEXT '^P&TERMINAL-&I&D [R:^P^A' > /L.U.A IFDEF DANISH < TEXT '^P&TERMINAL-&I&D ER:^P^A' > IFDEF V30SWE < TEXT '^P&IDENTIFIERINGSMEDDELANDET \DR:'> / MESFT3, IFDEF ENGLSH < TEXT '^P&LOG DOCUMENT IS:^P^A' > IFDEF ITALIAN< TEXT /^P&PROCEDURA DI COLLEGAMENTO:^P^A/ > IFDEF CANADA < TEXT "^P&DOCUMENT-R[PERTOIRE:^P^A" > /L.A.E IFDEF FRENCH < TEXT "^P&LE JOURNAL DE BORD EST :^P^A" > IFDEF DUTCH < TEXT "^P&LOGBOEK IS:^P^A" > IFDEF GERMAN < TEXT "^P&LOG &DATEI:^P^A" > IFDEF NORWAY < TEXT '^P"&LOG"-DOKUMENTET ER:^P^A' > IFDEF SWEDSH < TEXT '^P"&LOG"-DOKUMENTET [R:^P^A' > /L.U.A IFDEF DANISH < TEXT '^P"&LOG"-DOKUMENTET ER:^P^A' > IFDEF V30SWE < TEXT '^P"&INLOGGNINGSDOKUMENTET \DR:'> / MESFT4, IFDEF ENGLSH < TEXT '^P&SEND ONLY PASSWORD IS:^P^A' > IFDEF ITALIAN< TEXT /^P&PAROLA CHIAVE PER INVIO:^P^A/ > IFDEF CANADA < TEXT "^P&MOT DE PASSE D'ENVOI:^P^A" > IFDEF FRENCH < TEXT "^P&LE MOT DE PASSE POUR ENVOYER EST :^P^A" > /L.A.E IFDEF DUTCH < TEXT "^P&SLEUTELWOORD VOOR ALLEEN ZENDEN:^P^A" > IFDEF GERMAN < TEXT "^P&SENDE &PASSWORT:^P^A" > IFDEF NORWAY < TEXT "^P&PASSORDET FOR ] SENDE ER:^P^A" > /L.D.A IFDEF SWEDSH < TEXT '^P&L\SENORD F\R "S[ND" [R:^P^A' > /L.U.O, L.U.O, L.U.A, L.U.A IFDEF DANISH < TEXT "^P&PASORDET FOR AT SENDE ER:^P^A" > IFDEF V30SWE < TEXT '^P"&S\DND ENDAST L\VSENORD" \DR:'> / MESFT5, IFDEF ENGLSH < TEXT '^P&SEND AND RECEIVE PASSWORD IS:^P^A' > IFDEF ITALIAN< TEXT /^P&PAROLA CHIAVE PER INVIO E RICEZIONE:^P^A/ > IFDEF CANADA < TEXT "^P&MOT DE PASSE D'ENVOI-R[CEPTION:^P^A" > /L.A.E IFDEF FRENCH < TEXT "^P&LE MOT DE PASSE POUR ENVOYER ET RECEVOIR EST :^P^A" /L.A.E > IFDEF DUTCH < TEXT "^P&SLEUTEWOORD VOOR ZENDEN EN ONTVANGEN IS:^P^A" > IFDEF GERMAN < TEXT "^P&SENDE UND &EMPFANGS &PASSWORT:^P^A" > IFDEF NORWAY < TEXT "^P&PASSORDET FOR ] SENDE OG MOTTA ER:^P^A" > /L.D.A IFDEF SWEDSH < TEXT '^P&L\SENORD F\R "S[ND OCH MOTTAG" [R:^P^A' > /L.U.O, L.U.O, L.U.A, L.U.A IFDEF DANISH < TEXT "^P&PASORDET FOR AT SENDE OG MODTAGE ER:^P^A" > IFDEF V30SWE < TEXT '^P"&S\DND OCH TA EMOT L\VSENORD" \DR:'> / /D016;TRYCON, /D016; IFDEF ENGLSH < TEXT '^P!L^P--!L &COMMUNICATIONS ACTIVE --' > /D016; IFDEF CANADA < TEXT "^P!L^P--!L &COMMUNICATION EN COURS --" > /D016; IFDEF FRENCH < TEXT "^P!L^P--!L &COMMUNICATION EN COURS --" > /D016; IFDEF DUTCH < TEXT "^P!L^P--!L &COMMUNICATIE AKTIEF --" > /D016; IFDEF GERMAN < TEXT "^P!L^P--!L &KOMMUNIKATION AKTIV --" > /D016; IFDEF NORWAY < TEXT "^P!L^P--!L &KOMMUNIKASJON AKTIV --" > /D016; IFDEF SWEDSH < TEXT "^P!L^P--!L &KOMMUNIKATION AKTIV --" > /D016; IFDEF DANISH < TEXT "^P!L^P--!L &KOMMUNIKATION AKTIV --" > / IFDEF ENGLSH < NOANS, "C-200 / C "A-200 / A "N-200 / N "N-200 / N "O-200 / O "T-200 / T " -200 / Space "T-200 / T "R-200 / R "A-200 / A "N-200 / N "S-200 / S "F-200 / F "E-200 / E "R-200 / R " -200 / Space "D-200 / D "O-200 / O "C-200 / C "U-200 / U "M-200 / M "E-200 / E "N-200 / N "T-200 / T CLAMES, 0 BADPAS, "I-200 / I "N-200 / N "C-200 / C "O-200 / O "R-200 / R "R-200 / R "E-200 / E "C-200 / C "T-200 / T " -200 / Space "P-200 / P "A-200 / A "S-200 / S "S-200 / S "W-200 / W "O-200 / O "R-200 / R "D-200 / D 00000 PASPMT, 164 / T 150 / H 145 / E " -200 / Space "P-200 / P "A-200 / A "S-200 / S "S-200 / S "W-200 / W "O-200 / O "R-200 / R "D-200 / D 00000 ILLUSE, "--200 / - "--200 / - " -200 / Space "I-200 / I "L-200 / L "L-200 / L "E-200 / E "G-200 / G "A-200 / A "L-200 / L " -200 / Space "U-200 / U "S-200 / S "E-200 / E "R-200 / R " -200 / Space "--200 / - "--200 / - 0000 IDPMT, 171 / Y 157 / O 165 / U 162 / R " -200 / Space "i-200 / I "d-200 / D "e-200 / E "n-200 / N "t-200 / T "i-200 / I "f-200 / F "i-200 / I "c-200 / C "a-200 / A "t-200 / T "i-200 / I "o-200 / O "n-200 / N " -200 / Space "m-200 / M "e-200 / E "s-200 / S "s-200 / S "a-200 / A "g-200 / G "e-200 / E 0000 > / END IFNDEF ENGLSH IFDEF ITALIAN < NOANS, "T-200 / T "R-200 / R "A-200 / A "S-200 / S "F-200 / F "E-200 / E "R-200 / R "I-200 / I "M-200 / M "E-200 / E "N-200 / N "T-200 / T "O-200 / O " -200 / Space "D-200 / D "O-200 / O "C-200 / C "U-200 / U "M-200 / M "E-200 / E "N-200 / N "T-200 / T "O-200 / O " -200 / SPACE "I-200 / I "M-200 / M "P-200 / P "O-200 / O "S-200 / S "S-200 / S "I-200 / I "B-200 / B "I-200 / I "L-200 / L "E-200 / E CLAMES, 0 BADPAS, "P-200 / P "A-200 / A "R-200 / R "O-200 / O "L-200 / L "A-200 / A " -200 / SPACE "C-200 / C "H-200 / H "I-200 / I "A-200 / A "V-200 / V "E-200 / E " -200 / SPACE "N-200 / N "O-200 / O "N-200 / N " -200 / SPACE "C-200 / C "O-200 / O "R-200 / R "R-200 / R "E-200 / E "T-200 / T "T-200 / T "A-200 / A 00000 PASPMT, "L-200 / L "A-200 / A " -200 / Space "P-200 / P "A-200 / A "R-200 / R "O-200 / O "L-200 / L "A-200 / A " -200 / SPACE "C-200 / C "H-200 / H "I-200 / I "A-200 / A "V-200 / V "E-200 / E 00000 ILLUSE, "--200 / - "--200 / - " -200 / Space "U-200 / U "T-200 / T "E-200 / E "N-200 / N "T-200 / T "E-200 / E " -200 / Space "N-200 / N "O-200 / O "N-200 / N " -200 / SPACE "A-200 / A "U-200 / U "T-200 / T "O-200 / O "R-200 / R "I-200 / I "Z-200 / Z "Z-200 / Z "A-200 / A "T-200 / T "O-200 / O " -200 / Space "--200 / - "--200 / - 0000 IDPMT, "i-200 / I "l-200 / L " -200 / SPACE "m-200 / M "e-200 / E "s-200 / S "s-200 / S "a-200 / A "g-200 / G "g-200 / G "i-200 / I "o-200 / O " -200 / SPACE "i-200 / I "d-200 / D "e-200 / E "n-200 / N "t-200 / T "i-200 / I "f-200 / F "i-200 / I "c-200 / C "a-200 / A "z-200 / Z "i-200 / I "o-200 / O "n-200 / N "e-200 / E " -200 / Space "s-200 / S "i-200 / I "s-200 / S "t-200 / T "e-200 / E "m-200 / M "a-200 / A 0000 > / END IFDEF ITALIAN IFDEF CANADA < NOANS, "I-200 / I "M-200 / M "P-200 / P "O-200 / O "S-200 / S "S-200 / S "I-200 / I "B-200 / B "L-200 / L "E-200 / E " -200 / Space "D-200 / D "E-200 / E " -200 / Space "T-200 / T "R-200 / R "A-200 / A "N-200 / N "S-200 / S "M-200 / M "E-200 / E "T-200 / T "T-200 / T "R-200 / R "E-200 / E " -200 / Space "L-200 / L "E-200 / E " -200 / Space "D-200 / D "O-200 / O "C-200 / C ".-200 / . CLAMES, 0 BADPAS, "M-200 / M "O-200 / O "T-200 / T " -200 / Space "D-200 / D "E-200 / E " -200 / Space "P-200 / P "A-200 / A "S-200 / S "S-200 / S "E-200 / E " -200 / Space "I-200 / I "N-200 / N "C-200 / C "O-200 / O "R-200 / R "R-200 / R "E-200 / E "C-200 / C "T-200 / T 0000 PASPMT, "L-200 / L "E-200 / E " -200 / Space "M-200 / M "O-200 / O "T-200 / T " -200 / Space "D-200 / D "E-200 / E " -200 / Space "P-200 / P "A-200 / A "S-200 / S "S-200 / S "E-200 / E 0000 ILLUSE, "--200 / - "U-200 / U "T-200 / T "I-200 / I "L-200 / L "I-200 / I "S-200 / S "A-200 / A "T-200 / T "E-200 / E "U-200 / U "R-200 / R " -200 / Space "N-200 / N "O-200 / O "N-200 / N "--200 / - "A-200 / A "U-200 / U "T-200 / T "O-200 / O "R-200 / R "I-200 / I "S-200 / S "[-200 / [ "--200 / - 0000 IDPMT, "V-200 / V "O-200 / O "T-200 / T "R-200 / R "E-200 / E " -200 / Space "I-200 / I "D-200 / D "E-200 / E "N-200 / N "T-200 / T "I-200 / I "F-200 / F "I-200 / I "C-200 / C "A-200 / A "T-200 / T "I-200 / I "O-200 / O "N-200 / N 0000 > / END IFDEF CANADA / IFDEF FRENCH < NOANS, "N-200 / N "E-200 / E " -200 / Space "P-200 / P "E-200 / E "U-200 / U "T-200 / T " -200 / Space "P-200 / P "A-200 / A "S-200 / S " -200 / Space "O-200 / O "B-200 / B "T-200 / T "E-200 / E "N-200 / N "I-200 / I "R-200 / R " -200 / Space "L-200 / L "E-200 / E " -200 / Space "D-200 / D "O-200 / O "C-200 / C ".-200 / . CLAMES, 0 BADPAS, "M-200 / M "A-200 / A "U-200 / U "V-200 / V "A-200 / A "I-200 / I "S-200 / S " -200 / Space "M-200 / M "O-200 / O "T-200 / T " -200 / Space "D-200 / D "E-200 / E " -200 / Space "P-200 / P "A-200 / A "S-200 / S "S-200 / S "E-200 / E 0000 PASPMT, "L-200 / L "E-200 / E " -200 / Space "M-200 / M "O-200 / O "T-200 / T " -200 / Space "D-200 / D "E-200 / E " -200 / Space "P-200 / P "A-200 / A "S-200 / S "S-200 / S "E-200 / E 0000 ILLUSE, "--200 / - "U-200 / U "T-200 / T "I-200 / I "L-200 / L "I-200 / I "S-200 / S "A-200 / A "T-200 / T "E-200 / E "U-200 / U "R-200 / R " -200 / Space "N-200 / N "O-200 / O "N-200 / N " -200 / Space "A-200 / A "U-200 / U "T-200 / T "O-200 / O "R-200 / R "I-200 / I "S-200 / S "[-200 / [ "--200 / - 0000 IDPMT, "V-200 / V "O-200 / O "T-200 / T "R-200 / R "E-200 / E " -200 / Space "I-200 / I "D-200 / D "E-200 / E "N-200 / N "T-200 / T "I-200 / I "F-200 / F "I-200 / I "C-200 / C "A-200 / A "T-200 / T "I-200 / I "O-200 / O "N-200 / N 0000 > / END IFDEF FRENCH IFDEF GERMAN < NOANS, "K-200 / K "E-200 / E "I-200 / I "N-200 / N " -200 / Space "D-200 / D "A-200 / A "T-200 / T "E-200 / E "I-200 / I " -200 / Space "T-200 / T "R-200 / R "A-200 / A "N-200 / N "S-200 / S "F-200 / F "E-200 / E "R-200 / R CLAMES, 0 BADPAS, "F-200 / F "A-200 / A "L-200 / L "S-200 / S "C-200 / C "H-200 / H "E-200 / E "S-200 / S " -200 / Space "P-200 / P "A-200 / A "S-200 / S "S-200 / S "W-200 / W "O-200 / O "R-200 / R "T-200 / T 0000 PASPMT, "P-200 / P "A-200 / A "S-200 / S "S-200 / S "W-200 / W "O-200 / O "R-200 / R "T-200 / T 0000 ILLUSE, "--200 / - "K-200 / K "E-200 / E "I-200 / I "N-200 / N " -200 / Space "Z-200 / Z "U-200 / U "G-200 / G "R-200 / R "I-200 / I "F-200 / F "F-200 / F "--200 / - 0000 IDPMT, "I-200 / I "H-200 / H "R-200 / R "E-200 / E " -200 / "K-200 / K "E-200 / E "N-200 / N "N-200 / N "U-200 / U "N-200 / N "G-200 / G 0000 > / END IFDEF GERMAN IFDEF DUTCH < NOANS, "O-200 / O "N-200 / N "M-200 / M "O-200 / O "G-200 / G "E-200 / E "L-200 / L "I-200 / I "J-200 / J "K-200 / K " -200 / "T-200 / T "E-200 / E " -200 / "V-200 / V "E-200 / E "R-200 / R "Z-200 / Z "E-200 / E "N-200 / N "D-200 / D "E-200 / E "N-200 / N CLAMES, 0 BADPAS, "F-200 / F "O-200 / O "U-200 / U "T-200 / T "I-200 / I "E-200 / E "F-200 / F " -200 / "S-200 / S "L-200 / L "E-200 / E "U-200 / U "T-200 / T "E-200 / E "L-200 / L "W-200 / W "O-200 / O "O-200 / O "R-200 / R "D-200 / D 0000 PASPMT, "H-200 / H "E-200 / E "T-200 / T " -200 / "S-200 / S "L-200 / L "E-200 / E "U-200 / U "T-200 / T "E-200 / E "L-200 / L "W-200 / W "O-200 / O "O-200 / O "R-200 / R "D-200 / D 0000 ILLUSE, "--200 / - "V-200 / V "E-200 / E "R-200 / R "K-200 / K "E-200 / E "E-200 / E "R-200 / R "D-200 / D "E-200 / E " -200 / "G-200 / G "E-200 / E "B-200 / B "R-200 / R "U-200 / U "I-200 / I "K-200 / K "E-200 / E "R-200 / R "--200 / - 0000 IDPMT, "I-200 / I "D-200 / D "E-200 / E "N-200 / N "T-200 / T "I-200 / I "F-200 / F "I-200 / I "C-200 / C "A-200 / A "T-200 / T "I-200 / I "E-200 / E " -200 / "B-200 / B "E-200 / E "R-200 / R "I-200 / I "C-200 / C "H-200 / H "T-200 / T 0000 > / END IFDEF DUTCH IFDEF NORWAY < NOANS, "K-200 / K "A-200 / A "N-200 / N " -200 / "I-200 / I "K-200 / K "K-200 / K "E-200 / E " -200 / "O-200 / O "V-200 / V "E-200 / E "R-200 / R "F-200 / F "\-200 / \ "R-200 / R "E-200 / E " -200 / "D-200 / D "O-200 / O "K-200 / K "U-200 / U "M-200 / M "E-200 / E "N-200 / N "T-200 / T CLAMES, 0000 BADPAS, "U-200 / U "G-200 / G "Y-200 / Y "L-200 / L "D-200 / D "I-200 / I "G-200 / G " -200 / "P-200 / P "A-200 / A "S-200 / S "S-200 / S "O-200 / O "R-200 / R "D-200 / D 0000 / PASPMT, "P-200 / P "A-200 / A "S-200 / S "S-200 / S "O-200 / O "R-200 / R "D-200 / D "E-200 / E "T-200 / T 0000 ILLUSE, "--200 / - "--200 / - "I-200 / I "K-200 / K "K-200 / K "E-200 / E " -200 / "A-200 / A "U-200 / U "T-200 / T "O-200 / O "R-200 / R "I-200 / I "S-200 / S "E-200 / E "R-200 / R "T-200 / T " -200 / "B-200 / B "R-200 / R "U-200 / U "K-200 / K "E-200 / E "R-200 / R "--200 / - "--200 / - 0000 / IDPMT, "d-200 / d "i-200 / i "n-200 / n " -200 / "I-200 / I "D-200 / D 0000 > / End IFDEF NORWAY IFDEF SWEDSH < / NOANS, "K-200 / K "A-200 / A "N-200 / N " -200 / "I-200 / I "N-200 / N "T-200 / T "E-200 / E " -200 / "\-200 / \ "V-200 / V "E-200 / E "R-200 / R "F-200 / F "\-200 / \ "R-200 / R "A-200 / A " -200 / "D-200 / D "O-200 / O "K-200 / K "U-200 / U "M-200 / M "E-200 / E "N-200 / N "T-200 / T CLAMES, 0000 BADPAS, "U-200 / U "G-200 / G "I-200 / I "L-200 / L "T-200 / T "I-200 / I "G-200 / G " -200 / "L-200 / L "\-200 / \ "S-200 / S "E-200 / E "N-200 / N "O-200 / O "R-200 / R "D-200 / D 0000 / PASPMT, "L-200 / L "\-200 / \ "S-200 / S "E-200 / E "N-200 / N "O-200 / O "R-200 / R "D-200 / D "E-200 / E "T-200 / T 0000 ILLUSE, "--200 / - "I-200 / I "N-200 / N "T-200 / T "E-200 / E " -200 / "A-200 / A "U-200 / U "T-200 / T "O-200 / O "R-200 / R "I-200 / I "S-200 / S "E-200 / E "R-200 / R "A-200 / A "T-200 / T " -200 / "A-200 / A "N-200 / N "V-200 / V "[-200 / [ "N-200 / N "D-200 / D "A-200 / A "R-200 / R "E-200 / E "--200 / - 0000 / IDPMT, "d-200 / d "i-200 / i "n-200 / n " -200 / "I-200 / I "D-200 / D 0000 > / End IFDEF SWEDSH IFDEF DANISH < NOANS, "K-200 / K "A-200 / A "N-200 / N " -200 / "I-200 / I "K-200 / K "K-200 / K "E-200 / E " -200 / "O-200 / O "V-200 / V "E-200 / E "R-200 / R "F-200 / F "\-200 / \ "R-200 / R "E-200 / E " -200 / "D-200 / D "O-200 / O "K-200 / K "U-200 / U "M-200 / M "E-200 / E "N-200 / N "T-200 / T CLAMES, 0000 BADPAS, "U-200 / U "G-200 / G "Y-200 / Y "L-200 / L "D-200 / D "I-200 / I "G-200 / G " -200 / "P-200 / P "A-200 / A "S-200 / S "O-200 / O "R-200 / R "D-200 / D 0000 / PASPMT, "P-200 / P "A-200 / A "S-200 / S "O-200 / O "R-200 / R "D-200 / D "E-200 / E "T-200 / T 0000 ILLUSE, "--200 / - "--200 / - "I-200 / I "K-200 / K "K-200 / K "E-200 / E " -200 / "A-200 / A "U-200 / U "T-200 / T "O-200 / O "R-200 / R "I-200 / I "S-200 / S "E-200 / E "R-200 / R "E-200 / E "T-200 / T " -200 / "B-200 / B "R-200 / R "U-200 / U "G-200 / G "E-200 / E "R-200 / R 0000 / IDPMT, "d-200 / d "i-200 / i "n-200 / n " -200 / "I-200 / I "D-200 / D 0000 > / End IFDEF DANISH IFDEF V30SWE < / NOANS, "K-200 / K "A-200 / A "N-200 / N " -200 / "I-200 / I "N-200 / N "T-200 / T "E-200 / E " -200 / "\-200 / \ "V-200 / V "E-200 / E "R-200 / R "F-200 / F "\-200 / \ "R-200 / R "A-200 / A " -200 / "D-200 / D "O-200 / O "K-200 / K "U-200 / U "M-200 / M "E-200 / E "N-200 / N "T-200 / T CLAMES, 0000 BADPAS, "U-200 / U "G-200 / G "I-200 / I "L-200 / L "T-200 / T "I-200 / I "G-200 / G " -200 / "L-200 / L "\-200 / \ "S-200 / S "E-200 / E "N-200 / N "O-200 / O "R-200 / R "D-200 / D 0000 / PASPMT, "L-200 / L "\-200 / \ "S-200 / S "E-200 / E "N-200 / N "O-200 / O "R-200 / R "D-200 / D "E-200 / E "T-200 / T 0000 ILLUSE, "--200 / - "I-200 / I "N-200 / N "T-200 / T "E-200 / E " -200 / "A-200 / A "U-200 / U "T-200 / T "O-200 / O "R-200 / R "I-200 / I "S-200 / S "E-200 / E "R-200 / R "A-200 / A "T-200 / T " -200 / "A-200 / A "N-200 / N "V-200 / V "[-200 / [ "N-200 / N "D-200 / D "A-200 / A "R-200 / R "E-200 / E "--200 / - 0000 / IDPMT, "d-200 / d "i-200 / i "n-200 / n " -200 / "I-200 / I "D-200 / D 0000 > / End IFDEF V30SWE / CRLF, 15 CUPOS4, 12 / ++++ 0 AXDMS, / / The following foreign language code contains the closing angle bracket / character. This character causes the conditional code compilation to get / quite confused. Therefore it has been necessary to hide these characters / from PAL using their SIXBIT codes rather than the TEXT characters. This / makes quite a mess. The english for the following mess is: / TEXT "^AFROM>^A^ATIME>^A^AN>^A ^A#>!D.^D^Am>^A^A>^A" / IFDEF ENGLSH < TEXT "^AFROM" *.-1 7636 / closing angle and uparrow TEXT "A^ATIM" *.-1 0576 / "E" and closing angle TEXT "^A^A" *.-1 1676 / "N" and closing angle TEXT "^A ^A#" *.-1 7641 / closing angle and "!" TEXT "D.^D^A" *.-1 1576 / "M" and closing angle TEXT "^A^A" *.-1 7636 / closing angle and uparrow 0100 / "A" and null to terminate string > / End IFNDEF ENGLSH / IFDEF ITALIAN < TEXT "^ADA" *.-1 7636 / closing angle and uparrow TEXT "A^ADATA-OR" *.-1 0176 / "A" and closing angle TEXT "^A^A" *.-1 1676 / "N" and closing angle TEXT "^A ^A=" *.-1 7641 / closing angle and "!" TEXT "D.^D^A" *.-1 1576 / "M" and closing angle TEXT "^A^A" *.-1 7636 / closing angle and uparrow 0100 / "A" and null to terminate string > / End IFDEF ITALIAN / IFDEF CANADA < TEXT "^ADE" *.-1 7636 / closing angle and uparrow TEXT "A^ADAT" /M011 *.-1 0576 / "E" and closing angle /M011 TEXT "^A^A" /M011 *.-1 1676 / "N" and closing angle /M011 TEXT "^A ^A#" /M011 *.-1 7641 / closing bracket and "!" /M011 TEXT "D.^D^A" /M011 *.-1 1576 / "M" and closing angle /M011 TEXT "^A^A" /M011 *.-1 7636 / closing angle and uparrow /M011 TEXT "A" /M011 > / IFDEF FRENCH < TEXT "^ADE" *.-1 7636 / closing angle and uparrow TEXT "A^ATEMPS" *.-1 7636 / closing angle and uparrow TEXT "A^AN" *.-1 7636 / closing angle and uparrow TEXT "A ^A" *.-1 4376 / "#" and closing bracket TEXT "!D.^D^AM" *.-1 7636 / closing angle and uparrow TEXT "A^" *.-1 0176 / "A" and closing angle TEXT "^A" > / IFDEF DUTCH < TEXT "^AVA" *.-1 1676 / "N" and closing angle TEXT "^A^ATIJD" *.-1 7636 / closing angle and uparrow TEXT "A^AN" *.-1 7636 / closing angle and uparrow TEXT "A ^A" *.-1 4376 / "#" and closing angle TEXT "!D.^D^AM" *.-1 7636 / closing angle and uparrow TEXT "A^" *.-1 0176 / "A" and closing angle TEXT "^A" > / IFDEF GERMAN < TEXT "^AVO" *.-1 1676 / "N" and closing angle TEXT "^A^AZEIT" *.-1 7636 / closing angle and uparrow TEXT "A^AN" *.-1 7636 / closing angle and uparrow TEXT "A ^A" *.-1 4376 / "#" and closing angle TEXT "!D.^D^AM" *.-1 7636 / closing angle and uparrow TEXT "A^" *.-1 0176 / "A" and closing angle TEXT "^A" > IFDEF NORWAY < TEXT "^AFR" *.-1 0176 / "A"-closing bracket TEXT "^A^ATI" *.-1 0476 / "D"-Closing bracket > IFDEF SWEDSH < TEXT "^AFR]N" *.-1 7636 / Closing bracket-uparrow TEXT "A^ATID" *.-1 4076 / Space-Closing bracket > IFDEF DANISH < TEXT "^AFR" *.-1 0176 / "A"-closing bracket TEXT "^A^ATI" *.-1 0476 / "D"-Closing bracket > IFDEF V30SWE < TEXT "^AFR\EN" *.-1 7636 / closing angle and uparrow TEXT "A^ATIM" *.-1 0576 / "E" and closing angle TEXT "^A^A" *.-1 1676 / "N" and closing angle TEXT "^A ^A#" *.-1 7641 / closing angle and "!" TEXT "D.^D^A" *.-1 1576 / "M" and closing angle TEXT "^A^A" *.-1 7636 / closing angle and uparrow 0100 / "A" and null to terminate string > / End IFDEF V30SWE / / THE STRINGS THAT ARE USED FOR DELIMITERS / DEAX1, "<-200 / ++++ 156 / ++++ ">-200 / ++++ 0 DEAX2, "<-200 / ++++ "#-200 / ++++ ">-200 / ++++ 0 DEAX3, "<-200 / ++++ ">-200 / ++++ 0 / DECKDT, / USED TO COMPAY THE CURRENT CHARACTER IN DECKDS TO < DEAX4, "<-200 / ++++ 0 / IFDEF GERMAN < PAGE / The german TEXT is short enough to cause the code on / the next page to have severe problems. > IFDEF ENGLSH / DITTO FOR ENGLISH. IFDEF V30SWE / DITTO FOR V30SWE? / / / PART OF REDSIX ROUTINE TO AHNDLE THE ESCAPE SEQUENCES / REDESC, AC7776 / PART OF REDSIX ROUTINE TAD T1 / SEE IF LEGAL ESCAPE SEQUENCE SPA / ++++ JMP RDSIX4 / ERROR TAD (2-31) SMA SZA / ++++ JMP RDSIX4 / ERROR TAD (REDTAB+31-2) / COMPUTE TABLE ENTRY DCA T1 TAD I T1 / PICK UP ENTRY / DCA T1 / STORE THE ORIGINAL CHARACTER OUT OF THE TABLE TAD T1 / SMA / ++++ JMP REDES2 / IF NEGATIVE IT IS A ESCAPE SEQUENCE / IF POSITIVE IT IS EITHER 137 THAT IS SPECIAL / OR A CHARACTER THAT IS CASE DEPENDENT / CLA TAD T1 / ESCAPE AND P77 / GET THE SECOND BYTE THE CAHRACTER REPRESENTING DCA T2 / THE TYPE / TAD T1 / NOW GET THE ESCAPE BSW AND P77 TAD (100) REDES3, DCA T3 / TAD T3 / IF THE ESCAPE IS A 174 OR VERTICAL BAR THEN / ADD A 100 TO THE NEXT CHARACTER TAD (-173) SZA CLA / ++++ AC0100 TAD T2 AND P177 DCA REDNXT / SAVE IT FOR THE NEXT TIME THE ROUTINE IS CALLED / TAD T3 JMP RDSIX2 / SEND THE ESCAPE REDES2, TAD (-137) / IF SPECIAL THEN DOESNT MATTER IF UPPER OR LOWER SNA CLA / ++++ JMP REDES4 / SEND A 137 FOR UNDERSCORE TAD REDSHF / ELSE CASE DEPENDENT SNA / ++++ JMP REDES4 / NO CASE CHANGE THE CHARACTER IS OK TAD T1 DCA T2 / MAKE LOWER / TAD (174) / SEND AS A 174 ESCAPE JMP REDES3 REDES4, TAD T1 / GET THE OROGINAL JMP RDSIX2 REDNXT, 0 / / PART OF THE REDSIX ROUTINE / WRSIXB, DCA WRICHR / CLEAR HOLD CHAR MQA TAD (-140) / MAKE LOWER CASE SMA / ++++ TAD (-40) TAD (140-37) TAD (-74) / SEE IF SPECIAL CHAR SMA / ++++ JMP WRSIXC / YES, SEND ESCAPE SEQUENCE INSTEAD TAD (74) JMP WRSIXX / PAGE / / LOCDOC - WILL LOCK THE DOCUMENTS THAT WILL BE USED FOR AX. THIS IS / THE LOG AND DEFAULT LIST DOCUMENTS / Why this routine worked in the English system is anyone's guess. It was / just luck. The XXXXX symbol causes WPCRE to be loaded right after the last / instruction in this routine. This caused all the literals on this page / to be overwritten. It seems that the key literal was not changed when this / occurred--in the English system, that is, in the FORINized systems it is / and AX didn't work. To correct this all literals on this page have been / labeled so that they won't get overwritten. Take care if adding code to / to this page that you label your literals too. / /D032;LOCDOC, /D032; XX /D032; CLA /D032; CDFMYF /D015; TAD I PLOGNO / Get the log document number via pointer /D015; SNA CLA / ++++ /D015; JMP LOCDO2 /D014;/ /D014; CIFPRT /D014; JMS I PLCKFI / Jump to subroutine via pointer /D014; LOGNO /D014; ALTER /D014; USERNO /D014;/ /D014; JMP LOCER1 /D014;/ /D015; CDFMNU / CHANGE DATA FIELD TO MENU. /A014 /D015; DCA I PFLOCK / SET MENU LOCK WORD. /A014 /D015; CDFMYF / BACK TO US. /A014 /D032;LOCDO2, JMP I LOCDOC /D014;LOCER2, /D014; AC0001 / DISPLAY THAT THE DEFAULT LIST DOCUMENT IS LOCKED /D014;LOCER1, /D014; TAD VFOUR / LOG /D014;/ /D014; CDFMNU /D014; DCA I PMNUST / store via pointer to menu stuff /D014; CDFMYF /D014;/ /D014; CIFMNU /D014; JMS I MNUCAL /D014; DLMA13 /D014;/ /D014; JMP I LOCDOC /D014;/ /D015;PLOGNO, LOGNO / Pointer to log document number /D014;VFOUR, 4 / The value four /D014; /D014;/This line was causing an undefined symbol error for the 78. Since it /A010 /D014;/is only accessed when WS102 is defined I conditionalized it. /A010 /D014;IFDEF WS102 < /A010 /D014;PLCKFI, LCKFIL / Pointer to file locking routine /D014;> /A010 /D014;PMNUST, MUBUF+MNTMP2 / Pointer to menu stuff /D014;/ /D015;PFLOCK, MUBUF+MNLOCK / POINTER TO MENU LOCK WORD. /A014 / / CLEAR OUT THE SETTINGS WHEN AX IS LOADED OUT. THE ZBLOCK / MAKES SURE WHAT WE LOAD OUT IS ZEROS. THIS ALSO LIMITS THIS PROGRAM TO / THE VALUE OF DFCOMA / XXXXXX=. / CURRENT POSITION IS = XXXXXX / *DFCOMA / ZBLOCK 1000 / *XXXXXX / RESET THE CURRENT LOCATION COUNTER   /QUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. / /++ / FACILITY: / ABSTRACT: / ENVIRONMENT: / AUTHOR:ALICIA FODEN/MIKE STURAK CREATION DATE: OCTOBER 27,1980 / / / 033 EMcD 27-Sep-85 Add Dutch/Spanish Xlations / 032 EMcD 15-Sep-85 Add Nordic translations / 031 RCME 10-APR-85 Add handling of multinational and / technical characters in field names / / -------------------- All below refer to V2.0 and earlier ---------------- / / 030 TCW 02-NOV-83 ADD CHECK & TEXT FOR WINCHESTER DRIVE / 029 HLP 29-AUG-83 If type incorrectly to GO prompt / do not repaint screen, show error / 028 WCE 17-AUG-83 Removed code that generates CDF/CIF's / 027 WCE 19-JUL-83 Modified labels for new prefix file / 026 WCE 06-JUL-83 Removed WS102 conditionals and code / / 025 MJS 01-JAN-83 Corrected some error messages that may / have been "misleading" to the user / (the corrections consistes of "NOP"ing / or "JMP"ing around code) / / 024 AIB 10-DEC-82 Conditionalized "Rubout key" messages / 023 MJS 12-NOV-82 Cosmetic wording changes to message / at "TRYAGN"....same wording if you were / typing to Main Menu and got an error / / 0022 AIB 28-SEP-82 MORE COSMETIC WORDING CHANGES / 0021 AIB 30-AUG-82 WORDING CHANGES IN SOME MENUS / 0020 MJS 1-APR-82 Bug fix added 'GET DENSITY' in 'GTDKID' / 0019 MJS 25-MAR-82 'Bug fix #dm-481' changed 'jmp cusgr' / to 'jmp cusr1' at 'dtao' permitting / GOLD Menu to return to MAIN Menu and / not sort menu asking for new 't a o'. / 0018 MJS 09-MAR-82 Cosmetic display fix in 'nomean' / 0017 MJS 16-FEB-82 CHANGED 'SREXT=10' to 'SREXT=20' / (double density and goto page increased / number of header blocks permitted) / ALSO-deleted 'wpssdf.pa' from the / wpstpr line within master.inf / (was never needed) / 0016 GDH 08-FEB-82 Implemented "read error detection". / 0015 MJS 19-NOV-81 Moved the 'xxsdfnbuffer' from field 5 / to field 4 / 0014 AJF 06-OCT-81 CHANGED DDCHK TO ONLY LOOK AT BLOCK / NUMBER OF ALLOC BLOCK / 0013 GR 30-SEP-81 Fixed Press Return problem / 0012 JM 03-SEP-81 FRENCH TEXT CHANGES / 0011 JM 03-SEP-81 FIXED TYPING "-" HAS NO MEANING MESSAGE / 0010 GDH 26-Aug-81 WPFILS calling seq changes. / 0009 TT 09-JULY-81 REMOVED SUPERFLUOUS CONDITIONALS / 0008 AJF 25-JUNE-81 MISCELLANEOUS COSMETIC FIXES / 0007 AJF 31-MAR-81 VERSION 1 CLEANUP AND MULIT KEY STUFF / 0006 JM 10-MAR-81 Entered CANADIAN text / 0005 JM 09-MAR-81 Entered DUTCH text / 0004 JM 05-MAR-81 Entered FRENCH text / 0003 AJF 18-MAR-81 CHANGED RD1CHAR CALL IN GETFNCHAR TO / PROCESS BLANKS / / 0002 AJF 20-FEB-81 DELETE 127 BLOCK SIZE RESTRICTION IN / TSTSZ / 0001 AJF 27-OCT-81 ADDED SORT/PARSER MODULE TO SYSTEM /-- / / WRITE OUT SORT PARSER / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** FIELD 0 *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLOSPR;100;CDF 30;-DSOSPR 0 / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / WPSPAR.PA - SORT PARSER /D028 / THE 'USER FIELD' CONSTANTS /D028 / /D028 USRFL0= -10 / USER FIELD 0 /D028 USRFL1= 0 / USER FIELD 1 /D028 USRFL3= 20 / USER FIELD 3 (PHYSICAL FIELD 5) /D028 / /D028 / REPLACES THE 'JMS' WITHIN THE MAINLINE CODE WITH THE ACTUAL (CDF) (CIF) IOT FIELD 3 *SOTFL / THE FIRST 100 LOCATIONS CONTAIN COMMON SYSTEM CONSTANTS / (E.G. P177, ETCETERA.) / *SDFNBUFFER /THIS WILL BE DEFINED IN SORT IN SORT FIELD /D007 *FTYPE+1 CDFSDFN=6241 /A014 /D028 CDFSRT=JMS .; .; JMS CIDPAT; CDF+USRFL3 /D028 CDFEDT=JMS .; .; JMS CIDPAT; CDF+USRFL1 /D028 CDIMNU=JMS .; .; JMS CIDPAT; CDF!CIF+USRFL0 /D028 CDFMNU=JMS .; .; JMS CIDPAT; CDF+USRFL0 /D028 CIFMNU=JMS .; .; JMS CIDPAT; CIF+USRFL0 /D028 CDISRT=JMS .; .; JMS CIDPAT; CDF!CIF+USRFL3 CDFMYF=CDFEDT /DEFINE INSTRUCTION TO RETURN TO THIS FIELD /M028 CDFSRT=CDFLP /DEFINE INSTRUCTION TO CHANGE TO SORT FIELD /A028 CDISRT=CDILP /DEFINE INSTRUCTION TO CHANGE TO SORT FIELD /A028 /D028 /THE ALL PURPOSE ROUTINE FOR THE INSTRUCTIONS /D028 / /D028 CIDPAT, . /D028 DCA SAVEAC /SAVE THE AC AT ENTRY /D028 RAL; DCA SAVEL /AND THE LINK /D028 RIF /FIND THE INSTRUCTION FIELD /D028 TAD CDF0 /SAME AS 'TAD (CDF 0)' /D028 DCA CID /STORE THE MODIFIED INSTRUCTION FOR EXECUTION /D028 CID, . / CODE TO SET THE 'DATA FIELD' SAME AS 'INSTRUCTION FIELD' /D028 AC7776 / -2 FROM THE RETURN ADDRESS /D028 TAD CIDPAT /GET YOU THE ADDRESS OF THE CALLER /D028 DCA CID /SO AFTER ALL THAT SAVE IT /D028 AC7777 / -1 /D028 TAD I CID /GET THE ADDRESS OF THE CALLER /D028 DCA CID /STORE IT SO A EXIT CAN BE MADE FROM THE INTERNAL ROUTINE /D028 RIF /D028 TAD I CIDPAT /GET AND STORE THE GENERATED INSTRUCTION /D028 DCA I CID /D028 TAD SAVEL; CLL RAR /RESTORE LINK /D028 TAD SAVEAC /GET THE OLD CONTENTS OF THE AC /D028 JMP I CID /JUMP TO THE INSTRUCTION NOW CREATED /D028 SAVEAC, 0 /HOLDS THE AC AT ENTRY TO CIDPAT /D028 SAVEL, 0 /HOLDS THE LINK AT ENTRY TO CIDPAT / / / / / PZERR, ERR1 /STANDARD SPEC DOC ERROR MESSAGE PZNRM, ERR2 /MESSAGE OF SUCCESSFUL PARSING OF AT LEASE /ONE LINE OF SPEC DOC GIVING USER CHOICE OF /CONTINUING OR GOLD M ING OUT. OUTTMP, ZBLOCK 2 /Single character output store. /a031 NEGSPC, -40 /Negative ASCII value for space. /a031 CHR2VT, ZBLOCK 1 /Terminal output store /a031 PAGE BELL= 7 / BACKSP= 10 / LF= 12 / CR= 15 / /d0017 KVTWIDTH=121 / 81(10) IS THE WIDTH OF A LINE OF THE VT A12=X2 / auto index-register 12 A13=X3 / auto index-register 13 SREXT=20 /ADDED TO SIZE OF LIST DOC DURINGSIZING /m0017 MUISTR=MUBUF+MNIBUF ERR001= JMP I PZERR / 'GENERAL ERROR' CALL: ERR001 ERR002= JMP I PZNRM / 'ENOUGH FIELDS SPECIFIED' ERROR CALL: ERR002 ADRASM= 0 /THIS ASSEMBLES THE CREATE MODULE SO IT WILL NOT /TRY TO DISPLAY ERROR MESSAGES BUT SET THE AC FOR /A PARTICULAR MESSAGE SO WPSTPR DISPLAYS APPROPRIATE /MESSAGE ON CREATE ERROR /SORT START COMMAND CUSRCM, XX CLA /ZERO FILE NUMBERS FOR ERROR RECOVERY DCA SOTFL DCA SLSTFL DCA CUSRFO DCA ORDER DCA STATUS DCA DSKID /A007 CDFMNU TAD I (FNAMSP /THIS IS THE ADDRESS OF A BUFFER TO HOLD /THE DOCUMENT ADDRESS CDFMYF DCA CULFNM /STORE IT IN CULFMN /GET DISKETTE ID NUMBER /NOTE AC MUST BE 0 HERE TO ENSURE GTDKID READS SYSTEM FLOPPY JMS GTDKID /GO GET DISKETTE ID CIA /NEGATE DCA DSKNO /STORE IT IN DKSNO TAD DSKNO /GET IT BACK AND (777) /MASK OFF FIRST THREE BITS DCA DSKID /STORE FOR SORT M007 CUGSP, /PROMPT FOR SPEC DOC CLA /0 = ERASE FROM TOP OF SCREEN JMS ERASE JMS DCPRMT /GO DISPLAY PROMPT GSPEC /ADDRESS OF SPEC PROMPT CNRG /NULL ARGUMENT TO DISPLAY BLANK ON NEXT LINE A008 CDFMYF DCA STATUS /STORE AC IN STATUS -1 = NONEXISTENT DOCUMENT CDFMNU TAD I (MUBUF+MNFNO) /GET SPEC DRIVE & DOC NUMBER CDFMYF DCA CUSRFO /SAVE SPEC DOC AND DRIVE NUMBER TAD CULFNM /PATCH COPY COMMAND TO PICK UP STUFF DCA CUGSP1 JMS CUCOPY /COPY NAME TO OUR FIELD CUGSP1, 0 /ADDRESS OF FROM FOR CUCUPY CDFMNU /CDF FROM FIELD CUSSDN /ADDRESS TO RECEIVE SPEC DOC NAME CDFMYF /CDF TO FIELD STRLEN /NUMBER OF WORDS TO COPY (THIS IS STANDARD) TAD CUSRFO /GET SPEC FILE AND DRIVE NUMBER AND P377 /MASK OFF DOCUMENT NUMBER DCA CUSRC3 /SAVE DOCUMENT NUMBER FOR USER VERIFICATION MSG TAD CUSRFO /GET SPEC DOC FILE AND DRIVE NUMBER BSW;RTR /POSITION DRIVE NUMBER AND (17) /MASK OFF DRIVE NUMBER DCA CUSRC4 /SAVE DRIVE NUMBER TAD STATUS SMA CLA /-1 MEANS DOC DOESN'T EXIST NOTICE WE CLEAR AC HERE JMP GPARSE /IF NOT MINUS CONTINUE JMS NDERR CUSSDN /SPEC NAME CLA DCA STATUS /SET STATUS BACK TO 0 JMP CUGSP /ASK FOR SPEC DOC AGAIN /ALL THIS LOCK CODE IS HERE TO ENSURE USER DOESN'T SPECIFY RESULT DOC A007 /AS ANY OTHER DOC. BECAUSE OF SPACE LIMITATIONS I WILL DO AN EQUALITY A007 /TEST TO ENSURE LIST OR SPEC IS NOT OVERWRITTEN BY RESULT. THE 278 IS A007 /A SINGLE USER SYSTEM, THEREFORE THERE IS NO NEED FOR ALL THESE LOCKS. A007 /HERE WE GO TEST SPEC DOC FOR SYNTAX ERRORS GPARSE, TAD CUSRFO /PUT SPEC DRIVE AND DOC NUMBER INTO AC FOR PARSER JMS PARSE /GO CHECK SPEC DOC IF IS OK WE WILL CONTINUE IF NOT /RETURN TO MAIN MENU WITH ERROR MESSAGE /THIS ROUTINE IS A WAIT SO USER WILL SEE THE SPEC AS THE PARSER DISPLAYS IT AC7776 /SET AC TO -2 SO LOOP WILL ITERATE TWICE DCA WTCTR1 /SET WAIT COUNTER TO 0 DCA WTCTR /SET OUTER LOOP COUNTER TO 0 LOOP, CIFSYS /MAKE INSTRUCTION FIELD SYSTEM FIELD JSWAP / ISZ WTCTR /WHEN AC IS BACK TO 0 INCREMENT OUTER LOOP JMP LOOP /OTHERWISE LOOP ISZ WTCTR1 /INCREMENT OUTER LOOP IF ZERO CONTINUE JMP LOOP /OTHERWISE LOOP AGAIN CUSGL, /PROMPT FOR NAME OF LIST DOC CLA TAD CULFNM DCA CUSGL1 /PATCH COPY COMMAND TO PICK UP STUFF JMS ERASE /WILL ERASE ENTIRE SCREEN BECAUSE AC 0 IFDEF FRENCH < /A011 AC0001 /SET GLSTFG TO INDICATE /A011 DCA GLSTFG / THAT GLST TO BE DISPLAYED /A011 > / END IFDEF FRENCH /A011 JMS DCPRMT /CALL DISPLAY ROUTINE GLST /ADDRESS OF LIST DOC PROMPT CNRG /DISPLAYS BLANK ON NEXT LINE A008 CDFMYF DCA STATUS CDFMNU TAD I (MUBUF+MNFNO) /GET DRIVE AND DOC NUMBER CDFMYF / DCA SLSTFL /SAVE JMP PCUSG RETMNU, CDIMNU /RETURN TO MAIN MENU /M027 JMP I CUSRCM PCUSG, JMS CUCOPY CUSGL1, 0 /ADDRESS OF FROM FOR CUCOPY CDFMNU /CHANGE TO MENU DATA FIELD TO PICK UP CHAR STRING CUSLDN /ADDRESS TO RECEIVE LIST DOC NAME CDFMYF /CHANGE BACK TO MY DATA FIELD (FIELD TO COPY TO) STRLEN /NUMBER OF WORDS TO COPY (THIS IS STANDARD) TAD SLSTFL /GET LIST DOC FILE AND DRIVE NUMBER AND P377 /MASK OFF DOCUMENT NUMBER DCA CUSRC1 /SAVE DOCUMENT TAD SLSTFL /GET LIST DOC FILE AND DRIVE NUMBER BSW;RTR /POSITION DRIVE NUMBER AND (17) /MASK OFF DRIVE NUMBER DCA CUSRC2 /STORE AWAY TAD STATUS SMA CLA /CLEAR AC JMP CUSGR /IF POSITIVE DOC EXITST SO CONTINUE A007 JMS NDERR /ELSE GO TO NO DOCUMENT ERROR MSG CUSLDN /LIST DOC NAME CLA DCA STATUS /SET STATUS BACK TO 0 JMP CUSGL /DISPLAY PROMPT AGAIN STATUS, 0 /TELL NO DOC ERROR ROUTINE WHERE TO RETURN DSKNO, 0 /DISKETTE ID NUMBER WTCTR, 0 /THIS IS THE WAIT ROUTINE COUNTER WTCTR1, 0 /THIS IS WAIT ROUTINE COUNTER FOR OUTER LOOP CULFNM, 0 /ADDRESS OF BUFFER TO HOLD DOCUMENT ADDRESS CUSRFO, 0 IFDEF FRENCH < /A011 GLSTFG, 0 / SET WHEN GLST TO BE DISPLAYED /A011 > / END IFDEF FRENCH /A011 PAGE CUSGR, CLA /0 AC MEANS ERASE FROM TOP OF SCREEN JMS ERASE SRCUSRG,JMS DCPRMT /GO DISPLAY MESSAGE GRES /ADDRESS OF RESULT DOC PROMPT GRES2 /DISPLAYS SECOND LINE OF PROMPT CDFMYF /CHANGE DATA FIELD TO MINE DCA STATUS /STORE STATUS OF DOC (EXISTS OR NOT) CDFMNU /CHANGE DATA FIELD TO MENU TAD I (MUBUF+MNDRV) /GET RESULT DOC DRIVE CDFMYF /CHANGE DATA FIELD TO MINE DCA CUSRC6 /STORE JMS DDCHK /CHECK IF RESULT FLOPPY IS VALID DISKETTE JMP CUSGR /ERROR RETURN INVALID DISKETTE IS REPLACED /SO ASK FOR RESULT AGAIN TAD STATUS /DISKETTE IS VALID SO GO GET STATUS SPA CLA /SEE IF DOCUMENT EXISTS IF AC NEGATIVE JMP RESCRE /DOC DOESN'T EXIST SO GO CREATE IT CDFMNU /CHANGE DATA FIELD TO MENU FIELD TAD I (MUBUF+MNFNO);CDFMYF /ELSE GET DOC NUMBER DCA SOTFL /AND STORE IT JMS CUSGR1 /SEE IF RESULT DOC HAS BEEN PREVIOUSLY SPECIFIED A007 /NOTE AC IS 0 HERE TAD SOTFL /GET RESULT DOC NUMBER A007 CIA /NEGATE A007 TAD SLSTFL /GET NEGATIVE OF LIST DOC A007 SNA CLA /ARE THEY EQUAL? A007 JMS LCKMSG /IF YES DISPLAY ERROR MESSAGE A007 JMP TSTSPEC /CONTINUE ALSO OK RETURN FROM LCKMSG A007 JMP CUSGR /ERROR RETURN PROMPT FOR RESULT AGAIN A007 TSTSPEC,TAD SOTFL /GET RESULT DOC A007 CIA /NEGTATE A007 TAD CUSRFO /ADD SPEC DOC A007 SNA CLA /ARE THEY EQUAL A007 JMS LCKMSG /YES DISPLAY ERROR MESSAGE A007 JMP DTAO /NO CONTINUE THIS IS ALSO OK RETURN A007 /FROM LCKMSG A007 JMP CUSGR /ERROR RETURN PROMPT FOR RESULT AGAIN A007 /DOCUMENT EXISTS AND IS NOT IN USE SO DISPLAY TAO PROMPT DTAO, JMS ERASE /ERASE SCREEN A008 JMS DSORT /DISPLAY SORT CIFMNU JMS I IOACAL 0 DEXTS /ADDRESS OF TEXT STRING 205 /POSITION FIRST LINE ON SECOND ROW 5 COLUMN 305 505 705 1105 2305 JMS ORGOLD ORAR DTAOX, / /a025 AC0001 /SET AC TO 1 SO MENU WILL READ RESPONSE JMS READMU /READ INPUT FROM MENU MODULE JMP CUSR1 /GOLD M -- Return to MAIN Menu /a0019 /d0019 JMP CUSGR /GOLD M SO ASK FOR RESULT DOC AGAIN CDFMYF /CHANGE DATA FIELD TO MINE SMA CLA /IF AC NEGATIVE INAPPROPRIATE INPUT JMP STORE /IF APPROPRIATE CONTINUE JMS MVINPT /ELSE, COPY INPUT FROM MENU FIELD TO INBUF JMS NOMEAN /GO COMPLAIN ABOUT BAD INPUT /d025 JMP DTAO /ASK AGAIN /d025 JMP DTAOX / ask again /a025 /CALLED TO COPY RESULT DOC NAME FROM MENU FIELD AND ISOLATE DOC AND DRIVE /NUMBERS MADE INTO A SUBROUTINE SO IT CAN BE USED WHEN DOC EXISTS OR NOT CUSGR1, XX TAD CULFNM DCA CUSGR2 JMS CUCOPY CUSGR2, 0 /FROM FOR CUCOPY CDFMNU / CUSRDN /RESULT DOCUMENT NAME CDFMYF / STRLEN /SIZE OF DOCUMENT NAME FOR CUCOPY /NOTE CUCOPY RETURNS WITH AC 0 TAD SOTFL /GET RESULT DOC FILE AND DRIVE NUMBER AND P377 /MASK OFF DOCUMENT NUMBER DCA CUSRC5 /SAVE DOC NUMBER TAD SOTFL /GET RESULT DOC FILE AND DRIVE NUMBER BSW;RTR /POSITION DRIVE NUMBER AND (17) /MASK OFF DRIVE NUMBER DCA CUSRC6 /SAVE DRIVE NUMBER DCA STATUS /CLEAR STATUS VARIABLE JMP I CUSGR1 /RETURN /THIS ROUTINE IS CALLED BY ROUTINES WHICH PROCESS SPEC, INPUT DOCUMENT AND /RESULT DOCUMENT NAMES. /CALLED BY / JMS DCPRMT / ADDRESS OF PROMPT TO DISPLAY / ADDRESS OF SECOND LINE OF PROMPT, IS NULL (BLANK) FOR SPEC / AND LIST DOC, TEXT FOR RESULT DOC / RETURN WITH AC CONTAINING VALUE OF MNTMP3 / DATA FIELD SET TO MENU FIELD DCPRMT, XX CLA /CLEAR AC TAD I DCPRMT /GET FIRST PARAMETER PROMPT TO DISPLAY DCA WHCDOC /STORE IT ISZ DCPRMT /GET READY TO GET NEXT PARAMETER TAD I DCPRMT /GET SECOND LINE OF PROMPT, IS NULL (BLANK) FOR /SPEC AND LIST PROMPT BUT FOR RESULT CONTAINS /SECOND LINE OF PROMPT DCA WHC2ND /STORE ISZ DCPRMT /INCREMENT DCPRMT FOR RETURN DCPRM1, JMS DSORT CIFMNU JMS I IOACAL 0 SPRMPT 1505 LOC, 7777 /WILL DISPLAY PROMPT ON SAME LINE AS ABOVE PROMPT WHCDOC, 0000 CIFMNU JMS I IOACAL 0 WHC2ND, 0000 /SECOND LINE OF PROMPT 1605 /POSITION OF SECOND LINE JMS PRETURN JMS ORGOLD ORAR CLA /SET AC TO MENU WILL READ INPUT JMS READMU /PROCESS INPUT FROM MENU JMP CUSR1 /RETURN TO MM JMP I DCPRMT /GO BACK AND PROCESS INPUT NOTE DATA FIELD /STILL SET TO MENU FIELD PAGE RESCRE, CDFMNU /CHANGE DATE FIELD DO MENU TAD I (MUBUF+MNDRV) /NOTE AC 0 HERE, GET DRIVE NUMBER OF DOC /USER SPECIFIED CDFMYF /CHANGE DATA FIELD BACK TO MINE DCA CUSRC6 /STORE IN RESULT DRIVE NUMBER JMS TSTSZ /TEST IF THERE IS ROOM TO CREATE DOC JMP SMDRVS /ERROR RETURN GO PROCESS SIZE ERROR CLA CLL TAD DSKID /GET DSKID M007 AND (4777) /CLEAR BITS 1 AND 2 IN CASE THEY ARE DCA DSKID /SET FROM PREVIOUS RESULT DOC M007 CLL /THERE IS ENOUGH ROOM SO CONTINUE CLEAR LINK AC0003 /SET FOR OVERWRITE RTR RTR /MOVE TO BITS 2 AND 2 CDFMYF TAD DSKID /COMBINE WITH CONTENTS OF DSKID M007 DCA DSKID /STORE M007 JMS ADRCRT /CREATE THE OUTPUT DOCUMENT JMP CRERR /ERROR ON CREATE, PROCESS DCA SOTFL /STORE IN DOC NUMBER IN SOTFIL JMS CUSGR1 /GO COPY DOC NAME AND ISOLATE DOC AND DRIVE #S /NOTE AC MUST BE 0 HERE TO ENSURE RESULT DOC /IN SIZE TESTING ROUTINE EQUALS ZERO /BECAUSE WE ARE NOT OVERWRITING THE RESULT JMP CUSGO /CONTINUE CRERR, CLA /CLEAR AC TAD ERSTAT /GET ERROR STATUS FROM CREATE SNA /IF AC 0 JMP STMSG /DISPLAY SHORT MESSAGE TAD (7776) /ELSE ADD -2 TO SEE IF AC = 2 SZA CLA /AC =2? JMP WRGMSG /DISPLAY WRONG DOC NUMBER MESSAGE JMP NSPCMSG /ELSE MUST BE A 2 DISPLAY NO SPACE FOR DOC MESSAGE STMSG, TAD (CNRG) /GET NO DISPLAY ARGUMENT JMP CREMSG /GO TO DISPLAY CREATE ERROR MESSAGE WRGMSG, TAD (WNUM) /GET WRONG DOCUMENT NUMBER ARGUMENT JMP CREMSG /GO TO DISPLAY CREATE ERROR MESSAGE NSPCMSG,TAD (NMDC) /GET NO DOCUMENTS AVAILABLE ARGUMENT JMP CREMSG /GO TO DISPLAY CREATE ERROR MESSAGE CREMSG, DCA CRMSG /STORE APPROPRIATE MESSAGE ARGUMENT FOR DISPLAY CRMSG1, JMS ERASE JMS RBELL JMS DSORT /DISPLAY SORT ON FIRST LINE /A008 CIFMNU JMS I IOACAL 0 CNTCRE /DISPLAY CANNOT CREATE DOCUMENT 1505 /ON LINE 15 COLUMN 5 CIFMNU JMS I IOACAL 0 CRMSG, 0000 /DISPLAY DOC # OUT OF RANGE, OR NO MORE DOCS 1605 CIFMNU /CHANGE INSTRUCTION FIELD TO MENU JMS I IOACAL /CALL IOA A008 0 / A008 TARTN /DISPLAY PRESS RETURN TO TRY ANOTHER NAME A008 2005 /LINE TO DISPLAY A008 JMS ORGOLD /DISPLAY PRESS GOLD M A008 ORAR /DISPLAY OR M008 JMS KBRD /READ INPUT HANDLE GOLD KEYS D008 JMP CUSGR /RETURN WAS TYPED SO REQUEST RESULT AGAIN A008 STORE, CLA CLL /CLEAR LINK AND AC TAD DSKID /GET DSKID M007 AND (4777) /CLEAR BITS 1 AND 2 IN CASE THEY WERE SET /PREVIOUSLY WHEN RESULT WAS SPECIFIED DCA DSKID /STORE BACK M007 CDFMNU /CHANGE DATA FIELD TO MENU FIELD CLA CLL TAD I (MUBUF+MNTMP1) /GET INPUT CDFMYF /CHANGE BACK TO MY DATA FIELD RTR / RTR /MOVE INPUT TO BITS 1 AND 2 TAD DSKID /STORE IN DSKID M007 DCA DSKID / M007 CDFMNU /CHANGE DATA FIELD TO MENU FIELD TAD I (MUBUF+MNTMP1) /GET INPUT AGAIN CDFMYF /CHANGE DATA FIELD TO MINE CLL RAR /SEE IF WE ARE OVERWRITING /0 = ADD TO TOP /1 = ADD TO BOTTOM /3 = OVERWRITE (NOTE THESE ARE BINARY NUMBERS) /IF OVERWRITING AC NOT 0 SNA CLA /CONTINUE IF AC IS NOT EQUAL TO 0 JMP CLTSTSZ /GO TO TEST SIZE /ELSE TAD SOTFL /GET SIZE OF RESULT FILE CIFFIO /SET INSTRUCTION FIELD TO MENU /M0010 FILEIO / /M0010 XRDFIN CDFFIO /CHANGE DATA FIELD TO FILEIO /M0010 TAD I (RDFSIZ) /GET SIZE OF RESULT FILE CDFMYF /CHANGE DATA FIELD BACK TO MINE CLTSTSZ,JMS TSTSZ /GO TO TSTSZ WITH SIZE OF RESULT DOC IN AC JMP SMDRVS /ERROR RETURN CONTINUE SIZE ERROR HANDLING JMP CUSGO /OK RETURN CONTINUE /RTNWT MOVED HERE BECAUSE OF SPACE REASONS M007 / THIS ROUTINE READS INPUT IN RESPONSE TO ERROR MESSAGES WHICH REQUEST A RETURN / WHEN "RETURN" IS TYPED RETURN TO USER IF NOT RING BELL AND COMPLAIN AGAIN / called by: JMS RTNWT; WRONG RETURN; OK RETURN RTNWT, XX CIFMNU / JMS I INACAL / INBUF / INPUT BUFFER TO RECEIVE INPUT JMP .-3 / /a025 /d025 JMP WRNG / GOLD KEY RING BELL COMPLAIN AGAIN /a025 CLA MQA / MQ HAS # OF CHARS IF NOT 0 THEN NOT RETURN SZA CLA / SEE IF IT IS 0 JMP WRNG / IF NOT RETURN RING BELL COMPLAIN AGAIN ISZ RTNWT / MUST BE RETURN SO INCREMENT FOR OK RETURN JMP I RTNWT / RETURN TO CALLER WRNG, JMS RBELL / RING BELL JMP I RTNWT / RETURN TO CALLER TO COMPLAIN AGAIN PAGE /IF CALLED WITH ZER0 IN AC THIS ROUTINE CHECKS SIZE OF SPACE ON RESULT /FLOPPY AGAINS SIZE OF INPUT FLOPPY + 8 BLOCKS /OTHERWISE AC CONTAINS SIZE OF RESULT DOC TO ADD TO FREESPACE ON RESULT /FLOPPY WHEN OVERWRITING THE RESULT DOC /IF THERE IS ENOUGH SPACE ON RESULT FLOPPY TO ACCOMMODATE OUTPUT PROGRAM /CONTINUES. /WHEN THERE IS NOT ENOUGH SPACE ON RESULT FLOPPY DISPLAYS ARE DETERMINED /AS FOLLOWS: /IF INPUT AND OUTPUT ARE THE SAME, USER IS ASKED TO SPECIFY ANOTHER DRIVE /FOR OUTPUT AND IS RETURNED TO THE PROMPT FOR THE RESULT DOCUMENT SO /APPROPRIATE VALIDLITY TESTS ARE PERFORMED. /IF INPUT IS DRIVE 0 AND OUTPUT IS DRIVE 1 USER IS ASKED TO REPLACE /DISKETTE AND RESPECIFY RESULT DOCUMENT AS ABOVE. /IF OUTPUT AND ARE DIFFERENT AND OUTPUT IS DRIVE 0 USER IS ASKED TO /REMOVE SYSTEM FLOPPY TSTSZ, XX DCA FRESPCE /STORE RESULT DOC SIZE OR 0 DEPENDING HOW CALLED TAD SLSTFL /PUT INPUT DRIVE AND DOC NUMBER INTO AC CIFFIO /CALL RFDL TO OPEN INTPUT DOC /M0010 FILEIO / /M0010 XRDFIN CDFFIO / /M0010 TAD I (RDFSIZ) /GET SIZE OF LIST DOC CDFMYF /CHANGE TO MY DATA FIELD DCA LSTSIZ /STORE IN MY FIELD TAD CUSRC6 /TAD RESULT DRIVE NUMBER JMS CUPDRS /SET DRIVE NUMBER FOR QURX TAD (RXESP /GET SPACE LEFT ON DISKETTE DCA QUQBLK+RXQFNC JMS QURX CLA /THIS ERASES ANY ERROR RETURN FROM QURX TAD QUQBLK+RXQSPC /GET FREE SPACE ON RESULT FLOPPY TAD FRESPCE /ADD RESULT DOC SIZE (OR 0 FOR T, A, OR CREATE) DCA FRESPCE /STORE TAD (SREXT) /THIS IS EXTRA SPACE REQUIRED IF DOC IS TO BE /EDITED AFTER SORT TAD LSTSIZ /ADD THE SIZE OF INPUT DOC CIA /NEGATE TAD FRESPCE /ADD FREE SPACE SPA CLA /IF RESULT IS NEGATIVE INPUT IS GREATER THAN JMP I TSTSZ /SPACE AVAILABLE ON FLOPPY ERROR RETURN ISZ TSTSZ /ELSE THERE IS ENOUGH SPACE INCREMENT FOR OK RETURN JMP I TSTSZ ERSTAT, 0000 /TYPE OF CREATE ERROR MESSAGE TO DISPLAY /0 = GENERAL CANNOT CREATE /1 = DOC # OUT OF RANGE /2 = NO DOCS AVAILABLE LSTSIZ, 0 /SIZE OF INPUT FILE FRESPCE,0 /SIZE OF RESULT FILE 0 WHEN ADDING TO TOP, BOTTOM OR CREATING /THE RESULT DOC AND THE SIZE OF THE RESULT DOCUMENT WHEN /OVERWRITING. THIS PROGRAM ALSO ADDS THE AMOUNT OF FREE SPACE /ON THE RESULT FLOPPY WHEN COMPUTING SIZING / IF GLST (FRENCH) HAS JUST BEEN DISPLAYED, DSPACC IMBEDS AN ACCENTED a /A011 / (^Z 141) ONTO THE SCREEN WITHIN GLST. THIS COULD NOT BE DONE NORMALLY /A011 / BECAUSE GLST IS A ^S ARGUMENT ITSELF. /A011 IFDEF FRENCH < /A011 DSPACC, XX /A011 CLA /A011 TAD GLSTFG /A011 SNA CLA / HAS GLST BEEN DISPLAYED ? /A011 JMP I DSPACC / NO, SO RETURN /A011 DCA GLSTFG / YES, CLEAR GLSTFG UNTIL NEXT DISPLAY /A011 CIFMNU / AND DISPLAY ACCENTED CHAR /A011 JMS I IOACAL /A011 0 /A011 ACCHAR /A011 1536 / CURSOR POS /A011 141 / ACCENTED a /A011 JMP I DSPACC / RETURN /A011 ACCHAR, TEXT '^P^Z' / STRING USED TO DISPLAY ACCENTED a /A011 > / END IFDEF FRENCH /A011 /**************************************************************************** / / The OUT2VT routine, which displays characters on the terminal has /a031 / been moved here to make room for the changes associated with outputing/a031 / multinational and technical characters. /a031 / /**************************************************************************** OUT2VT, XX / The moved output to terminal routine /m031 DCA CHR2VT / Save the character to be displayed /m031 TAD CHR2VT / Check for right away /m031 TAD (-CR) / /m031 SNA CLA / Is it an end dead char (CR)? /a031 JMP OU2LIV / Yes, tidy up after dead key sequence. /a031 TAD DEADKEY / No, check for in dead key sequence. /m031 SZA CLA / Are we in dead key sequence? /m031 JMP INDEAD / Yes, deal with the character. /a031 TAD CHR2VT / No. /m031 TAD (-BACKSP) / Check for a . /m031 SNA / Was it a start of dead character (BS)?/m031 JMP OU2DOA / Yes, start of dead key sequence. /a031 TAD (BACKSP-LF) / No, test for line feed. /m031 SZA CLA / Is it an LF? /m031 JMP NOTEOL / No, jump round handler. /m031 JMS NEWLN / Output a CR-LF. /m031 VTEXIT, TAD CHR2VT / Get back the character /m031 JMP I OUT2VT / Return /m031 NOTEOL, TAD CHR2VT / Output the character passed to the /a031 OU2ANY, JMS OUTCHR / routine origionally in the AC /a031 JMP VTEXIT / and return with it in AC /a031 OU2DOA, AC7777 / Set the dead key flag /a031 DCA DEADKEY / /a031 JMP VTEXIT / Get the character back and return /a031 /**************************************************************************** / / The following code handles dead key sequences found in the /a031 / sort specification document. Technical and multinational /a031 / characters are now displayed using the correct character sets /a031 / and user dead key sequences are depicted by the conventional /a031 / blot rather than the +/- symbol previously used. /a031 / /**************************************************************************** INDEAD, ISZ DEADKEY / This peice of code is used for each /a031 / character in the dead key sequence /a031 / Is this the first char in the sequence?/a031 JMP INDNOT1 / No, deal with others. /a031 ISZ DEADKEY / Yes, set the dead key flag again /a031 TAD CHR2VT / No, get the character. /a031 TAD NEGSPC / Test for space character. /a031 SNA CLA / Is it a space? /a031 JMP VTEXIT / Yes, accept and forget it. /a031 CIFMNU / No, output the escape sequence to send/a031 JMP I IOACAL / a blot to the screen /a031 0 / /a031 ASTRING / /a031 ASDK / /a031 AC4000 / Set the top bit of the dead key flag /a031 DCA DEADKEY / to indicate a user dead key that /a031 JMP VTEXIT / requires no further processing /a031 INDNOT1,TAD DEADKEY / Check the top bit of the flag for user/a031 SPA / Is this a user dead key sequence? /a031 JMP VTEXIT / Yes, ignore all further characters /a031 CLL RTR / No, test for the 2nd char in sequence /a031 SZA / Is this the 2nd character? /a031 JMP OU2DCH / No, it's a later one /a031 TAD CHR2VT / Yes, get it. /a031 TAD NEGSPC / Test for a GOLD space. /a031 SNA / Is it a GOLD space? /a031 JMP GLDSPC / Yes, deal with it. /a031 TAD (-23) / No, test character set specifier /a031 SNA / Is it a technical character? /a031 JMP OU2DTC / Yes, go send an SS3 /a031 IAC / Test for multinational character set /a031 SNA CLA / Is it multinational? /a031 JMP OU2DMC / Yes, output an SS2 /a031 JMP OU2DLC / No, is line drawing, so output SO /a031 OU2DTC, AC0001 / Build value 217 for technical char /a031 OU2DMC, TAD (200) / Build value 216 for multinational char/a031 OU2DLC, TAD (16) / Build value 16 for a line drawing char/a031 JMP OU2ANY / Output the built value to the screen /a031 OU2DCH, CLL RAL / Check that this is the 3rd character /a031 SZA CLA / Is this the 3rd character? /a031 JMP VTEXIT / No, exit /a031 JMP NOTEOL / Yes, print it /a031 GLDSPC, AC4000 / Deal with GOLD spaces. Is not dead key/a031 DCA DEADKEY / sequence, so set flag to ignore rest /a031 JMP NOTEOL / Display the space /a031 OU2LIV, DCA DEADKEY / Turn off the deadkey flag /a031 TAD (17) / Output SI when dead key finishes /a031 JMP OU2ANY / clean up after line drawing set mode /a031 OUTCHR, XX / Routine to display the character in AC/a031 DCA OUTTMP / Save the character /a031 CIFMNU / Change to the menu field /a031 JMS I IOACAL / to use IOA for character output /a031 0 / /a031 ASTRING / /a031 OUTTMP / /a031 JMP I OUTCHR / Return /a031 DEADKEY,ZBLOCK 1 / Dead key flag /m031 PAGE /SEE IF INPUT AND OUTPUT DOCS ARE IN SAME DRIVES SMDRVS, TAD CUSRC2 /GET INPUT DRIVE NUMBER CIA /NEGATE TAD CUSRC6 /RESULT DRIVE NUMBER SZA CLA /IF THEY ARE EQUAL TELL USER TO SPECIFY ANOTHER DRIVE JMP DKTST /OTHERWISE SEE IF 4 DRIVE SYSTEM M007 NDPRMT, JMS ERASE JMS TOSMALL /TELL USER THERE IS NOT ENOUGH ROOM FOR RESULT CIFMNU JMS I IOACAL 0 NWDRV /TEXT TELLING USER TO SPECIFY ANOTHER DRIVE 1205 /DISPLAY NEXT PROMPT ON LINE 12 COLUMN 5 NWSTR, 0000 / ADDR OF SUBSTRING /A030 JMP SRCUSRG /GO PROMPT FOR RESULT DOC AGAIN DKTST, CDF 0 /CHANGE DATA FIELD TO SYSTEM FIELD A007 TAD I (RXONLN) /GET NUMBER OF DISKETTES ON LINE NOTE AC IS ZERO A007 CDFMYF /CHANGE DATA FIELD BACK TO MINE A007 TAD (-4) /SEE IF IT IS 4 A007 SNA CLA /IF THERE OR 4 RX'S ON LINE A007 JMP NDPRMT /DISPLAY SPECIFY ANOTHER DRIVE A007 /OTHERWISE FALL THROUGH A007 /DRIVES ARE DIFFERENT AND THIS IS 2 DRIVE SYSTEM /SEE IF INPUT DRIVE IS 0 DFDRVS, TAD CUSRC6 /GET OUTPUT DRIVE NUMBER SNA CLA /IF IT IS NOT ZERO GO TO REPLACE DISKETTE ROUTINE JMP OUTPT0 /IF IT IS ZERO TELL USER TO REPLACE SYSTEM DISKETTE JMP DFMSG DFMSG, JMS PTRCHK /MAKE SURE NOTHING IS PRINTING. IF PRINTING USER /IS RETURNED TO THE MAIN MENU OF NOT CONTINUE JMS ERASE JMS TOSMALL /TELL USER THERE IS NOT ENOUGH ROOM FOR RESULT CIFMNU JMS I IOACAL 0 RPLACE /ASK USER FOR NEW DISKETTE FOR RESULT DOC 1205 /DISPLAY REPLACE PROMPT ON LINE 12 COLUMN 5 1305 /DISPLAY SECOND LINE ON LINE 13 COLUMN 5 JMP SRCUSRG /DISKETTE OK NOW PROMPT FOR RESULT DOC AGAIN OUTPT0, JMS PTRCHK /MAKE SURE USER IS NOT PRINTING IF SO RETURN TO MM /ELSE CONTINUE OT0MSG, JMS ERASE JMS TOSMALL /TELLS USER THERE IS NOT ENOUGH ROOM FOR RESULT CIFMNU JMS I IOACAL 0 RMOVE0 /ASK USER FOR NEW DISKETTE FOR RESULT DOC 1205 /DISPLAY REPLACE PROMPT ON LINE 12 COLUMN 5 1305 /DISPLAY SECOND LINE ON LINE 13 COLUMN 5 JMP SRCUSRG /GO BACK AND PROMPT FOR RESULT DOC AGAIN CUSGO, JMS ERASE /ERASE SCREEN A008 JMS DSORT /GO DISPLAY SORT CIFMNU /CHANGE TO MENU FIELD JMS I IOACAL /OUTPUT WHAT WE THINK THINGS ARE 0 CUSR1A /ADDRESS OF OUTPUT STRING 105 /TEXT TO DISPLAY ON 1 LINE 5 COLUMN 5 IFDEF CANADA <141> CUSRC2, 0 /DRIVE NUMBER OF LIST DOC CUSRC1, 0 /DOCUMENT NUMBER OF LIST DOC CUSLDN /LIST DOCUMENT NAME 205 /TEXT TO DISPLAY ON LINE 2 COLUMN 5 CUSRC4, 0 /SPEC DRIVE NUMBER CUSRC3, 0 /SPEC DOC NUMBER CUSSDN /SPEC DOCUMENT NAME 305 /TEXT TO DISPLAY ON LINE 3 COLUMN 5 CUSRC6, 0 /RESULT DRIVE NUMBER CUSRC5, 0 /RESULT DOC NUMBER CUSRDN /RESULT DOCUMENT NAME 405 NUMKEY /NUMBER OF KEY FIELDS WE WILL SORT ON CIFMNU JMS I IOACAL 0 TYPGO /TEXT STRING TYPE GO TO BEGIN SORT 1505 JMS PRETURN /AND PRESS RETURN JMS ORGOLD /OR PRESS GOLD M ORAR CUSGO1, /A029 AC0002 /SET AC TO 2 SO MENU WILL PROCESS GO PROMPT JMS READMU JMP CUSR1 /RETURN TO MM CDFMYF /SET DATA FIELD TO MY FIELD SPA CLA /TEST FOR NEGATIVE AC JMP GNMEAN /IF NEGATIVE RESPONSE WAS INAPPRIPRIATE SO COMPLAIN /ELSE CONTINUE / /A015 / IF THE OPERATOR SPECIFIED 'O' TO OVERWRITE THE OUTPUT DOCUMENT /A015 / THEN WE MUST DELETE ALL DOCUMENT BLOCKS FROM THE ALLOCATION BLOCK /A015 / ASSOCIATED WITH THAT OUTPUT DOCUMENT /A015 / OTHERWISE THE SORT COULD RUN OUT OF 'SCRATCH' DISK SPACE /A015 / AND A 'DISK ERROR UNIT n' WOULD OCCUR /A015 / /A015 TOSORT, TAD (3000) / /A015 AND DSKID / mask the 'T', 'B', AND 'O' MODE /A015 TAD (-3000) / /A015 SZA CLA / SKIP NEXT IF 'O' /A015 JMP SORT / JMP BECAUSE 'T' OR 'B' /A015 TAD SOTFL /that / OUTPUT DOCUMENT # AND DRIVE # /A015 MQL /is / INTO THE MQ FOR THE 'XDSKIN' /A015 AC7777 /all / -1 MEANS SET FOR 'OVERWRITE' /A015 CIFFIO /there / /A015 FILEIO /is / OPEN the document /A015 XDSKIN /to / /A015 CIFFIO /it / /A015 FILEIO /boo- / CLOSE the document /A015 XDSKCL /bie / /A015 SORT, CDFSRT /CHANGE TO SORT FIELD TAD I (PARSELIST) /GET THE ADDRESS OF SELECTER ROUTINE DCA T1 /STORE IT IN T1 CDFMYF TAD CUSRCM /TO PASS THE RETURN POINT IN AC TO SELECTOR CDISRT /INSTRUCTION FIELD TO SORT FIELD DCA MMRETURN /STORE IN A LOCATION IN SORT FIELD JMP I T1 /JUMP TO SELECTER GNMEAN, JMS MVINPT /COPY INPUT FROM MENU TO INBUF JMS NOMEAN /COMPLAIN ABOUT INCORRECT INPUT JMP CUSGO1 /ASK AGAIN /C029 PAGE /ROUTINES TO DISPLAY COMMON PROMPTS ON THE SCREEN DSORT, XX CIFMNU JMS I IOACAL 0 SRT 0 JMP I DSORT /CALLED BY JMS ORGOLD / VALUE FOR FIRST WORD ARGUMENT (EITHER ORAR FOR OR PRESS GOLD / M OR NARG FOR PRESS GOLD M) ORGOLD,XX /DISPLAYS (OR) PRESS GOLD M TO RECALL MENU CLA TAD I ORGOLD DCA FWARG /STORE ARGUMENT IN FIRST WORD ARGUMENT ISZ ORGOLD /NOTE AC MUST BE 0 HERE TO ENSURE GTDKID WILL READ SYSTEM FLOPPY JMS GTDKID /READ SYSTEM DISKETTE ID TAD DSKNO /ADD TO PREVIOUS ID # SZA CLA /IF EQUAL SYSTEM DISKETTE HAS NOT BEEN REMOVED JMP SDOUT /AC NOT 0 SYSTEM DISKETTE WAS REMOVED OGOLD1,CIFMNU JMS I IOACAL 0 DOGM /ADDRESS OF OR TYPE GOLD M TO RECALL MENU 2505 /POSITION OF LINE FWARG, 0 /FIRST WORD OF PROMPT EITHER "OR" OR " " JMP I ORGOLD /RETURN TO CALLER SDOUT, /THIS IS TO SEE OF GOLD M MESSAGE IS DISPLAYED WITH /OR OR NOT IF IT IS THEN REPLACE MESSAGE WILL BE /ALSO PRECEDED WITH AN OR ALSO TAD FWARG /GET CONTENTS OF FWARG CIA /NETATE IT TAD (NARG) /SEE IF IT IS NARG SZA CLA /IF IT IS CONTINUE JMP CHARG /IF NOT NARG CHANGE FIRST WORD OF REPLACE MESSAGE TAD (NARG) /IF NARG SET FIRST WORD ARGUMENT OF REPLACE MESSAGE TO DCA SDFW /NULL SDOUT1, TAD (AARG) /PUT ARGUMENT FOR AND IN FIRST WORD ARGUMENT OF GOLD DCA FWARG /M PROMPT SO WILL DISPLAY AND PRESS GOLD M JMS RSDSK /GO DISPLAY REPLACE SYSTEM DISK PROMPT JMP OGOLD1 /GO DISPLAY AND PRESS GOLD M CHARG, TAD (ORAR) DCA SDFW /MAKE OR FIRST WORD OF REPLACE MESSAGE JMP SDOUT1 /VERIFIES USER INSERTS INITIALIZED DOCUMENT FLOPPY INTO DRIVE WHEN /REPLACING A FLOPPY DUE TO SPACE PROBLEMS /CALLED BY JMS DDCHK;ERROR RETURN;OK RETURN /AC 0 ON RETURN DDCHK, XX DDCHK1, JMS ERASE CLA TAD CUSRC6 /MAKE AC EQUAL TO RESULT DRIVE /SO GTDKID READS FLOPPY IN APPROPRIATE DRIVE JMS GTDKID /READ HOME BLOCK INTO CUB1 CLA CLL /GTDKIT RETURNS WITH DISKETTE ID IN AC SO CLEAR / TAD CUB1+0 /GET WORD 0 OF HOME BLOCK /D014 / TAD (-7401) /ADD NEGATIVE OF VALUE IT SHOULD BE /D014 / SZA CLA /IF 0 CONTINUE CHECK /D014 / JMP DDERR /ELSE TELL USER DISKETTE IS NOT VALID /D014 / TAD CUB1+1 /GET WORD 1 (BLOCK TYPE) OF HOME BLOCK /D014 / AND (0070) /ISOLATE BITS 6-8 /D014 / CLL RTR /CLEAR LINK AND /D014 / RAR /MOVE TO BITS 9-11 /D014 / TAD (-3) /ADD NEGATIVE OF VALUE IT SHOULD BE /D014 / SZA CLA /IF 0 CONTINUE CHECKING /D014 / JMP DDERR /ELSE TELL USER DISKETTE IS NOT VALID /D014 TAD CUB1+6 /GET BLOCK NUMBER OF HOME BLOCK TAD (-DLALOC) /ADD NEGATIVE OF VALUE IT SHOULD BE SZA CLA /IF 0 RETURN TO USER JMP DDERR /ELSE TELL USER DISKETTE IS NOT VALID ISZ DDCHK /INCREMENT FOR OK RETURN TAD (500) /ERASE SCREEN JMS ERASE /BEFORE CONTINUING CLA DCHKXT, JMP I DDCHK /RETURN AND CONTINUE DDERR, JMS ERASE JMS DSORT JMS DERCKW / CHECK FOR WINCHESTER DRIVE /A030 CIFMNU JMS I IOACAL 0 DERR / INVALID DISKETTE MESSAGE 505 DERST1, 0000 / ADDR OF SUBSTRING - SET BY DERCKW /A030 CUSRC6 / RESULT DOC DRIVE NUMBER DERST2, 0000 / ADDR OF SUBSTRING - SET BY DERCKW /A030 605 DERST3, 0000 / ADDR OF SUBSTRING - SET BY DERCKW /A030 JMS PRETURN JMS ORGOLD ORAR JMS KBRD /READ INPUT CLA /USER PRESSED RETURN SO TAD (RXERT /TO TELL SYSTEM TO FORGET INDEX INFORMATION DCA QUQBLK+RXQFNC /BECAUSE USER WILL PUT IN NEW FLOPPY JMS QURX CLA /THIS ERASES ANY ERROR RETURN FROM QURX JMP DCHKXT /USER PRESSED RETURN GO ASK FOR RESULT AGAIN PAGE /DISPLAYS THAT RESULT DOC IS ALREADY IN USE. /CALLED BY / JMS LCKMSG / NON ERROR RETURN CONTINUES / ERROR RETURN PROMPTS FOR RESULT AGAIN /TEST FOR REMOVAL OF SYSTEM FLOPPY, IF IT HAS BEEN REMOVED SURPRESS LOCK ERROR /MESSAGE BECAUSE DOCUMENTS ARE NOT THE SAME LCKMSG, XX /M007 JMS GTDKID /GET DISKETTE ID NOTE AC 0 HERE A007 TAD DSKNO /GET CURRENT SYSTEM DISKETTE ID A007 SZA CLA /HAS DISKETTE BEEN REMOVED A007 JMP LOKRTN /YES RETURN TO CALLER WITHOUT DISPLAYING ERROR A007 /ELSE DISPLAY LOCK ERROR MESSAGE TAD (2205) /ERASE GOLD M PROMPT JMS ERASE CIFMNU JMS I IOACAL 0 SRLCKER /TEXT STRING DOC ALREADY IN USE 2205 IFDEF FRENCH < 141 > /L.G.A. BELTXT /RING BELL CUSRC6 /RESULT DOC DRIVE NUMBER M007 CUSRC5 /RESULT DOC NUMBER M007 CUSRDN /RESULT DOC NAME M007 CIFMNU JMS I IOACAL 0 TARTN 2405 JMS RTNWT /READ INPUT AND WAIT FOR RETURN JMP LCKMSG /IF NOT RETURN REDISPLAY COMPLAINT TAD (2205) /RETURN WAS TYPED ERASE COMPLAINT JMS ERASE ISZ LCKMSG /INCREMENT FOR ERROR RETURN LOKRTN, JMP I LCKMSG /RETURN TO CALLER /CALLED BY JMS GMTST;GOLD M;GOLD KEY NOT GOLD M GMTST, XX /TEST IF KEY IN GOLD KEY. IF GOLD M GOES TO MM /IF GOLD KEY NOT GOLD M DISPLAYS WHEN TYPING TO MENU /ERROR MESSAGE. ASSUMES THAT CHARACTER IS IN AC GMTST1, TAD (-EDMENU) /SEE IF GOLD M SNA CLA /IF AC = 0 JMP CHKIT /GO SEE IF SYSTEM FLOPPY IS IN /ELSE RING BELL AND OUTPUT WHEN TYPING TO MENU ERROR /MESSAGE GMERDSP, / /d025 TAD (2205) /ERASES BEFORE DISPLAYING NEXT /d025 /d025 JMS ERASE / /d025 JMS RBELL / /d025 CIFMNU / /d025 /d025 JMS I IOACAL / /d025 /d025 0 / /d025 /d025 TRYAGN / /d025 /d025 2205 / /d025 /d025 2305 / /d025 /d025 2405 / /d025 /d025 IFDEF FRENCH < 153 > /L.CLFX.E /d025 /d025 2605 / /d025 /d025 IFDEF CANADA < 141 > /L.G.A. /d025 /d025 IFDEF FRENCH < 141 > /L.G.A. /d025 /d025 JMS RTNWT /WAIT FOR RETURN /d025 /d025 JMP GMERDSP /NOT RETURN DISPLAY COMPLAINT AGAIN /d025 /d025 TAD (2205) /ERASE SCREEN, RETURN TO CALLER, ASK AGAIN /d025 /d025 JMS ERASE / /d025 GMRTN2, ISZ GMTST /GOLD KEY NOT GOLD M RETURN GMRTN1, JMP I GMTST /GOLD M RETURN CHKIT, /AC MUST BE 0 HERE TO ENSURE GTDKID READS SYSTEM FLOPPY JMS GTDKID /GO READ DISKETTE ID TAD DSKNO /ADD CURRENT DISKETTE ID SNA CLA /IF ZERO SAME DISKETTE IS IN SO JMP GMRTN1 /SET FOR GOLM RETURN JMS RBELL /ELSE RING BELL JMS RSDSK /FLASH REPLACE SYSTEM FLOPPY DISPLAY CDFMYF CIFMNU JMS I INACAL INBUF JMP GMTST1 JMS RBELL JMP CHKIT / SUBROUTINE TO DISPLAY: 'TYPING "" HAS NO MEANING HERE' / CALLED BY: JMS NOMEAN; RETURN PC (and read input again) NOMEAN, XX / COSMETIC display mods /M0018 NOMNDSP,JMS RBELL / RING BELL /d025 /d025 IFDEF ENGLSH < /A011 /d025 CLA / TRUNCATE STUFF BETWEEN QUOTES /A011 /d025 DCA I (INBUF+14)/ SO MESSAGE WILL FIT ON 1 LINE /A011 /d025 / end 'ifdef english' /A011 > /d025 /d025 IFDEF FRENCH < /A011 /d025 CLA /A011 /d025 DCA I (INBUF+14) /A011 /d025 / end 'ifdef french' /A011 > /d025 /d025 CIFMNU / DISPLAY: 'TYPING "" HAS NO MEANING HERE' /d025 JMS I IOACAL /d025 0 /d025 NMEAN /d025 -2700 / LINE 27 COLUMN 0 /M011 /d025 /d025 IFNDEF DUTCH < /A011 /d025 INBUF+1 / WE NEED THE +1 TO MOVE ONE ADDRESS BEYOND /d025 / THE -BUFFER SIZE IN FIRST LOCATION /d025 / end 'ifndef dutch' / > /d025 /d025 IFDEF CANADA < 141 > / L.G.A. /d025 IFDEF FRENCH < 141 > / L.G.A. /d025 /d025 JMS RTNWT / WAIT FOR RETURN /d025 JMP NOMNDSP / NO RETURN COMPLAIN AGAIN /d025 TAD (2605) / RETURN SO ERASE SCREEN /d025 JMS ERASE / CLA / /a025 JMP I NOMEAN / RETURN TO CALLER TO ASK AGAIN NDERR, XX TAD I NDERR /PICK UP DOC NAME DCA DCNAM /STORE IT FOR ERROR MESSAGE ISZ NDERR /INCREMENT FOR RETURN CDFMNU /CHANGE TO MENU FIELD TAD I (MUBUF+MNDRV) /PICK UP DRIVE NUMBER CDFMYF /CHANGE BACK TO MY FIELD DCA DCRV /STORE IN DRIVE NUMBER FOR ERROR MESSAGE TAD (2205) JMS ERASE JMS NDERCW / CHECK FOR WINCHESTER DRIVE /A030 NDDSP, CIFMNU JMS I IOACAL 0 NDOC 2205 NDSTR, 0000 / ADDR OF SUBSTRING "DRIVE-DEVICE /A030 DCRV, 0000 DCNAM, 0000 CIFMNU JMS I IOACAL 0 TARTN 2505 JMS RTNWT /WAIT FOR RETURN JMP NDDSP /NOT RETURN COMPLAIN AGAIN TAD (2205) /RETURN ERASE SCREEN JMS ERASE JMP I NDERR /AND CONTINUE / CHECK FOR WINCHESTER DRIVE /A030 NDERCW, XX /A030 CLA / CLEAR AC /A030 CDFMNU / MENU FIELD /A030 TAD MUBUF+MNOPTN / OPTION WORD /A030 CDFMYF / BACK TO THIS FIELD /A030 DCA NDOPTN / SAVE VALUE /A030 AC0004 / MASK - WINCHESTER DRIVE /A030 AND NDOPTN / IS WINNIE BIT SET ? /A030 SNA CLA / YES - SKIP AND CONTINUE /A030 JMP NDCTD / NO - INSERT TEXT "DRIVE /A030 TAD DCRV / CK FOR DRIVE 0 /A030 SNA / NO - SKIP AND CONTINUE /A030 JMP NDCTD / YES - INSERT TEXT "DRIVE /A030 TAD (-1 / CK FOR DRIVE 1 /A030 SZA CLA / YES - SKIP AND CONTINUE /A030 JMP NDCTW / NO - INSERT TEXT "DEVICE /A030 AC0010 / MASK - VOLUME ASSIGNED TO 1 /A030 AND NDOPTN / IS VOLUME ASSIGNED TO 1 /A030 SNA CLA / YES - SKIP AND INSERT "DEVICE /A030 JMP NDCTD / NO - INSERT TEXT "DRIVE /A030 NDCTW, TAD (SRDEV) / ADDR OF TEXT "DEVICE /A030 DCA NDSTR / INTO PARAMETER LIST /A030 JMP NDCWEX / BRANCH TO EXIT /A030 NDCTD, TAD (SRDRV) / ADDR OF TEXT "DRIVE /A030 DCA NDSTR / INTO PARAMETER LIST /A030 NDCWEX, JMP I NDERCW / RETURN /A030 NDOPTN, 0 / OPTION WORD /A030 PAGE / READ FROM KEYBOARD / CALLED BY: JMS KBRD; RETURN TYPED KBRD, XX /COMPARE IS DESIRED CALLED WITH 0 IN AC KBRD1, CDFMYF CIFMNU JMS I INACAL / CALL INA TO READ INPUT INBUF / LOCATION TO RECEIVE INPUT JMP GOLDTST / PROCESS GOLD KEY CLA MQA / MQ CONTAINS #CHARS IN BUFFER SNA CLA / IF THIS IS 0 RETURN WAS TYPED JMP I KBRD / GO BACK TO CALLER JMS NOMEAN / ELSE MUST BE INAPPROPRIATE RESPONSE COMPLAIN JMP KBRD1 / ASK AGAIN GOLDTST,JMS GMTST / GO READ GOLD KEY JMP CUSR1 / GOLD MENU RETURN JMS PRETURN / DISPLAY PRESS RETURN A007 JMS ORGOLD / DISPLAY OR PRESS GOLD M A007 ORAR / A007 JMP KBRD1 / READ INPUT AGAIN NOT GOLD MENU / CALLED WITH 0 OR 1 IN AC TO DETERMINE / FROM WHICH FLOPPY THE 'HOME' BLOCK / WILL BE READ GTDKID, XX JMS CUPDRS TAD (CUB1) / BUFFER ADDRESS DCA QUQBLK+RXQBAD TAD (RXBDIR)/ BLOCK TO READ (HOME BLOCK) DCA QUQBLK+RXQBLK TAD (RXEDN) / TELL QURX TO 'get density' /A0020 DCA QUQBLK+RXQFNC /A0020 JMS QURX / /A0020 CLA / /A0020 TAD (RXERD) / TELL QURX TO 'read' DCA QUQBLK+RXQFNC JMS QURX CLA / THIS CLOBBERS ANY QURX ERROR RETURN TAD CUB1+5 / INDEX TO FIFTH WORD (DISKETTE ID#) JMP I GTDKID / EXIT WITH CURRENT DISKETTE ID IN AC /SEE IF PRINTER IS BUSY BEFORE TELLING USER TO REMOVE FLOPPY PTRCHK, XX CLA CDFPRT /CHANGE DATA FIELD TO PRINTER FIELD TAD I (PRSTTS) /GET PRINTER STATUS WORD CDFMYF /CHANGE DATE FIELD BACK TO MINE SNA CLA /IF NOT ZERO COMPLAIN JMP I PTRCHK /ELSE RETURN TO CALLER AND CONTINUE PTRMSG, JMS ERASE CIFMNU /DISPLAY PRINTER IS BUSY MESSAGE JMS I IOACAL 0 PTRBUS 505 605 JMS ORGOLD /DISPLAY PRESS GOLD M FOR MM NARG JMP INPUT /READ INPUT /HERE FOR SPACE REASONS M007 NEWLN, XX / A007 CDFMYF / A007 CIFMNU / A007 JMS I IOACAL / CALL IOA OUTPUT ROUTINE A007 0 / ADDRESS OF OUTPUT ROUTINE A007 ASTRING / A007 CRLF / STRING FOR CAR RETURN LINEFEED A007 JMP I NEWLN / A007 TOSMALL, XX JMS TOSCKW / CHECK FOR WINCHESTER /A030 CDFMYF CIFMNU /CHANGE INSTRUCTION FIELD TO MENU FIELD JMS I IOACAL /GO DISPLAY NOT ENOUGH ROOM SPECIFY ANOTHER DRIVE 0 TSMALL /ADDRESS OF FIRST PROMPT 505 /DISPLAY FIRST PROMPT ON LINE 5 COLUMN 5 TSSTRA, 0000 / ADDR OF SUBSTRING /A030 CUSRC6 /RESULT DRIVE NUMBER 605 JMP I TOSMALL /EXIT ROUTINE WHICH UNLOCKS DOCUMENTS BEFORE GOING TO MM CUSR1, JMP RETMNU /M027 /CALLS MENU TO READ INPUT TO DOC PROMPTS, TOA AND GO PROMPTS /CALLED BY: /JMS READMU / GOLD M DATA FIELD SET TO MY FIELD / CONTINUE PROCESSING DATA FIELD SET TO MENU FIELD READMU, XX CDFMNU DCA I (MUBUF+MNTMP4) /SET TMP4 FOR APPROPRIATE FUNCTION READLP, CDFMYF /SET DATA FIELD TO MENU /M027 CIFMNU;JMS I MNUCAL;DLMSR1 /CALL MENU CDFMNU /CHANGE DATA FIELD TO MENU TAD I (MUBUF+MNTMP3) /GET AND TEST CONTENTS OF TMP3 SZA /IF 0 THEN GOLD KEY WAS PRESSED JMP RDRTN2 /NOT GOLD KEY SO RETURN AND PROCESS INPUT TAD I (MUBUF+MNSYSA) /WAS GOLD KEY TO GET IT TAD (4000) /SET FIRST BIT TO 1 BECAUSE MENU STRIPS IT OFF CDFMYF /CHANGE DATA FIELD TO MINE JMS GMTST /PROCESS GOLD KEY JMP RDRTN1 /GOLD M RETURN /d025 JMS PRETURN /DISPLAY PRESS RETURN /A007 /d025 /d025 JMS ORGOLD /DISPLAY OR PRESS GOLD M /A007 /d025 /d025 ORAR / /A007 /d025 JMP READLP /GOLD GARBAGE, READ INPUT AGAIN /M027 RDRTN2, ISZ READMU /GOLD M EXIT RDRTN1, JMP I READMU /CONTINUE EXIT /COPIES INPUT FROM MENU FIELD TO INBUF FOR NO MEANING PROMPT MVINPT, XX CLA JMS CUCOPY /GO COPY INPUT FROM MENU FIELD TO INBUF MUISTR /ADDRESS OF FROM FOR CUCOPY CDFMNU /DATA FIELD OF FROM INBUF+1 /ADDRESS OF FOR FOR CUCOPY CDFMYF /CHANGE DATA FIELD TO MINE STRLEN /NUMBER OF WORDS TO COPY (STANDARD) JMP I MVINPT /RETURN TO CALLED PAGE / PARSE A SPECIFICATION DOCUMENT FOR SORT AND LOAD THE RESULT INTO MEMORY / PARSE, . DCA SPECNO /AJF PUT SPEC DRIVE & DOC FROM AC INTO SPECNO DCA DEADKEY / CLEAR DEADKEY FLAG / TAD (-KVTWIDTH); DCA VTWIDTH /SET LINE WIDTH FOR DISPLAY ROUTINE D007 /INITIALIZE FIELD NAME COUNTER MAXIMUM FIELD SIZE M007 DCA NUMKEY /SET KEY FIELD COUNTER TO ZERO A007 AC4000 /SET AC TO 4000 A007 DCA ORDWD /SET FIRST BIT OF ORDWRD TO 1 A007 DCA FTYPE /SET FIELD NAME TYPE TO 0 A007 / SETUP INTO AUTO INDEX #12 / AC7777 CDFSRT /CHANGE DATA FIELD TO SORT FIELD A007 TAD I (SDFNBUFFER) /GET LOCATION OF BUFFER M007 CDFMYF /CHANGE DATA BACK TO MY FIELD A007 DCA A12 TAD (-FNSIZE-1); DCA FNCOUNT JMS ERASE /ERASE SCREEN A008 JMS DSORT /DISPLAY SORT A008 CIFMNU JMS I IOACAL /CALL IOA 0 /ADDRESS OF OUTPUT ROUTINE HC /TEXT STRING TO POSITION CURSOR ON LINE 3 M008 0100 /SET TO LINE 3 SO THERE IS ROOM FOR 12 LINES /OF SPEC DOC AND ERROR MESSAGES / /OPEN THE FILE FOR READING / TAD SPECNO; CIFFIO; FILEIO; XRDFIN /M0010 /LOOKING FOR THE TEXT STRING: / / 'SORT ON IN ASCENDING ORDER' / /OR: 'SORT ON IN DESCENDING ORDER' / / WITHIN THE SORT SELECTION SPECIFICATION DOCUMENT / STPARS, JMS TXTCOM; MSORTON; ERR001 / PARSE THE FROM THE SPECIFICATION DOCUMENT / /GET A CHARACTER FROM THE SPEC DOC - *** ERR001 IF NO MORE / CLA; JMS RD1CHR; ERR001 / TEST CHARACTER FOR '<' LEFT ANGLE BRACKET *** ERR001 IF NOT / (AC) = CHARACTER FROM 'JMS RD1CHR' / TAD (-74); SZA CLA; ERR001 JMP GETFNCHAR DONE, CLA AC7777 /SET AC TO -1 CDFSDFN /CHANGE DATA FIELD TO 'SDFN' FIELD /A007/M014 DCA I A12 /WRITE -1 BUFFER TERMINATOR XSDFN A007 CDFMYF /CHANGE DATA FIELD BACK TO MINE A007 JMP I PARSE /EXIT TO PROMPT FOR LIST DOC ERR, XX / A007 CDFMYF /MAKE SURE DATA FIELD IS MY FIELD A007 CIFMNU /MAKE INSTRUCTION FIELD MENU FIELD A007 JMS I IOACAL /CALL IOA A007 0 / A007 ASTRING / A007 ACARET /STRING TO POSITION THE CARET A007 JMS NEWLN / POSITION THE NEXT LINE A007 JMP I ERR /EXIT A007 / CHECK FOR WINCHESTER /A030 DERCKW, XX /A030 CLA / CLEAR AC /A030 CDFMNU / MENU FIELD /A030 TAD MUBUF+MNOPTN / OPTION WORD /A030 CDFMYF / BACK TO THIS FIELD /A030 DCA DEOPTN / SAVE VALUE /A030 AC0004 / MASK - WINCHESTER INSTALLED /A030 AND DEOPTN / IS WINNIE BIT SET ? /A030 SNA CLA / YES - SKIP AND CONTINUE /A030 JMP DERCT1 / NO - INSERT TEXT - DISKETTE, DRIVE /A030 TAD CUSRC6 / CK FOR DRIVE 0 /A030 SNA / NO - SKIP AND CONTINUE /A030 JMP DERCT2 / YES - INSERT TEXT - DISKETTE,DRIVE,DISK/VOL /A030 TAD (-1 / CK FOR DRIVE 1 /A030 SZA CLA / YES - SKIP AND CONTINUE /A030 JMP DERCT3 / NO - INSERT TEXT - VOLUME,DEVICE,DISK/VOL /A030 AC0010 / MASK - VOLUME ASSIGNED TO 1 /A030 AND DEOPTN / IS VOLUME ASSIGNED ? /A030 SNA CLA / YES - SKIP & INSERT TEXT - VOL,DEV,DSK/VOL /A030 JMP DERCT2 / NO - GO INSERT TEXT - DSK,DRV,DSK/VOL /A030 DERCT3, TAD (DERVL1) / ADDR OF "VOLUME ON DEVICE /A030 DCA DERST1 / INTO PARAMETER LIST /A030 TAD (DERVL2) / ADDR OF "VOLUME /A030 DCA DERST2 / INTO PARAMETER LIST /A030 TAD (DERDKV) / ADDR OF "DISKETTE/VOLUME /A030 DCA DERST3 / INTO PARAMETER LIST /A030 JMP DERCEX / BBRANCH TO EXIT /A030 DERCT1, TAD (DERDS2) / ADDR OF "DISKETTE /A030 DCA DERST3 / INTO LIST /A030 JMP DERCT4 /A030 DERCT2, TAD (DERDKV) / ADDR OF "DISKETTE/VOLUME /A030 DCA DERST3 / INTO LIST /A030 DERCT4, TAD (DERDS1) / ADDR OF "DISKETTE IN DRIVE /A030 DCA DERST1 / INTO LIST /A030 TAD (DERDS2) / ADDR OF "DISKETTE /A030 DCA DERST2 / INTO LIST /A030 DERCEX, JMP I DERCKW / RETURN /A030 DEOPTN, 0000 / OPTION WORD /A030 PAGE /GETFNCHAR, AC0000; JMS RD1CHR; ERR001 GETFNCHAR, AC7777; JMS RD1CHR; ERR001 /M003 MQL / TEMP SAVE IT IN THE MQ MQA TAD (-76) /SEE IF '>' SNA JMP FNEND /YES, DONE FIELD TAD (2) /SEE IF '<' SNA ERR001 / '<' FOUND WITHIN TAD (2) /SEE IF IT IS A : (COLON SIGNIFIES A007 SZA CLA /NUMERIC KEY FIELD) A007 JMP INCFCTR /IF NOT A COLON CONTINUE A007 TAD ORDWD /IF COLON SET APPROPRIATE BIT IN FTYPE A007 TAD FTYPE /A007 DCA FTYPE /STORE WORD WITH BIT SET FOR NUMERIC A007 INCFCTR,TAD DEADKEY / Check for the status of dead keys /a031 SNA CLA / Is one currently being evaluated? /a031 ISZ FNCOUNT / No, SEE IF ROOM /m031 SKP ERR001 / EXCEEDED 30(10) CHARACTERS MQA CDFSDFN /CHANGE DATA FIELD TO 'SDFN' FIELD /A007M014 DCA I A12 /AND STORE IN STRING CDFMYF /CHANGE DATA FIELD BACK TO MY FIELD A007 JMP GETFNCHAR /LOOP BACK FOR MORE FNEND, CLA / A007 TAD FNCOUNT /GET COUNT OF WORDS USED A007 TAD (FNSIZE+1) /COMPARE WITH ORIGINAL BUFFER SIZE A007 SNA CLA /IF EQUAL A007 ERR001 /THERE IS AN ERROR ONLY <> FOUND A007 CDFSDFN /CHANGE DATA FIELD TO 'SDFN' FIELD /A007/M014 DCA I A12 / [0] /THERE ARE CHARACTERS STORE TRAILING 0 A007 CDFMYF /CHANGE DATA FIELD BACK TO MY FIELD A007 DCA FNCOUNT /SET FIELD CHARACTER COUNTER BACK TO 0 A007 /FOR NEXT FIELD A007 ISZ NUMKEY /INCREMENT KEY FIELD COUNTER A007 CMPORDER,JMS TXTCOM; MINA; JMP CHKD; JMP CHKETC CHKD, CLA TAD THCHAR /GET CHAR TXTCOM STORED IFDEF ENGLSH < TAD (4) /IS IT A D? > IFDEF ITALIAN < TAD (4) > IFDEF V30NOR < TAD (31) /IS IT A Y? > IFDEF V30SWE < TAD (6) /IS it an F > IFDEF DUTCH < TAD (1) > IFDEF SPANISH < TAD (4) > SZA /IF AC 0 THEN IT IS A D SEE IF NEXT CHAR IS AN E ERR001 /ELSE ERROR CHKE, JMS TXTCOM; ME; ERR001 CLA / A007 TAD ORDWD /GET ORDER WORD AND COMBINE WITH ORDER A007 /FIRST TIME HERE BIT 0 IS SET FOR DESCENDING, NEXT TIME BIT 1 ETC. A007 TAD ORDER /ADD CONTENTS OF ORDER A007 DCA ORDER /STORE BACK IN ORDER A007 CHKETC, JMS TXTCOM; MSCENDING; ERR001 /A SUCCESSFUL COMPARISON OF THE TEXT STRING 'ASCENDING ' OR 'DESCENDING ' /HAS BEEN COMPLETED /SET NEXT BIT IN ORDWD FOR KEY FIELD DESCRIPTOR WORDS ORDER AND FTYPE A007 CLA CLL TAD ORDWD /GET ORDER WORD A007 RAR /MOVE BIT ONCE TO RIGHT A007 DCA ORDWD /STORE BACK IN ORDER WORD A007 /THE TEXT STRING 'ORDER' MUST SUFFIX / JMS TXTCOM; MORDER; ERR001 / /PARSE FOR AND A007 PSAND, JMS TXTCOM; MAND; JMP ERRTST / A007 CLA /SEE IF MAX FIELDS HAVE BEEN SPECIFIED A007 TAD NUMKEY /GET KEY FIELDS SPECIFIED A007 TAD (-MXFLD) /IS MAX = TO NUMBER SPECIFIED A007 SNA CLA /IF AC 0 A007 ERR002 /DISPLAY ERROR A007 JMP STPARS /ELSE BEGIN PARSING NEXT LINE A007 SPECNO, 0000 ORDWD, 0000 /USED TO SET KEY FIELD NAME DESCRIPTOR WORDS A007 /ORDER AND FTYPE, 1 IN ORDER MEANS SORT IS DESCENDING A007 /ORDER, AND 1 IN FTYPE MEANS NUMERIC FIELD A007 /THIS VARIABLE IS FIRST SET TO 4000 AND THE 1 IN BIT 0 A007 /IS SHIFTED ONCE TO RIGHT EACH TIME THROUGH PARSER A007 FNCOUNT,0000 /**************************************************************************** / / The next routine has been moved to where OUT2VT was to make /a031 / room for changes to the parser for dead key sequence evaluation /a031 / /**************************************************************************** / CHECK FOR WINCHESTER DRIVE /A030 /d031 TOSCKW, XX / CK FOR WINCHESTER ON SYSTEM /A030 /d031 CLA / CLEAR AC /A030 /d031 CDFMNU / MENU FIELD /A030 /do31 TAD MUBUF+MNOPTN / FECTH OPTION WORD /A030 /d031 CDFMYF / BACK TO THIS FIELD /A030 /d031 DCA TSOPTN / SAVE VALUE /A030 /d031 AC0004 / MASK - WINCHESTER INSTALLED /A030 /d031 AND TSOPTN / IS WINNIE BIT SET ? /A030 /d031 SNA CLA / YES - SKIP AND CONTINUE /A030 /d031 JMP TSCTD1 / NO - INSERT TEXT "DRIVE" ONLY /A030 /d031 TAD CUSRC6 / CK FOR DRIVE 0 /A030 /d031 SNA / NO - SKIP & CONTINUE /A030 /d031 JMP TSCTD2 / YES - GO INSERT "DRIVE/DEVICE" /A030 /d031 TAD (-1 / CK FOR DRIVE 1 /A030 /d031 SZA CLA / YES - SKIP & CONTINUE /A030 /d031 JMP TSCTW / NO - INSERT "VOLUME ON DEVICE /A030 /d031 AC0010 / MASK - VOLUME ASSIGNED TO 1 /A030 /d031 AND TSOPTN / IS VOLUME ASSIGNED /A030 /d031 SNA CLA / YES - SKIP & INSERT "VOLUME ON DEVICE /A030 /d031 JMP TSCTD2 / NO - GO INSERT "DISKETTE ON DRIVE /A030 /d031 TSCTW, TAD (DERVL1) / ADDR OF "VOLUME ON DEVICE /A030 /d031 DCA TSSTRA / INTO PARAMETER LIST /A030 /d031 TAD (TSDEV) / ADDR OF "DRIVE/DEVICE /A030 /d031 DCA NWSTR / INTO LIST - "SPECIFY ANOTHER DRIVE/DEVICE /A030 /d031 JMP TSCKEX / BRANCH TO EXIT /A030 /d031 TSCTD1, TAD (SRDRV) / ADDR OF "DRIVE /A030 /d031 DCA NWSTR / INTO LIST - "SPECIFY ANOTHER DRIVE /A030 /d031 JMP TSCTD3 / /A030 /d031 TSCTD2, TAD (TSDEV) / ADDR OF "DRIVE/DEVICE /A030 /d031 DCA NWSTR / INTO LIST - "SPECIFY ANOTHER DRIVE/DEVICE /A030 /d031 TSCTD3, TAD (DERDS1) / ADDR OF "DISKETTE IN DRIVE /A030 /d031 DCA TSSTRA / INTO LIST /A030 /d031 TSCKEX, JMP I TOSCKW / RETURN /A030 /d031 TSOPTN, 0000 / OPTION WORD /A030 PAGE /BEFORE YOU START TEARING YOUR HAIR OUT I WILL EXPLAIN A007 /EVERYTHING YOU ARE AFRAID TO ASK ABOUT THE FOLLOWING FEW A007 /LINES OF CODE. WE ARE HERE BECAUSE OF A TEXT COMPARISON A007 /FAILURE. THE CATCH IS THERE ARE TWO EXITS OUT OF TXTCOM A007 /IF THERE ARE NO MORE CHARACTERS IN THE SPEC DOC AND IF A007 /THERE IS A MATCH FAILURE WITH THE CONTENTS OF SPEC DOC A007 /AND THE WORD 'AND'. IF THERE ARE NO MORE CHARACTERS IN SPEC A007 /DOC THE VARIABLE THCHAR IS NOT UPDATED SO IT STILL CONTAINS A007 /THE R FROM THE WORD ORDER FROM LAST TXTCOM CALL. SO TO A007 /DETERMINE IF WE ARE EXITING BECAUSE IT IS END OF SPEC DOC A007 /I TEST FOR AN R. THE VARIABLE THCHAR CONTAINS THE NEGATIVE A007 /VALUE OF THE LAST CHARACTER. THIS SEEMED EASIER THAN REWRITING A007 /PARSER. A007 ERRTST, CLA /SEE WHAT KIND OF ERROR A007 TAD THCHAR /SEE IF THCAR IS UPDATED IF NOT DONE A007 IFDEF ENGLSH < TAD (22) /SEE IF LAST CHAR READ FROM SPEC IS R A007 > IFDEF V30NOR < TAD (5) > IFDEF ITALIAN < TAD (5) > IFDEF V30SWE < TAD (7) > IFDEF DUTCH < TAD (5) > IFDEF SPANISH < TAD (5) > SZA CLA /IF IT IS WE ARE DONE A007 ERR002 /ELSE JUST AN ORDINARY ERROR A007 JMP DONE / NOTE THAT (AC) = 0 HERE NATURALLY / / JMS RD1CHR; SKP /TRY TO GET ANOTHER CHAR FROM THE SPEC DOC / ERR002 /CALL ERROR 2 SPEC DOC TOO BIG / /THE SORT SELECTION SPECIFICATION DOCUMENT HAS BEEN PARSED SUCCESSFULLY / ERR2, JMS ERR /POSITION CARET UNDER TEXT A007 CIFMNU / A007 JMS I IOACAL /DISPLAY ERROR MESSAGE A007 0 / A007 FSERR /DISPLAY # FIELDS SPECIFIED A007 NUMKEY, 0000 /NUMBER OF KEY FIELDS SPECIFIED A007 JMS NEWLN /CARRIAGE RETURN LINE FEED A007 CIFMNU /CHANGE INSTRUCTION FIELD TO MENU A007 JMS I IOACAL / A007 0 / A007 FSER2 /NEXT LINE OF PROMPT A007 JMS NEWLN /POSITION ON NEXT LINE A007 CIFMNU / A007 JMS I IOACAL / A007 0 / A007 PRCON /PRESS RETURN TO CONTINUE A007 JMS ORGOLD / A007 ORAR / A007 JMS KBRD /Return was typed /A013 JMP DONE /Exit parser /A013 ERR1, JMS ERR / A007 CIFMNU / A007 JMS I IOACAL / A007 0 / A007 MWHAT /THIS OUTPUT ROUTINE ASSUMES SPEC DOC A007 IFDEF CANADA < 141 > /L.G.A. /WON'T EXCEED 12 LINES IFDEF FRENCH < 141 > /L.G.A. JMS ORGOLD / A007 NARG / A007 /D026 IFDEF WS102 < /D007 JMS ULKSUB; SPECNO; CDFMYF /D026 > /END IFDEF WS102 JMP INPUT /READ INPUT A008 / THE SORT SPECIFICATION DOCUMENT HAS BEEN PARSED OK / / THE RESIDES WITHIN 'SDFNBUFFER' / / READ A CHARACTER FROM THE SPECIFICATION DOCUMENT (OR THE DOCUMENT OPENED) / / JMS RDNXCH; EOF RETURNS TO HERE; OK RETURNS TO HERE / RDNXCH, .; CLA; CIFFIO; FILEIO; XRDFNC /M0010 SPA; CLA / Treat read errors like E-O-F. /A0016 SZA ISZ RDNXCH JMP I RDNXCH /SUBROUTINE TO READ IN A CHARACTER FROM THE SPECIFICATION DOCUMENT /AND EXIT WITH IT IN THE AC / / AC AT ENTRY = 0: IGNORE ALL BLANKS, TABS, RULERS, FUNNY SPACES AND 'S / AC AT ENTRY =-1: IGNORES ONLY: RULERS, FUNNY SPACES AND LINE FEEDS / /CALLED WITH AC=0 OR AC=-1: / JMS RD1CHR /EOF RETURN (AC UNDEFINED) /NORMAL RETURN (AC CONTAINS CHARACTER) / RD1CHR, 0 DCA RDFLAG /SAVE FLAG RDNEXT, JMS RDNXCH /GET A CHAR JMP I RD1CHR / *** DISK EOF - EXIT *** DCA CHARIN /SAVE CHAR ( *** INCLUDING MODE BITS *** ) TAD CHARIN AND P177 /STRIP OFF MODE BITS TAD (-41) / IS IT A PRINTABLE CHARACTER ? SPA JMP NPC / NON PRINTABLE CHARACTER TAD (41) /GET BACK PRINTABLE CHARACTER JMS OUT2VT /AND OUTPUT TO THE SCREEN ISZ RD1CHR / +1 TO RETURN ADDRESS JMP I RD1CHR /AND EXIT /NON PRINTING (SPECIAL) CHARACTER / NPC, TAD (25) / IS THE CHARACTER A FORM FEED: (-41)+(25)=- (14) SNA JMP LPTCTRL /YES, NOW CHECK IF SPECIAL TAD (-2) /NO, WHAT ABOUT START OF RULER (16) SNA CLA JMP SKPRULER /YES, GO IGNORE RULER TAD CHARIN /NO, GET CHAR BACK AND (7600) / LOOK AT MODE BITS SZA CLA JMP RDNEXT /YES, SO IGNORE IT TAD CHARIN /NO, GET CHAR ONCE MORE AND P177 / STRIP MODE BITS TAD (-BELL) / TEST FOR ^G (MODIFIED FLAG) ? SNA CLA JMP RDNEXT /YES, JUST IGNORE NORMFF, TAD CHARIN /GET CHARACTER TO RETURN WITH AND P177 / STRIP MODE BITS JMS OUT2VT /SHOW CHAR ON SCREEN MQL /SAVE CHAR TAD RDFLAG / TEST 'IGNORE ALL' FLAG SNA CLA JMP RDNEXT /YES, IGNORE CHARACTER MQA /NO, GET CHAR BACK ISZ RD1CHR / +1 TO RETURN ADDRESS JMP I RD1CHR / EXIT / /LOOKING FOR -1014 (START OF PRINTER CONTROL) / OR -1414 (END OF PRINTER CONTROL) / LPTCTRL,TAD CHARIN /TEST FOR 'START OF PRINTER CONTROL' TAD (-1014) SZA CLA /YES, IGNORE ALL CHAR UNTIL 'END OF PRINTER CONTROL' JMP NORMFF /NO, MUST HAVE BEEN NORMAL FF TILEND, JMS RDNXCH /GET A CHAR JMP I RD1CHR / *** ERROR EXIT, DISK EOF *** TAD (-1414) / 'END OF PRINTER CONTROL' YET ? SZA CLA JMP TILEND / KEEP LOOKING FOR 'END OF PRINTER CONTROL' JMP RDNEXT /YES, BACK TO NORMAL PROCESSING / /START OF RULER (16) WAS FOUND ... IGNORE THE RULER / SKPRULER,JMS RDNXCH /GET A CHARACTER JMP I RD1CHR / *** ERROR EXIT *** TAD (-17) /END OF RULER? SZA CLA JMP SKPRULER /NO, KEEP LOOKING JMP RDNEXT /YES, BACK TO NORMAL PROCESSING RSDSK, XX / DISPLAYS 'REPLACE SYSTEM DISKETTE, CALLED IF USER CIFMNU / TYPES GOLD M AND A DOCUMENT RATHER THAN SYSTEM JMS I IOACAL / DISKETTE IS IN DRIVE 0 0 RSYS / REPLACE SYSTEM DISKETTE TEXT 2405 SDFW, NARG / FIRST WORD EITHER OR OR " " JMP I RSDSK PAGE /DISPLAY (OUTPUT TO THE SCREEN) THE CHARACTER IN THE AC AT ENTRY / (INSERTING A WHEN THE CHAR IN THE AC AT ENTRY = / /This routine has been moved to page 1000 to make room for the dead key /a031 /changes. /a031 /d031 OUT2VT, 0 /d031 DCA CHR2VT /SAVE CHARACTER TO BE DISPLAYED /d031 TAD CHR2VT /CHECK FOR RIGHT AWAY /d031 TAD (-CR) /d031 SZA CLA /d031 JMP NOTCR /d031 DCA DEADKEY /d031 JMP VTEXIT /d031 NOTCR, TAD DEADKEY /SEE IF IN MIDDLE OF DEADKEY SEQUENCE /d031 SZA CLA /d031 JMP VTEXIT /YES, DON'T OUTPUT CHAR /d031 TAD CHR2VT /d031 TAD (-BACKSP) /BACKSPACE ? /d031 SZA /d031 JMP NOTBACKSPACE / / START OF DEADKEY SEQUENCE / /d031 AC7777; DCA DEADKEY /SET DEADKEY FLAG /d031 CIFMNU /d031 JMS I IOACAL /DISPLAY DEAD KEY SEQUENCE /d031 0 /d031 ASTRING /d031 ASDK /d031 JMP VTEXIT /GET CHARACTER BACK AND EXIT /d031 NOTBACKSPACE,TAD (BACKSP-LF) /SEE IF LF /d031 SZA CLA /d031 JMP NOTEOL /NO M007 /d031 JMS NEWLN /OUTPUT CARRIAGE RETURN LINE FEED A007 /d031 VTEXIT, TAD CHR2VT /GET CHAR BACK /d031 JMP I OUT2VT /AND EXIT /d031 /d031 NOTEOL, CIFMNU / CHANGE THE 'IF' TO THE 'MENU' FIELD A007 /d031 JMS I IOACAL / TO 'IOA' FOR CHARACTER OUTPUT A007 /d031 0 /d031 ASTRING / ^S MEANS AN ASCII STRING (OF 1 CHAR) A007 /d031 CHR2VT / 'CHR2VT' CONTAINS 7-BIT ASCII A007 /d031 JMP VTEXIT / /**************************************************************************** / / The following code was moved here to make room for changes to /a031 / the parsing code for dead key sequence evaluation. /a031 / /**************************************************************************** / CHECK FOR WINCHESTER DRIVE /A030 TOSCKW, XX / CK FOR WINCHESTER ON SYSTEM /A030 CLA / CLEAR AC /A030 CDFMNU / MENU FIELD /A030 TAD MUBUF+MNOPTN / FECTH OPTION WORD /A030 CDFMYF / BACK TO THIS FIELD /A030 DCA TSOPTN / SAVE VALUE /A030 AC0004 / MASK - WINCHESTER INSTALLED /A030 AND TSOPTN / IS WINNIE BIT SET ? /A030 SNA CLA / YES - SKIP AND CONTINUE /A030 JMP TSCTD1 / NO - INSERT TEXT "DRIVE" ONLY /A030 TAD CUSRC6 / CK FOR DRIVE 0 /A030 SNA / NO - SKIP & CONTINUE /A030 JMP TSCTD2 / YES - GO INSERT "DRIVE/DEVICE" /A030 TAD (-1 / CK FOR DRIVE 1 /A030 SZA CLA / YES - SKIP & CONTINUE /A030 JMP TSCTW / NO - INSERT "VOLUME ON DEVICE /A030 AC0010 / MASK - VOLUME ASSIGNED TO 1 /A030 AND TSOPTN / IS VOLUME ASSIGNED /A030 SNA CLA / YES - SKIP & INSERT "VOLUME ON DEVICE /A030 JMP TSCTD2 / NO - GO INSERT "DISKETTE ON DRIVE /A030 TSCTW, TAD (DERVL1) / ADDR OF "VOLUME ON DEVICE /A030 DCA TSSTRA / INTO PARAMETER LIST /A030 TAD (TSDEV) / ADDR OF "DRIVE/DEVICE /A030 DCA NWSTR / INTO LIST - "SPECIFY ANOTHER DRIVE/DEVICE /A030 JMP TSCKEX / BRANCH TO EXIT /A030 TSCTD1, TAD (SRDRV) / ADDR OF "DRIVE /A030 DCA NWSTR / INTO LIST - "SPECIFY ANOTHER DRIVE /A030 JMP TSCTD3 / /A030 TSCTD2, TAD (TSDEV) / ADDR OF "DRIVE/DEVICE /A030 DCA NWSTR / INTO LIST - "SPECIFY ANOTHER DRIVE/DEVICE /A030 TSCTD3, TAD (DERDS1) / ADDR OF "DISKETTE IN DRIVE /A030 DCA TSSTRA / INTO LIST /A030 TSCKEX, JMP I TOSCKW / RETURN /A030 TSOPTN, 0000 / OPTION WORD /A030 /**************************************************************************** / / END OF MOVED CODE /M031 / /**************************************************************************** CHARIN, 0 RDFLAG, 0 TOEFLG, 0 /d031 CHR2VT, ZBLOCK 1 / 7-BIT ASCII FOR OUTPUT TO THE SCREEN /d031 0 / [0] TERMINATOR FOR 'ASTRING' / 6-BIT TEXT STRING COMPARISON SUBROUTINE / JMS TXTCOM; MTEXT; ERROR RETURN; OK RETURN /THE ORDER OF CHAR COMPARS FROM THE 'TEXT' STRING IS: CX(1ST) CY(2ND) / TXTCOM, 0 AC7777 TAD I TXTCOM /ADDR-1 BECAUSE OF 'ISZ' THEN 'TAD I' ISZ TXTCOM / GET THE ADDRESS OF THE 'M'TEXT DCA TXTADR /SAVE THAT ADDRESS TSC1, AC7776 / -2 DCA COUNT /TWO 'TEXT' CHARACTERS PER 12-BIT WORD ISZ TXTADR / / NOTE THAT THE (AC) = 0 HERE NATURALLY / TSC2, TAD I TXTADR /GET TWO 'TEXT' CHARACTERS: CX CY ISZ COUNT BSW /AC LOOKS LIKE: CY CX AND (37) /KEEP ONE SNA JMP EXIT DCA T1 / AND TEMP (T1) SAVE IT JMS RD1CHR /READ 1 CHARACTER FROM THE SORT SPEC DOC JMP I TXTCOM / ** ERROR ** IF NO CHARACTERS REMAIN AND (37) / MAKE CHAR FROM SPEC DOC LOWER CASE CIA /THEN NEGATE IT FOR A COMP LATER DCA THCHAR /STORE THE NEGATED CHARACTER FROM SPEC DOC TAD THCHAR /GET IT BACK IN AC TAD T1 /GET BACK NEGATED CHAR VALUE FROM MTEXT SZA CLA /ARE THEY EQUAL? JMP I TXTCOM /NO ERROR RETURN TAD COUNT /YES CONTINUE COMPARE SNA CLA JMP TSC1 /TO RESET THE 'COUNT' JMP TSC2 /TO GET THE OTHER CHARACTER FROM THE TXTADR EXIT, ISZ TXTCOM /INCREMENT FOR NON ERROR RETURN JMP I TXTCOM /RETURN /D026 IFDEF WS102 < / INPUT, CDFMYF /MAKE SURE DATA FIELD IS SET TO MINE A008 CIFMNU /CHANGE INSTRUCTION FIELD TO MINE A008 JMS I INACAL /READ INPUT A008 INBUF /BUFFER TO HOLD KEYBOARD INPUT A008 JMP GLDKY /PROCESS GOLD KEY INPUT A008 JMS RBELL /NOT GOLD KEY RING BELL A008 JMP INPUT /READ INPUT AGAIN A008 GLDKY, JMS GMTST /TEST AND HANDLE GOLD KEY A008 JMP CUSR1 /GOLD M SO EXIT A008 JMS RBELL /GOLD GARBAGE RING BELL A008 JMS ORGOLD /DISPLAY PRESS GOLD M A008 NARG /DO NOT DISPLAY OR A008 JMP INPUT /READ INPUT AGAIN A008 RBELL, XX CIFMNU JMS I IOACAL 0 ASTRING BELTXT JMP I RBELL /D026 > / END IFDEF WS102 /d031 DEADKEY,0 TXTADR, 0 COUNT, -2 THCHAR, 0000 THRHRD, 0300 / CALLED WITH POSITION OF CURSOR IN AC ERASE, XX DCA CRPOS / STORE POSITION FOR CURSOR CIFMNU JMS I IOACAL 0 PSCR / STRING TO ERASE SCREEN AND POSITION CURSOR CRPOS, 0000 / CURSOR POSITION PASSED IN AC FROM CALLER JMP I ERASE / RETURN PRETURN,XX / DISPLAYS 'and press return CIFMNU JMS I IOACAL 0 PRTRN 2305 JMP I PRETURN PAGE PAGE CUSRDN, ZBLOCK STRLEN /RESULT DOCUMENT NAME CUSSDN, ZBLOCK STRLEN /SPEC DOCUMENT NAME CUSLDN, ZBLOCK STRLEN /LIST DOCUMENT NAME SRT, IFDEF ENGLSH < TEXT '^P--&S&O&R&T--' > IFDEF ITALIAN < TEXT /^P--!&ORDINAMENTO--/ > IFDEF V30NOR < TEXT '^P--!&SORTERING--'> IFDEF V30SWE < TEXT '^P--!&SORTERING--'> IFDEF DUTCH < TEXT '^P-- &SORTEREN --'> IFDEF SPANISH < TEXT '^P-!&CLASIFICAR--'> SPRMPT, IFDEF ENGLSH < TEXT '^P&TYPE THE NAME OF THE ^P^S' > IFDEF ITALIAN < TEXT /^P&INTRODURRE IL DOCUMENTO ^P^S/ > IFDEF V30NOR < TEXT '^P&SKRIV NAVNET P\E ^P^S'> IFDEF V30SWE < TEXT '^P&SKRIV NAMNET P\E ^P^S'> IFDEF DUTCH < TEXT '^P&TYPE DE NAAM VAN ^P^S'> IFDEF SPANISH < TEXT '^P&TECLEE EL NOMBRE DE ^P^S'> GSPEC, IFDEF ENGLSH < TEXT 'SORT SPECIFICATION DOCUMENT.' > IFDEF ITALIAN < TEXT /DI SPECIFICA ORDINAMENTO./ > IFDEF V30NOR < TEXT 'SORTERINGSPESIFIKASJONEN.'> IFDEF V30SWE < TEXT 'URVALSDOKUMENTET'> IFDEF DUTCH < TEXT 'DE SORTEERSPECIFICATIE'> IFDEF SPANISH < TEXT 'DOC. DE CLASIFICACI\SN DE ESPECIFICACI\SN.'> GLST, IFDEF ENGLSH < TEXT 'INPUT DOCUMENT YOU WANT TO SORT.' > IFDEF ITALIAN < TEXT /LISTA DA ORDINARE./ > IFDEF V30NOR < TEXT 'DET DOKUMENTET DU VIL SORTERE'> IFDEF V30SWE < TEXT 'REGISTERDOKUMENTET SOM DU VILL HA SORTERAT'> GRES, IFDEF ENGLSH < TEXT 'OUTPUT DOCUMENT THAT WILL RECEIVE' GRES2, TEXT '^PTHE SORTED COPY OF THE INPUT DOCUMENT.' > IFDEF ITALIAN < TEXT 'DI USCITA.'> IFDEF V30NOR < TEXT 'DET DOKUMENTET DEN SORTERE' /M008 GRES2, /M008 TEXT '^PKOPIEN SKAL LEGGES I.' /M008 > IFDEF V30SWE < TEXT 'SLUTDOKUMENTET SOM DU VILL HA SORTERAT' GRES2, TEXT 'DET SORTERADE REGISTERDOKUMENTET' > IFDEF DUTCH < TEXT 'HET DOCUMENT WAARIN HET RESULTAAT MOET KOMEN' GRES2, TEXT '' > IFDEF SPANISH < TEXT 'DOC. SALIDA QUE RECIBIR\A' GRES2, TEXT '^PLA COPIA CLASIFICADA DEL DOC. DE ENTRADA.'> DEXTS, IFDEF ENGLSH < TEXT '^P&DOCUMENT ALREADY EXISTS. ' *.-1 TEXT '^P&HOW WOULD YOU LIKE THE DOCUMENT MODIFIED?' *.-1 TEXT '^P&T = &ADD TEXT TO THE TOP ' *.-1 TEXT '^P&B = &ADD TEXT TO THE BOTTOM' /M021 *.-1 TEXT '^P&O = &OVERWRITE THE DOCUMENT' *.-1 TEXT '^P&TYPE THE LETTER AND &PRESS &R&E&T&U&R&N.' > IFDEF ITALIAN < TEXT '^P&DOCUMENTO ESISTENTE. ' *.-1 TEXT '^P&MODALIT\@ DI MODIFICA: ' *.-1 TEXT /^P&I = &INSERIMENTO TESTO ALL'INIZIO / *.-1 TEXT '^P&F = &INSERIMENTO TESTO ALLA FINE ' /M021 *.-1 TEXT '^P&S = &SOVRASCRITTURA ' *.-1 TEXT /^P&SCEGLIERE UN'OPZIONE E &PREMERE !&RITORNO./ > IFDEF V30NOR < TEXT '^P&DOKUMENTET FINNES ALLEREDE.' *.-1 TEXT '^P&HVORDAN VIL DU ENDRE DOKUMENTET? ' *.-1 TEXT '^P&T = &TILF\XYE TEKST P\E TOPPEN ' *.-1 TEXT '^P&B = &TILF\XYE TEKST P\E BUNNEN ' /M021 *.-1 TEXT '^P&O = &OVERSKRIVE DOCUMENTET' *.-1 TEXT '^P&TYPE THE LETTER AND &PRESS &R&E&T&U&R&N.' > IFDEF V30SWE < TEXT '^P&DOKUMENTET FINNS REDAN ' *.-1 TEXT '^P&HUR VILL DU \DNDRA I DOKUMENTET? ' *.-1 TEXT '^P%B = &L\DGGA TILL TEXT I B\VRJAN ' *.-1 TEXT '^P%S = &L\DGGA TILL TEXT I SLUTET' /M021 *.-1 TEXT '^P%S%K = &SKRIVA \VVER DOKUMENTET' *.-1 TEXT '^P&TYPE THE LETTER AND &PRESS !&RETURN.' > IFDEF DUTCH < TEXT '^P&DOCUMENT BESTAAT AL. ' *.-1 TEXT '^P&HOE WILT U DIT DOCUMENT WIJZIGEN?' *.-1 TEXT '^P&B = &VOEG TEKST TOE AAN HET BEGIN' *.-1 TEXT '^P&E = &VOEG TEKST TOE ANN HET EINDE' /M021 *.-1 TEXT '^P&O = &OVERSCHRIJF HET DOCUMENT' *.-1 TEXT '^P&MAAK EEN KEUZE EN DRUK OP !&RETURN.' > IFDEF SPANISH < TEXT '^P&EL DOCUMENTO Y EXISTE. ' *.-1 TEXT '^P\?&C\SMO LE GUSTAR\MA MODIFICAR EL DOCUMENTO? ' *.-1 TEXT '^P&T = &A\QADIR TEXTO EN PARTE SUPERIOR ' *.-1 TEXT '^P&B = &A\QADIR TEXTO EN PARTE INFERIOR ' /M021 *.-1 TEXT '^P&O = &ESCRIBIR SOBRE EL DOCUMENTO' *.-1 TEXT '^P&TECLEE LA LETRA Y PULSE !&RETORNO.' > NDOC, IFDEF ENGLSH < TEXT '^P&^S ^D DOES NOT HAVE A DOCUMENT NAMED ^A.' /M030 > IFDEF ITALIAN < TEXT /^P&^S ^D NON HA IL DOCUMENTO ^A./ > IFDEF V30NOR < TEXT '^P&^S ^D HAR IKKE NOE DOKUMENT KALT ^A.' /M030 > IFDEF V30SWE < TEXT '^P&^S ^D HAR INGET DOKUMENT SOM HETER ^A'> IFDEF DUTCH < TEXT '^P&^S ^D BEVAT GEEN DOCUMENT GENAAMD ^A.'> IFDEF SPANISH TRYAGN, /m023 IFDEF ENGLSH < / -------------------------------------------- /m023 TEXT '^P&WHEN TYPING TO THE MENU, USE THE NORMAL KEYS ON THE KEYBOARD ONLY. ' *.-1 IFDEF CONDOR < /A024 TEXT '^P&THE &RUBOUT KEY' /M024 > / END IFDEF CONDOR /A024 IFNDEF CONDOR < /A024 TEXT '^P&R&U&B &C&H&A&R AND &R&U&B &W&O&R&D' /A024 > / END IFNDEF CONDOR /A024 *.-1 TEXT ' CAN ALSO BE USED. &A LINE MAY CONTAIN A MAXIMUM ' /M024 *.-1 TEXT '^POF 71 CHARACTERS AND MUST END WITH &R&E&T&U&R&N. ' *.-1 TEXT '^P&PLEASE PRESS &R&E&T&U&R&N AND TRY AGAIN.' > /Amdh / end ifdef ENGLSH -------------------------------------------------- IFDEF ITALIAN < TEXT'^P&PER SCEGLIERE LE OPZIONI DEL MENU UTILIZZARE SOLO I TASTI ALFANUMERICI ' *.-1 IFDEF CONDOR < /A024 TEXT '^P&E SE NECESSARIO IL TASTO' /M024 > / END IFDEF CONDOR /A024 IFNDEF CONDOR < /A024 TEXT '^P&R&U&B &C&H&A&R AND &R&U&B &W&O&R&D' /A024 > / END IFNDEF CONDOR /A024 *.-1 TEXT ' !A&X]. &UNA RIGA PU\R CONTENERE AL' /M024 /Mmdh *.-1 TEXT '^PMASSIMO 71 CARATTERI E DEVE TERMINARE CON !&RITORNO. ' *.-1 TEXT '^P&PREMERE !&RITORNO PER CONTINUARE.' 74;0 /amdh > IFDEF V30NOR < / -------------------------------------------- /m023 TEXT '^P&BRUK BARE TASTENE P\E HOVEDTASTATURET N\ER DU SKRIVER EN KOMMANDO. ' *.-1 IFDEF CONDOR < /A024 TEXT '^P!&SLETT-TASTEN' /M024 > / END IFDEF CONDOR /A024 *.-1 TEXT ' KAN OGS\E BRUKES. &EN LINJE KAN HA MAKS. ' /M024 *.-1 TEXT '^P71 TEGN OG M\E AVSLUTTES MED !&RETUR. ' *.-1 TEXT '^P&TRYKK P\E !&RETUR OG PR\XV IGJEN.' > /Amdh IFDEF V30SWE < TEXT '^P&ANV\DND BARA "VANLIGA" TANGENTER N\DR DU SKRIVER I MENYN ' *.-1 TEXT '^P!&BACKSTEG' *.-1 TEXT ' KAN OCKS\E ANV\DNDAS. &EN RAD F\ER BEST\E AV MAXIMALT' *.-1 TEXT '^P71 TCKEN OCH M\ESTE AVSLUTAS MED !&RETUR' *.-1 TEXT '^P&TRYCK P\E !&RETUR OCH F\VRS\VK IGEN' > IFDEF DUTCH < TEXT '^P&GEBRUIK ALLEEN DE TOETSEN OP HET HOOFDTOETSENBORD. ' *.-1 TEXT '^P&U KUNT DE TOETS X&] GEBRUIKEN OM TEKENS TE WISSEN.' *.-1 TEXT 'EEN REGEL MAG 71 TEKENS BEVATTEN GEVOLGD DOOR !&RETURN. ' *.-1 TEXT '^P' *.-1 TEXT '^P&DRUK OP !&RETURN PROBEER OPNIEUW.' > IFDEF SPANISH < TEXT '^P&CUANDO TECLEE EN EL MEN\Z, USE S\SLO LAS TECLAS DEL TECLADO NORMAL.' *.-1 TEXT '^P&LA TECLA &CORRECTORA TAMBI\IN SE PUEDE USAR. &UNA L\MNEA PUEDE ' *.-1 TEXT 'CONTENER UN M\AXIMO DE ^P71 CARACTERES Y HA DE TERMINAR CON !&RETORNO' > SRLCKER, IFDEF ENGLSH < TEXT '^P^A&DOCUMENT (!D.!D)^A IS ALREADY IN USE.' > IFDEF ITALIAN < TEXT /^P^A&DOCUMENTO (!D.!D)^A GI\@ IN USO./ > IFDEF V30NOR < TEXT '^P^A&DOKUMENT (!D.!D)^A FINNES ALLEREDE.' > IFDEF V30SWE < TEXT '^P^A&DOKUMENT (!D.!D)^A ANV\DNDS REDAN'> IFDEF DUTCH < TEXT '^P^A&DOCUMENT (!D.!D)^A IS AL IN GEBRUIK.' > IFDEF SPANISH < TEXT '^P^A&EL DOCUMENTO (!D.!D)^A YA EST\A EN USO.'> TARTN, IFDEF ENGLSH < TEXT '^P&PRESS &R&E&T&U&R&N TO TRY ANOTHER NAME.' > IFDEF ITALIAN < TEXT '^P&PREMERE !&RITORNO, USARE UN ALTRO NOME.'> IFDEF V30NOR < TEXT '^PTRYKK P\E !&RETUR OG ANGI ET ANNET NAVN.'> IFDEF V30SWE < TEXT '^PTRYCK P\E !&RETUR OCH SKRIV ETT ANNAT NAMN' > IFDEF DUTCH < TEXT '^P&DRUK OP !&RETURN EN PROBEER OPNIEUW'> IFDEF SPANISH < TEXT '^P&PULSE !&RETORNO PARA INTENTAR OTRO NOMBRE.'> CNTCRE, IFDEF ENGLSH < TEXT '^P&UNABLE TO CREATE DOCUMENT.' > IFDEF ITALIAN < TEXT '^P&IMPOSSIBILE CREARE DOCUMENTO.' > IFDEF V30NOR < TEXT '^PKAN IKKE OPPRETTE DOKUMENT.' > IFDEF V30SWE < TEXT '^PDET G\ER INTE ATT SKAPA DOKUMENT.'> IFDEF DUTCH < TEXT '^P&KAN DOCUMENT NIET AANMAKEN.'> IFDEF SPANISH < TEXT '^P&IMPOSIBLE CREAR EL DOCUMENTO.'> WNUM, IFDEF ENGLSH < TEXT '^P&DOCUMENT NUMBERS MUST BE FROM 1 TO 200.' > IFDEF ITALIAN < TEXT '^P&NUMERI DOCUMENTO DEVONO ESSERE DA 1 A 200.' > IFDEF V30NOR < TEXT '^PDOKUMENTNUMRENE G\ER FRA 1 TIL 200.'> IFDEF V30SWE < TEXT '^PDOKUMENTETS NUMMER M\ESTE VARA 1-200.' > IFDEF DUTCH < TEXT '^PDOCUMENTNUMMERS MOETEN LIGGEN TUSSEN 1 EN 200.'> IFDEF SPANISH < TEXT '^PNO HA M\AS DOCUMENTOS DISPONIBLES.'> NMDC, IFDEF ENGLSH < TEXT '^P&THERE ARE NO MORE DOCUMENTS AVAILABLE.' > IFDEF ITALIAN < TEXT '^P&NON CI SONO DOCUMENTI DISPONIBILI.' > IFDEF V30NOR < TEXT '^P&INGEN LEDIGE DOKUMENTER.' > IFDEF V30SWE < TEXT '^P&DET FINNS INGA FLER DOKUMENT.' > IFDEF DUTCH < TEXT '^P&MAXIMALE AANTAL DOCUMENTEN BEREIKT.'> IFDEF SPANISH < TEXT '^PNO HA M\AS DOCUMENTOS DISPONIBLES.'> CNRG, TEXT '^P ' TYPGO, IFDEF ENGLSH < TEXT '^P&TYPE !&GO TO BEGIN &SORT' /M021 > IFDEF ITALIAN < TEXT '^P&INTRODURRE &E PER INIZIARE &ORDINAMENTO' /M021 > IFDEF V30NOR < TEXT '^P&SKRIV !&ST FOR \E SORTERE DOKUMENTET.' /M021 > IFDEF V30SWE < TEXT '^P&SKRIV !&OK F\VR ATT B\VRJA SORTERA.' /M021 > IFDEF DUTCH < TEXT '^P&TYP !&SV OM MET SORTEREN.'> IFDEF SPANISH < TEXT '^P&TECLEE &G&O PARA COMENZAR A &CLASIFICAR'> NMEAN, /m0018 IFDEF ENGLSH < TEXT '^P &TYPING "^A" HAS NO MEANING HERE. &PRESS &R&E&T&U&R&N AND TRY AGAIN.' /M011 > IFDEF ITALIAN < TEXT '^P &OPZIONE NON VALIDA.' /M011 > IFDEF V30NOR < TEXT '^P "^A" KAN IKKE BRUKES HER. &TRYKK P\E !&RETUR OG PR\XV IGJEN.' /M011 > IFDEF V30SWE < TEXT '^P "^A" BETYDER INGENTING H\DR.&TRYCK P\E !&RETUR OCH F\VRS\VK IGJEN.' /M011 > IFDEF DUTCH < TEXT '^P &"^A" HEEFT HIER GEEN BETEKENIS. &DRUK OP !&RETURN.'> IFDEF SPANISH < TEXT '^P &"^A" IS INCORRECTO. &PULSE !&RETORNO E INT\INTELO OTRA VEZ.'> PRTRN, IFDEF ENGLSH < TEXT '^P&AND &PRESS &R&E&T&U&R&N.' >/M008 IFDEF ITALIAN < TEXT '^P&PREMERE !&RITORNO.' >/M008 IFDEF V30NOR < TEXT '^POG TRYKK P\E !&RETUR.' >/M008 IFDEF V30SWE < TEXT '^POCH TRYCK P\E !&RETUR.' >/M008 IFDEF DUTCH < TEXT '^P&DRUK OP !&RETURN.'> IFDEF SPANISH < TEXT '^P&Y PULSE !&RETORNO.'> DOGM, IFDEF ENGLSH < TEXT '^P^A&PRESS &GOLD &M&E&N&U TO RECALL THE &MAIN &MENU.' >/M008 IFDEF ITALIAN < TEXT '^P^A&PREMERE &ORO !&MENU PER TORNARE AL &MENU &PRINCIPALE.' >/M008 IFDEF V30NOR < TEXT '^P^A&TRYKK P\E &GULL !&MENY FOR \E F\E &HOVEDMENYEN.' >/M008 IFDEF V30SWE < TEXT '^P^A&TILLBAKA TILL HUVUDMENYN: AND\DND !&GULD !&MENY.' >/M008 IFDEF DUTCH < TEXT '^P^A&DRUK OP &GOUD !&MENU OM TERUG TE GAAN NAAR HET &HOOFDMENU.'> IFDEF SPANISH < TEXT '^P^A&PULSE &DORADA !&MENU PARA VOLVER AL &MEN\Z &PRINCIPAL.'> ORAR, IFDEF ENGLSH < "O-200;"R-200;40;0 > IFDEF ITALIAN < 0 > IFDEF V30NOR < "E-200; "L-200; ".-200;40;0> IFDEF V30SWE < "E-200; "L-200; ".-100;40;0> NARG, IFNDEF DUTCH < 0 > IFDEF DUTCH < 40;0 > AARG, IFDEF ENGLSH < "A-200;"N-200;"D-200;40;0 > IFDEF ITALIAN < "E-200;40;0 > IFDEF V30NOR < "O-200;"G-200;40;0> IFDEF V30SWE < "O-200;"C-200;"H-200;40;0> IFDEF DUTCH <40;0> IFDEF SPANISH < "Y-200;40;0> RSYS, IFDEF ENGLSH < TEXT '^P^A&REPLACE THE SYSTEM DISKETTE IN DRIVE 0' > IFDEF ITALIAN < TEXT /^P^A&INSERIRE IL DISCO SISTEMA NELL'UNIT\@ 0/ > IFDEF V30NOR < TEXT '^P^A&SETT SYSTEMDISKETTEN TILBAKE I STASJON 0' > IFDEF V30SWE < TEXT '^P^A&S\DTT TILLBAKA SYSTEMDISKETTEN I ENHET 0' > IFDEF DUTCH < TEXT '^P^AZET DE SYSTEEMDISKETTE IN AANDRIJVER 0'> IFDEF SPANISH < TEXT '^P^AREPLACE THE DISKETTE IN UNIDAD 0'> CUSR1A, IFDEF ENGLSH < TEXT '^P&INPUT DOCUMENT: (^D.^D) ^A ' /M008 *.-1 TEXT '^P&USING SORT SPECIFICATION DOCUMENT: (^D.^D) ^A' *.-1 /THIS CLOBBERS ZERO WORD SO IOA WILL PROCESS MORE THAN 1 LINE PER CALL TEXT '^P&THE SORTED DOCUMENT WILL BE STORED IN: (^D.^D) ^A' *.-1 TEXT '^P&!D &KEY &SORT' > IFDEF ITALIAN < TEXT '^P&DOCUMENTO LISTA: (^D.^D) ^A ' /M008 *.-1 TEXT '^P&DOCUMENTO DI SPECIFICA ORDINAMENTO: (^D.^D) ^A ' *.-1 /THIS CLOBBERS ZERO WORD SO IOA WILL PROCESS MORE THAN 1 LINE PER CALL TEXT '^P&DOCUMENTO USCITA: (^D.^D) ^A ' *.-1 TEXT '^P&!D &CHIAVI &ORDINAMENTO' > IFDEF V30NOR < TEXT '^P&DOKUMENT SOM SKAL SORTERES: (^D.^D) ^A ' /M008 *.-1 TEXT '^P&BRUKER SORTERINGSSPESIFIKASJON: (^D.^D) ^A ' *.-1 /THIS CLOBBERS ZERO WORD SO IOA WILL PROCESS MORE THAN 1 LINE PER CALL TEXT '^P&SORTERT KOPI LAGRES I: (^D.^D) ^A' *.-1 TEXT '^P&!D SORTERINGSN\XKLER' > IFDEF V30SWE < TEXT '^P&DU ANV\DNDER REGISTERDOKUMENT (^D.^D) ^A ' /M008 *.-1 TEXT '^P&URVALSDOKUMENTET \DR (^D.^D) ^A' *.-1 TEXT '^P&DET SORTERADE REG (SLUTDOKUMENTET) \DR: (^D.^D) ^A ' *.-1 /THIS CLOBBERS ZERO WORD SO IOA WILL PROCESS MORE THAN 1 LINE PER CALL TEXT '^P&!D SORTERINGSNYCKEL' > IFDEF DUTCH < TEXT '^P&HET TE SORTEREN BESTAND IS: (^D.^D) ^A ' /M008 *.-1 TEXT '^P&DE SORTEERSPECIFICTIE IS: (^D.^D) ^A' *.-1 TEXT '^P&HET RESULTAT KOMT IN DOCUMENT: (^D.^D) ^A' *.-1 TEXT '^P&ER WORDT GESORTEERD OP !D VELD(EN).' > IFDEF SPANISH < TEXT '^P&DOCUMENTO DE ENTRADA: (^D.^D) ^A ' *.-1 TEXT '^P&USANDO DOCUMENTO ESPECIFICACI\SN CLASIFICACI\SN:^A ' /M008 *.-1 TEXT '^P&EL DOC. CLASIFICADO SE ALMACENAR\A EN: (^D.^D) ^A' *.-1 TEXT '^P&!D &CLAVE &CLASIFICACI\SN' > TSMALL, IFDEF ENGLSH < TEXT '^P!E&THERE IS NOT ENOUGH ROOM ON THE ^S !D ' /A030 *.-1 TEXT '^PFOR THE SORTED DOCUMENT.' >/M008 IFDEF ITALIAN < TEXT /^P!E&SPAZIO INSUFFICIENTE SULL'^S !D / /A030 *.-1 TEXT '^P' >/M008 IFDEF V30NOR < TEXT '^P!E&IKKE NOK PLASS P\E ^S !D ' /A030 *.-1 TEXT '^PTIL DET SORTERE DOKUMENTET.' >/M008 IFDEF V30SWE < TEXT '^P!E&DET FINNS INTE TILLR\CKLIGT MED ^S !D ' /A030 *.-1 TEXT '^PF\VR DET SORTERADE DOKUMENTET.' >/M008 IFDEF DUTCH < TEXT '^P!E&ONVLDOENDE RUIMTE OP ^S !D VOOR HET RESULTAAT. ^P' > IFDEF SPANISH < TEXT '^P!E&NO HAY SUFICIENTE ESPACIO EN EL ^S !D' *.-1 TEXT '^PPARA EL DOCUMENTO CLASIFICADO.' > NWDRV, IFDEF ENGLSH < TEXT '^P&SPECIFY ANOTHER ^S.' /M030/M021 > IFDEF ITALIAN < TEXT /^P&SPECIFICARE UN'ALTRA ^S./ /M030/M021 > IFDEF V30NOR < TEXT '^P&ANGI EN ANNEN ^S.'> IFDEF V30SWE < TEXT '^P&V\DLJ ANNAN ^S.'> IFDEF DUTCH < TEXT '^P&GEBRUIK EEN ^S MET MEER RUIMTE.'> IFDEF SPANISH < TEXT '^P&ESPECIFIQUE OTRO ^S.'> PTRBUS, IFDEF ENGLISH < TEXT '^P&THERE ARE DOCUMENTS PRINTING > IFDEF ITALIAN < TEXT '^P&CI SONO DOCUMENTI IN STAMPA.' > IFDEF V30NOR < TEXT '^P&UTSKRIVING AV DOKUMENTER P\EG\ER.' > IFDEF V30SWE < TEXT '^P&UTSKRIFT P\EG\ER JUST NU.' > IFDEF DUTCH < TEXT '^P&DE PRINTER IS IN GEBRUIK.'> IFDEF SPANISH DERR, IFDEF ENGLSH < TEXT '^P&THE ^S !D IS NOT A VALID DOCUMENT ^S.' /M030 *.-1 TEXT '^P&USE ANOTHER DOCUMENT ^S.' /M030 > IFDEF ITALIAN < TEXT /^P&^S !D NON \H UN VALIDO ^S. / /M030 *.-1 TEXT '^P&USARE UN ALTRO ^S.' /M030 > IFDEF V30NOR < TEXT '^P&^S !D ER IKKE EN GYLDIG DOKUMENT^S.' /M030 *.-1 TEXT '^P&BRUK EN ANNAN DOKUMENT^S.' /M030 > IFDEF V30SWE < TEXT '^P&^S !D \DR INTE ETT DOKUMENT SOM G\ER ATT ANV\DNDA^S.' /M030 *.-1 TEXT '^P&ANV\DND ETT ANNAT DOKUMENT ^S.' /M030 > IFDEF DUTCH < TEXT '^P&DE ^S !D IS GEEN DOCUMENT ^S.' /M030 *.-1 TEXT '^P&GEBRUIK EEN DOCUMENT ^S.' /M030 > IFDEF SPANISH < TEXT '^P&^P&EL ^S !D NO ES UN DOCUMENTO V\ALIDO ^S. ' /M030 *.-1 TEXT '^P&USE OTRO DOCUMENTO ^S.' /M030 > RPLACE, IFDEF ENGLSH < TEXT '^P&REPLACE THE DISKETTE WITH AN EMPTY DOCUMENT DISKETTE ' *.-1 TEXT '^POR ONE WITH MORE AVAILABLE SPACE.' > /M008 IFDEF ITALIAN < TEXT '^P&UTILIZZARE UN ALTRO DISCHETTO.^P' > /M008 IFDEF V30NOR < TEXT '^P&ERSTATT DEN MED EN DISKETTEN SOM HAR PLASS TIL DET' *.-1 TEXT '^PSORTERTE DOKUMENTET.' > /M008 IFDEF V30SWE < TEXT '^P&ERSTATT DEN MED EN DISKETTEN SOM HAR PLASS TIL DET' *.-1 TEXT '^PSORTERTE DOKUMENTET.' > /M008 IFDEF DUTCH < TEXT '^P&VERVANG DE DISKETTE DOOR EEN LEGE DOCUMENTDISKETTE ' *.-1 TEXT '^P OF EEN MET MEER RUIMTE.' > IFDEF SPANISH < TEXT '^P&RETIRE EL DISKETTE DOCUMENTO Y C\AMIELO POR UN DISKETTE HAY ' *.-1 TEXT '^P M\AS ESPACIO'> RMOVE0, IFDEF ENGLSH < TEXT '^P&REMOVE THE DISKETTE IN DRIVE 0.' *.-1 TEXT'^P&REPLACE IT WITH A DOCUMENT DISKETTE TO ACCOMMODATE THE SORTED DOCUMENT.' > IFDEF ITALIAN < TEXT /^P&TOGLIERE IL DISCHETTO DALL'UNIT\@ 0 / *.-1 TEXT'^PE SOSTITUIRLO CON UN ALTRO.' > IFDEF V30NOR < TEXT '^P&FJERN DISKETTEN I STASJON 0 .' *.-1 TEXT '^P&ERSTATT DEN MED EN DOKUMENTDISKETT SOM HAR PLASS TIL DET SORTERTE' *.-1 TEXT ' DOKUMENTET' > IFDEF V30SWE < TEXT '^PTA UT DISKETTEN I ENHET 0 . ' *.-1 TEXT '^P&ERSTATT DEN MED DOK.DISKETT SOM KAN TA EMOT DET SORTERADE DOKUMENTET' > IFDEF DUTCH < TEXT '^P&VERVANG DE DISKETTE IN AANDRIJVER 0.' *.-1 TEXT'^PDOOR DE DISKETTE WAAROP HET RESULTAAT MOET KOMEN.' > IFDEF SPANISH < TEXT '^P&RETIRE EL DISKETTE DEL LA UNIDAD 0.' *.-1 TEXT '^PC\AMIELO POR UN DISKETTE DOC. PARA ACOMODAR EL DOC. CALSIFICADO'> / NOTE THAT A DOES NOT EXIST BETWEEN THE WORDS 'SORT' AND 'ON' / BECAUSE THE SUBROUTINE ( 'RD1CHR' ) WHICH GETS A CHARACTER / FROM THE SPECIFICATION DOCUMENT IGNORES IF ENTERED WITH THE AC=0 / / THEREFORE THE SUBROUTINE 'TXTCOM' WHICH COMPARES TWO CHARACTERS / ( ONE OF WHICH IS A CHARACTER FROM THE SPEC DOC) - IGNORES / IFDEF ENGLSH < MSORTON, TEXT 'SORTON' / USED BY 'TXTCOM' MINA, TEXT 'INA' /USED BY TXTCOM ME, TEXT 'E' /USED BY TXTCOM MSCENDING, TEXT 'SCENDING' /USED BY TXTCOM MORDER, TEXT 'ORDER' /USED BY TXTCOM MAND, TEXT 'AND' /USED BY TXTCOM /A007 > IFDEF ITALIAN < MSORTON, TEXT 'ORDINAMENTODI' / USED BY 'TXTCOM' MINA, TEXT 'INORDINEC' /USED BY TXTCOM ME, TEXT 'EC' /USED BY TXTCOM MSCENDING, TEXT 'RESCENTE' /USED BY TXTCOM MORDER, TEXT '' /USED BY TXTCOM MAND, TEXT 'E' /USED BY TXTCOM /A007 > IFDEF V30NOR < MSORTON, TEXT 'SORTERETTER' MINA, TEXT 'ISTIG' ME, TEXT 'NK' MSCENDING, TEXT 'ENDE' MORDER, TEXT 'REKKEFOLGE' MAND, TEXT 'OG' > IFDEF V30SWE < MSORTON, TEXT 'SORTERAEFTER' MINA, TEXT 'ISTIG' ME, TEXT 'ALL' MSCENDING, TEXT 'ANDE' MORDER, TEXT 'ORDNING' MAND, TEXT 'OCH' > IFDEF DUTCH < MSORTON, TEXT 'SORTEEROP' MINA, TEXT 'INOP' ME, TEXT 'F' MSCENDING, TEXT 'LOPENDE' MORDER, TEXT 'VOLGORDE' MAND, TEXT 'EN' > IFDEF SPANISH < MSORTON, TEXT 'CLASIFICARSEGUN' MINA, TEXT 'ENORDENA' ME, TEXT 'E' MSCENDING, TEXT 'SCENDENTE' MORDER, TEXT '' MAND, TEXT ',' > HC, /POSITION CURSOR TEXT '^P' /M008 PSCR, TEXT '^P!E' ASTRING, /POSITION THE CARET TEXT '^A' ACARET, LF;BACKSP;"^-200;CR;LF;0 ASDK, ESC;"(;"0&177 /TURN ON GRAPHICS MODE ESC;"0;"G-140 /DISPLAY DEAD KEY SEQUENCE ESC;"(;"B&177 /TURN OFF GRAPHICS MODE AGAIN 0 CRLF, CR;LF;0 MWHAT, IFDEF ENGLSH < TEXT '&E&R&R&O&R--SPECIFICATION NOT UNDERSTOOD STARTING AT THIS POINT.' > IFDEF ITALIAN < TEXT '!&ERRORE--SPECIFICA NON CORRETA DA QUESTO PUNTO.' > IFDEF V30NOR < TEXT '!&FEIL--FORST\ER IKKE SPESIFAKASJONEN FRA DETTE PUNKTET." > IFDEF V30SWE < TEXT '!&FEL - URVALSDOKUMENTET KAN INTE INLEDAS P\E DETTA S\DTT'> IFDEF DUTCH < TEXT '!&FOUT: &SPECIFICATIE NIET BEGREPEN VANAF DIT PUNT'> IFDEF SPANISH < TEXT '!&ERROR--NO SE HA ENTENDIDO LA ESPECIFICACI\SN COMENZANDO EN ESTE PUNTO.'> IFDEF ENGLSH < FSERR, TEXT '^D FIELD NAMES HAVE BEEN SPECIFIED. &TEXT FOLLOWING THE' /M021 FSER2, TEXT 'LAST COMPLETE KEY FIELD SPECIFICATION WILL BE IGNORED.' /M021 PRCON, TEXT '&PRESS &R&E&T&U&R&N TO CONTINUE.' /A007 > IFDEF ITALIAN < FSERR, TEXT '^D CAMPI NOME SPECIFICATI. &IL TESTO CHE SEGUE' /M021 FSER2, TEXT /L'ULTIMO CAMPO SPECIFICATO VIENE IGNORATO./ /M021 PRCON, TEXT '&PREMERE !&RITORNO PER CONTINUARE.' /A007 > IFDEF V30NOR < FSERR, TEXT '^D FELTNAVN ER SPESIFISERT. &DET VIL IKKE BLI TATT HENSYN' /M021 FSER2, TEXT 'TIL TEKST SOM ST\ER ETTER SISTE FULLSTENDIGE FELTSPESIFIKASJON.'/M021 PRCON, TEXT '&TRYKK P\E !&RETUR FOR \E FORTSETTE.' /A007 > IFDEF V30SWE < FSERR, TEXT '^D F\DLTNAMN HAR SPECIFICERATS.&TEXT SOM FINNS EFTER DEN' FSER2, TEXT 'SISTA FULLST\DNDIGA SORTERINGNYCKELN KOMMER INTE ATT BEHANDLAS.' PRCON, TEXT '&TRYCK P\E !&RETUR F\VR ATT FORTS\DTTA.'> IFDEF DUTCH < FSERR, TEXT '&E ZIJN ^D VELDNAMEN OPGEGEVEN. &TEKST NA DE LAATSTE' FSER2, TEXT 'VELDNAAMSPECIFICATIE ZAL WORDEN GENEGEERD.' PRCON, TEXT '&DRUK OP !&RERTURN OM VERDER TE GAAN.'> IFDEF SPANISH < FSERR, TEXT '&SE HAN ESPECIFICADO NOMBRESS DE CAMPO^D. &TEXTO QUE SIGUE HA' FSER2, TEXT '&SE IGNORAR\A LA \ZLTIMA ESPECIFICACI\SN DE CAMPO DE CLAVE CPMPLETA.' PRCON, TEXT '&PULSE !&RETORNO PARA CONTINUAR' > BELTXT, BELL;0 GOTXT, IFDEF ENGLSH < TEXT 'GO' > IFDEF ITALIAN < TEXT 'E' > IFDEF V30NOR < TEXT 'ST' > IFDEF V30SWE < TEXT 'OK' > IFDEF DUTCH < TEXT 'SV'> IFDEF SPANISH < TEXT 'GO'> SRDRV, /A030 IFDEF ENGLSH < TEXT 'DRIVE'> /A030 IFDEF ITALIAN < TEXT 'UNIT\@'> /A030 IFDEF V30NOR < TEXT 'STASJON'> IFDEF V30SWE < TEXT 'ENHET'> IFDEF DUTCH < TEXT 'AANDRIJVER'> IFDEF SPANISH < TEXT 'UNIDAD'> SRDEV, /A030 IFDEF ENGLSH < TEXT 'DEVICE'> /A030 IFDEF ITALIAN < TEXT 'UNIT\@'> /A030 IFDEF V30NOR < TEXT 'ENHET'> IFDEF V30SWE < TEXT 'ENHET'> IFDEF DUTCH < TEXT 'AANDRIVJVER'> IFDEF SPANISH < TEXT 'DISPOSITIVO'> DERDS1, /A030 IFDEF ENGLSH < TEXT 'DISKETTE IN DRIVE'> /A030 IFDEF ITALIAN < TEXT /ARCHIVIO DOCUMENTI NELL'UNIT\@/ > /A030 IFDEF V30NOR < TEXT 'DISKETTEN I STASJON'> IFDEF V30SWE < TEXT 'DISKETTEN I ENHET'> IFDEF DUTCH < TEXT 'DISKETTE IN AANDRIJVER'> IFDEF SPANISH< TEXT 'DISKETTE EN UNIDAD'> DERDS2, /A030 IFDEF ENGLSH < TEXT 'DISKETTE'> /A030 IFDEF ITALIAN < TEXT 'SUPPORTO'> /A030 IFDEF V30NOR < TEXT 'DISKETT'> IFDEF V30SWE < TEXT 'DISKETTEN'> IFDEF DUTCH < TEXT 'DISKETTE'> IFDEF SPANISH DERVL1, /A030 IFDEF ENGLSH < TEXT 'VOLUME ON DEVICE'> /A030 IFDEF ITALIAN < TEXT /ARCHIVIO DOCUMENTI NELL'UNIT\@/ > /A030 IFDEF V30NOR < TEXT 'OMR\EDET P\E ENHET'> IFDEF V30SWE < TEXT 'VOLYMEN I ENHET'> IFDEF DUTCH < TEXT 'GEBIED OP AANDRIJVER'> IFDEF SPANISH < TEXT 'VOLUMEN EN DISPOSITIVO'> DERVL2, /A030 IFDEF ENGLSH < TEXT 'VOLUME'> /A030 IFDEF ITALIAN < TEXT 'SUPPORTO'> /A030 IFDEF V30NOR < TEXT 'OMR\DE'> IFDEF V30SWE < TEXT 'VOLYMEN'> IFDEF DUTCH < TEXT 'GEBIED'> IFDEF SPANISH < TEXT 'VOLUMEN'> DERDKV, /A030 IFDEF ENGLSH < TEXT 'DISKETTE/VOLUME'> /A030 IFDEF ITALIAN < TEXT 'SUPPORTO'> /A030 IFDEF V30NOR < TEXT 'DISKETT/OMR\DE'> IFDEF V30SWE < TEXT 'DISKETTEN/VOLYMEN'> IFDEF DUTCH < TEXT 'DISKETTE/GEBIED'> IFDEF SPANISH< TEXT 'DISKETTE/VOLUMEN'> TSDEV, /A030 IFDEF ENGLSH < TEXT 'DRIVE/DEVICE'> /A030 IFDEF ITALIAN < TEXT 'SUPPORTO'> /A030 IFDEF V30NOR < TEXT 'STASJON/ENHET'> IFDEF V30SWE < TEXT 'ENHET'> IFDEF DUTCH < TEXT 'AANDRIVJER'> IFDEF SPANISH < TEXT 'UNIDAD/DISPOSITIVO'> /XSDFNBUFFER,ZBLOCK FNSIZE+1^MXFLD+1 /MXFLD 12(10) FNSIZE+1 31(10) D007 /CHAR BUFFER EACH KEY /SEPARATED BY [0]TERM /BUFFER ENDS WITH [-1] TERM /THE XSDFNBUFFER BUFFER WILL BE DEFINED IN THE SORT FIELD DUE TO SPACE /CONSTRAINTS IN EDIT FIELD CUB1, ZBLOCK 400 INBUF, -STRLEN ZBLOCK STRLEN+1 PAGE / 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 / WPUDKS 3.3 / .VERSION / / / / COPYRIGHT (C) 1980 / DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754 / / THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED / ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE / INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER / COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY / OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY / TRANSFERRED. / / THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE / AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT / CORPORATION. / / DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS / SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. / /++ / FACILITY: / / ABSTRACT: / / ENVIRONMENT: / / AUTHOR: CREATION DATE: / / MODIFIED BY: / / 039 EMcD 12-Sep-85 Add Nordic translations / 038 EMcD 28-Aug-85 Show insert_overstrike Key / 037 EMcD 13-JUl-85 Display FAO Gold Commands (conditional) / 036 AH 28-OCT-84 EXTENSION TO 035 / 035 AH 28-SEP-84 ADD CODE TO SAVE/RESTORE SYSTEM / VALUES ACROSS DIRECTORY READ/WRITES / 034 AH 17-AUG-84 CHANGE TEXT FOR ALT CHR DISPLAY / 033 AH 17-JUL-84 MORE OF ONE SCREEN; 20 LINES + 1 KEYSTR / 032 AH 13-JUL-84 SET UDK KEYSTROKE INPUT TO ONE SCREEN / 031 AH 12-JUL-84 ASSIGN NUMBER TO OLD EDITS / 030 AH 11-JUL-84 BELL ON ILLEGAL INPUT / 029 JAC 10-JUL-84 ALLOW DELETES AT END OF FULL UDKS / 028 AH 09-JUL-84 CHANGE TO LOAD FROM LOC 0 / 027 JAC 13-JUN-84 REFINEMENT OF BELOW / 026 JAC 12-JUN-84 FIX TO FULL UDK'S PROBLEMS / 025 JAC 08-JUN-84 MR. H'S FIX TO SQUEEZE ACROSS SECTORS / 024 JAC 30-MAY-84 ADAM'S FIX TO UNDEFINED UDK0 / 023 JAC 08-MAY-84 100 UDK DEVELOPMENT / 022 DKR 30-MAY-84 Changed "Tabcen" to "G-Tab" for when / Gold:Tab is entered / 021 EJL 08-may-84 added technical character / Removed all occurances of USERNO / 020 AH 21-MAR-84 ADDED CODE FOR COLUMN CUT / 019 WJY 03-FEB-84 DECmate I compatability. / 018 DMB 31-AUG-83 Added new key names for DM2V15 / 017 WCE 17-AUG-83 Removed code that generates CDF/CIF's / 016 TCW 19-MAY-83 CHANGE POSITION OF COMMAND KEY / 015 EPS 28-SEP-82 FIXED CODE MODIFIED IN 0014 / 014 EPS 23-SEP-82 FIXED CODE MODIFIED IN 0013 / 013 EPS 10-SEP-82 ADDED END OF TABLE CHECK / 012 EPS 09-SEP-82 ADDED HELP KEY FOR DECMATE II / 011 EH 30-SEP-81 Removed "MAIN" from message at CUDMS3 / 010 GDH 01-SEP-81 New Write-out code conventions. / 009 JM 01-SEP-81 Fixed GOLD CONT SRCH & SEL for ENGCAN / 008 TT 07-JUL-81 Removed superfluous conditionals / 007 DM,JM 15-SEP-80 Merged Scandi and Europe/English / 006 REG 12-AUG-80 ADDED THIS STANDARD HEADER / 005 CMW 06-AUG-80 MADE GRAMMATICAL DUTCH CHANGES / 004 DSS 09-JUL-80 MODIFIED FOR ENGLISH/FRENCH-CANADIAN / 003 CMW 06-MAY-80 ENTERED CANADA TRANSLATIONS / 002 DSS 17-APR-80 ENTERED DUTCH FIXES / 001 CMW GLT 01/10/80 ADDED FRENCH, DUTCH, GERMAN TRANSLATIONS / / Note: changes other than text translation / / must be performed on this module. CUDTAB / / must be modified to reflect any keyboard / / changes. (see CUDTAB). / / French diacritical substitutions: / / "&["=degree;"["=L.A.E, "]"=L.G.E; "&" not usable / / German diacritical substitutions: / / "["=L.U.A, "\"=L.U.O, "]"=L.U.U; "&" causes / / capitalization / 2.L-1 RLT 09/09/77 CHANGE OVERLAY LENGTH / 2.K-1 RLT 08/31/77 CHANGE TO ASSEMBLE PROPERLY / 2.G-1 MB PUT IN NEW OVERLAY TO HELP EDITOR / /-- / / WPUDKS - USER DEFINED KEYS / / ***** NOTE-- THE EDITOR LOADS THIS OVERLAY, AND KNOWS ITS LENGTH ***** / *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLOUDK / ++++ 000 / ++++ /C028 CDF 20 / ++++ -DSOUDK 0 /D017 / /D017 / THIS IS THE PATCH TO PAGE ZERO THAT WILL CONTAIN THE ROUTINES /D017 / THAT WILL TAKE CARE OF THE CDFS AND CIFS. /D017 / /D017 / CONSTANT USED TO FORM A CDF CIF CALL TO CIDPAT /D017 / /D017 CDIF00=CDF CIF /D017 / /D017 / THE USER FIELD CONSTANTS /D017 / /D017 USRFL0=-20 /D017 USRFL1=-10 /D017 USRFL2=0 /D017 / FIELD 2 / *100 / THE FIRST 100 LOCATIONS ARE USED FOR THE SYSTEM / /D017 CDIMNU=JMS . /D017 XX /D017 JMS CIDPAT / CALL THE ALL PURPOSE ROUTINE /D017 CDIF00+USRFL0 / FOR A CDF CIF MENU /D017 / /D017 CDFMNU=JMS . /D017 XX / THIS WILL CREATE A CDF FOR THE MENU FIELD /D017 JMS CIDPAT / CALL THE GENERAL ROUTINE THAT HANDLES ALL CDF OR CIFS /D017 CDF+USRFL0 / THE ARGUEMENT FOR CIDPAT /D017 / /D017 CIFMNU=JMS . /D017 XX / CREATE A CIF MENU FIELD /D017 JMS CIDPAT / RUOTINE THAT WILL CREATE THE INSRTUCTION /D017 CIF+USRFL0 /D017 / /D017 CDFMYF=JMS . /D017 XX / GENERATE A CDF INSTRUCTION FOR THIS FIELD /D017 JMS CIDPAT / ROUTINE THAT WILL CREATE THE INSTRUCTION /D017 CDF+USRFL2 / THIS FEILD IS USER FIELD ONE /D017 / /D017 CIDPAT, /D017 XX / THE ALL POURPOSE ROUTINE FOR THE INSTRUCTIONS /D017 DCA CIDTM1 / SAVE THE AC /D017 RAL / ++++ /D017 DCA CIDTM3 / SAVE LINK /D017 RIF / FIND OUT THE INSTRUCTION FIELD SO TO SET THE DATA /D017 / FIELD TO THE SAME /D017 TAD CDF0 /D017 DCA .+1 / STORE TO EXECUTE /D017 CIDTM2, /D017 XX / LOCATION LEFT FOR THE INSTRUCTION /D017 AC7776 / NOW GET THE ADDRESS OF THE CALLER /D017 TAD CIDPAT / SUBTRACTING THE 2 GETS YOU TO THE ADDRESS /D017 DCA CIDTM2 /D017 AC7777 /D017 TAD I CIDTM2 / GET THE ADDRESS OF THE CALLER FROM THE PROGRAM /D017 DCA CIDTM2 / STORE IT SO A RETURN CAN BE MADE FROM THE /D017 / INTERNAL ROUTINE /D017 RIF /D017 TAD I CIDPAT / GET AND STORE THE GENERATED INSTRUCTION /D017 DCA I CIDTM2 /D017 TAD CIDTM3 / ++++ /D017 CLL RAR / RESTORE LINK /D017 TAD CIDTM1 / GET THE OLD CONTENTS OF THE AC /D017 JMP I CIDTM2 / JUMP TO THE INSTRUCTION NOW CREATED /D017 / /D017 CIDTM1, /D017 0 /D017 CIDTM3, 0 / NOW TO USE SOME OF THE SPACE SAVED ON PAGE 0 TO REMOVE SOME /A024 / INDIRECTS AND MAKE ROOM FOR SOME MORE CODE /A024 CUDILX, CUDILM / CHECK FOR INPUT BUFFER OUT OF ROOM /A024 CUDFMX, CUDFMS / HANDLE OUT OF ROOM /A024 CUDSTX, CUDSTR / STORE KEYSTROKE IN UDK /A024 CURWUX, CURWUD / READ/WRITE UDK BLOCK /A024 CUDCOX, CUDCOD / DECODE UDK DIRECTORY ENTRY /A024 CURWDX, CURWDI / READ/WRITE UDK DIRECTORY /A024 CUDXBC, CUDXBF / BUFFER ADDRESS /A024 CUDREX, CUDRET / PROGRAM EXIT /A026 CUDPOX, CUDPOS / POSITION CURSOR /A026 CUDOUX, CUDOUT / OUTPUT CHARACTER TO SCREEN /A026 CUDP7, 7 / CONSTANT /A026 CUDSLX, CUDSLM / CHECK FOR ROOM IN OUTPUT BUFFER /A027 CUDGCX, CUDGCR / GET USER INPUT FROM KEYBOARD /A031 CUDIMX, CUDIMV / MOVE FROM PLACE TO PLACE /A031 CUM120, -120 / CHARACTERS ON LINE /A031 BUFEND, CUDBUF+CUBFSZ-1 / END OF BUFFER 1 /A033 XBFEND, CUDXBF+CUBFSZ-1 / END OF BUFFER 2 /A033 MDLUM1, -DLUDKS-1 / -START BLOCK -1 /A033 DLUDP1, DLUDKS+1 / START BLOCK + 1 /A033 DLUDM1, DLUDKS-1 / START BLOCK -1 /A033 DLUCUN, DLUDKS+CUNBLK / START BLOCK + NUMBER OF BLOCKS /A033 DECIMAL /A032 /D033 MSCRCT, -1600 / NUMBER OF CHARACTERS DISPLAYED /A032 MLINCT, -19 / NUMBER OF LINES /A033 OCTAL /A032 CUDFMY, CUDFMM / POINTER TO A MESSAGE DISPLAY /A032 CUDDSX, CUDDSP / POINTER TO KEYSTROKE DISPLAY /A032 CUDDIX, CUDDIS / POINTER TO UDK DISPLAY /A032 CNTSCX, CNTSCR / TEST NUMBER OF CHARS. ON SCREEN /A032 CUDCLX, CUDCL0 / CLOSE UDK /A033 CUDDGX, CUDDG0 / ACCEPT AND SCAN KEYBOARD INPUT /A033 CUDK4, CUUDF1 / POINTER; MOVED FOR ROOM /A035 / THE FOLLOWING ARE MOVED HERE FROM PAGE 2 /M024 6 LINES CUDIPT, 0 / ADDRESS OF UDK DIRECTORY SLOT CUUDKB, 0 / STARTING BLOCK CUUDKW, 0 CUUDKY, 0 / RELATIVE ADDRESS OF FIRST WORD OF UDK CUUDKD, 0 / USED ELSEWHERE AS WORKING POINTER CUUDKC, 0 / STARTING BLOCK / END M024 CUDRUB, 0 / VALUE FOR RUBOUT /M033 CUDNRB, 0 / NEGATIVE RUBOUT TO RESTORE VALUE /M033 CUDLIN, 0 / COUNTER FOR CUM120 /A031 LINCNT, 0 / COUNTER FOR NUMBER OF CHARS. /A032 CUGASW, 1 / MOVED FROM PAGE 3 /M024 / ......... A035 ......... / PLACE FOR SYSTEM VERSION, GENERATION DATE, OTHER VALUES / VALUES PLACED IN BLOCK "DLUDKS" IN SOURCE "WPUDKD" CUDP3, 3 / CONSTANT, MASK CUFUNC, 0 / TEMP STORE FOR DISK FUNCTION UDSYNM=14 / NUMBER OF PARAMETERS SAVED /A036 UDSYDA, ZBLOCK UDSYNM / EDITOR RULERS DLRLRE /A036 / PRINTER SETTINGS DLRLRP /A036 / SYSTEM PARAMETERS DLSVAL /A036 / START OF UDK DEFINITIONS DLUDKD /A036 / SYSTEM VERSION #; 8 BIT ASCII; 3 WORDS SYSVER / BASE LEVEL SYSBAS / REV. LEVEL SYSREV / BUILD DAY BLDDY / MONTH BLDMO / YEAR BLDYR / "UD" UDK DIRECTORY BLOCK IDENTFIER, WORD 1 CURWAA, 0 CUDILA, 0 / "K"0 WORD 2 ENDCOD=. / ........ END A035 .......... PAGE CDFMYF=CDFBUF / INSTRUCTION TO RETURN TO THIS FIELD /A017 CUDBUF=UDKSTR / THE BUFFER IS AT THE SAME ADDRESS AS IN THE / MENU FIELD / CUUDKR, XX / CUUDDF - DEFINE USER KEYS CLA RDF TAD CIDF0 DCA CUUDKX CDFMYF JMS CUUDDF CUUDKX, XX JMP I CUUDKR CURWDI, XX / POINTED TO BY CURWDX /C024 DCA QUQBLK+RXQDRV / SET DRIVE /C027 RDF TAD CDF0 DCA QUQBLK+RXQBFD / SET CDF TAD I CURWDI / FUNCTION DCA QUQBLK+RXQFNC / .......... A035 ............. / RESTORE VALUES BEFORE DIRECTORY WRITE TAD QUQBLK+RXQFNC / GET FUNCTION DCA CUFUNC / SAVE THE REQUESTED FUNCTION BECAUSE I DON'T / KNOW IF THE PARAMETER BLOCK IS INVIOLATE TAD CUFUNC / TEST FOR WRITE AND CUDP3 / 3=READ; (2)004=WRITE SZA CLA / SKIP IF WRITE JMP CURWYY / IS READ JMS I CUDIMX / MOVE VALUES TO BUFFER FOR WRITE CUDBUF+CUBFSZ-UDSYNM / DESTINATION /C036 UDSYDA / SOURCE -UDSYNM / COUNT /C036 CURWYY, / ........ END A035 ......... TAD (CUDBUF DCA QUQBLK+RXQBAD TAD (DLUDKS DCA QUQBLK+RXQBLK JMS QURX / WRITE OUT NEW UDK BLOCK CLA / ............ A035 ............... TAD CUFUNC / TEST ROR READ AND CUDP3 SNA CLA / 3=READ JMP CURWZZ / NOT READ JMS I CUDIMX / MOVE VALUES FROM BUFFER TO SAVE UDSYDA / DESTINATION CUDBUF+CUBFSZ-UDSYNM / SOURCE /C036 -UDSYNM / COUNT /C036 CURWZZ, /........... END A035 ........... ISZ CURWDI JMP I CURWDI QURX, XX CLA CIFSYS / ++++ ENQUE / ++++ QUBLK CIFSYS / ++++ JWAIT TAD QUQBLK+RXQCOD SNA / ++++ JMP .-4 JMP I QURX / QUBLK, DSKQUE / ++++ 0 / ++++ 0 QUQBLK, ZBLOCK 17 / /D023 PAGE CUDPTR= X0 CUDCUR= X1 CUDNXT= X2 / /D023 CDFUDK=CDFMNU / CUUDDF, 0 / THIS ROUTINE ACCEPTS CHARACTERS FROM THE / KEYBOARD AND STORES THEM IN THE UDK / SPECIFIED BY THE NUMBER IN MNTMP1. / TAD MNUCAL+1 / GET UDK TO MODIFY FROM THE MENU TAD (MNTMP1 DCA T1 CDFMNU TAD I T1 CDFMYF DCA CUDNUM / SAVE UDK NUMBER AC7777 / TURN OFF UDK'S CIFSYS / ++++ UDKOPS CIFMNU / JMS I IOACAL / Definition of user key #. Press gold halt to 0 / default output routine CUDMS1 / string address 0 / Cursor position IFNDEF FRENCH < IFNDEF CANADA < 10 / Cursor position (not in french or canada) >> CUDNUM, 0 / UDK number IFDEF V30NOR < CUTRYK > / /D033 TAD CUDNUM / UDK NO. /C023 /D033 TAD (CUDBUF / /C023 /D033 DCA CUDADR TAD CUDNUM / FIGURE OUT VALUE FOR RUBOUT CIA TAD (-EDUDK0 DCA CUDRUB / AND SAVE IT TAD CUDRUB / NOW GET NEG. RUBOUT VALUE CIA DCA CUDNRB / AND SAVE IT ALSO JMS I CURWDX /READ UDK DIRECTORY (CURWDI) /C024 RXERD TAD CUDNUM / CONSTRUCT ADDRESS OF DIRECTORY ENTRY TAD (CUDBUF DCA CUDIPT TAD CUDIPT / SAVE FOR INDIRECT USE DCA T3 IAC / SET HERE IN CASE CLEARED BY "CUUNDF" DCA CUGASW / AND PROGRAM NOT RELOADED TAD I T3 / GET ADDRESS OF UDK FROM DIRECTORY SZA CLA / IS THE UDK DEFINED JMP CUDK1 / YES, DO DECODE AND SQUEEZE JMS CUUNDF / NO, FIND LAST UDK; NO RETURN IF NO ROOM/C027 JMP CUDK2 CUDK1, JMS I CUDCOX / DECODE DIRECTORY ENTRY (CUDCOD) /C024 TAD CUUDKY / SET UP POINTER TO INPUT BUFFER TAD CUDXBC / (CUDXBF /C024 DCA CUDPTR CUDK2, JMS I CURWUX / READ THE FIRST BLOCK OF THE UDK(CURWUD) /C024 RXERD CUDXBF CUUDKC /D031 JMS CUUDF1 / CONTINUATION OF CODE JMP I CUDK4 / CONTINUATION OF CODE /A031 CUDRET, / PROGRAM EXIT /M031 CIFSYS / ENABLE UDK'S /M031 UDKOPS /M031 JMP I CUUDDF / DONE /D035 CUDK4, CUUDF1 / MOVED TO PAGE 0 FOR ROOM /A031 PAGE CUUDF1, /D031 XX JMS I CUDDIX / SHOW USER THE UDK DEFINITION /C032 CUDINP, JMS I CUDDGX / GET FIRST CHAR /C023 /C033 JMP I CUDREX / HLT SET, JUST RETURN /C031 JMP CUDINP / ILLEGAL INPUT - NOT DIG, (DIG), RET /A030 DCA CUDCHR / SAVE CHAR TAD CUDCHR / GET CHAR BACK TAD CUDRUB / AND MAKE SURE IT WASN'T A RUBOUT SZA CLA JMP CUDIN2 / NOT, KEEP GOING TAD CUDP7 / WAS, RING THE BELL (WAS TAD (7 ) /C026 JMS I CUDOUX / DING-DONG AVON CALLING (CUDOUT) /C026 JMP CUDINP / AND LOOK FOR SOMETHING BETTER / CUDIN2, JMS CUDIN3 / DISPLAY HEADER /A032 TAD CUGASW / SQUEEZE ONLY IF WE ARE ACCESSING AN /A023 SZA CLA / EXISTING UDK; OTHERWISE WE ARE AT THE /A023 / RIGHT PLACE TO START INSERTING /A023 JMS CUDGAR / SQUEEZE /BACK FROM MOVING ALL THE UDK'S. /CUUDKB CONTAINS FIRST BLOCK OF THIS UDK /CUUDKY CONTAINS RELATIVE WORD / /READ BLOCK CONTAINED IN CUUDKB INTO CUDBUF /SET UP CUDPTR USING CONTENTS OF CUUDKY /STORE UDK # & WE ARE READY TO STORE INPUT / JMS I CURWUX / READ A BLOCK (CURWUD) /C024 RXERD CUDXBF CUUDKB TAD CUUDKB / REFERENCE POINTER DCA CUUDKD / WORKING CLA CMA / SET UP POINTER TAD CUUDKY TAD CUDXBC / (CUDXBF /C024 DCA CUDPTR JMS I CUDSLX / CHECK BUFFER BOUNDRIES /A033 NOP / STORAGE CANNOT BE FULL / TESTED IN UNDEFINED UDK OR / DEFINED UDK HAS BEEN DELETED TAD CUDNUM / OK; ENCODE & STORE UDK NUMBER TAD (CUUDID JMS I CUDSTX / (CUDSTR) /C024 /D033 JMP CUNORM / STORAGE FULL; SHOULD NOT GET HERE /C027 / FULL STORAGE WITH UNDEFINED UDK /C027 / TAKEN CARE OF IN (CUUNDF) /C027 / JMP I CUDFMX / NO ROOM, QUIT (CUDFMS) /C024 /D026 / DCA I CUDPTR /D023 /D031 TAD (-120 / RESET LINE CHAR COUNT TAD CUM120 / RESET LINE COUNT /A031 DCA CUDLIN TAD MLINCT / NUMBER OF LINES TO DISPLAY /A033 DCA LINCNT JMS I CUDSLX / TEST FOR BUFFER FULL BEFORE STORE /A033 NOP /A033 TAD CUDCHR / GET CHAR BACK JMP CUDIN1 / AND STORE IT CUDIN4, /A033 JMS I CUDSLX / TEST FOR BUFEER AND STORAGE FULL /A033 JMP I CUDFMX / STORAGE FULL /A033 TAD LINCNT / TEST FOR FULL SCREEN /A033 SNA CLA /A033 JMP I CNTSCX / SCREEN FULL; LOOK FOR R.O. OR G-HALT /A033 CUDINL, JMS I CUDDGX / GET A CHAR /C023 /C033 JMP I CUDCLX / HALT SET, ALL DONE /C023 /C033 JMP CUDINL / ILLEGAL INPUT /A030 TAD CUDRUB / CHECK IF RUBOUT ? SNA JMP CUDRUT / YES, REMOVE LAST CHAR TAD CUDNRB / NO, GET CHAR BACK CUDIN1, /D033 JMS I CUDSLX / SEE IF ROOM, NEEDED WHEN IN LAST BLOCK/A027 /D033 / CHAR IN AC IN, & OUT IF OK TO STORE /A027 /D033 JMP I CUDFMX / NO ROOM, AC = 0 /A027 /D032 JMS CUDDSP / DISPLAY CHAR; ABLE TO STORE /C027 /D033 JMS I CNTSCX / COUNT CHARS. ON SCREEN /A032 JMS I CUDDSX / DISPLAY KEYSTROKE; ABLE TO STORE /A032 / EXCEPT IF SCREEN FULL /A032 JMP CUDINL / JUMP IF CHARACTER IGNORED /A015 JMS I CUDSTX / STORE CHAR (CUDSTR) /C024 /D033 JMP I CUDFMX / NO MORE ROOM (CUDFMS) /C024 TAD CUUDKD / KEEP POINTERS IN SYNC /A023 DCA CUUDKC /A023 /D033 JMP CUDINL / ALL O.K., KEEP GOING JMP CUDIN4 / SEE IF ROOM BEFORE NEXT KEYSTROKE /A033 / /M031 CUDRET, CIFSYS / ++++ /M031 UDKOPS / TURN UDK'S BACK ON /M031 JMP I CUUDF1 / AND RETURN /C023 CUDCHR, 0 /A023 /D033 CUDRUB, 0 /A023 /D033 CUDNRB, 0 /A023 /D033 CUDADR, 0 /A023 /D033 CUDSWT, 0 /A023 / /RUBOUT OUT A CHARACTER /WATCH OUT FOR UDK BEGINNING, BUFFER BOUNDRY, BLOCK HANDLING /CUUDKB: STARTING BLOCK; CUUDKY: STARTING WORD CUDRUT, JMS CUDRU0 / CHECK FOR END OF BUFFER, ADJUST POINTERS TAD CUDNUM TAD (CUUDID CIA TAD I T1 SNA CLA / IS CURRENT CHARACTER THE UDK ID? JMP CUDRBL / YES, SET SWITCH DCA I T1 / COMMAND; LEGAL TO REMOVE CHARACTER CMA TAD T1 / BACK UP POINTER DCA CUDPTR JMS I CURWUX / WRITE THE ALTERED BLOCK (CURWUD) /C024 RXEWT+2000 CUDXBF CUUDKD JMS I CURWUX / SET UP TO REPAINT THE SCREEN (CURWUD) /C024 RXERD CUDXBF CUUDKB TAD CUUDKY / SET POINTER TO FIRST WORD TAD CUDXBC / (CUDXBF /C024 DCA CUDPTR TAD CUUDKB / RESET BLOCK POINTER DCA CUUDKC JMS CUDIN3 / DISPLAY HEADER /A032 JMS I CUDDIX / DISPLAY UDK /C032 TAD CUUDKC / KEEP POINTERS IN SYNC. DCA CUUDKD JMP CUDRU9 CUDRBL, TAD CUDP7 / MOURNING BELLS ARE RINGING (WAS (7 ) /C026 JMS I CUDOUX / (CUDOUT) /C026 CUDRU9, /D033 JMP CUDINL / TRY SOMETHING ELSE /C023 JMP CUDIN4 /A033 CUNORM, /A026 CIFMNU /A026 JMS I IOACAL /A026 CUDMSC, 0 /A026 /C033 /D033 CUDMS8 /^ANO ROOM --- ^A^S /A026 CUDMS3 / ^A UDK ... GOLD MENU ... ^S^S /A033 CUDMSA /CR,LF,LF /A026 /D033 CUDMSB /CR,LF /A026 IFDEF V30NOR < CUTRYK /A039 CUNUL /A039 > CUDMS7 /PRESS GOLD MENU ... /A026 CUDMSC / DUMMY ARG TO FILL CUDMS3 /A033 JMS I CUDPOX / POSITION CURSOR /A026 CUNOR1, /A026 JMS I CUDGCX / GET G. M. /A026 JMP CUNOR2 / GOLD HALT; NOT LEGAL /A026 TAD (-EDMENU /A026 SNA CLA /A026 JMP I CUDREX / (CUDRET) FOUND G.M., EXIT /A026 CUNOR2, /A026 TAD CUDP7 / (7 ;BELL /A026 JMS I CUDOUX / (CUDOUT) /A026 CLA /A031 CDFSYS / CLEAR HALT SWITCH SO NEXT /A031 DCA I HLTFLG / CALL TO READ DOESN'T FIND IT /A031 / CHAR GET ROUTINE RESETS DATA FIELD JMP CUNOR1 / TRY AGAIN /A026 / ************* M032 ************ / ****** MADE SUBROUTINE AND MOVED FROM "CUDIN2" ****** CUDIN3, 0 CIFMNU JMS I IOACAL / Modifying user key #. Press Gold HALT to 0 / default output routine CUDMS2 / string address 0 / cursor position IFNDEF FRENCH < IFNDEF CANADA < 10 / cursor position (not in french or canada) >> CUDNUM / UDK number /D033 100 / cursor position IFDEF V30NOR < CUTRYK > 200 JMP I CUDIN3 / *********** M032 *********** PAGE CUDCL0, / SET UP TO CLOSE UDK JMS I CURWDX / READ DIRECTORY (CURWDI) /C024 RXERD TAD CUDPTR / SAVE CURRENT ADDRESS DCA T3 TAD CUDNUM / CONSTRUCT DIRECTORY ADDRESS TAD CUDGBB / ADDRESS OF CUDBUF DCA T1 TAD CUDNUM / TEST FOR ID TAD (CUUDID CIA TAD I T3 SZA CLA / IF ID THEN NULL UDK JMP CUDCLS / NOT NULL, NORMAL EXIT DCA I T3 / NULL, CLEAR ID HERE JMP CUDCL1 / CLEAR DIRECTORY ENTRY /C033 CUDCLS, /D033 TAD (-DLUDKS-1 / CONSTRUCT DIRECTORY ENTRY TAD MDLUM1 / -DLUDKS-1; /A033 TAD CUUDKB BSW CLL RTL DCA I T1 / BLOCK PART OF ADDRESS TAD CUUDKY TAD I T1 CUDCL1, /C033 DCA I T1 / RELATIVE WORD PART OF ADDRESS JMS I CURWDX / WRITE THE DIRECTORY (CURWDI) /C024 RXEWT+2000 JMS I CURWUX / WRITE THE CURRENT BUFFER (CURWUD) /C024 RXEWT+2000 CUDXBF CUUDKD JMP I CUDREX / (CUDRET) /C026 / CUDFMS MOVED FROM HERE TO A COUPLE OF PAGES HENCE /M023 / / / CUDDIS / THIS ROUTINE DISPLAYS THE UDK POINTED TO BY CUDADR / ON THE SCREEN STARTING FROM LINE 2. ON RETURN, IT LEAVES / THE AC ZERO AND CUDPTR POINTING TO THE END (FINAL 0) OF / THE UDK. / CUDDIS, 0 CIFMNU JMS I IOACAL / Clear from the second line to EOS 0 / Using default output routine CUDMS5 / String to clear screen 100 / cursor position 200 / cursor position /C033 / /D031 TAD (-120 / RESET LINE CHAR COUNT TAD CUM120 / RESET LINE COUNT /A031 DCA CUDLIN TAD MLINCT /A033 DCA LINCNT / CLEAR CHAR COUNTER /A032 JMP CUDDI2 / TEST FOR END OF STORAGE FIRST /A023 CUDDI1, TAD I CUDPTR / GET A CHAR SNA / END OF UDK STRING ? JMP CUDDID / YES, GO CHECK INPUT JMS I CUDDSX / NO, DISPLAY CHAR /C032 NOP /FILLER /A015 CLA CUDDI2, JMS I CUDILX / CHECK FOR BUFFER & BLOCK END (CUDILM) /C024 /D033 JMP CUDDID / OUT OF DATA /A023 NOP / CAN'T BE OUT OF DATA /A033 JMP CUDDI1 / AND BACK FOR MORE / CUDDID, AC7777 / SET CUDPTR BACK ONE TAD CUDPTR / SO THAT NEXT STORE WILL OVERWRITE DCA CUDPTR / TRAILING ZERO JMP I CUDDIS / RETURN / / CUDGAR / THIS ROUTINE TAKES THE UDK POINTED TO BY CUDADR / DELETES IT, MOVE ALL FOLLOWING UDK'S DOWN, AND / RETURNS THE NEW VALUE TO START STORING THIS UDK. / CALLED WITH: / JMS CUDGAR / RETURN (AC=0) / CUDGAR, 0 JMS I CURWDX /CLEAR DIRECT'Y ENTRY IN CASE THIS(CURWDI)/C024 RXERD / IS THE LAST UDK IN STORAGE JMS I CUDIMX / MOVE DIRECTORY TO BUFFER /A031 CUDIBB, DIRBUF / DESTINATION /A031 CUDBUF / SOURCE /A031 -CUUDNM / COUNT /A035 TAD CUDNUM /D031 TAD CUDGBB / ADDRESS OF CUDBUF TAD CUDIBB / ADDRESS OF BUFFER /A031 DCA T1 / CORE ADDRESS OF ENTRY DCA I T1 / CLEAR THE UDK ADDRESS /D031 JMS I CURWDX / WRITE THE DIRECTORY (CURWDI) /C024 /D031 RXEWT+2000 JMS CUDG01 / SET UP AND READ UDK BLOCK CUDG20, TAD CUDCUR / SET UP ZERO UDK WE ARE DELETING DCA CUDNXT / WE NEED TO DO THIS BECAUSE WE MAY SET / "CUDCUR" IN "CUDOLM" TAD I CUDCUR / GET A KEYSTROKE SNA CLA / TEST FOR END JMP CUDG21 / FOUND END OF UDK DCA I CUDNXT / NOT END, CLEAR KEYSTROKE JMS CUDOLM / BE CAREFUL ABOUT END OF STORAGE JMP CUDG20 / DO ANOTHER CUDG21, JMS CUDG01 / SET POINTERS AND READ BLOCK / WE GOT HERE AFTER DISPLAY OF UDK & A LEGAL KEYSTROKE / SO WE ARE GOING TO OVERWRITE UDK JUST DISPLAYED BY / MOVING EVERY THING ELSE UP. ASSUME NO HOLES, AND IF / NEXT CHAR FROM UDK IS NOT ID THERE ARE NO MORE UDK'S. /D031JMS I CUDILX /HAVE WE REACHED THE END OF INPUT?(CUDILM)/C024 /D031NOP / WE CANNOT BE AT END OF STORAGE /D031 / BECAUSE OF INPUT ALGORITHM ISZ CUDPTR / POINTER DECREMENTED AT END OF DISPLAY / SO ADJUST HERE JMS I CUDILX / IS THE INPUT BUFFER NOW EMPTY? /A031 NOP / CANNOT BE END OF STORAGE, /A031 / SO IGNORE OUT-OF-DATA RETURN /A031 CUDG05, TAD I CUDPTR / THERE IS AT LEAST ONE MORE CHARACTER. DCA CUDKNM / SAVE THE UDK # TAD CUDKNM / CHECK FOR UDK ID TAD (-CUUDID SPA JMP CUDG90 / NOT AN ID WHERE WE EXPECTED ONE, END TAD (-CUUDNM SMA CLA JMP CUDG90 / NOT AN ID, END JMS CUDOLM / CHECK FOR END OF BUFFER /A031 TAD CUDKNM / NOW WE CAN MOVE THIS UDK. DCA I CUDCUR / MOVES UDK # TO OUTPUT CUDG10, JMS CUDOLM / CHECK FOR ROOM IN OUTPUT BUFFER JMS I CUDILX / TEST FOR END OF INPUT BUFFER (CUDILM) /M025 NOP / INPUT CANNOT END W/O TERMINATING 0 /M025 TAD I CUDPTR DCA T1 / SAVE BECAUSE MIGHT BE TERMINATING 0 TAD T1 DCA I CUDCUR / AND STUFF IT TAD T1 SNA CLA JMP CUDG80 / FOUND END OF UDK / NEXT TWO LINES MOVED BACK 7 LINES /D025 JMS I CUDILX / TEST FOR END OF INPUT BUFFER (CUDILM) /C024 /D025 NOP / INPUT CANNOT END W/O TERMINATING 0 JMP CUDG10 CUDKNM, 0 CUDG01, / PART OF ZERO UDK 0 CLA CMA / SET UP POINTER TAD CUUDKY TAD CUDGBB / ADDRESS OF CUDBUF DCA CUDCUR TAD CUUDKB / SET UP WORKING BLOCK DCA CUUDKD JMS I CURWUX / READ UDK BLOCK (CURWUD) /C024 RXERD CUDGBB, CUDBUF CUUDKB JMP I CUDG01 PAGE / / CUDDSP / Display the character contained in the AC on the screen. Print the names / of the GOLD sequences, if there are names. If the name will not fit on the / line then go to the next line on the screen. / / If character to be displayed is negative (a WPKBDA character) /A013 / and beyond EDUKND, it will not be displayed or stored. /A013 / ROUTINE WILL EXIT TO CALL+1 IF CHARACTER IS NOT DISPLAYABLE /A015 / ROUTINE WILL EXIT TO CALL+2 IF CHARACTER IS DISPLAYABLE (AND STORABLE)/A015 CUDDSP, 0 DCA T1 / Save the character in the AC in a temporary TAD T1 / Get it back in AC TAD (-40 / Encode it for comparisons later DCA T2 / SAVE IT LIKE THIS TAD T2 / Get it back into AC SPA SNA / Is it a printable character? JMP CUDDS3 / No. SPECIAL CHAR: GO DISPLAY by name / Yes. Print it in UDK format... AC0001 JMS CUDLCK / SEE IF ROOM FOR ONE CHAR TAD T1 / Get the raw character JMS CUDIOT / Print it CUDDS2, TAD (40 / and print a trailing space JMS CUDIOT TAD T1 / Put the raw character back into AC ISZ CUDDSP /BUMP RETURN ADDRESS /A015 JMP I CUDDSP / and return to caller / / Special character printing code. Print the name of the sequence on the / screen. / CUDDS3, AC0006 / SEE IF ROOM FOR 6 CHARS on this line IFDEF SCANDI < IAC / check for 7 characters, if Scandinavian > IFDEF FRENCH < TAD (2 / check for 8 characters, if french > IFDEF GERMAN < TAD (2 / or German > JMS CUDLCK TAD T2 / Get the encoded character SZA / Is it a space? TAD (40 / Yes: decode it. CIA / Make encoded characters positive values. TAD (EDUKND /CHECK /A013 SMA SZA /FOR /A013 JMP CUDDS6 /BEYOND END OF TABLE, IF SO JUMP /A013 TAD (-EDUKND /RESTORE CODE /A013 JMS CUDSS0 / SPECIAL DISPLAY FOR UDK /A023 JMP CUDDS2 / UDK DISPLAYED /A023 CLL RAL / Multiply by two to skip table parameters. TAD (CUDTAB / Get beginning of table DCA T2 / Store the table pointer TAD I T2 / Get the character description DCA CUDDS4 / Install it in the IOA call TAD T2 / Get the table pointer again IAC / Increment it to point to the table parameter DCA CUDDS5 / Install pointer in IOA call TAD I CUDDS5 / Get the argument pointed to. SNA CLA / Is there one? DCA CUDDS5 / No, clear the argument parameter. CIFMNU JMS I IOACAL / Print the character name CUDIOT / Using the special I/O routine CUDDS4, XX / Description text CUDDS5, XX / Argument (if any--0000 if none.) JMP CUDDS2 / return to the subroutine mainline CUDDS6, CLA /CLEAR AC /A013 /D0014 ISZ CUDDSP /BUMP RETURN ADDRESS TO SKIP STORE /A013 JMP I CUDDSP /EXIT, GRACEFULLY /A013 / CUDLCK, 0 / CHECKS THE LINE COUNT TO SEE IF THERE / IS ENOUGH ROOM FOR THE NEXT GROUP OF CHARS. / SIZE OF THE GROUP IS IN THE AC, WHEN CALLED. / TAD CUDLIN / ADD IN LINE COUNT SMA CLA / SEE IF OVERFLOWED ? JMP CUDLC1 / YES, GIVE CR-LF, ETC. JMP I CUDLCK / NO, RETURN / CUDLC1, / TEST FOR LAST LINE /A032 TAD (15 / CR JMS I CUDOUX / (CUDOUT) /C026 TAD (12 / LF JMS I CUDOUX / (CUDOUT) /C026 /D031 TAD (-120 / RESET COUNTER TAD CUM120 /A031 DCA CUDLIN ISZ LINCNT / BUMP NUMBER OF LINES ON SCREEN /A033 NOP / ALL WE ARE DOING IS BUMPING THE / COUNTER; IT IS TESTED AT "CUDIN4" JMP I CUDLCK / AND RETURN / /D031 CUDLIN, -120 / CROSS-FEILD CALLABLE ROUTINE THAT INCREMENTS THE / NUMBER OF CHARS ON A LINE COUNT AND DISPLAYS THE CHAR / IN THE AC ON THE SCREEN USING CUDOUT. IT DOESN'T DISPLAY THE CHAR / IF THE CHAR COUNT (CUDLIN) GOES TO ZERO. CUDIOT, 0 DCA T2 / SAVE CHAR FOR A WHILE RDF TAD CIDF0 / MAKE CDF CIF DCA CUDIOR CDFMYF / MAKE SURE WE'RE IN THE RIGHT PLACE TAD T2 / GET CHAR BACK SNA / SEE IF END OF IOA STRING ? JMP CUDIOR / YES, RETURN ISZ CUDLIN / SEE IF END OF LINE REACHED JMS I CUDOUX / NO, DISPLAY CHAR /D033 JMS CUDIO1 / COUNT CHARS DISPLAYED /A032 CLA / YES, DON'T DISPLAY AND CLEAR AC CUDIOR, .-. JMP I CUDIOT / RETURN /D033 CUDIO1, / COUNT CHARS SENT TO SCREEN /A032 /D033 0 /A032 /D033 ISZ LINCNT /A032 /D033 JMS I CUDOUX /A032 /D033 JMP I CUDIO1 /A032 CUDGCR, 0 / THIS ROUTINE CHECKS THE KEYBOARD FOR INPUT. / IT NORMALLY RETURNS WITH THE NEXT INPUT CHARACTER / IN THE AC. / CALLED WITH: / JMS CUDGCR / HALT FLAG SET RETURN (AC=0) / REGULAR RETURN (AC CONTAINS CHARACTER) / JMP CUDGC2 / DON'T JWAIT YET CUDGC1, CIFSYS / ++++ JWAIT CUDGC2, CDFSYS TAD I HLTFLG / CHECK HALT FLAG CDFMYF SZA CLA JMP I CUDGCR / SET, JUST RETURN CIFSYS / ++++ XLTIN / ++++ JMP CUDGC1 / CHECK KEYBOARD TAD (-EDPWFL / SEE IF POWER FAIL SNA JMP I CUDGCR / YES, PRETEND IT'S A HALT TAD (EDPWFL / NO, GET CHAR BACK ISZ CUDGCR / AND RETURN WITH CHAR JMP I CUDGCR / CUDSTR / STORE A CHARACTER AWAY IN A UDK / CALLED WITH CHAR TO STORE IN AC: / JMS CUDSTR OR JMS I CUDSTX /C024 / NO MORE ROOM RETURN (AC=0) / REGULAR RETURN (AC=0) / CUDSTR, 0 / POINTED TO BY CUDSTX /C024 /D015 SNA /CHARACTER TO STORE? /A0014 /D015 JMP CUDST1 /NO, SKIP STORAGE STUFF /A0014 /D033 JMS I CUDSLX / ROOM FOR TWO CHARACTERS?(CUDSLM)/C027 /D033 JMP CUDST1 / NO DCA I CUDPTR / STORE CHAR JMS I CUDSLX / (CUDSLM) TO GET NEXT BUFFER /C027 NOP IAC TAD CUDPTR / GOING TO INSERT TERMINATING 0 DCA T1 DCA I T1 /D033 ISZ CUDSTR /M0014 JMP I CUDSTR / YES, RETURN / / Substring to cut down on message sizes for CUDMS6,7,1 and 2 /A039 / / IFDEF V30NOR < CUTRYK, TEXT ' &TRYKK P\E &GULL ' /Press Gold.. /A039 CUEL, TEXT '!&EL.' /Or /A039 CUNUL, TEXT ' ' / Dummy for CUDMS7 /A039 > /---------------------------- PAGE / CHECK FOR FULL OUTPUT BUFFER (CUDBUF) / BECAUSE WE ARE DELETING A UDK / WE CAN NEVER RUN OUT OF BLOCKS CUDOLM, XX TAD CUDCUR / CONTAINS ADDR OF LAST CHAR STORED CIA /D033 TAD (CUDBUF+CUBFSZ-1 TAD BUFEND / ADDRESS OF END OF BUFFER 1 /A033 SZA CLA JMP CUDOL9 / STILL ROOM, EXIT JMS I CURWUX / FULL, WRITE BLOCK (CURWUD) /C024 RXEWT+2000 CUDBUF CUUDKD ISZ CUUDKD / BUMP TO NEXT BLOCK TAD (CUDBUF-1 DCA CUDCUR / RESET POINTER CUDOL9, JMP I CUDOLM / CHECK FOR FULL INPUT BUFFER (CUDBUF+400) / CALL+1: OUT OF DATA; CALL+2: CONTINUE / IF FROM "CUUNDF" (UNDEFINED), AC = -3; ELSE AC = 0; USED IN LAST BLOCK CUDILM, XX DCA CUDILA / SAVE CHAR. COUNT FOR END CONDITION /A033 / SET = -2 BY UNDEFINED; ELSE = 0 /A033 TAD CUUDKC / CURRENT BLOCK IN CORE /M033 CIA /M033 /D033 TAD (DLUDKS+CUNBLK / LAST BLOCK /M033 TAD DLUCUN / LAST BLOCK /A033 SNA CLA / ANOTHER TO READ? /M033 JMP CUDIL7 / OUT OF DATA /M033 TAD CUDPTR / CONTAINS ADDR OF LAST CHAR RETRIEVED CIA /D033 TAD (CUDXBF+CUBFSZ-1 / ADDR OF END OF BUFFER TAD XBFEND / ADDR. OF END OF BUFFER 2 /A033 SZA CLA JMP CUDIL8 / BUFFER NOT EMPTY, CONTINUE ISZ CUUDKC / BUMP TO NEXT BLOCK JMS I CURWUX / READ IT (CURWUD) /C024 RXERD CUDXBF CUUDKC TAD (CUDXBF-1 / SET POINTER TO BUFFER-1 DCA CUDPTR CUDIL8, ISZ CUDILM / BUMP RETURN FOR MORE DATA CUDIL9, JMP I CUDILM / ************ A033 ************* CUDIL7, / IN LAST BLOCK; MUST BE AT LEAST 3 PLACES LEFT / IF FROM UNDEFINED UDK; ELSE DOESN'T MATTER / ZERO TERMINATOR WILL BE ENCOUNTERED TAD CUDPTR CIA TAD CUDILA / CONSTANT TO ADJUST FOR SPACE LEFT /D033 TAD (CUDXBF+CUBFSZ-1 TAD XBFEND / ADDR. OF END OF BUFFER 2 /A033 /D033 SZA CLA SMA CLA /A033 JMP CUDIL8 / STILL ROOM JMP CUDIL9 / NO ROOM / ************* END A033 ************ / READ/WRITE UDK BLOCK. / ARGUMENTS: FUNCTION, BUFFER, BLOCK CURWUD, / POINTED TO BY CURWUX /C024 XX DCA QUQBLK+RXQDRV / WAS JMS SETUSD /C027 RDF TAD CDF0 DCA QUQBLK+RXQBFD / RETURN FIELD TAD I CURWUD ISZ CURWUD DCA QUQBLK+RXQFNC / FUNCTION TAD I CURWUD ISZ CURWUD DCA QUQBLK+RXQBAD / BUFFER TAD I CURWUD ISZ CURWUD DCA CURWAA TAD I CURWAA DCA QUQBLK+RXQBLK / BLOCK JMS QURX CLA JMP I CURWUD / DECODE ADDRESS OF UDK IN DIRECTORY BLOCK CUDCOD, / POINTED TO BY CUDCOX /C024 XX TAD I CUDIPT / ADDRESS OF ADDRESS AND (CUBKMS / KEEP BLOCK PART BSW / TO BITS 6,7,8,9 CLL RTR / TO BITS 8,9,10,11 /D033 TAD (DLUDKS+1 / + STARTING BLOCK # TAD DLUDP1 / DLUDKS+1; STARTING BLOCK /A033 DCA CUUDKB TAD I CUDIPT AND (CUWDMS / KEEP WORD PART DCA CUUDKY / RELATIVE WORD ADDRESS TAD CUUDKB DCA CUUDKC / SET UP WORKING POINTER JMP I CUDCOD / CUDIPT, CUUDKB, CUUDKW, CUUDKY, CUUDKD, CUUDKC MOVED TO PAGE 0 /M023 CUDFMS, / NO MORE ROOM (POINTED TO BY CUDFMX) /C026 JMS CUDFMM / MESSAGE ROUTINE /A032 CUDMS3 / ARGUMENT /A032 JMP CUTSC1 / LOOK FOR LEGAL INPUT /A033 /D033 CUDFUL, /C026 / TAD (7 / RING-A-DING /D026 / JMS CUDOUT /D026 / CIFMNU /D026 / JMS I IOACAL /D026 / 0 /D026 / CUDMS4 /D026 / -2700 /D026 /D033 JMP I .+1 / GET NEXT INPUT /A029 /D033 CUDINL /A029 /D029 JMS CUDPOS /A026 /D029 JMS I CUDGCX / READ CHARACTER /C031 /D029 JMP CUDCL0 / HLT SET, FINISH UP (WAS CUDCLS) /C026 /D029 CLA /A027 / TAD (-EDMENU / SEE IF USER TYPED GOLD MENU /D027 / SNA CLA /C026 /D027 / JMP I CUDREX / (CUDRET) /A026 /D027 /D029 TAD CUDP7 / (TAD (7 ) /A026 /D029 JMS I CUDOUX / (CUDOUT) /A026 /D029 JMP CUDFUL / NO, KEEP CHECKING / ********** A032 *********** / MOVED FROM CUDFMS AND MADE SUBROUTINE CUDFMM, 0 TAD I CUDFMM / LOAD MESSAGE ADDRESS DCA CUDFM1 ISZ CUDFMM / BUMP FOR RETURN CIFMNU / GIVE MESSAGE /C026 JMS I IOACAL 0 /C026 CUDFM1, CUDMS3 /"^a---text---^s^s" /C026 /C029 /C033 CUDMSA /"RET,LF,LF" /C026 /D033 CUDMSB /"RET,LF" /C026 CUDMS9 /"DELETE KEYSTROKE(S)" /A029 /D033 CUDMSB /"RET,LF" /A029 IFDEF V30NOR < CUEL CUTRYK > CUDMS6 /"PRESS GOLD HALT ... " /A026 /D033 CUDMSB /"RET,LF" /A026 JMP I CUDFMM / *************** END A032 *********** CUDOUT, 0 JMP CUDOU2 CUDOU1, CIFSYS JWAIT CUDOU2, CIFSYS TTYOU JMP CUDOU1 JMP I CUDOUT CUDPOS, /A026 0 /A026 CIFMNU /A026 JMS I IOACAL /A026 0 /A026 CUDMS4 /"^P" /A026 -2700 /A026 JMP I CUDPOS /A026 / ********** A033 *********** CNTSCR, JMS I CUDFMY / MESSAGE ROUTINE CUDMS0 / UDK FULL CUTSC1, JMS I CUDDGX / GET KEYBOARD INPUT JMP I CUDCLX / G-HALT; CLOSE UDK JMP CUTSC1 / ILLEGAL INPUT TAD CUDRUB / IS IT R.O.? SNA CLA JMP CUDRUT / YES; R.O. LAST AND GO TO NORMAL INPUT TAD CUDP7 / NO; RING BELL AND TRY AGAIN JMS I CUDOUX JMP CUTSC1 / ************** END A033 ********** PAGE / BE SURE THERE IS ROOM FOR TWO CHARACTERS IN LAST BLOCK / ELSE CHECK BUFFER BOUNDRY; WRITE BLICK & ZERO BUFFER / AS NECESSARY. / CALL+1: NO ROOM, AC CLEAR, CHAR IN T1 / CALL+2: STILL ROOM, CHAR IN AC CUDSLM, XX DCA T1 / SAVE CHARACTER /D033 TAD (DLUDKS+CUNBLK / TEST FOR LAST BLOCK TAD DLUCUN / LAST BLOCK /A033 CIA TAD CUUDKD SNA CLA JMP CUDSL3 / LAST BLOCK FOUND /D033 TAD (CUDXBF+CUBFSZ-1 / NOT LAST; TEST FOR BUFFER END TAD XBFEND / ADDR. OF END OF BUFFER 2; BUFFER END? /A033 CIA TAD CUDPTR SZA CLA JMP CUDSL1 / STILL ROOM JMS I CURWUX / NO ROOM IN THIS BLOCK; WRITE (CURWUD) /C024 RXEWT+2000 CUDXBF CUUDKD ISZ CUUDKD / BUMP TO NEXT BLOCK TAD (CUDXBF-1 / SET TO BUFFER START-1 DCA CUDPTR JMS I CURWUX /A024 RXERD /A024 CUDXBF /A024 CUUDKD /A024 TAD CUUDKD /A024 DCA CUUDKC /A024 CUDSL1, TAD T1 / EXIT WITH ROOM ISZ CUDSLM CUDSL2, JMP I CUDSLM / WE ARE IN THE LAST BLOCK; NEED ROOM FOR TWO CHARACTERS / BECAUSE WE ARE TESTING BEFORE STORE C(CUDPTR) IS ONE LESS / THAN NEXT STORE LOCATION AND TWO LESS THAN TERMINATING 0. / LAST ALLOWABLE VALUE FOR "CUDPTR" IS BUFFER END - 3. CUDSL3, TAD CUDPTR /A026 CIA /A026 TAD (CUDXBF+CUBFSZ-3 /C033 SMA CLA /C026 JMP CUDSL1 / STILL ROOM JMP CUDSL2 / NO ROOM CUDSLA, 0 / PART OF SQUEEZE ROUTINE "CUDGAR" / FOUND END OF A UDK. UPDATE DIRECTORY IN BUFFER / AND COMPUTE NEXT UDK ADDRESS FOR NEXT ENTRY / CUDG80, /D031 JMS I CURWUX / WRITE OUTPUT BUFFER (CURWUD) /C024 /D031 RXEWT+2000 /D031 CUDBUF /D031 CUUDKD /D031 JMS I CURWDX / READ DIRECTORY INTO "CUDBUF" (CURWDI) /C024 /D031 RXERD TAD CUDKNM / DECODE UDK # FROM PTR. TO DIREC. TAD (-CUUDID / UDK WORD = UDK # + 2001 /D031 TAD (CUDBUF / UDK # + START OF BUFFER TAD (DIRBUF / UDK # + START OF BUFFER /A031 DCA CUDGAA / = ADDRESS OF SLOT IN DIREC. /D033 TAD (-DLUDKS-1 TAD MDLUM1 / -DLUDKS-1 /A033 TAD CUUDKB / ABSOLUTE BLOCK - FIRST BLOCK BSW / = RELATIVE BLOCK CLL RTL / TO BITS 0,1,2,3 DCA I CUDGAA / STORE IN SLOT TAD CUUDKY / RELATIVE WORD TAD I CUDGAA / ADD TO SLOT FOR COMPLETE ADDRESS DCA I CUDGAA /D031 JMS I CURWDX / WRITE DIRECTORY BACK OUT (CURWDI) /C024 /D031 RXEWT+2000 /D031 JMS I CURWUX / READ OUTPUT BLOCK BACK IN (CURWUD) /C024 /D031 RXERD /D031 CUDBUF /D031 CUUDKD TAD CUUDKD / SET UP TO COMPUTE NEXT UDK ADDRESS DCA CUUDKB TAD (-CUDBUF+1 TAD CUDCUR DCA CUUDKY / RELATIVE WORD JMS I CUDILX / IS THERE MORE INPUT? (CUDILM) /C024 NOP / CAN'T BE AT PHYSICAL END OF STORAGE JMP CUDG05 / YES, MOVE NEXT UDK / WE HAVE REACHED THE END OF INPUT / ZERO REMAINING WORDS OF BLOCK CUDG90, CLA DCA I CUDCUR TAD CUDCUR CIA /D033 TAD (CUDBUF+CUBFSZ-1 TAD BUFEND / ADDR. OF END OF BUFFER 1 /A033 SZA CLA JMP CUDG90+1 JMS I CURWUX / WRITE THE BLOCK (CURWUD) /C024 RXEWT+2000 CUDBUF CUUDKD JMS I CUDIMX / MOVE DIRECTORY TO DISK BUFFER /A031 CUDBUF / DESTINATION /A031 DIRBUF / SOURCE /A031 -CUUDNM / COUNT /A035 / ************* ADD 031 ************** / ZERO BALANCE OF DIRECTORY BUFFER FOR NEATNESS TAD (CUDBUF+CUUDNM / PLACE TO START DCA CUDGAA TAD (CUUDNM-CUBFSZ / NUMBER OF LOCATIONS DCA CUDSSA CUDG91, DCA I CUDGAA ISZ CUDGAA / BUMP POINTER ISZ CUDSSA / COUNT JMP CUDG91 / ***************** END ADD 031 ********** JMS I CURWDX / WRITE THE DIRECTORY /A031 RXEWT+2000 /A031 TAD CUDGAR / GET RETURN ADDRESS DCA CUDGAA JMP I CUDGAA / AND GO THERE CUDGAA, 0 / EXTENSION TO DISPLAY ROUTINE FOR UDK'S CUDSS0, 0 DCA CUDSSA TAD CUDSSA TAD (EDUDK0 / BOTTOM VALUE CIA DCA CUDSSB / SAVE BINARY VALUE TAD CUDSSB SPA JMP CUDSS9 / NOT A UDK TAD (-CUUDNM / RANGE SMA CLA JMP CUDSS9 / NOT A UDK CIFMNU / OUTPUT WITH IOA JMS I IOACAL 0 CUDSSM / MESSAGE ADDRESS CUDSSB / VALUE AC0006 / UPDATE LINE COUNT FOR UDK:NN /A031 TAD CUDLIN / UPDATE LINE COUNT /A023 /D031 TAD (7 / WITH 7 CHAR FOR GOLD:NN /A023 DCA CUDLIN /A023 JMP CUDSS8 CUDSS9, CLA TAD CUDSSA / NOT A UDK; RETURN VALUE ISZ CUDSS0 CUDSS8, JMP I CUDSS0 CUDSSA, 0 CUDSSB, 0 / TEXT CUDSSM: GOLD:!2D MOVED TO MESSAGE PAGE /M023 PAGE / UDK REQUESTED IS NOT DEFINED. / FIND LAST UDK SO WE CAN ADD THE REQUESTED ONE TO THE END OF UDK STORAGE / DIRECTORY IN CORE AT "CUDBUF" / SCAN DIRECTORY FOR HIGHEST UDK ADDRESS / WHEN ADDRESS FOUND, FIND END OF THAT UDK; KEEP TRACK OF AADDRESS / FOR DIRECTORY UPDATE WHEN REQUESTED UDK IS ENTERED CUUNDF, XX DCA T3 / GOING TO BE HIGHEST BLOCK ADDRESS DCA T2 / GOING TO BE HIGHEST WORD ADDRESS FOR T3 TAD (CUDBUF-1 / POINTER FOR DIRECTORY DCA CUDPTR TAD (-CUUDNM / COUNTER FOR NUMBER OF UDK'S DCA T1 CUUND1, TAD I CUDPTR SNA CLA / DOES UDK EXIST? JMP CUUND8 / NO, COUNT ENTRIES TAD CUDPTR DCA CUDIPT / SAVE THE ADDRESS JMS I CUDCOX / CUUDKB: STARTING BLOCK (CUDCOD) /C024 / CUUDKY: RELATIVE WORD / CUUDKW: ABSOLUTE CORE ADDRESS TAD T3 CIA TAD CUUDKB / COMPARE LAST BLOCK TO CURRENT BLOCK SPA JMP CUUND8 / CURRENT BLOCK .LT. LAST SZA JMP CUUND3 / CURRENT BLOCK .GT. LAST; UPDATE LAST TAD T2 / CURRENT BLOCK .EQ. LAST; CHECK WORD CIA TAD CUUDKY SPA CLA JMP CUUND8 / CURRENT WORD .LT. LAST; LAST STILL HIGH CUUND4, TAD CUUDKY / CURRENT WORD .GT. LAST; BLOCK #'S .EQ. DCA T2 / UPDATE WORD JMP CUUND8 CUUND3, CLA TAD CUUDKB / UPDATE BLOCK AND WORD DCA T3 JMP CUUND4 CUUND8, CLA ISZ T1 / COUNT UDK ENTRIES JMP CUUND1 / NOT DONE SCAN TAD T3 / NOW HAVE ADDRESS OF LAST UDK SNA / TEST FOR NO DEFINED UDK'S /A024 /D033 TAD (DLUDKS+1 / FIRST DATA BLOCK /A024 TAD DLUDP1 / DLUDKS + 1; FIRST DATA BLOCK /A033 DCA CUUDKC / SET UP FOR READ TAD (CUDXBF-1 TAD T2 DCA CUDPTR / POINTER = RELATIVE WORD + BUFFER START JMS I CURWUX / READ UDK (CURWUD) /C024 RXERD CUDXBF CUUDKC CUUND7, TAD I CUDPTR / GET CHARACTER FROM UDK SNA CLA JMP CUUND9 / FOUND END OF LAST DEFINED UDK JMS I CUDILX / END OF BUFFER OR STORAGE? (CUDILM) /C024 /D033 JMP I CUDFMX / END OF STORAGE (CUDFMS) /C024 NOP / CAN'T RUN OUT OF STORAGE HERE /A033 JMP CUUND7 CUUND9, TAD CUUNM3 / FOR LAST BLOCK TEST /A033 JMS I CUDILX / BE SURE NOT AT END OF BLOCK,ETC.(CUDILM)/C024 / JMP I CUDFMX / NO ROOM (CUDFMS) /C024 /D027 JMP CUNORM / AT END OF STORAGE; QUIT IMMEDIATELY /A027 TAD CUDPTR / PUT IN A TERMINATOR SO WE IAC / DON'T DISPLAY GARBAGE DCA T1 DCA I T1 JMS I CURWUX / (CURWUD) /C024 RXEWT+2000 CUDXBF CUUDKC TAD T3 / TEST FOR NO DEFINED UDK'S /A024 SZA CLA /A024 JMP CUUCUU / .+3 /A024 TAD CUDXBC /A024 DCA CUDPTR /A024 CUUCUU, TAD CUDPTR /C024 IAC AND P377 DCA CUUDKY / CONSTRUCT RELATIVE WORD TAD CUUDKC DCA CUUDKB / BE SURE TO HAVE COPY OF FIRST BLOCK DCA CUGASW / CLEAR SQUEEZE SWITCH FOR NO SQUEEZE JMP I CUUNDF CUUNM3, -3 /A033 /CUGASW, 1 / SET TO SQUEEZE INITIALLY /MOVED TO PAGE 0 /D023 / USED BY EXTENSION TO KEYBOARD INPUT ROUTINE "CUDDG0" CUDGL0, 0 JMS I CUDGCX / GET THE KEYSTROKE JMP CUDGL1 / HALT OR POWER FAIL; CALL+1; AC=0 DCA CUDGGA TAD CUDGGA TAD (-EDNWLN / {RETURN}? SNA CLA JMP CUDGL3 / FOUND {RETURN}; CALL+3; AC=0 TAD CUDGGA TAD CUDG60 / DIGIT? SPA JMP CUDGL2 / NOT {RETURN} OR DIGIT; CALL+2; AC=0 TAD (-11 / RANGE SMA SZA CLA JMP CUDGL2 / NOT {RETURN} OR DIGIT ISZ CUDGL0 / FOUND DIGIT; CALL+4; AC=0; CUDGGA=CHAR. CUDGL3, ISZ CUDGL0 CUDGL2, ISZ CUDGL0 CUDGL1, CLA JMP I CUDGL0 / TESTING FOR BEGINNING OF BUFFER WHEN DELETING KEYSTROKES / READS PREVIOUS BUFFER IF NECESSARY AND SETS POINTER AND / DISK BLOCK CUDRU0, 0 TAD CUDPTR TAD (-CUDXBF+1 SZA CLA JMP CUDRU1 / NOT AT START OF BUFFER CMA / DECREMENT BLOCK TAD CUUDKC DCA CUUDKC JMS I CURWUX / READ THE BLOCK (CURWUD) /C024 RXERD CUDXBF CUUDKC TAD CUUDKC / SET UP FOR NEXT WRITE IF DELETE DCA CUUDKD TAD (CUDXBF+377 / SET POINTER TO BUFFER TOP JMP CUDRU2 CUDRU1, TAD CUDPTR CUDRU2, DCA T1 JMP I CUDRU0 PAGE /A013 / EXTENSION TO CHAR. INPUT ROUTINE / {UDK}{RETURN}: ALWAYS A RUBOUT; SET RETURN CHARACTER / TO CONTENTS OF "CUDNUM"+EDUDK0 / {UDK}(M){RETURN}: WHERE (M) IS 0-99. A UDK ENTRY / C+1: GOLD HALT / C+2: ILLEGAL INPUT / C+3: KEYSTROKE IN AC CUDDG0, 0 JMS I CUDGCX / CHAR INPUT /C031 JMP CUDGG2 / POWER FAIL OR HALT DCA CUDGGA / SAVE INPUT TAD CUDGGA /D031 TAD MGOLDU / GOLD U TAD MEDUDK / UDK KEY (F14) /A031 SNA CLA JMP CUDD02 / FOUND GOLD U (UDK KEY - F14) /C033 CUDGG1, TAD CUDGGA CUDGG3, ISZ CUDDG0 CUDGG4, ISZ CUDDG0 CUDGG2, JMP I CUDDG0 CUDD01, / ILLEGAL INPUT; BELL AND EXIT C+2 TAD CUDP7 JMS I CUDOUX JMP CUDGG4 /D030 JMP CUDD02 / BYPASS ERROR FIRST TIME /D030 CUDD01, /D030 TAD CUDP7 / RING BELL FOR ILLEGAL CHARACTER /D030 JMS I CUDOUX / (CUDOUT) /C026 CUDD02, JMS I CUDGLX / GET KEYSTROKE AFTER {UDK} JMP CUDGG2 / GOT HALT OR POWER FAIL, EXIT JMP CUDD01 / NOT {RETURN} OR DIGIT, RING BELL JMP CUDD03 / GOT {RETURN}; {UDK}{RETURN} TAD CUDGGA / GOT DIGIT; {UDK}(M) TAD CUDG60 / MAKE INTO BINARY NUMBER DCA CUDGGB /D030 JMP CUDD05 /D030 CUDD04, /D030 TAD CUDP7 /D030 JMS I CUDOUX / (CUDOUT) /C026 CUDD05, JMS I CUDGLX / GET NEXT KEYSTROKE JMP CUDGG2 / HALT OR POWER FAIL, EXIT JMP CUDD01 / NOT DIGIT OR {RETURN}, RING BELL /C030 JMP CUDD10 / {RETURN}; {UDK}(M){RETURN} TAD CUDGGB / KEYSTROKE IN CUDGGA, MULTIPLY / LAST DIGIT BY 10 CLL RTL RAL TAD CUDGGB TAD CUDGGB DCA CUDGGB TAD CUDGGA / CONVERT CURRENT TO BINARY TAD CUDG60 TAD CUDGGB / ADD LAST TO CURRENT TO MAKE NUMBER DCA CUDGGB /D030 JMP CUDD07 / LOOK FOR RETURN /D030 CUDD06, /D030 TAD CUDP7 /D030 JMS I CUDOUX / (CUDOUT) /C026 CUDD07, JMS I CUDGLX / MUST HAVE {RETURN} JMP CUDGG2 / POWER FAIL OR HALT JMP CUDD01 / NOIT DIGIT OR RETURN /C030 JMP CUDD10 / FOUND {RETURN} JMP CUDD01 / FOUND DIGIT /C030 CUDD10, / FOUND {RETURN} AFTER {UDK}(M) TAD CUDGGB / BINARY NUMBER CUDD11, TAD CUDUDK / MAKE INTO UDK CODE JMP CUDGG3 / EXIT CALL+2 CUDD03, / FOUND {UDK}{RETURN} TAD I CUDNUX / CONVERT TO UDK TO BE USED AS R.O. JMP CUDD11 NOP / LEAVE SOME PATCH ROOM NOP NOP NOP CUDGGA, 0 CUDGGB, 0 CUDG60, -60 / -"0 /D031 MGOLDU, -EDGLDU MEDUDK, -EDUDKY /A031 /CUDP7, 7 / MOVED TO PAGE 0 /D026 /CUDOTX, CUDOUT / CHANGED TO CUDOUX AND MOVED TO PG 0 /D026 CUDUDK, EDUDK0 CUDNUX, CUDNUM CUDGLX, CUDGL0 /D031 CUDGCP, CUDGCR / ******** A031 ******** / MOVE UDK DIRECTORY FROM/TO CUDBUF/DIRBUF / DON'T USE AUTO-INCREMENT REGISTERS CUDIMV, 0 TAD I CUDIMV / DESTINATION DCA CUDIDE ISZ CUDIMV TAD I CUDIMV / SOURCE DCA CUDISO ISZ CUDIMV /D035 TAD CUDICN / COUNT TAD I CUDIMV /A035 DCA CUDICT ISZ CUDIMV /A035 CUDIM1, / LOOP FOR MOVE TAD I CUDISO DCA I CUDIDE ISZ CUDISO ISZ CUDIDE ISZ CUDICT JMP CUDIM1 JMP I CUDIMV NOP / SAVE SPACE FOR DEBUG CUDIDE, 0 CUDISO, 0 /D035 CUDICN, -CUUDNM CUDICT, -CUUDNM DECIMAL DIRBUF, ZBLOCK 100 / DIRECTORY BUFFER OCTAL / *************** END A031 ******** /MOVED FOR ROOM ON PAGE /A013 /C031 CUDSSM, TEXT "&G&O&L&D:!2D" /M023 CUDSSM, IFNDEF ITALIAN /A031 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE < TEXT '!&DT: !2D'> IFDEF DUTCH IFDEF SPANISH CUDMS3, IFDEF ENGLSH < /D033 TEXT '^A&NO MORE ROOM FOR KEYSTROKES.^A^S^A^S^A' /C026/C027/C029/C032 TEXT '^A !&UDK STORAGE FULL.^S^S' /A033 CUDMS9, TEXT ' &DELETE KEYSTROKE(S)' /A029 CUDMS0, TEXT '^A &NO MORE ROOM IN THIS !&UDK.^S^S' /A032 /C033 > IFDEF ITALIAN < TEXT '^A &ARCHIVIO !&TDU PIENO.^S^S' CUDMS9, TEXT ' &CANCELLARE CARATTERE/I' CUDMS0, TEXT '^A &SPAZIO INSUFFICIENTE.^S^S' > IFDEF V30NOR < TEXT '^A !&BDT-LAGERET ER FULLT.^S^S^S^S' CUDMS9, TEXT ' &FJERN TASTANSLAG' CUDMS0, TEXT '^A &IKKE MER PLASS I AKTUELL !&BDT.^S^S^S^S' > IFDEF V30SWE < TEXT '^A &MINNET D\DR !&DT LAGRAS, \DR FULLT ^S^S' /A033 CUDMS9, TEXT ' &TA BORT TANGENTNEDSLAG' /A029 CUDMS0, TEXT '^A &DET FINNS INTE PLATS F\VR FLER NEDSLAG I DENNA !&DT ^S^S' /A032 /C033 > / END IFDEF V30SWE IFDEF DUTCH < /D033 TEXT '^A&NO MORE ROOM FOR KEYSTROKES.^A^S^A^S^A' /C026/C027/C029/C032 TEXT '^A !&UDK STORAGE FULL.^S^S' /A033 CUDMS9, TEXT ' &DELETE KEYSTROKE(S)' /A029 CUDMS0, TEXT '^A &NO MORE ROOM IN THIS !&UDK.^S^S' /A032 /C033 > IFDEF SPANISH < TEXT '^A &ALMACENAMIENTO !&TDU COMPLETO .^S^S' /A033 CUDMS9, TEXT ' &BORRE PULSACI\SN(ES)' /A029 CUDMS0, TEXT '^A &NO HY M\AS ESPACIO EN ESTA !&TDU.^S^S' /A032 /C033 > / CUDMS5, TEXT '^P!E^P' / / CUDMS6, 7 & 8 ADDED FOR 100 UDK'S /A026 9 LINES CUDMS6, IFDEF ENGLSH < TEXT ' !&OR &PRESS &GOLD !&HALT TO SAVE !&UDK.' /C029 /C033 > /END IFDEF ENGLSH IFDEF ITALIAN < TEXT ' &PREMERE &ORO !&STOP PER MEMORIZZARE !&TDU.' > IFDEF V30NOR < TEXT '!&STOPP FOR \E LAGRE AKTUELL !&BDT' > IFDEF V30SWE < TEXT '&ANV\DND GULD STOPP F\VR ATT SPARA !&DT'> IFDEF DUTCH < TEXT ' !&OR &PRESS &GOLD !&HALT TO SAVE !&UDK.' /C029 /C033 > /END IFDEF DUTCH IFDEF SPANISH < TEXT ' &O &PULSE &DORADA !&PARAR SALVAR !&TDU.' > / ENd IFDEF SPANISH CUDMS7, IFDEF ENGLSH < TEXT ' &PRESS &GOLD !&MENU TO RECALL THE !&MENU' > /END IFDEF ENGLSH IFDEF ITALIAN < TEXT ' &PREMERE &ORO !&MENU PER TORNARE AL !&MENU' > IFDEF V30NOR < TEXT ' !&MENY FOR \E F\E MENYEN' > IFDEF V30SWE < TEXT ' &TILLBAKA TILL MENYN: ANV\DND GULD MENY'> IFDEF DUTCH < TEXT ' &PRESS &GOLD !&MENU TO RECALL THE !&MENU' > /END IFDEF ENGLSH IFDEF SPANISH < TEXT ' &PULSE &DORADA !&MENU PARA VOLVER AL !&MENU' > /END IFDEF SPANISH /D0033 CUDMS8, IFDEF ENGLSH < /D0033 TEXT '^A&NO MORE ROOM.^S' /C033 /D0033 > /END IFDEF ENGLSH / CUDMSA, 15 / ++++ 12 / ++++ 12 / ++++ 0 CUDMSB, 15 / ++++ 12 / ++++ 0 / CUDMS1, IFDEF ENGLSH < TEXT '^P!E ^P&DEFINITION OF USER KEY ^D. &PRESS &GOLD &H&A&L&T TO' *.-1 TEXT ' RECALL THE &MENU.' > IFDEF ITALIAN < TEXT "^P!E ^P&DEFINIZIONE TASTO FUNZIONE ^D. &PREMERE &ORO !&STOP PER' *.-1 TEXT ' TORNARE AL &MENU.' > IFDEF V30NOR < TEXT '^P!E ^P&DEFINISJON AV BRUKERTAST ^D. ^S &STOPP FOR \E F\E MENYEN.' > IFDEF V30SWE < TEXT '^P!E ^P&DEFINITION AV TANGENT ^D. &ANV\DND GULD STOPP F\VR ATT ' *.-1 TEXT '\ETERG\E TILL MENYN'> IFDEF DUTCH < TEXT '^P!E ^P&DEFINITION OF USER KEY ^D. &PRESS &GOLD &H&A&L&T TO' *.-1 TEXT ' RECALL THE &MENU.' > IFDEF SPANISH < TEXT '^P!E ^P&DEFINICI\SN DE TECLA DE USARIO ^D.&PULSE &DORADA' *.-1 TEXT ' !&PARAR PARA VOLVER AL &MEN\Z.' > / CUDMS2, IFDEF ENGLSH < TEXT '^P!E ^P&MODIFYING USER KEY !D. &PRESS &GOLD &H&A&L&T TO' *.-1 TEXT ' TERMINATE DEFINITION.^P' > IFDEF ITALIAN < TEXT '^P!E ^P&MODIFICA TASTO FUNZIONE !D. &PREMERE &ORO !&STOP PER' *.-1 TEXT ' TERMINARE LA DEFINIZIONE.^P' > IFDEF V30NOR < TEXT '^P!E ^P&ENDRER BRUKERTAST !D. ^S &STOPP FOR' /L.D.A *.-1 TEXT " \E AVSLUTTE DEFINISJON.^P" > IFDEF V30SWE < TEXT '^P!E ^P&\DNDRING AV TANGENTDEF. !D. &ANV\DND GULD STOPP F\VR ATTL ' *.-1 TEXT 'AVSLUTA DEFINITIONEN.^P'> IFDEF DUTCH < TEXT '^P!E ^P&MODIFYING USER KEY !D. &PRESS &GOLD &H&A&L&T TO' *.-1 TEXT ' TERMINATE DEFINITION.^P' > IFDEF SPANISH < TEXT '^P!E ^P&MODIFICANDO TECLA USUARIO !D. &PULSE &DORADA !&PARAR' *.-1 TEXT ' PARA TERMINATE DEFINITION.^P' > / /D013 / / CUDTAB - Table of key names for UDK code. Format is : / IOA string / one IOA parameter (or zero) / / Any one word IOA argument can be used in the second slot as long as the / IOA arg is expecting it. Future foreign language work may require the use of / the second argument for accented character information. (GLT) / / Different keyboards require a different ordering of the entries in the / CUDTAB. / / Presently two special IOA arguments are defined. They are: / CUDGTL - Prints GOLD: / where is a TEXT string / "Calling" sequence: / CUDGTL / TEXT "*" (where "*" is one character) / / CDCMND - Prints GOLD: where list is an ASCII / list ending with a zero word / "Calling" sequence: / CDCMND / PTR (where ptr points to the beginning / of the ASCII list) / CUDTAB, /C016 / / Space / CDSPCE 0 / / Power Fail / XX 0 / / Rubout / CDRBCH 0 / / Rubword / CDRBWD 0 / / Return / CDNWLN 0 / / GOLD:CMND /C016 / IFDEF ENGLSH < / GOLD:{ in English IFNDEF V30FAO< /M037 CDCMND CUDLCB > IFDEF V30FAO< /A037 CDCMND /A037 ACUTE /A037 > > IFDEF ITALIAN < CDCMND ITAST1 > IFDEF V30NOR < CDCMND ARING > IFDEF V30SWE < CDCMND ARING > IFDEF DUTCH < CDCMND CUDLCB > IFDEF SPANISH < CDCMND /A037 ACUTE /A037 > / / Para marker / CDCRET 0 / / Tab / CDTAB 0 / / Tab Center / CDTABC 0 / / GOLD:FILE / CUDGTL TEXT 'F' / / GOLD:MENU / CUDGTL TEXT 'M' / / GOLD:CONT SRCH & SEL / IFDEF ENGLSH < / GOLD:/ in English IFNDEF V30FAO< /A037 CUDGTL TEXT '/' > / END IFNDEF V30FAO /A009 IFDEF V30FAO< /A037 CUDGTL /A037 TEXT '-' /A037 > > / END IFDEF ENGCAN /A009 IFDEF ITALIAN < CDCMND ITAST2 > IFDEF V30NOR < CUDGTL TEXT '-' > /A039 IFDEF V30SWE < CUDGTL TEXT '-' > IFDEF DUTCH < CUDGTL TEXT '/' > / END IFNDEF V30FAO /A009 IFDEF SPANISH < CUDGTL /A037 TEXT '-' /A037 > / / Rub Line / CDRBLN 0 / / Rub Sent / CDRBSE 0 / / Del Char / CDDLTC 0 / / Del Word / CDDLTW 0 / / Word / CDWORD 0 / / Sent / CDSENT 0 / / Line / CDLINE 0 / / TabPos / CDTABP 0 / / <> (Enter) / CDENTR 0 / / Page / CDPAGE 0 / / Para / CDPARA 0 / / Advance / CDADVN 0 / / Back up / CDBKUP 0 / / GOLD:ADVANCE / CDGADV 0 / / GOLD:BACKUP / CDGBKP 0 / / Bold / CDBOLD 0 / / Sel / CDSLCT 0 / / Uppercase / CDUPPR 0 / / Underline / CDUNDL 0 / / Cut / CDSCUT 0 / / Swap / CDSWAP 0 / / Paste / CDPSTE 0 / / GOLD:DEL (both Char and Word) / CDUDLT 0 / / GOLD:BOLD / CDUBLD 0 / / GOLD:UPPERCASE / CDLOWR / Gold:Uppercase (I.e. Lowercase) 0 / / GOLD:UNDERLINE / CDUUDL 0 / / Hyph Push / CDHYPS 0 / / Hyph Pull / CDHYPL 0 / / Print Hyph / IFDEF ENGLSH < / GOLD:- in English IFNDEF V30FAO < /A037 CUDGTL TEXT '-' > IFDEF V30FAO < /A037 CUDGTL /A037 TEXT "'" /A037 > > IFDEF ITALIAN < CUDGTL TEXT ')' > IFDEF V30NOR < CUDGTL TEXT '+'> /A039 IFDEF V30SWE < CUDGTL TEXT '+'> IFDEF DUTCH < CUDGTL TEXT '-' > IFDEF SPANISH < CUDGTL /A037 TEXT "'" /A037 > / / Shift Print Hyph / IFDEF ENGLSH < / GOLD:_ in English IFNDEF V30FAO < /A037 CUDGTL TEXT '_' > IFDEF V30FAO < CUDGTL TEXT '?' > > IFDEF ITALIAN < CDCMND ITAST3 > IFDEF V30NOR < CUDGTL TEXT '?'> IFDEF V30SWE < CUDGTL TEXT '?'> IFDEF DUTCH < CUDGTL TEXT '_' > IFDEF SPANISH < CUDGTL TEXT '?' > / / GOLD:DEAD KEY / CUDGTL TEXT 'D' / / GOLD:ABBREV / IFDEF ENGLSH < / GOLD:= in English IFNDEF V30FAO < /A037 CUDGTL TEXT '=' > IFDEF V30FAO < /A037 CUDGTL /A037 TEXT '+' /A037 > > IFDEF ITALIAN < CUDGTL TEXT '-' > IFDEF V30NOR < CDCMND OSLASH > /A039 IFDEF V30SWE < CDCMND UUMLAT > IFDEF DUTCH < CUDGTL TEXT '=' > IFDEF SPANISH < CUDGTL /A037 TEXT '+' /A037 > / / GOLD:LIBRY / CUDGTL TEXT 'L' / / GOLD:GET DOCMT / CUDGTL TEXT 'G' / / GOLD:TOP DOCMT / CUDGTL TEXT 'T' / / GOLD:BOT DOCMT / CUDGTL TEXT 'B' / / GOLD:SRCH / IFDEF ENGLSH < / GOLD:, in English CUDGTL TEXT ',' > IFDEF ITALIAN < CUDGTL TEXT ';' > IFDEF V30NOR < / GOLD:, in Scandinavian CUDGTL TEXT ',' > IFDEF V30SWE < CUDGTL TEXT ',' > IFDEF DUTCH < CUDGTL TEXT ',' > IFDEF SPANISH < CUDGTL TEXT ',' > / / GOLD:CONT SRCH / IFDEF ENGLSH < / GOLD:. in English CUDGTL TEXT '.' > IFDEF ITALIAN < CUDGTL TEXT ':' > IFDEF V30NOR < CUDGTL TEXT '.' /A039 > IFDEF V30SWE < CUDGTL TEXT '.' > IFDEF DUTCH < CUDGTL TEXT '.' > IFDEF SPANISH < CUDGTL TEXT '.' > / / GOLD:NEW PAGE / CUDGTL TEXT 'N' / / GOLD:PAGE MARKER / CUDGTL TEXT 'P' / / GOLD:RULER / CUDGTL TEXT 'R' / / GOLD:CENTER / CUDGTL TEXT 'C' / / GOLD:CUT / CDGCUT 0 / / GOLD:PASTE / CDGPST 0 / / GOLD:"Page" / CDGPGE 0 / / GOLD:REPLC / IFDEF ENGLSH < / GOLD:' in English IFNDEF V30FAO < CUDGTL TEXT \'\ > IFDEF V30FAO < /A037 CDCMND /A037 NENIA /A037 > > IFDEF ITALIAN < CDCMND ITAST4 > IFDEF V30NOR < CDCMND AE > /A039 IFDEF V30SWE < CDCMND AUMLAT > IFDEF DUTCH < CUDGTL TEXT \'\ > IFDEF SPANISH < CDCMND /A037 NENIA /A037 > / / GOLD:SUPER SCRIPT / IFNDEF FRENCH < CUDGTL TEXT 'A' > IFDEF FRENCH < CUDGTL TEXT 'Q' > / / GOLD:SUB SCRIPT / IFNDEF FRENCH < CUDGTL TEXT 'Q' > IFDEF FRENCH < CUDGTL TEXT 'A' > / / GOLD:VIEW / CUDGTL TEXT 'V' / / GOLD:DATE & TIME / IFDEF ENGLSH < IFNDEF V30FAO < CDCMND / GOLD:\ in English BSLASH > IFDEF V30FAO < /A037 CDCMND /A037 CCEDLA /A037 > > IFDEF ITALIAN < CUDGTL TEXT '*' > IFDEF V30NOR < CUDGTL TEXT "'"> IFDEF V30SWE < CUDGTL TEXT "'"> IFDEF DUTCH < CDCMND / GOLD:\ in English BSLASH > IFDEF SPANISH < CDCMND /A037 CCEDLA /A037 > IFDEF CONDOR < / / technical character /a021 / CDXTC 0 > / /A012 / HELP /A012 / /A012 CDHELP /A012 0 /A012 / /A018 / PREVIOUS SCREEN /A018 / /A018 CDPRSC /A018 0 /A018 / /A018 / NEXT SCREEN /A018 / /A018 CDNXSC /A018 0 /A018 / /A018 / UP ARROW (CURSOR UP) /A018 / /A018 CDUPAR /A018 0 /A018 / /A018 / DOWN ARROW (CURSOR DOWN) /A018 / /A018 CDDNAR /A018 0 /A018 IFDEF CONDOR < /A019 / /A018 / RIGHT ARROW (CURSOR RIGHT) /A018 / /A018 CDRARO /A018 0 /A018 / /A018 / LEFT ARROW (CURSOR LEFT) /A018 / /A018 CDLARO /A018 0 /A018 / /A018 / GOLD: RIGHT ARROW /A018 / /A018 CDGRAR /A018 0 /A018 / /A018 / GOLD: LEFT ARROW /A018 / /A018 CDGLAR /A018 0 /A018 > / END IFDEF CONDOR /M019 / /A018 / GOLD: SPACE (NONBREAKING SPACE - ALIAS REQUIRED SPACE) /A018 / /A018 CDRQSP /A018 0 /A018 IFDEF CONDOR < /A020 CDCOLM / COLUMN CUT /A020 0 /A020 > / END IFDEF CONDOR /A020 / / ??? / CDINOV /A038 0 / /D023 20 LINES / GOLD: for UDK activation / / CUDGTL / GOLD:9 / TEXT '9' / CUDGTL / GOLD:8 / TEXT '8' / CUDGTL / GOLD:7 / TEXT '7' / CUDGTL / GOLD:6 / TEXT '6' / CUDGTL / GOLD:5 / TEXT '5' / CUDGTL / GOLD:4 / TEXT '4' / CUDGTL / GOLD:3 / TEXT '3' / CUDGTL / GOLD:2 / TEXT '2' / CUDGTL / GOLD:1 / TEXT '1' / CUDGTL / GOLD:0 / TEXT '0' /END D023 20 LINES / CDSPCE, IFDEF ENGLSH < TEXT '&SPACE' > IFDEF ITALIAN < TEXT '&SPAZIO' > IFDEF V30NOR < TEXT '&ORDSKILLER'> /A039 IFDEF V30SWE < TEXT '&BLANK'> IFDEF DUTCH < TEXT '&SPATIE'> IFDEF SPANISH < TEXT '&ESPACE'> / CDRBCH, IFDEF ENGLSH < TEXT '&RUBCHR' > IFDEF ITALIAN < TEXT '&AN&CAR' > IFDEF V30NOR < TEXT '&SLETT TEGN'> /A039 IFDEF V30SWE < TEXT '&RATKN'> IFDEF DUTCH < TEXT '&R-TEK'> IFDEF SPANISH < TEXT 'BORCAR'> / CDRBWD, IFDEF ENGLSH < TEXT '&RUBWRD' > IFDEF ITALIAN < TEXT '&CANC&PA' > IFDEF V30NOR /A039 IFDEF V30SWE < TEXT '&RADRD'> IFDEF DUTCH < TEXT '&R-WRD'> IFDEF SPANISH < TEXT '&BORPAL'> / CDNWLN, IFDEF ENGLSH < TEXT '&RETURN' > IFDEF ITALIAN < TEXT '&RITORNO' > IFDEF V30NOR < TEXT '&RETUR'> /A039 IFDEF V30SWE < TEXT '&RET'> IFDEF DUTCH < TEXT '&RETURN> IFDEF SPANISH < TEXT '&RETORNO'> / CDCRET, IFDEF ENGLSH < TEXT '&PARMRK' > IFDEF ITALIAN < TEXT '&CRE&PAR' > IFDEF V30NOR < TEXT '&AVSNITMRK'> /A039 IFDEF V30SWE < TEXT '&STYMARK'> IFDEF DUTCH < TEXT '&ALIMRK'> IFDEF SPANISH < TEXT '&MRKPAR'> / CDTAB, IFDEF ENGLSH < TEXT '&TAB' > IFDEF ITALIAN < TEXT '&TAB' > IFDEF V30NOR < TEXT '&TAB'> IFDEF V30SWE < TEXT '&TABB'> IFDEF DUTCH < TEXT '&TAB'> IFDEF SPANISH < TEXT '&TAB'> / CDTABC, / /d022 IFDEF ENGLSH < TEXT '&TABCEN' > /d022 IFDEF CANADA < TEXT "&CENTAB" > /d022 IFDEF FRENCH < TEXT "&TABCEN" > /d022 IFDEF DUTCH < TEXT "&TABCEN" > /d022 IFDEF GERMAN < TEXT "&TABCEN" > /d022 IFDEF NORWAY < TEXT "&TABSEN" > /d022 IFDEF SWEDSH < TEXT "&TABCEN" > /d022 IFDEF DANISH < TEXT "&TABCEN" > / IFDEF ENGLSH < TEXT "&G-TAB" > /A022 IFDEF ITALIAN < TEXT "&O-&TAB" > IFDEF V30NOR < TEXT '&G-TAB'> /A039 IFDEF V30SWE < TEXT '&G-TABB'> IFDEF DUTCH < TEXT '&G-TAB'> IFDEF SPANISH < TEXT '&D-TAB'> / CDRBLN, IFDEF ENGLSH < TEXT '&RUBLIN' > IFDEF ITALIAN < TEXT '&AN&RIG' > IFDEF V30NOR < TEXT '&SLETT LINJE'> /A039 IFDEF V30SWE < TEXT '&RARAD'> IFDEF DUTCH < TEXT '&WISREG'> IFDEF SPANISH < TEXT '&BORLIN'> / CDRBSE, IFDEF ENGLSH < TEXT '&RUBSEN' > IFDEF ITALIAN < TEXT '&CANC&FR' > IFDEF V30NOR < TEXT '&SLETT SETN'> /A039 IFDEF V30SWE < TEXT '&RAMEN'> IFDEF DUTCH < TEXT '&WISZIN'> IFDEF SPANISH < TEXT '&BORFRA'> / CDDLTC, IFDEF ENGLSH < TEXT '&DELCHR' > IFDEF ITALIAN < TEXT '&CAN&CAR' > IFDEF V30NOR < TEXT '&TEGN UT'> /A039 IFDEF V30SWE < TEXT '&RATKN'> IFDEF DUTCH < TEXT '&WISTEK'> IFDEF SPANISH < TEXT '&BORCAR'> / CDDLTW, IFDEF ENGLSH < TEXT '&DELWRD' > IFDEF ITALIAN < TEXT '&CAN&PAR' > IFDEF V30NOR < TEXT 'ORD UT'> /A039 IFDEF V30SWE < TEXT '&RAORD'> IFDEF DUTCH < TEXT '&WISWRD'> IFDEF SPANISH < TEXT '&BORPAL'> / CDWORD, IFDEF ENGLSH < TEXT '&WORD' > IFDEF ITALIAN < TEXT '&PAROLA' > IFDEF V30NOR < TEXT '&ORD'> /A039 IFDEF V30SWE < TEXT '&ORD'> IFDEF DUTCH < TEXT '&WOORD'> IFDEF SPANISH < TEXT '&PALAB'> / CDSENT, IFDEF ENGLSH < TEXT '&SENT' > IFDEF ITALIAN < TEXT '&FRASE' > IFDEF V30NOR < TEXT '&SETN'> /A039 IFDEF V30SWE < TEXT '&MEN'> IFDEF DUTCH < TEXT '&ZIN'> IFDEF SPANISH < TEXT '&FRASE'> / CDLINE, IFDEF ENGLSH < TEXT '&LINE' > IFDEF ITALIAN < TEXT '&RIGA' > IFDEF V30NOR < TEXT '&LINJE'> /A039 IFDEF V30SWE < TEXT '!&RAD'> IFDEF DUTCH < TEXT '®EL'> IFDEF SPANISH < TEXT '&L\MNEA'> / CDTABP, IFDEF ENGLSH < TEXT '&TABPOS' > IFDEF ITALIAN < TEXT '&CER&TAB' > IFDEF V30NOR < TEXT '&TABPOS'> /A039 IFDEF V30SWE < TEXT '&TABBPOS'> IFDEF DUTCH < TEXT '&TABPOS'> IFDEF SPANISH < TEXT '&POSTAB'> / CDENTR, TEXT '!<>' CDPAGE, IFDEF ENGLSH < TEXT '&PAGE' > IFDEF ITALIAN < TEXT "&PAGINA" > IFDEF V30NOR < TEXT '&SIDE'> /A039 IFDEF V30SWE < TEXT '&SIDA'> IFDEF DUTCH < TEXT '&PAGINA'> IFDEF SPANISH < TEXT '&P\AG'> / CDPARA, IFDEF ENGLSH < TEXT '&PARA' > IFDEF ITALIAN < TEXT '&PARAGR' > IFDEF V30NOR < TEXT '&AVSNITT'> /A039 IFDEF V30SWE < TEXT '&STY'> IFDEF DUTCH < TEXT '&ALINEA'> IFDEF SPANISH < TEXT '&PARRA'> / CDADVN, IFDEF ENGLSH < TEXT '&ADVANC' > IFDEF ITALIAN < TEXT '&AVANTI' > IFDEF V30NOR < TEXT '&FREM'> /A039 IFDEF V30SWE < TEXT '&FRAM'> IFDEF DUTCH < TEXT '&VOORUIT'> IFDEF SPANISH < TEXT '&DELAN'> / CDBKUP, IFDEF ENGLSH < TEXT '&BACKUP' > IFDEF ITALIAN < TEXT '&INDIET' > IFDEF V30NOR < TEXT '&TILBAKE'> /A039 IFDEF V30SWE < TEXT '&BAK'> IFDEF DUTCH < TEXT '&TERUG'> IFDEF SPANISH < TEXT '&ATR\AS'> / CDGADV, IFDEF ENGLSH < TEXT '&G-&ADV' > IFDEF ITALIAN < TEXT '&O-&AVA' > IFDEF V30NOR < TEXT '&G-FREM'> /A039 IFDEF V30SWE < TEXT '&G-FRAM'> IFDEF DUTCH < TEXT '&G-&VRT'> IFDEF SPANISH < TEXT '&D-&ADEL'> / CDGBKP, IFDEF ENGLSH < TEXT '&G-&BACK' > IFDEF ITALIAN < TEXT '&O-&INDI' > IFDEF V30NOR < TEXT '&G-TILBAKE'> /A039 IFDEF V30SWE < TEXT '&G-BAK'> IFDEF DUTCH < TEXT '&G-&TRG'> IFDEF SPANISH < TEXT '&D-&ATR\AS'> / CDBOLD, IFDEF ENGLSH < TEXT '&BOLD' > IFDEF ITALIAN < TEXT '&NERET' > IFDEF V30NOR < TEXT '&FET'> /A039 IFDEF V30SWE < TEXT '&FET'> IFDEF DUTCH < TEXT '&VET'> IFDEF SPANISH < TEXT '&NEGR'> / CDSLCT, IFDEF ENGLSH < TEXT '&SEL' > IFDEF ITALIAN < TEXT '&SEL' > IFDEF V30NOR < TEXT '&VELG'> /A039 IFDEF V30SWE < TEXT '&MARK'> IFDEF DUTCH < TEXT '&SEL'> IFDEF SANISH < TEXT '&SEL'> / CDUPPR, IFDEF ENGLSH < TEXT '&UPPER' > IFDEF ITALIAN < TEXT '&MAIUS' > IFDEF V30NOR < TEXT 'STORE BOKST'> /A039 IFDEF V30SWE < TEXT '&VERS'> IFDEF DUTCH < TEXT '&HOOFDL'> IFDEF SPANISH < TEXT 'MAY\ZSC'> / CDUNDL, IFDEF ENGLSH < TEXT '&UNDER' > IFDEF ITALIAN < TEXT '&SOTTOL' > IFDEF V30NOR < TEXT 'UNDERSTREK'> /A039 IFDEF V30SWE < TEXT '&GEM'> IFDEF DUTCH < TEXT '&ONDER'> IFDEF SPANISH < TEXT 'SUBRY'> / CDSCUT, IFDEF ENGLSH < TEXT '&CUT' > IFDEF ITALIAN < TEXT '&TOGLI' > IFDEF V30NOR < TEXT '&TA UT'> /A039 IFDEF V30SWE < TEXT '&KLIPP'> IFDEF DUTCH < TEXT '&KNIP'> IFDEF SPANISH < TEXT '&CORTA'> / CDSWAP, IFDEF ENGLSH < TEXT '&SWAP' > IFDEF ITALIAN < TEXT '&SCAMB&C' > IFDEF V30NOR < TEXT '&BYTT OM'> /A039 IFDEF V30SWE < TEXT '&SKIFT'> IFDEF DUTCH < TEXT '&VERWIS'> IFDEF SPANISH < TEXT '&INTCAM'> / CDPSTE, IFDEF ENGLSH < TEXT '&PASTE' > IFDEF ITALIAN < TEXT '&METTI' > IFDEF V30NOR < TEXT '&SETT INN'> /A039 IFDEF V30SWE < TEXT '&KLISTRA'> IFDEF DUTCH < TEXT '&PLAK'> IFDEF SPANISH < TEXT 'PEGA'> / CDUDLT, IFDEF ENGLSH < TEXT '&G-&DEL' > IFDEF ITALIAN < TEXT '&O-&CAN' > IFDEF V30NOR < TEXT 'G-UT'> /A039 IFDEF V30SWE < TEXT '&G-RA'> IFDEF DUTCH < TEXT '&G-WIS'> IFDEF SPANISH < TEXT '&D-&BORRA'> / CDUBLD, IFDEF ENGLSH < TEXT '&G-&BOLD' > IFDEF ITALIAN < TEXT '&O-&NERE' > IFDEF V30NOR < TEXT 'G-FET'> /A039 IFDEF V30SWE < TEXT '&G-FET'> IFDEF DUTCH < TEXT '&G-&VET'> IFDEF SPANISH < TEXT '&D-&BOLD'> / CDLOWR, IFDEF ENGLSH < TEXT '&G-&UPPR' > IFDEF ITALIAN < TEXT '&O-&MAIU' > IFDEF V30NOR < TEXT '&G-STORE BOKST'> /A039 IFDEF V30SWE < TEXT '&G-VERS'> IFDEF DUTCH < TEXT '&G-HFDL'> IFDEF SPANISH < TEXT '&D-MAY\Z'> / CDUUDL, IFDEF ENGLSH < TEXT '&G-&UNDR' > IFDEF ITALIAN < TEXT '&O-&SOTT' > IFDEF V30NOR < TEXT '&G-U_STREK'> /A039 IFDEF V30SWE < TEXT '&G-GEM'> IFDEF DUTCH < TEXT '&G-ONDR'> IFDEF SPANISH < TEXT '&D-&SUBR'> / CDHYPS, IFDEF ENGLSH < TEXT '&HYPUSH' > IFDEF ITALIAN < TEXT '&CAR&SU' > IFDEF V30NOR < TEXT '&DEL ORD !C^'> /A039 IFDEF V30SWE < TEXT '&AVSTUPP'> IFDEF DUTCH < TEXT '&KPL-V'> IFDEF SPANISH < TEXT '&SBGUI\SN'> / CDHYPL, IFDEF ENGLSH < TEXT '&HYPULL' > IFDEF ITALIAN < TEXT '&CAR&GIU' > IFDEF V30NOR < TEXT '&DEL ORD V'> /A039 IFDEF V30SWE < TEXT '&AVSTNED'> IFDEF DUTCH < TEXT '&KPL-&!^'> IFDEF SPANISH < TEXT '&BAJAG'> / CDGCUT, IFDEF ENGLSH < TEXT '&G-&CUT' > IFDEF ITALIAN < TEXT '&O-&TOGL' > IFDEF V30NOR < TEXT '&G-TA UT'> /A039 IFDEF V30SWE < TEXT '&G-KLIPP'> IFDEF DUTCH < TEXT '&G-&KNIP'> IFDEF SPANISH < TEXT '&D-&CORTA'> / CDGPST, IFDEF ENGLSH < TEXT '&G-&PSTE' > IFDEF ITALIAN < TEXT '&O-&METT' > IFDEF V30NOR < TEXT '&G-SETT INN'> /A039 IFDEF V30SWE < TEXT '&G-KLISTRA'> IFDEF DUTCH < TEXT '&G-&PLAK'> IFDEF SPANISH < TEXT '&D-PEGA'> / CDGPGE, IFDEF ENGLSH < TEXT '&G-&PAGE' > IFDEF ITALIAN < TEXT '&O-&PAGI' > IFDEF V30NOR < TEXT '&G-SIDE'> IFDEF V30SWE < TEXT '&G-SIDA'> IFDEF DUTCH < TEXT '&G-&PAG'> IFDEF SPANISH < TEXT '&D-&P\AG'> / / The next text statements were removed from the previous "8" page to / make room / CDCMND, IFDEF ENGLSH < TEXT '&G&O&L&D:!A' > IFDEF ITALIAN < TEXT '&ORO:!A' > IFDEF V30NOR < TEXT '!&GOLD: !A'> IFDEF V30SWE < TEXT '&GULD:!A'> IFDEF DUTCH < TEXT '&GOUD:!A'> IFDEF SPANISH < TEXT '&DOR:!A'> / CUDGTL, IFDEF ENGLSH < TEXT '&G&O&L&D:&^S' > IFDEF ITALIAN < TEXT '&ORO:&^S' > IFDEF V30NOR < TEXT '!&GULL:&^S'> IFDEF V30SWE < TEXT '&GULG: &^S'> IFDEF DUTCH < TEXT '&GOUD:&^S'> IFDEF SPANISH < TEXT '&DOR:&^S'> / CUDMS4, TEXT '^P' / IFNDEF FRENCH < CUDLCB, "{-200 / curly bracket 0000 / end of list > IFDEF ITALIAN < ITAST1, "l;0 ITAST2, "r;0 ITAST3, "0;0 ITAST4, "y;0 > IFDEF V30NOR < OSLASH, 330;0 /O with slash /A039 ARING, 305;0 / A with ring /A039 AE, 306;0 / Ae ligature /A039 > IFDEF SPANISH < OSLASH, 330;0 /O with slash /A039 ARING, 305;0 / A with ring /A039 AE, 306;0 / Ae ligature /A039 > IFDEF V30SWE < ARING, 305;0 UUMLAT, 334;0 AUMLAT, 304;0 > IFDEF ENGLSH < BSLASH, 134;0 > / Backslash /A039 IFDEF DUTCH < BSLASH, 134;0 > / Backslash /A039 IFDEF V30FAO < CCEDLA, 347;0 NENIA, 321;0 > IFDEF SPANISH < CCEDLA, 347;0 NENIA, 321;0 > / IFDEF FRENCH < > / Not used in french / IFDEF V30FAO < ACUTE, 0140 / ` for CMND for FAO /A037 0000 /A037 > IFDEF SPANISH < ACUTE, 0140 / ` for CMND for FAO /A037 0000 /A037 > IFDEF CONDOR < CDXTC, IFDEF ENGLSH /C034 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH > CDHELP, IFDEF ENGLSH /A012 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH CDPRSC, IFDEF ENGLSH /A018 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH CDNXSC, IFDEF ENGLSH /A018 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH CDUPAR, IFDEF ENGLSH /A018 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH CDDNAR, IFDEF ENGLSH /A018 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH IFDEF CONDOR < /A019 CDRARO, IFDEF ENGLSH /A018 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH CDLARO, IFDEF ENGLSH /A018 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH CDGRAR, IFDEF ENGLSH /A018 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH CDGLAR, IFDEF ENGLSH /A018 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH > / END IFDEF CONDOR /M019 CDRQSP, IFDEF ENGLSH /A018 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH IFDEF CONDOR < /A020 CDCOLM, IFDEF ENGLSH / COLUMN CUT /A020 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH > / END IFDEF CONDOR /A020 CDINOV, IFDEF ENGLSH /A038 IFDEF V30NOR /A039 IFDEF ITALIAN IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH   / WPUDKD - UDK POINTERS & SYSTEM BLOCK VALUES / / 033 Mart 15-aug-85 modified date and time sep for DUTCH / 032 EMcD 28-Feb-85 Added DECDEV switch / 031 AH 29-OCT-84 EXTENSION TO 029 / 030 WCE 08-OCT-84 INITIALIZE MNOPTC FOR STANDARD SYSTEM / 029 AH 13-SEP-84 ADDED SYSTEM DATE, VERSION TO DIRECTORY / 028 WCE 20-AUG-84 ADDED TELEPHONE DIRECTORY WORD / 027 AH 10-AUG-84 CHANGED "RETURN" TO "ADVANCE" IN UDK 0 / 026 TCW 16-JUL-84 Definition of MNPRTB CHANGED / 025 JAC 03-JUL-84 Fix Loading Sequence / 024 JAC 15-APR-84 ZERO UNUSED UDK BLOCKS ON DISK / 023 JAC 25-APR-84 100 UDK DEVELOPMENT / 022 WCE 30-APR-84 Added words to system area for British / 021 WJY 02-FEB-84 DECmate I compatability. / 020 EPS 21-JUN-83 ADDED BOOKMARK UDK'S FOR CONDOR / 019 WCE 21-JUN-83 Added conditional for Develop options / 018 HLP 08-JUN-83 NCONDOR to use PB 4800 / 017 HLP 04-NOV-82 DM-II TM default to VT-100 / 016 MJS 12-OCT-82 Conditionalized "MNSECN" (the secondary / comm port characteristics on CONDOR / because "SETUP" mode uses this location / to save the terminal characteristics / (thus no other loc had to be defined) / / 015 SBB 17-SEP-82 Deleted ICP's for CONDOR. 4800 baudprt / / 014 AIB 11-AUG-82 Add UDK 5: editor math ICP, and UDK 6: / list processing math ICP / / 013 SBB 25-AUG-82 Made timeout delays variable from MNXDLY / (DEFAULT TO CT=5) / 012 HLP 30-JUN-82 TM default conditionalized for DM-II / 011 GDH 16-OCT-81 TM option changes. / 010 GR 05-OCT-81 Updated UDK's for ICP docs. for V2.0 / 009 GDH 23-SEP-81 made system value area location independent. / 008 GDH 01-SEP-81 New write-out code conventions. / 007 GR 06-AUG-81 ADDED MATH SWITCH FLAG / 006 TT 07-JUL-81 Removed superfluous conditionals / 005 DRH 2-FEB-81 INSTALLED SORT ICP IN UDK 9 / 004 DAO 21-JAN-81 Changed stop bit default to 1 (was 2) / Most timeshare systems use 1. / 003 DRH 20-JAN-81 INSTALLED KERNEL 1.0 SOFTWARE ICP IN / UDK 7 & LIST PROCESSING ICP IN UDK 8 / 002 WCE 17-NOV-80 ADDED INITIALIZE VALUE FOR UNBUNDILING / 001 DAO 11-NOV-80 Conditionalize DP2 baud rate to be set / to 9600 for a VT278 since it is used / for the LQPSE. / 2.N-1 RLT 14-SEP-77 CHANGE FOR UDKPRT OPTION / 2.N KEE 7-SEP-77 CHANGE 'MN' SYMBOLS FOR 4-FLOPPY SUPPORT / FIELD 0 *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLUDKS / ++++ 1200 / ++++ /C023 CDF 10 / ++++ /D025 -DSUDKS -2 / Load Directory and next block only /A025 DLSVAL / ++++ 600 / ++++ CDF 10 / ++++ -DSSVAL / Below loads rest of zeroed udk blocks /A025 DLUDKS+2 / ZERO THE UNUSED BLOCKS /A024 ZEROLA / BLOCK 0, /A024 IFNDEF DECDEV < CDF 20 / FIELD 2 (ASS'Y TIME) /M032 /A024 > IFDEF DECDEV < CDF 50 / FIELD 2 (ASS'Y TIME) /A032 > -DSUDKS+2 / SHOULD BE -17 = 7761 /A024 0 / FIELD 1 *1200 RELOC CUDBUF / EACH LOCATION CONTAINS THE ADDRESS OF THE ASSOCIATED UDK. THAT IS, / WORD 0 CONTAINS THD ADDRESS OF UDK 0, WORD 1 CONTAINS THE ADDRESS OF / UDK 1, ETC. THE UDK DIRECTORY OCCUPIES ONE BLOCK; ONLY 100 DECIMAL / LOCATIONS ARE USED. THE ADDRESS WORD IS DECODED AS FOLLOWS: / BITS 0-3: RELATIVE BLOCK OF CORRESSPONDING UDK / BITS 4-11: WORD IN THE RELATIVE BLOCK / / UDK'S START IN THE BLOCK FOLLOWING THE DIRECTORY (ALTHOUGH THEY DON'T / NECESSARILY HAVE TO) AND USE 16 DECIMAL BLOCKS. UDK'S MAY BE ANY LENGTH / AND MAY CROSS BLOCK BOUNDRIES. THE FIRST WORD OF A UDK IS THE UDK NUMBER / PLUS 2001 OCTAL; THE FIRST WORD OF UDK 1 WILL BE 2001 OCTAL, THE FIRST / WORD OF UDK 2 WILL BE 2002 OCTAL, ... , THE FIRST WORD OF UDK 99 WILL / BE 2144 OCTAL. / / COMPUTATIONS FOR THE FIRST UDK DEFINED (NOT NECESSARILY UDK 0). / A SET OF THESE COMPUTATIONS IS REQUIRED FOR EACH UDK DEFINED. BLKSET= CUDBUF+400%400 / BLOCK OF UDK DIRECTORY BLKADR= UDK0%400-BLKSET / RELATIVE BLOCK OF UDK RELADR= UDK0-CUDBUF-400 / RELATIVE CORE ADDRESS BLKWRD= RELADR%400^400 / ADDRESS OF FIRST WORD OF BLOCK WRDADR= RELADR-BLKWRD / ADDRESS OF WORD IN BLOCK BLKADR^400+WRDADR / ADDRESS OF UDK 0 0 / 1 0 / 2 0 / 3 0 / 4 0 / 5 0 / 6 0 / 7 0 / 8 BLKADR= UDK9%400-BLKSET RELADR= UDK9-CUDBUF-400 BLKWRD= RELADR%400^400 WRDADR= RELADR-BLKWRD BLKADR^400+WRDADR / ADDRESS OF UDK 9 ZBLOCK 400-.+CUDBUF-14 /ZERO REST OF DIRECTORY /C029 DLRLRE / EDITOR RULERS /A031 DLRLRP / PRINTER SETTINGS /A031 DLSVAL / SYSTEM PARAMETERS /A031 DLUDKD / UDK DEFINITIONS /A031 SYSVER / VERSION NUMBER, 8-BIT ASCII /A029 SYSBAS / BASE LEVEL NUMBER /A029 SYSREV / BASE LEVEL REV. NUMBER /A029 BLDDY / BUILD DAY, BINARY /A029 BLDMO / MON /A029 BLDYR / YR /A029 TEXT "UDK" / UDK DIRECTORY BLOCK IDENTIFIER, 2WORDS/A029 NOP / PLACE HOLDER SO ADDRESS OF UDK 0 / IS NOT ZERO. THIS PREVENTS HAVING A UDK / DEFINED WHOSE ADDRESS IN THE DIRECTORY / IS ZERO. A ZERO ADDRESS IN THE DIRECTORY / WOULD INDICATE THAT THAT UDK WAS NOT / DEFINED. UDK0, 0+CUUDID EDFIND /SEARCH /A020 IFDEF ENGLSH < "*-200 /* /A020 "*-200 /* /A020 "*-200 /* /A020 "B-200 /B /A020 "O-200 /O /A020 "O-200 /O /A020 "K-200 /K /A020 " -200 /SPACE /A020 "M-200 /M /A020 "A-200 /A /A020 "R-200 /R /A020 "K-200 /K /A020 "*-200 /* /A020 "*-200 /* /A020 "*-200 /* /A020 > IFDEF ITALIAN < "*-200 /* /A020 "*-200 /* /A020 "*-200 /* /A020 "B-200 /B /A020 "O-200 /O /A020 "O-200 /O /A020 "K-200 /K /A020 " -200 /SPACE /A020 "M-200 /M /A020 "A-200 /A /A020 "R-200 /R /A020 "K-200 /K /A020 "*-200 /* /A020 "*-200 /* /A020 "*-200 /* /A020 > /D027 EDNWLN /RETURN /A020 EDADVN /ADVANCE NEW TERMINATOR FOR SEARCH /A027 EDRBCH /RUB CHAR /A020 EDDLTW /DEL WORD /A020 EDDLTC /DEL CHAR /A020 EDDLTC /DEL CHAR /A020 EDDLTC /DEL CHAR /A020 EDDLTC /DEL CHAR /A020 EDDLTC /DEL CHAR /A020 EDDLTC /DEL CHAR /A020 EDDLTC /DEL CHAR /A020 EDDLTC /DEL CHAR /A020 0 /A015 UDK9, 11+CUUDID EDNWLN /RETURN /A020 IFDEF ENGLISH < "*-200 /* /A020 "*-200 /* /A020 "*-200 /* /A020 "B-200 /B /A020 "O-200 /O /A020 "O-200 /O /A020 "K-200 /K /A020 " -200 /SPACE /A020 "M-200 /M /A020 "A-200 /A /A020 "R-200 /R /A020 "K-200 /K /A020 "*-200 /* /A020 "*-200 /* /A020 "*-200 /* /A020 > IFDEF ITALIAN < "*-200 /* /A020 "*-200 /* /A020 "*-200 /* /A020 "B-200 /B /A020 "O-200 /O /A020 "O-200 /O /A020 "K-200 /K /A020 " -200 /SPACE /A020 "M-200 /M /A020 "A-200 /A /A020 "R-200 /R /A020 "K-200 /K /A020 "*-200 /* /A020 "*-200 /* /A020 "*-200 /* /A020 > EDSLCT /SEL /A020 EDBKUP /BACK-UP /A020 EDLINE /LINE /A020 EDBOLD /BOLD /A020 EDNWLN /RETURN /A020 EDFILE /GOLD:F /A020 0 ZBLOCK 400-.+CUDBUF+400 / ZERO REST OF BLOCK / / DLSVAL - SYSTEM BLOCK INITAL SETTINGS / THESE ARE THE DEFAULT SYSTEM SETTING THAT ARE STORED ON THE DISK WHEN NEW / RELOC *600 / STARTING ADDRESS TO LOAD FROM AT WRITEOUT TIME / X=MUSYSV-MUBUF-600 / BASE OFFSET OF SYSTEM AREA. *MNABRV-X; 2 / MNABRV, USED BY THE EDITOR FOR ABBREVIATION *MNLBRY-X; 3 / MNLBRY, USED BY THE EDITOR FOR LIBRARY *MNPGSZ-X; 66 / MNPGSZ, USED BY THE EDITOR FOR PAGE SIZE *MNSTAT-X; IFDEF CONDOR < 2 > / MNSTAT, USED BY THE EDITOR FOR STATUS LINE /C021 IFNDEF CONDOR < 0 > / HAVE DMI COME UP WITH ES=0 /A021 *MNFMAT-X; 0 / MNFMAT, FORMAT WORD FOR DATE, CURRENCY, DICT. /A022 *MNSDRV-X; 0 / USER DRIVE SELECTION FOR SPELLING /A022 *MNPDFN-X; 0 / PERSONAL DICTIONARY DRIVE & FILE NUMBER /A022 *MNLGFN-X; 0 / LOGON EASY COMM DRIVE AND FILE NUMBER /A022 *MNADFN-X; 0 / AUTODIAL DIRECTORY DRIVE & FILE NUMBER /A028 IFDEF DUTCH < *MNDSEP-X; 5500 / DATE SEPARATOR TYPED IN BY USER /A022 > IFNDEF DUTCH < *MNDSEP-X; 5700 / DATE SEPARATOR TYPED IN BY USER /A022 > *MNXTRA-X; 0 / ** EXTRA WORD AVALAIBLE FOR SAVING /A028 *MNCMTP-X; 0 / MNCMTP - THE COMMUNICATIONS / SET FOR 0 = CX 1 = MAGCARD *MNXONF-X; 0 / MNXONF - USE XON/XOF AT HANDLER LEVEL OF / COMM PORT 0 = YES 1 = NO / FOR A DETAILED DESCRIPTION OF THE TWO / LOCATIONS SLU2PM AND 3 LOOK AT WPSYS SLDATA=4000 / 8 Data bits DDD D-- --- --- /A004 SLPARA=0200 / No Parity --- -PP --- --- /A004 SLSTOP=0020 / 1 Stop bit --- --- SS- --- /A004 SLBAUD=0005 / 300 baud --- --- --B BBB /A004 SLDFLT=SLDATA+SLPARA+SLSTOP+SLBAUD *MNPRIM-X; SLDFLT / MNPRIM - Primary port (0) settings. IFNDEF CONDOR < /A016 *MNSECN-X; SLDFLT / MNSECN - Alternate port (1) settings. > / END IFNDEF CONDOR /A016 IFDEF CONDOR < /A016 *MNSECN-X; 0 / MNSECN - condor SETUP mode values /A016 > / END IFDEF CONDOR /A016 / FORMAT FOR THE MNPRTB WORD: / BITS INFORMATION / / 0-2 TERMINAL MODE (0=VT52, 1=VT100, 2=DECMATE, 3=VT125, 4=VT227 / / 3-6 BREAK TIME (IN TENTHS OF A SECOND). / / / / 7 PORT SELECT (0=PRIMARY, 1=ALTERNATE) / / 8-11 PRINTER BAUD RATE. / / ********************************************************** / / LIMITS - VALUES THAT ARE CHECKED FOR IN THE MENU / / CHARACTER SIZE - CAN BE FROM 5 - 8 / / PARITY - 2 = NO PARITY, 1 = ODD, 0 = EVEN / / STOP BITS - 1 OR 2 NOTE: IF SET FOR 5 FOR CHARACTER SIZE AND 1 FOR STOP / IT WILL AUTOMATICALLY SET FOR 1.5 STOP BITS / / AND BAUD: / / VALUE BAUD / 0 50 / 1 75 / 2 110 / 3 134.5 (MAGCARD) / 4 150 / 5 300 / 6 600 / 7 1200 / 10 1800 / 11 2000 / 12 2400 / 13 3600 / 14 4800 / 15 7200 / 16 9600 / 17 19200 / *MNPRTB-X; / MNPRTB - See WPCU3/WPCU4 for defn of bits IFNDEF CONDOR < 0514 > / Initialized for PB=4800, /C018 / Primary port (0), BT=5. /C012 / TM = WS52 /C012 IFDEF CONDOR < 1254 > / Initialized for PB=4800,/C017 /M026 / Primary port (0), BT=5. /A012 / TM = VT-100 /C017 *MNCXP-X; 0 / MNCXP - DOCUMENT NUMBER FOR CX DOCUMENT / TRANSFER PROTOCOL *MNOPTC-X; / MNOPTC - USED BY THE UNBUNDLING CODE /A002 IFDEF UNBUND < /A019 COMBIT!LPBIT!SRBIT!MABIT / TURN ON SYSTEM OPTIONS /C030 > / END IFDEF UNBUND /A019 IFNDEF UNBUND < -1 > / MAKE SURE ALL OPTIONS ARE ACTIVE /A019 *MNXDLY-X; 5 / MNXDLY is used as a multiplier to mod /A013 / the time out delays for DX /A013 / THE NEXT 3 ITEMS ARE NOT COPIED INTO THE SYSTEM AREA BECAUSE OF SPACE //*MNCDV-X; 0 / DOCUMENT DRIVE NUMBER (MNCDV) //*MNCNO-X; 0 / DOCUMENT NUMBER WITHOUT THE DRIVE (MNCNO) //*MNCFAD-X; 0 / START OF THE ASCII STRING THAT IS THE / DOCUMENT NAME (MNCFAD) ZBLOCK 400-.+600 / THE FOLLOWING SETS UP A DUMMY ZEROED FIELD TO LOAD TO UNUSED UDK BLOCKS/A024 IFNDEF DECDEV < FIELD 2 /M032 > IFDEF DECDEV < FIELD 5 /A032 > *0 ZEROLA, ZBLOCK 7777 $$$$$$