File: RTESC.PG of Tape: Sources/Other/new-18
(Source file text)
FILE R T E S C -- RTES Documentation Program TITLE Upper level character extraction / / This co-routine is the first level of character extraction. / / Note that there are four main routines which can drive / the character extraction: / / a. normal character extraction from OS/8 routines / b. backtracking when we are re-reading the last word that did not / fit. / c. generating the date string from a [d] type command / d. generating section/page # from [=] type command / GETC SUB Entry point to first co-routine CLA Ensure non-zero AC allowed here TAD NEXTC Get the next character to read DCA CHAR Set as the current character to return GETCX SUB GETC2 Exit pointer for second co-routine DCA NEXTC Save the next character to go out TAD CHAR Reget character RET GETC Exit via first co-routine / / Here when we are backtracking. I.e. we are re-reading the word / that did not fit when the prior line was justified. / RECAP TAD NEXTC Save NEXTC while switching co-routine linkage DCA NEXTSV ... / TADI KXR Get the next character from the line buffer SPA Test for line sentinel JMP RESET Sentinel found - back to OS/8 buffer now RTL Test for conditional hyphen flag (to LINK) SZL Skip if not conditional hyphen JMP 3F Conditional hyphen is special case / RTR Restore original character code / / Merge here to return character / 1H JMS GETCX Return this character JMP RECAP+2 Loop for next one / 3H CLL RTR Restore original character (& remove flag bit) JMS GETCX Return that character first TAD =DHYPHEN Now return the conditional hyphen character JMP 1B ... / / Here to reset the co-routine linkage back to the main OS/8 routine / RESET CLA AC maybe non-zero on entry here TAD =GETC2 Reset the co-routine linkage DCA GETCX+0 ... TAD NEXTSV Get the saved NEXTC cell JMP GETCX+1 Return now to flush out CHAR EJECT / / Here when we are reading characters from the OS/8 character buffer / GETC2 CLA AC may be non-zero on entry here JMSI GETCHAR Load up the next character (LDC or GETKAR) / / Test for CR and FF since these characters are stripped. Also / we must test for ^A (ICE correction flag) and post this in / case a /P proof is being handled. / SNA Always ignore binary nulls JMP GETC2+1 ... TAD =-0201 Test for ^A correction character SNA JMP 6F ^A found -- off to handle it IAC Test for ASCII null code (200) SZA Skip if ASCII null TAD =0200-CR Else test for carriage return SNA JMP GETC2+1 Strip CR, NULL TAD =CR-LF Test for end of line code SNA JMP 4F Off to handle line feed code TAD =LF-FF Test for form-feed code SNA JMP 5F Off to handle form-feed TAD =FF Restore character ISZ COLUMN Update column number on line NOP Ensure no problem if it skips for some reason / / Also merge back here with LF code in AC / 7H JMS GETCX Return that character JMP GETC2+1 Loop for the next one / / Here is the third part where we are returning characters that / we are reading from the date buffer / DODATE TAD =DAYBUF-1 First time through set pointer to DAYBUF DCA DPTR ... TAD NEXTC Save NEXTC while switching co-routine linkage DCA NEXTSV ... / / Loop here to get the next characters of the date / 2H INC DPTR Step to next character in the buffer TADI DPTR Load that character SNA Test for sentinel on the buffer JMP RESET Sentinel -- continue with OS/8 buffer now JMS GETCX Else return this character JMP 2B And loop for the next one / / Here to handle line feed. Just update the line number, / and reset the column position on line back to zero / 4H TAD =SECTION+7 Get address of low part of line number JMS INCNUM Increment the line number DCA COLUMN Reset column position on line back to zero DCA TABFLAG Reset tabulation flag for indent TAD =LF Now return the LF character JMP 7B ... / / Here on form feed, update the page number and strip this character / 5H TAD =' First reset line number back to 1 DCA SECTION+5 ... TAD =' ... DCA SECTION+6 ... TAD ='1 ... DCA SECTION+7 ... TAD =SECTION+3 Get address of low part of page number JMS INCNUM Increment the page number JMP GETC2+1 Now strip the FF character / / Here to handle correction flag. Post double * just before file / number. / 6H TAD ='* Insert two asterisks before file number DCA PSECT ... TAD ='* ... DCA PSECT+1 ... JMP GETC2+1 And strip the correction flag character EJECT / / Here when end of all input files has been found. Just keep / returning end-of-file character until upper level routines / do something about it. / FEOF TAD =CTLZ Get ASCII end-of-file code JMS GETCX Return that code ISZ 0F Ensure we don't loop out here JMP FEOF Loop here till upper level program notices JMS E2 Force ourselves out of here / 0H DC 0 Loop-out inhibit counter for above / / The following co-routine resides between LDC/GETC and PIKUP. Its only / function is to expand tabulation codes. GETC routine is responsible / for updating the column width, and resetting it back to zero / when a LF code is found. / We must return the appropriate / number of blanks to the calling routine. This is complicated / somewhat by the need to restore the tabulation sequence originally / present in the input file (stripping of initial blank means that / we must restore the tabulation columns) / GETKAR SUB GETKARX SUB 1F Initial coroutine linkage RET GETKAR / 1H JMS PIKUP Pickup the next character TAD =-TAB Only test for TAB code here SNA Skip if not JMP 2F TAB -- off to handle it TAD =TAB Else restore code JMS GETKARX And return it JMP 1B Loop back for next character / 2H TAD =' Return a blank first JMS GETKARX ... ISZ TABFLAG Is this first tab after an indent? JMP *+2 No, so continue JMP 2B Yes, so don't check for end of field yet / / Check for end of tab stop now (modulo 8 on line position) / TAD COLUMN Find out what column position we are on AND =7 Take it modulo 8 SNA CLA Test for the end of a tabulation column JMP 1B At the end, off for a new character JMP 2B Not at end -- return another blank PART EJECT / / / Subroutine to pick up next character from PIKUP routine but / in addition handle the SLASH character which handles generation / of upper/lower case characters from a terminal which is only in / upper case. / / Following rules are used: / / 1. all characters are normally treated as being in lower case / 2. a single SLASH force the next character to be in upper case. / 3. 2 SLASHES in a row mean all following characters are to be in / upper case until a single slash is found. / 4. Character after [ is ignored (to allow the / character through) / LDC SUB JMS GETKAR Pick up the next character DCA TEMP Save for a moment ISZ IGNORE Are we ignoring this character? JMP 1F No -- so continue here / TAD TEMP Yes, so reget this character RET LDC Return it now (may be slash) / / Merge back here to return to lower case and return character / 1H TAD TEMP Reget the character TAD =-'[ Test for command coming up SNA CLA Skip if not LDI -1 Else set to ignore the next character now DCA IGNORE ... / TAD TEMP Reget the character now TAD =-SLASH Is this the SLASH character? SNA Skip if not JMP 2F SLASH handled specially / / Only alphabetic characters are effected by the folding option. This / is primarily because the [,] and \ characters must always be / recognized. / TAD =SLASH-'Z-1 Test for alphabetic character code CLL ... TAD ='Z-'A+1 ... SZL Skip if not an alphabetic code here TAD CASE Else add in the CASE shift bit TAD ='A Restore the original character code now RET LDC And return / / Here when a SLASH was found. Check for 2 slashes in a row / 2H JMS GETKAR Pick up the following character DCA TEMP Save for a moment TAD TEMP Reget it TAD =-SLASH Do we have 2 slashes in a row here? SNA CLA Skip if not JMP 4F Yes we do EJECT / / Just one slash. If already in upper case, this means we just return / to lower case. If in lower case (normal case) this means that the / this new character is to go out in upper case / TAD CASE Get CASE flag SZA CLA Skip if currently in upper case JMP 3F No, we were in lower case / TAD =040 Force back now to lower case DCA CASE ... JMP 1B Return it now in lower case / / Here when 2 SLASHES were found in a row / 4H DCA CASE 2 SLASHES -- force now to upper case JMP LDC+1 Off now to get following character / / Here to return just the next character in upper case. All we do / is return characters as is (since this is an upper case terminal) / 3H TAD TEMP Return upper case on next character (as is) RET LDC ... / IGNORE DC 0 Set to -1 to ignore the next character / / This routine extracts characters via EXR and returns them / via GETCHAR. This routine is set up at SWITCH and is used / to return the text strings for the [d] and [=] commands. / GETEXR SUB TADI EXR Get the next character from string SZA Skip if sentinel on string found RET GETEXR Else return to call / TAD GETCSV All done -- restore original GETCHAR pointer DCA GETCHAR ... TAD NEXTSV2 Get the prior NEXTC that we saved at SWITCH RET GETEXR And exit here for the last time / / Little subroutine to test for an abort from the console on ^C / ABORTCK SUB IOS 3,1 Skip if keyboard flag is up RET ABORTCK Not up - so nothing to do IOT 3,4 Read keyboard static (don't clear flag yet) AND =0177 Remove parity bit TAD =-3 Test for ^C in the keyboard buffer SZA CLA Skip if ^C found RET ABORTCK Else just return now / CDF %* Ensure current field is set JMP $07600 Go to OS/8 Monitor now TITLE Main text buffer character fetch/put routines / / Routine to pick up characters out of the main text buffer / and return them in the AC / / In both the PIKUP and PAKUP routines, three 8-bit characters are / stored in two 12-bit words as follows. AAAAAAAA is the first / character, BBBBBBBB is the second character and CCCCCCCC is the / third character: / / c0 c1 c2 c3 a0 a1 a2 a3 a4 a5 a6 a7 / c4 c5 c6 c7 b0 b1 b2 b3 b4 b5 b6 b7 / / AC register must be clear on entry to this routine / PIKUP SUB CDF %INBUF Set CDF to current field in the buffer PIKX SUB RNEXT Intial co-routine linkage AND =0377 Truncate to 8-bit byte on exit CDF %* Restore current data field TAD =-CTLZ Test for ASCII end-of-file SNA Skip if not JMP NEXTFIL Off for next file now TAD =CTLZ Something else -- restore character RET PIKUP / / Here for the first character position / PIKGO TADI PKPTR2 First charact to the AC INC PKPTR2 Step pointer to next cell for next time JMS PIKX Return character / / Here for the second character position / PIK2 TADI PKPTR2 Load second character JMS PIKX Return in AC / / Here for the third character position / PIK3 LDI -1 Backup a copy of the pointer into buffer TAD PKPTR2 ... DCA TEMP Save address of previous cell TADI PKPTR2 Get high nibble, third character AND =07400 Extract it CLL RTR Start downwards shift RTR ... RTR ... DCA KCELL Save partially shifted value TADI TEMP Get low nibble, third character AND =07400 Extract it CLL RTR Start downward shift TAD KCELL Merge in partially shifted low nibble RTR Continue full shift to right-justify in AC JMS PIKX Return third character EJECT / / Step pointer and test now for end of the current buffer / INC PKPTR2 Step buffer pointer to next double-word TAD PKPTR2 Load the buffer pointer TAD =-INBUFE Compare with last slot+1 SZA CLA Skip if now at the end of the buffer JMP PIKGO Not at the end -- back for first character then / / Here we are at the end of the buffer and must read in the next / block from the input file. / RNEXT CDF %* Reset current field now TAD =INBUF First reset pointer to the start of the buffer DCA PKPTR2 ... / TAD MLENGTH Get length left in input file SNA Check for non-file structured device JMP *+4 Ahead -- non-file structured device / TAD IVBLK Compare with current input virtual block SNA CLA Skip if still more room in input file JMP NEXTFIL Else off to read the next input file here / ROOM 9 JMSI IDEV Call device handler to read next set of blocks DC 0200+(%INBUF.LS.3) DC INBUF Address of input buffer ISBLOK DC 0 Input file starting block SMA CLA Skip if fatal I/O error SKP Skip if non-fatal I/O error (viz. end of file) JMP ZAP FATAL I/O ERROR ON INPUT / INC ISBLOK Update current block in file INC IVBLK Update current virtual block CDF %INBUF Return data buffer field now JMP PIKGO Off to read the first character in new block / / Here on fatal I/O error -- issue USR ERROR 9 message / ZAP CLA JMSX USR,7,9 Issue error message & quit program / / Here to read in the next input file in the input file stream / NEXTFIL INC FPTR Step the input file pointer CDF 1 To field of COMMAND DECODER tables TADI FPTR Get the next input file in stream CDF %* Reset current field now SNA Test for end of all input files JMP FEOF All done here on END-OF-FILE / / Extract length and device number from this word / DCA TEMP Save for a moment INC SECTION Update the file number now TAD =' Reset section number back to 1 DCA SECTION+2 ... TAD ='1 ... DCA SECTION+3 ... TAD TEMP Reget AND =017 Isolate the OS/8 system device number DCA IDEV Save for later use TAD TEMP Reget the word again AND =017.XO.-1 Extract the length (range 0-256 blocks) SNA Check for non-file structured device JMP *+3 Non-file structured -- leave length of 0 / STL IAC RTR Convert to minus file length STL IAC RTR ... / DCA MLENGTH Save minus length of file in blocks / INC FPTR Step now to starting block on device CDF 1 To COMMAND DECODER field TADI FPTR Get the starting block for file CDF %* Back to current field DCA ISBLOK Set the starting block DCA IVBLK Set input virtual block back to zero / / Now load the OS/8 device handler to handle this input file / TAD =IDRIVER+1 Reset argument in USR call below DCA 3F ... / TAD IDEV Get the OS/8 device # for this device ROOM 9 JMSX USR,1 Load the device driver 3H DC IDRIVER+1 Where to load driver (2-page driver allowed) JMP ZAP ERROR -- CAN NOT LOAD DEVICE HANDLER / TAD 3B Get entry point address for device handler DCA IDEV And save it JMP RNEXT Off to read in the first block of file now TITLE PAKUP - routine to pack up characters into OS/8 buffer / / Routine to pack up characters into the output buffer area / PAKUP SUB CDF %OUTBUF To field of the output buffer AND =0177 Ensure parity bit is normalized TAD =0200 ... / / Merge below to call second co-routine / PAKX SUB PAKGO Initial co-routine linkage CDF %* Reset data field for exit RET PAKUP / / Here for the first character position / PAKGO DCAI PKPTR Store the first character position JMS PAKX Quit now INC PKPTR Step the pointer / / Here for the second character position / DCAI PKPTR Store the second character JMS PAKX Quit now / / Here for the third character position / CLL RTL Partially shift for now DCA KCELL Save for a moment TAD KCELL Reget it now RTL Move the low nibble up RTL ... RTL ... AND =07400 Isolate the low nibble TADI PKPTR Merge with the second character DCAI PKPTR ... LDI -1 Back up a copy of the pointer now TAD PKPTR ... DCA TEMP ... TAD KCELL Reget the character now RTL ... AND =07400 Isolate it now TADI TEMP Merge with the first character DCAI TEMP And store it back JMS PAKX Return now EJECT / / After storing the third character position we must step the / pointer and test for running past the end of the output buffer / DCA KCELL Save the character INC PKPTR Step pointer to next double-word / TAD PKPTR Get the character pointer TAD =-OUTBUFE Compare with 1 slot past end of output buffer SNA CLA Skip if still more room in output buffer JMS BWR Else write out the output buffer now TAD KCELL Reget the character to be stored JMP PAKGO Off to store in the first character position / / Here to write out the output buffer when it is all filled up / BWR SUB TAD =OUTBUF Reset pointer into the output buffer DCA PKPTR ... / TAD ODEV If this word is 0, there is no output file SNA CLA Skip if we have an output file RET BWR No output file -- so nothing to do here / CDF %* Set current data field now TAD OMLENGTH Get length allotted for the output file SNA Check for non-file structured device JMP *+4 Not file-structured, so no test here / TAD OVBLK Compare with current output virtual block SNA CLA Skip if we still have more room here JMP FULL ERROR - OUTPUT DEVICE HAS OVERFLOWED ! / ROOM 9 JMSI ODEV Call output device handler DC 04200+(%OUTBUF.LS.3) DC OUTBUF Address of the output buffer OSBLOK DC 0 Current output block we are writing JMP ZAP FATAL I/O ERROR RETURNED BY DEVICE DRIVER INC OSBLOK Update current output block to write INC OVBLK Update current output virtual block number EJECT JMS ZEROBUF Zero out the output buffer RET BWR Return to call (DF = 1) / / / Subroutine to zero out OUTBUF, / so all unused character positions will be zero / ZEROBUF SUB TAD =OUTBUF-1 Set pointer to the output buffer DCA XR in indexing cell TAD =OUTBUF-OUTBUFE Set counter for number of words to clear DCA CNTR ... CDF %OUTBUF To field of output buffer 4H DCAI XR Zero out a word LOOP 4B Loop till all words cleared out RET ZEROBUF All done here / / Here when output buffer has overflowed. We issue an error message / but first dump the line in the input file, so the user can tell / where we ran out of room. / FULL INC FATAL Set flag to show this is a fatal error here JMS E5 Print error and then quit / / Routine to dump out the page buffer if /D option in effect / DUMPF SUB RET DUMPF #NOP# if /D option is set JMSX FDUMP Dump out page buffer RET DUMPF All done / / Routine to call PAKUP from field 1. / CIF 1 Call from field 1, so return there XPAKUP SUB JMS PAKUP Call PAKUP routine in this field JMP XPAKUP-2 Return to field 1 DSEC disable paging now TITLE Initialization routines, device handler region / / Region here for the OS/8 device driver programs / ORG 06600 IDRIVER QUT %*,* ODRIVER QUT %*,07200 ISEC 0 Re-enable auto-paging / / Overlaying the input driver is the subroutine to determine / memory size on this computer. / THIS IS THE STANDARD OS/8 ROUTINE FOR DETERMINING CORE SIZE / / Note that we first check for a MEMORY command to OS/8. / / CORE SUB CAL TAD OSBIP Get batch-in-progress word AND =070 Isolate possible maximum field bits SNA Skip if MEMORY command issued JMP COR0 No: so continue TAD =010 Step to following memory field JMP 1F All done here / COR0 CDF 0 TAD CORSIZ Get field to test RTL ... RAL ... AND COR70 Mask useful bits TAD COREX ... DCA *+1 ... COR1 CDF 0 This is field to test TADI CORLOC Save current contents COR2 NOP Protection for PDP-8 DCA COR1 ... TAD COR2 Use NOP as pattern to store for test DCAI CORLOC Store into memory COR70 DC 070 NOP for PDP-8 TADI CORLOC Try to read it back CORX DC 07400 NOP for PDP-8 TAD CORX Guard against 'wrap-around' TAD CORV ... SZA CLA Skip if field exists JMP COREX non-existent field exit TAD COR1 restore contents we destroyed DCAI CORLOC ... INC CORSIZ Try next higher field / JMP COR0 Loop for next / COREX CDF 0 Return CDF 0 TAD CORSIZ Get number of last existing field CLL RAL Shift to CDF position (AC 6-8) RTL ... 1H TAD =06201 Build CDF instruction DCA MAXF Save CDF to first non-existing field RET CORE All done here / CORLOC DC CORX Address to test in each field CORV DC 01400 7000+7400+1400=0 CORSIZ DC 1 Current field to test TITLE Program initialization circuit / / Here to do the pre-pass initialization for the RTES program / RTES SNA CLA Skip if direct R command issued JMP RTES2 Chained to by CCL, don't call COMMAND DECODER CDF %* Show calling field JMSX USR,5,"AC,0 Call command decoder (extension = AC) JMS CRLF Return carriage / / Process the / options now / RTES2 JMS CORE Find CDF to maximum available memory field CDF %SWITCH1 To field of COMMAND DECODER switches TADI =$07617 Test for no input files entered SNA CLA Skip if we have some files JMP HELP Off to give HELP message with no files / TADI =SWITCH1 Get COMMAND DECODER switch CDF %* Back to current field AND =0100 Isolate the /F switch now SZA CLA Skip if /F NOT set JMP *+3 /F set -- nothing to do TAD =07000 Inhibit calling FOLD routine at OUTC DCA OUTC+1 ... / CDF %SWITCH1 To field of COMMAND DECODER switches TADI =SWITCH1 Get decoder switch with /I in it AND =010 Isolate the /I switch DCA IFLAG Set/clear flag to inhibit index generation / TADI =SWITCH2 Get COMMAND DECODER switch with /U option CDF %* Restore original data field now AND =010 Isolate the /U bit SNA CLA Skip if /U flag set JMP *+3 Not set (GETCHAR points to PIKUP) / TAD =LDC Set pointer to routine to handle upper case DCA GETCHAR terminal. / TADX SWITCH2 Switch with the /M switch SPA CLA Skip if /M not set JMP *+5 Nothing to do if set / TAD =07000 Enable call to autohyphenator DCA SLASHM ... TAD =07000 Allow hyphenation in pass 1 DCA SLASHM2 (may avoid error only in pass 1 etc.) / TADX SWITCH2 Switch with the /T bit AND =020 Isolate the /T bit SZA CLA Skip if not set JMP *+3 /T set: nothing to do / TAD =07000 Update threshhold for hyphenation mode DCA SLASHT ... / TADX SWITCH3 Test for /Z option RAL Shift /Z bit to AC 0 SPA CLA Skip if not set JMP *+3 /Z set: nothing to do / TAD =07000 Not set: allow CONTROL/Z at end of file DCA SLASHZ ... / LDI 02000 Set mask for the /N bit ANDX SWITCH2 Get DECODER switch with /N option DCA NFLAG Save status of /N bit TAD NFLAG Reget SZA CLA Skip if /N not set LDI 1 /N set -- set to skip pass 1 DCA PASS ... TADX SWITCH1 Test for /D option AND =0400 Isolate /D bit SNA CLA Skip if set JMP 0F Not set: continue / / Here to handle the /D option which sets double column mode / TAD =07000 Modify instructions to implement 2-col mode DCA NOFIN ... TAD =07000 ... DCA DUMPF+1 ... TAD MAXF Ensure we have at least 16k memory TAD =-06241 Should be at least CDF to field 4 SMA CLA Skip if not enough memory JMP *+3 OK: continue / INC FATAL Mark fatal error JMS E7 Log error / TAD =PAKF Set to call PAKF rather than PAKUP DCA PAKUPR ... TAD =SYMD Mark top of table past /D routines DCA SYSTART ... TAD SYSTART ... DCA SYMTOP ... TAD SYSTART ... DCA SYMPTR ... / TAD MWIDTH Get the maximum default width value STL CMA IAC RAR Negate, divide by 2 (since 2 columns) and TAD GAP Account for intercolumn gap DCA MAXW set it TAD MLINES Set default for maximum number of lines/page CLL RAL Multiply by 2 for dual column mode DCA LINES ... JMP 1F Avoid changing initial value of SLASHD etc. / / Set up some things now since /D option not in effect / 0H TAD =07000 NOP instruction DCA SLASHD Modify instructions to implement 2 col mode TAD =07000 ... DCA SLASHD2 ... TAD =07000 ... DCA SLASHD3 ... TAD =07000 ... DCA SLASHD4 ... TAD =07200 Don't set EJFLAG in INDEX routine DCA SLASHD5 ... DCA GAP Set intercolumn gap to zero / TAD MWIDTH Get the maximum default width value CMA IAC Negate and DCA MAXW set it TAD MLINES Set default for maximum number of lines/page DCA LINES ... / 1H TADX $07646,1 Get possible fixed indent count SZA Skip if no indent specified here DCA FINDENT And set that indent now / JMS PDATE Process the OS/8 date and build DAYBUF JMSX ENTER Do enter on the output file now / / Copy over the default parameters located in low core / TAD TOPM Set the default value for top margin DCA DROP ... TAD BOTTOMM Set default value for bottom margin on page DCA BOTTOM ... JMS ZEROBUF ensure output buffer zeroed out now CDF %* ZEROBUF returns data field of 1 JMP PASS2 Off to do pass initialization now EJECT TITLE Process HELP file built into RTES / HELP LDI 4 /V bit value ANDI =SWITCH2 Field was set already CDF 0 back to main field SNA CLA do we want LPT: ? JMP 2F No, use tty: TAD =06666 patch TYPE for LPT: DCA TYPE+1 ... TAD =06661 ... DCA TYPE+2 ... 2H TAD =BIGMSG Set pointer to main message CDF %BIGMSG To field of messages JMS MESSAGE Output the entire message now CDF 0 Ensure correct data field set JMP $07600 Quit now TITLE Process OS/8 date word & build DAYBUF / / Here we process the OS/8 date word. If there was no date / entered to OS/8, a minus 1 is stored in DAYBUF, so we can / generate an error if the [d] command is ever used. / Otherwise, the date is moved in ASCII into DAYBUF, in the form / 23. Sep. 1976 / PDATE SUB TAD =DAYBUF-1 Set pointer to the DAYBUF buffer DCA LXR ... TADX OSDATE Get the OS/8 date word now SZA Skip if no date entered to OS/8 JMP 1F OK -- we have a date here / LDI -1 Set flag - there is no OS/8 date here DCAI LXR ... RET PDATE Return now / / Now process the days in the range 1 to 31 / 1H RAR Shift the binary days down RTR ... AND =037 Isolate the binary value of days JMS BINASC Convert binary days to ASCII SNA Change leading zero to a blank TAD =' ... DCAI LXR Store high part of days TAD LOW Get the low order part of the days DCAI LXR And store it TAD ='. Point after the days DCAI LXR ... TAD =' And a blank DCAI LXR ... / / Here to do the months as the first 3 letters of the month / TADX OSDATE Reget the OS/8 date again CLL RTL Get the binary months (right justified in AC) RTL ... RAL ... AND =017 Isolate the binary months DCA SAVE Save for a moment TAD SAVE Now multiply that value by 3 TAD SAVE ... TAD SAVE ... TAD =(MONTHS-3)-1 Index table of names of months DCA DXR Save pointer into months table TADI DXR Get first word of months DCAI LXR Store first letter TADI DXR Copy second character DCAI LXR ... TADI DXR Copy third character DCAI LXR ... TAD SAVE Get binary value of months TAD =-5 May is the fifth month SNA CLA Skip if not May (only 3-character month) TAD =' -'. May - so no period after month TAD ='. Period to separate months from year DCAI LXR ... TAD =' ... DCAI LXR And another blank / / Now do the years. / TAD ='1 First two digits always '19' DCAI LXR ... TAD ='9 ... DCAI LXR ... / TADX OSDATE Get OS/8 date AND =7 Extract the years field DCA TEMP Save for a moment TAD OSBIP Get batch in progress word AND =0600 Get extended date bits CLL RTR shift down (multiplied by 8 after shift) RTR ... TAD =70 Bias now to the 1970's TAD TEMP Add in offset in range 0-7 JMS BINASC Convert to ASCII digits DCAI LXR Store the high order part TAD LOW Get the fourth digit of the year DCAI LXR And store that DCAI LXR Install sentinel on DAYBUF RET PDATE All done here EJECT EJECT DSEC Auto-paging off now / / Following macro generates the part of the month needed for the / the [d] command. For now we just use the first 3 characters / MACRO .MONTH <ARG> ; Argument is name of month :A MSCAN 0,<ARG> ; Scan first character :B MSCAN 1,<ARG> ; Scan second character :C MSCAN 2,<ARG> ; Scan third character !<> DC :A,:B,:C ; Generate three words MEND / MONTHS QUT %*,* .MONTH January .MONTH February .MONTH March .MONTH April .MONTH Mai .MONTH June .MONTH July .MONTH August .MONTH September .MONTH Oktober .MONTH November .MONTH Dezember TITLE Automatic hyphenation circuit FIELD 1 DSEC Autopaging should be off / ORG 0 / CONS DC 0 Counts number of consonants in word WSTART DC 0 Has starting address of word WEND DC 0 Has ending address of word WLEN DC 0 Has length of word / AS 3 Reserve 4,5,6 for ODT / MAXC DC 0 - maximum # of positions left on line to fill ORG 014 Indexing area / CXR DC 0 Indexing cell COL1XR DC 07777 Left hand column pointer COL2XR DC 07777 Right hand column pointer / ORG CNTR+1 Origin over standard temporary cells / PCOL DC 0 Keeps track of column for audit trail SUFLEN DC 0 Save cell for suffix length FCHAR DC 0 Temporary character hold LLCOL DC 0 keeps track of chars printed in column 1 HYPHR DC 0 last good hyphenation point CKREM DC 0 CK split remembrance TITLE Entry to hyphenator / ORG 0200 Start of code ISEC 0 Enable paging now / / Enter here to hyphenate the word starting at SAVEP+1 and / ended with a sentinel of -1. / / HYPHENATION ALGORITHM / / This is the basic algorithm we will use. Goal is to find best / (but not all possible) hyphen point in word. The basic logical / rule is original, and does a remarkably good job / / 1. trim off all leading and trailing non-alpha characters / 2. verify that word is at least 6 characters long. / 3. search suffix table to see if we can find a suffix to remove / If found, verify that first part of word before suffix: / * is short enough to fit on line / * has at least one vowel (avoid SPR-ING) / * has at least 3 characters before suffix. / If suffix is 'ING' and preceded with doubled consonant, then / move hyphenation point to between doubled consonant (i.e. / FLAG-GING rather than FLAGG-ING / / 4. Search prefix table. If found, verify that / * prefix is short enough to fit on line / * part of word after prefix has at least one vowel / * part of word after prefix has at least 3 characters / / 5. Try logical rules / * Search for the first vowel in the word / * Scan for a consonant / * Scan to last consonant in sequence / * If only one consonant, / Hyphenate before consonant / * If two or more consonants, / Hyphenate before the last consonant of the sequence. / * Do several 'fixup' operations: / / check for a bad split (CK,TH,SH...). If so, then / hyphenate after split if split preceded by vowel, / else hyphenate before split if preceded by consonant / Must find at least 3 characters before and after / hyphenation point. / If exactly 3 characters after hyphen point and the / last two characters are 'ED', then hyphenate in front / of the 'ED' (avoid BLAS-TED, make it BLAST-ED) EJECT / / First, trim off all nonalphabetic characters at both ends / of the string. Otherwise we will have trouble trying to / hyphenate digit strings etc. / AUTOHY TADI =SAVEP Get address of word DCA CXR Save in indexing cell DCA HYPHR set hyphenation point to none DCA CKREM set CK split to none / / Loop here trimming leading non-alpha characters / 0H TADI CXR Get next character of word SPA If -1, we had no alphas in word, can't do it JMP HYEND Can not hyphenate this AND =040.XO.-1 Ignore difference in shift case TAD =-'Z-1 Test for letter in range a-z CLL ... TAD ='Z-'A+1 ... SNL CLA Skip if alphabetic JMP 0B non-alpha, trim it off / LDI -1 Set start of word now TAD CXR ... DCA WSTART ... / / Now scan forward until first non-alpha character is found / 1H TADI CXR First find the end of the word AND =040.XO.-1 Remove lower case TAD =-'Z-1 Test for alpha character CLL TAD ='Z-'A+1 ... SZL CLA Skip when non-alpha character found JMP 1B Loop till non-alpha found / LDI -1 Get position of last alpha character TAD CXR ... DCA WEND Mark end of word TAD WEND Get ending address again CMA IAC Negate and subtract TAD WSTART From the starting address DCA WLEN To save minus length of the word EJECT / / Get the maximum number of characters in this word that we / can use on this line for hyphenating. / LDI 2 Account for blank before word and hyphen TADI =CURW + current width of line TADI =INDENT + any indent in effect TADI =MAXW - maximum width of this line DCA MAXC Save minus maximum # of positions we can use / / If length of word to be hyphenated is < 6, skip it. No 5 letter / words are to be hyphenated. / LDI 6 ... TAD WLEN Subtract length of word from 6 SMA SZA CLA Skip if word is 6 or more characters long JMP HYEND 5 or less: skip hyphenation TITLE Hyphenate by suffix extraction / / Here to search the suffix table to see if we can hyphenate the / word on a suffix. / / Suffix and prefix table format is: / / word 1 -1 length of suffix, 0 = table sentinel / words 2 - n - 8 bit ASCII code of prefix/suffix / TAD =SUFFIX-1 Set pointer to table / / Loop here to search for next word with new table address in AC / 2H DCA XR1 Set new table address CDF %SUFFIX To field of table TADI XR1 Load up length word of next suffix CDF 0 Restore main field SNA Test for sentinel on table JMP TRYPFX No suffix found, try prefix DCA CNTR Else save length EJECT TAD CNTR Copy over suffix length for later use DCA SUFLEN ... JMP 3F Jump into loop below / / Not enough room. also merge here to move to the next entry / SKIPENT TAD CNTR Get -length remaining to deal with CMA IAC Make it positive value TAD XR1 Update address to next entry in table JMP 2B Loop back to handle it / 3H TAD CNTR Get minus length TAD WEND Subtract from ending address DCA XR2 Set -1 from start of where suffix will be TAD XR2 Get address again DCA CXR Set in case success. / / Loop here to see if we have a suffix on this word / 4H TADI XR2 Get character from word AND =040.XO.-1 Remove lower case bit CDF %SUFFIX To field of suffix table TADI XR1 Compare with next letter from current suffix CDF 0 Reset main field SNA CLA Skip if no match on this letter JMP *+3 Match: continue / LDI 1 (since XR1 incremented but not CNTR yet) JMP SKIPENT No match: try next suffix then / LOOP 4B Loop until all characters compared / / Must check now that we have a vowel before the hyphen point. Otherwise / we could have problems such as LAND-UNG etc. Good for FRAU-EN / TAD CXR Get address of last letter before hyphen point DCA TEMP TADI TEMP Get letter before suffix JMS GTYPE Get type (-1=vowel,+1 = cons., 0 = 'Y') SPA SNA CLA Look for 'Y' or vowel (viz. SPY-ING, is ok) JMP TLENGTH Vowel or 'Y' found--ok JMP SKIPENT No vowel before hyphen point--skip it EJECT / / verify now that there would be room on line for part of this / word before suffix. / TLENGTH TAD SUFLEN Get suffix length TAD MAXC Add length available on the line CMA IAC Make it positive now TAD WLEN Subtract from length of entire word SMA CLA skip if not enough room JMP GOTIT All ok, continue JMP 2B+1 won't fit: try next suffix then / / Subroutine to get the type of the letter in the AC / Returns in the AC.: / / -1 for vowel / +1 for consonant / 0 for the letter 'Y' (treated both ways sometimes) / GTYPE SUB AND =037 Trim to range 1-26 and ignore case shift TAD =LETTERS-1 Index table of type for each letter DCA TEMP Save pointer CDF %LETTERS to field of table TADI TEMP Get entry in table CDF 0 Always return main field RET GTYPE return type in AC TITLE Hyphenate by prefix extraction / / Here to see if we can extract a prefix from this word / logic is very similar to the suffix extraction / TRYPFX TAD =PREFIX-1 Set pointer to prefix table / / loop back here with next table address in AC / 1H DCA XR1 Set new table address of next prefix CDF %PREFIX To field of prefix table TADI XR1 Next letter from table CDF 0 If zero, table sentinel SNA Skip if not JMP RULES Not in prefix table, try logical rules DCA CNTR Else set minus length of this prefix TAD WSTART Reset pointer to start of word DCA CXR ... / / If length(prefix) > maximum needed, don't even bother with this / prefix--cannot possibly fit / TAD MAXC Get minus, maximum length that will fit CMA IAC make it a positive value TAD CNTR subtract length of prefix SPA CLA Skip if there is room for it JMP 4F not enough room: skip it / / Must be at least 2 characters (3?) after hyphen point / LDI -1 Get length -1 TAD CNTR ... CMA IAC Make it positive TAD WLEN Compare with word length SMA CLA Skip if we have room for this JMP 4F Only 1 character after hyphen point / / Loop here to see if this prefix exists at beginning of word / 2H TADI CXR Next letter from word AND =040.XO.-1 Remove lower case CDF %PREFIX To field of prefix table TADI XR1 Next letter from prefix CDF 0 always reset main field SZA CLA Skip if we have a match here JMP 5F No match, try next one LOOP 2B Loop till match found / / Here prefix is in the word. Check now that we have at least one / vowel after the hyphen point. This eliminates problems such as / PRO-NGS. / TAD CXR Copy ending position of prefix DCA XR1 ... / / Loop here looking for a vowel / 3H TADI XR1 Next letter from word SPA Test for sentinel on word JMP 4F Skip: no vowel here JMS GTYPE Else get type SPA SNA CLA Skip if consonant JMP 6F Vowel or 'Y': off to hyphenate JMP 3B Loop till vowel or end of word found / / Come here to skip the current entry / 5H LDI 1 Here when XR1 updated, but not CNTR 4H TAD CNTR Get minus length up to this point CMA IAC Make it positive TAD XR1 Update address into the prefix table JMP 1B Loop back with address in the AC / / Here if found prefix. Store hyphr and try logics / 6H TAD CXR Store current pointer DCA HYPHR into hyphenation reference point JMP 1F Jump into logical rules at current position TITLE Hyphenate by logical rules / / Here to hyphenate by logical rule. / / STEP 1: Find the first vowel in the word / RULES TAD WSTART Set pointer to start of word DCA CXR in indexing cell / / Loop here looking for a vowel / 1H TADI CXR Next Letter from word SPA Test for sentinel on word JMP HYEND No vowel in word (probably not a word) JMS GTYPE Else get type of word SMA SZA CLA Skip if vowel or 'Y' JMP 1B Keep looking / / STEP 2: Find last consonant of a group of 1 or more consonants / DCA CONS Set count of consonants found to zero / / Loop here looking for consonants / 2H TADI CXR Next letter from word SPA Skip if not end of word JMP HYEND Cannot hyphenate JMS GTYPE Get type of letter SPA CLA Skip if consonant or letter 'Y' JMP *+3 All done here / INC CONS Count consonants JMP 2B Loop back now / / Found a non-consonant. Check we had at least one consonant / TAD CONS Get count of consonants found SNA Skip if at least one JMP 2B None: scan past second vowel then CLL RAR If just one, AC is now zero SZA CLA Skip if just one JMP 3F Two or more, continue / / Just one consonant. Hyphenate before. / LDI -1 ... TAD CXR Hyphenate before consonant DCA CXR ... JMP 4F Continue now EJECT / / If two or more consonants, we hyphenate before the last / consonant. If just one consonant, hyphenate after it / / viz. FOR-MAT / SEC-OND / 3H LDI -1 Two or more, hyphenate before TAD CXR ... DCA CXR ... / / STEP 3: Handle bad splits in the word such as / CH, TH, SH, QU etc. / / rule is that if we have 3 or more consonants, then we hyphenate / before the split. If only 2, hyphenate after the split: / / PAY-CHECK / PUSH-OVER / / / First get AC so left half has second-to-last consonant, / right half has last consonant. / LDI -2 Set pointer to before 2nd-to-last TAD CXR consonant DCA XR1 ... TADI XR1 Get the letter AND =037 Remove case shift CLL RTL Move to LH of AC RTL ... RTL ... DCA TEMP save for a moment TADI XR1 Get second consonant AND =037 Remove case shift TAD TEMP Merge first consonant DCA TEMP ... / TAD TEMP First check if CK split special case TAD =-"CK SZA CLA Is it CK ? JMP 2F No, look at other bad splits LDI -1 TAD CXR Position of 'C' DCA CKREM is saved for eventual hyphenation JMP 4F and jump into midway split 2H TAD =SPLITS-1 Set pointer to table of bad splits DCA XR1 ... / / Format of table to be searched is: / / DC -"TH Bad split / ... / DC -"CH must be last in table / DC 0 Sentinel on table / 3H CDF %SPLITS To field of table TADI XR1 Next entry from table CDF 0 Reset main field SNA Test for table sentinel JMP 4F Not in table: continue TAD TEMP Compare with 2 letters from word SZA CLA Skip if we have a match JMP 3B Not yet: keep looking EJECT / / Found a bad split. Now check to see if we have SCH / LDI -2 Set pointer to possible first of 3 consonants TAD CXR ... DCA TEMP ... CDF %SPLITS To field of table TADI XR1 Next entry 0 means we found 'CH' CDF 0 Reset main field SZA CLA ... JMP 2F No, not 'CH' TADI TEMP was it 'S' ? AND =040.XO.-1 remove lower case TAD =-'S SZA CLA JMP 2F not 'S' LDI -1 S, hyphenate before triple split 2H TAD =-1 Not 'S', hyphenate before double split TAD CXR ... DCA CXR ... / / Now check: we must have at least 3 characters before and after / the hyphenation point. We must also have room on the line for / the part of the word in front of the hyphenation point. / 4H TADI =SAVEP Get starting address of WHOLE word CMA IAC Negate and subtract from TAD CXR the address of the hyphenation point DCA TEMP Save for a moment LDI -3 Do we have at least 3 characters before? TAD TEMP ... SPA CLA Skip if so JMP 1B 2 or less: keep hyphenating then / TAD TEMP Get number of characters again TAD MAXC Compare with maximum there is room for SMA SZA CLA Skip if still room JMP HYEND Cannot hyphenate this word / TAD CXR Get address of hyphenation point CMA IAC Negate and subtract from TAD WEND Ending address of word TAD =-2 At least 3 characters after? SPA CLA Skip if so JMP HYEND No: better skip this now EJECT / LDI -1 Decrement pointer now for merge TAD CXR Set address in temporary DCA TEMP ... TAD TEMP Now compare this hyphen CIA CLL with negative of last hyphen TAD HYPHR which we keep updated SZL CLA was this further along ? JMP 1B No, search along and leave HYPHR TAD TEMP Yes, set new HYPHR and go on DCA HYPHR ... JMP 1B to search for more logical possibilities / / Come here on failing logical rules / HYEND CLA Ac is often non-zero on merge here TAD HYPHR Get last defined hyphenation point SNA was it defined ? JMP SKIPH No, no hyphenation SKP Yes, set hyphenation point / / Merge here to hyphenate the current word by placing a hyphen / immediately after the letter currently pointed to by CXR or HYPHR / GOTIT TAD CXR Copy over address DCA TEMP ... TAD CKREM Was a CK split found ? CMA IAC ... TAD TEMP At the hyphenation point ? SNA CLA ... TAD ='K-'C Yes, ZUCKER becomes ZUK-KER TADI TEMP and zucker becomes zuk-ker TAD =02000 Set hyphen point DCAI TEMP on that word INCI =HYPHO Just to be sure: mark we hyphenated / / Now if /L switch is set, print out the word with hyphen / Note that we only do this during pass 2 (in case listing / on console printer) / CDF 1 To field of command decoder switches TADI =SWITCH1 .. CDF 0 ... CLL RAR Shift /L bit to link SNL CLA Skip if /L is set JMP 7F Not set: so quit / LDI -1 Test for pass 2 TADI =PASS ... SZA CLA Skip if in pass 2 JMP 7F Not pass 2, continue / / print out word on console printer / Move over to next tab position on printout. This sets columns / at intervals of 32 characters. Use 3 columns on LPT, else just 2 / 1H TAD PCOL Get current column position AND =037 At next tab stop? SNA CLA Skip if not JMP 2F Yes, so continue / TAD =' No, so print out a blank JMS ZTYPE ... JMP 1B And loop till tab stop reached / 2H TADI =SAVEP Set pointer to start of word DCA XR ... TAD =SECTION-1 Set pointer to section number DCA XR1 in indexing cell / TADI XR1 Next character from section SNA Test for sentinel JMP 6F All done here JMS ZTYPE else type it out JMP *-4 Loop for next / / Loop here to print out the word / 6H TADI XR Next letter of word SPA Test for sentinel on word JMP 1F All done here CLL RAL Test for letter with hyphen bit SPA Skip if not JMP 9F Handle hyphen point RAR Restore letter TAD =-LF Don't print out LF at end of word! SNA Skip if not LF JMP 6B Ignore LF code TAD =LF Restore character / 8H JMS ZTYPE Print it out JMP 6B Loop for next letter / 1H CLA AC non-zero here CDF 0 Reset main field TAD =-33 If past column 32, do CR/LF TAD PCOL Add current column position on line SPA CLA Skip if past JMP 7F Not past, so done here / TAD =CR End of word: do CR/LF JMS ZTYPE ... TAD =LF ... JMS ZTYPE ... DCA PCOL Reset column position back to zero 7H JMPX REHYPH All done here / / Here when hyphen point is found / 9H RAR Restore the letter AND =0377 Remove hyphen flag JMS ZTYPE Print out the letter TAD ='- Do the hyphen now JMP 8B ... / / Here to skip hyphenation completely / SKIPH TAD ='# Post flag for debug in /P mode DCAI =NHYPH ... JMPX JUSTIFY Just justify line now without hyphenating EJECT / / Here to print out character on console printer, or, if /V switch is / set, on a line printer on device address 66. / ZTYPE SUB ISZ PCOL Update column counter (may skip if bad file) DCA TEMP Save character (ok if it does) LDI 4 Set to examine the /V bit CDF %SWITCH2 To field of switches ANDI =SWITCH2 ... CDF 0 Back to main field SZA CLA Skip if /V switch is set JMP 2F /V set: output on LPT / TAD TEMP Else get the character JMSX XTYPE output via console ptiner RET ZTYPE All done here / / Here to output on line printer / 2H TAD TEMP Get the character IOT LPT,6 strobe out IOT LPT,1 Wait for flag to come up JMP *-1 ... CLA Remove garbage from AC RET ZTYPE All done here TITLE Field 1 buffers and tables / DSEC Paging off / INBUF QUT %*,* Input block buffer ORG *+256 Allocate space for buffer / INBUFE QUT %*,* Last slot + 1 in input buffer / OUTBUF QUT %*,* Output block buffer ORG *+256 Allocate space for the output buffer / OUTBUFE QUT %*,* Last slot + 1 in the output buffer / HPOINTS QUT %*,* Hyphenation point half-word table ORG *+128 Allocate room for table / TITLE AS 135 Room for the title line / E0MS TEXT 'ZEILEN-PUFFER VOLL%' E1MS TEXT "UNBEKANNTER BEFEHL IN '[]'%" E2MS TEXT "KEIN ']' ABSCHLUSS NACH BEFEHL%" E3MS TEXT 'ZEILE HAT KEINEN LEER-RAUM ZUM BUENDIG MACHEN%' E4MS TEXT '[D] BEFEHL OHNE OS/8 DATUM%' E5MS TEXT 'AUS:-PUFFER VOLL (ABBRUCH)%' E6MS TEXT 'NUMERISCHER FEHLER IM BEFEHL%' E7MS TEXT 'NICHT GENUG SPEICHER-PLATZ (ABBRUCH)%' E8MS TEXT '[=] REFERENZ FEHLT%' E9MS TEXT 'SILBEN-TRENNUNGSTABELLE VOLL (ABBRUCH)%' E10MS TEXT 'ABSCHNITTS-TITEL ZU BREIT%' E11MS TEXT 'ABSCHNITTS-REFERENZ NICHT EINDEUTIG%' / / table of bad splits for hyphenation / SPLITS DC -"BL DC -"BR DC -"DR DC -"GN DC -"KL DC -"KR DC -"PH DC -"PL DC -"PR DC -"ST DC -"TR DC -"CH Must be last in table for SCH check DC 0 Sentinel on table / / Type table identifies type of each letter: / / -1 vowel / +1 consonant / 0 'Y' can be both / LETTERS DC -1,1,1,1 A,B,C,D DC -1,1,1,1 E,F,G,H DC -1,1,1,1 I,J,K,L DC 1,1,-1,1 M,N,O,P DC 1,1,1,1 Q,R,S,T DC -1,1,1,1 U,V,W,X DC 0,1 Y,Z TITLE Prefix and Suffix tables / / Following table handles prefixes and suffixes. Macro below sets / up table as follows: / / word 1 - length of prefix/suffix / words 2 - n - 8-bit ASCII code of each character / MACRO .FIX <ARG> ; argument is suffix/prefix :A SET 0 ; initialize pointer .LOOP ANOP ; loop for next :B\:A MSCAN :A,<ARG>$ ; Scan entire string AIF :B\:A.EQ.'$,.DONE ; if '$', we are done :A SET :A+1 ; advance scan pointer AGO .LOOP ; loop on it !.DONE DC -:A ; set count of characters :C SET 0 ; reset pointer .LOOP2 ANOP DC -:B\:C ; set minus ASCII character code :C SET :C+1 ; advance pointer AIF :C.NE.:A,.LOOP2 ; loop till last character found MEND / / Here for the PREFIX table / / CAUTION: Watch the order of prefixes and suffixes. / For example, if EX preceded EXTRA, we would / never find EXTRA because the routine would / quit when EX was found. / PREFIX QUT %*,* / .FIX ALL .FIX ANTI .FIX AN .FIX AUF .FIX AUS .FIX AUTO .FIX DAR .FIX DES .FIX DIS .FIX DURCH .FIX EIN .FIX ENT .FIX ELEK .FIX ERST .FIX ER .FIX EXTRA .FIX EX .FIX GE .FIX HER .FIX HIN .FIX IM .FIX INTER .FIX IN .FIX KOM .FIX KON .FIX MISS .FIX MITTEL .FIX MIT .FIX MULTI .FIX NACH .FIX NAH .FIX NEBEN .FIX NIEDER .FIX POST .FIX PRAE .FIX PRE .FIX PRO .FIX RETRO .FIX RUECK .FIX SUB .FIX SUPER .FIX TRANS .FIX UEBER .FIX UM .FIX UNTER .FIX UN .FIX UR .FIX VER .FIX VORDER .FIX VOR .FIX WEG .FIX WOHL .FIX ZER .FIX ZWISCHEN .FIX ZU DC 0 / / Here for the Suffix table. In German only used for suffixes / preceded by a vocal, other cases work anyway. / SUFFIX QUT %*,* / .FIX AET .FIX AL .FIX ART .FIX AT .FIX ELN .FIX EL .FIX EN .FIX ERNS .FIX ERN .FIX ER .FIX IG .FIX ING .FIX ISCH .FIX ON .FIX UM .FIX UNG DC 0 Sentinel SYMB QUT %*,* Start of symbol table for references TITLE /D Option processing / ISEC 0 Enable automatic paging / / Here to handle dump of page buffer. We must now dump page buffer / in such a way that we have a double column format. This means / print first line from left page buffer (stripping CR/LF), generate / gap between columns, and then print line from right hand page buffer. / CIF 0 Always return to field 0 FDUMP SUB LDI -1 First store sentinels on page buffer CDF 2 Do left first DCAI COL1XR ... LDI -1 Do right hand CDF 3 ... DCAI COL2XR ... / LDI -1 Reset pointers into page buffer DCA COL1XR ... LDI -1 ... DCA COL2XR ... / / Check for empty page buffer / CDF 2 TADI =$0 Check first location in buffer CDF 0 Return main field SPA CLA Skip if not sentinel JMP FDUMP-2 Empty: nothing to do here / / Perform significant optimization test. If both lines are blank / just do a CR/LF instead of printing a row of blanks. This will / significantly improve throughput on line printers with a fast / slew rate on lines with just a CR/LF. / 1H TAD COL1XR Copy over register pointers DCA XR1 ... TAD COL2XR ... DCA XR2 ... / CDF 2 Get first character in left column TADI XR1 ... CDF 3 To field of other column TAD =-CR Test for return code SNA CLA Skip if not null line TADI XR2 Load first characte in right hand column CDF 0 Reset main field now TAD =-CR Is right hand column null too? SZA CLA Skip if both columns are blank JMP 5F Not both blank: must print them / INC COL1XR Skip over CR/LF in left column INC COL1XR ... INC COL2XR ... in right column INC COL2XR ... TAD =CR Just do a CR/LF now JMSX XPAKUP ... TAD =LF ... JMP 9F ... / / Loop here to print next full line in page buffer / 5H TADI =FINDENT Generate floating indent first JMS FSPAC ... DCA LLCOL Set left column count to zero / / Loop here to print next character of line in left hand buffer / 2H CDF 2 to field of page buffer TADI COL1XR Get next character CDF 0 Return main field SPA Test for page buffer sentinel JMP 8F Sentinel: all done here TAD =-CR Test for CR character SNA Skip if not JMP 3F Yes: done with this line then TAD =CR Else restore character JMSX XPAKUP Output character INC LLCOL Count character JMP 2B Loop back for next / 3H INC COL1XR Step over LF that must follow CR TADI =MAXW Get line width TAD LLCOL Remove characters already printed CMA IAC Make a positive number TADI =GAP Add gap between columns JMS FSPAC Space it out / / Loop here to get the next character of line from right hand page / buffer / 4H CDF 3 To field of right hand page buffer TADI COL2XR Next character CDF 0 Return main field SPA Test for sentinel (just for safety) JMP 8F All done here / 9H DCA FCHAR Save for a moment TAD FCHAR Reget character JMSX XPAKUP Output character TAD FCHAR Get character again TAD =-LF Done with the line? SZA CLA Skip if so JMP 4B No: so keep going JMP 1B Yes: start next line from left column / / Here on sentinel / 8H LDI -1 AC non-0 but ok. Reset pointers DCA COL1XR ... LDI -1 ... DCA COL2XR ... JMP FDUMP-2 All done here DSEC Disable paging SYMD QUT %*,* End of table if /D option in effect / Macro below generates TEXT directive without listing all the object / code / MACRO .TEXT <ARG> :A SET * ; Target for listing (show location) NOLIST <> TEXT $<ARG>$ LIST MEND EJECT / / Here is the main help message for the RTES program / BIGMSG QUT %*,* .TEXT <R T E S -- V6A++> .TEXT <+AUFRUFS-OPTIONEN:++> .TEXT < /F -- AUSGABE NUR IN GROSS-BUCHSTABEN+> .TEXT < /D -- AUSGABE IN DOPPEL-KOLONNE+> .TEXT < /I -- KEIN INHALTSVERZEICHNIS, KEINE REFERENZEN+> .TEXT < /H -- KEINE SILBENTRENNUNG+> .TEXT < /L -- ZEIGE SILBENTRENNUNGEN AM TERMINAL+> .TEXT < /M -- MANUELLE SILBENTRENNUNG+> .TEXT < /N -- KEINE REFERENZEN (NUR LAUF 2,3)+> .TEXT < /P -- KORREKTUR (DATEI/ZEILEN/ABSCHNITTS NR. ANGABE)+> .TEXT < /T -- KOMPRIMIERTE SILBENTRENNUNG+> .TEXT < /U -- EINGABE VON TERMINAL OHNE KLEINBUCHSTABEN+> .TEXT < /V -- DRUCKE SILBENTRENNUNGEN AUF LPT:+> .TEXT < /Z -- KEIN END-OF-FILE (^Z) NACH DATEI-ENDE+> .TEXT < /0-9- ZEIGE [S] GESCHALTETER TEXT+> .TEXT < = -- SETZE LINKES EINRUECKEN MIT ANGEGEBENEM WERT+> .TEXT <+> .TEXT <SPEZIAL SPEICHER-ZELLEN:++> .TEXT < 0000 -- MAXIMALE ZEILEN-BREITE+> .TEXT < 0001 -- OBERER SEITEN-SPRUNG+> .TEXT < 0002 -- MAXIMALE ANZAHL ZEILEN+> .TEXT < 0003 -- UNTERER SEITEN-SPRUNG (0= FORM FEED)+> .TEXT < 0007 -- ABSTAND LINKES EINRUECKEN+> .TEXT < 0025 -- ABSTAND [[ ABSCHNITT EINRUECKEN+> .TEXT < 0026 -- ABSTAND ZWISCHEN KOLONNEN FUER /D++> .TEXT <+RTES BEFEHLE:++> .TEXT < [/] -- DRUCKT "/" ZEICHEN+> .TEXT < [[] -- DRUCKT "[" ZEICHEN+> .TEXT < []] -- DRUCKT "]" ZEICHEN+> .TEXT < [[ -- ABSCHNITT EINRUECKEN+> .TEXT < [ ] -- DRUCKT NICHT-TRENNENDES LEER+> .TEXT < [\] -- DRUCKT "\" ZEICHEN+> .TEXT < [-] -- DRUCKT NICHT-TRENNENDES '-'+> .TEXT < [D] -- SCHREIBE DATUM VON HEUTE : 24. DEZ. 1980+> .TEXT < [J] -- ZEILEN RECHTS-BUENDIG MACHEN+> .TEXT < [N] -- ZEILEN NICHT RECHTS-BUENDIG MACHEN+> .TEXT < [1] -- MACHE ABSCHNITTS-NUMMER (1=ZIFFER 1-9)+> .TEXT < [H] -- NAECHSTES WORT NICHT TRENNEN+> .TEXT < [P] -- NEUE SEITE+> .TEXT < [P12] -- NEUE SEITE WENN WENIGER ALS 12 ZEILEN+> .TEXT < [M60] -- SETZE RECHTEN RAND BEI KOLONNE 60+> .TEXT < [V25] -- MACHE VERTIKAL-TAB NACH ZEILE 25+> .TEXT < [C] -- ZENTRIERE TEXT+> .TEXT < [R] -- SCHIEBE TEXT RECHTS-BUENDIG+> .TEXT < [=REFERENZ] -- REFERENZ =: ABSCHNITT & SEITEN-NR.+> .TEXT < [W] -- ZEILE AUFFUELLEN+> .TEXT < [FA,B,C] -- SEITEN-EINTEILUNG:+> .TEXT < A = ABSTAND VON TITEL ZEILE,+> .TEXT < B = ZEILEN PRO SEITE+> .TEXT < C = UNTERER RAND, 0 = FORM-FEED+> .TEXT < [S#] -- TEXT-AUSWAHL (KEIN AUSDRUCK MIT /#)+> .TEXT < [S] -- ENDE TEXT-AUSWAHL+> .TEXT < [NNN] -- DRUCKE NICHT-TRENNENDES 'NNN' ZEICHEN+> .TEXT < [P] (TITEL) -- DRUCKE SEITEN-NUMMER (NUR TITEL ZEILE)+> .TEXT < [T] (TITEL) -- DRUCKE SEITEN-ANZAHL (NUR TITEL ZEILE)+> .TEXT <%> END OF MESSAGE TITLE OS/8 CLOSE and ENTER routines ORG 07400 Origin to last usable page in field 1 ISEC 0 Re-enable auto-paging now / / Here to close out the output file if we had one / CID 00 Always return to field zero on exit CLOSE SUB CLA CDF %ODEV To field of output device TADI =ODEV Was there an output file? SNA CLA Skip if so JMP CLOSE-2 No output file -- so nothing to do here / TADI =OVBLK Get the current length of the output file CDF %* Back to current field DCA CLOSE2 And store in USR calling sequence TADI =$07600 Get the device number for output file AND =017 Extract it ROOM 9 JMS USR Call USR to close out the file DC 4 (close operation) DC 07601 Location of name of output file CLOSE2 DC 0 Length of output file stored here JMP *+2 ERROR OF SOME KIND ON CLOSE FUNCTION JMP CLOSE-2 No error - return to call now / / Here when there was an error on a CLOSE function / FAIL CLA JMS USR,7,8 Log USR error 8 for the error message EJECT / / Here for the OS/8 ENTER routine. Must load the device handler / and set up the output device driver parameters. / / CID 00 Only called from field 0 ENTER SUB CDF 1 TADI =$07604 Examine output file extension SNA Skip if extension specified TAD ="LS Else default extension to .LS DCAI =$07604 ... TADI =$07600 Get the output device number SNA Skip if we have an output device here JMP ENTER-2 No output device specified here / ROOM 9 JMS USR Load the device handler for this file DC 1 (Load device handler function) DC ODRIVER+1 Location -- 2 page handler is allowed JMP FAIL ERROR -- CAN NOT LOAD OUTPUT DEVICE DRIVER TAD *-2 Get the address of the device driver CDF %ODEV To main field DCAI =ODEV Store address of driver entry point CDF 1 / / Now perform the ENTER operation on this device / TADI =$07600 Get the output device information ROOM 9 JMS USR DC 3 (Function 3 = do file ENTER) ENT1 DC 07601 Location of name of output file ENT2 DC 0 Dummy arguments JMP NO:ENTER ERROR - ENTER FUNCTION FAILED / TAD ENT1 Get the starting block for output file CDF %OSBLOK Set field DCAI =OSBLOK Store the output starting block now / CDF %* Back to current field now TAD ENT2 Get the space available for the output file CDF %OMLENGTH Back to main field DCAI =OMLENGTH Store the minus length of space available JMP ENTER-2 Return to caller now / / Here when the OS/8 ENTER function failed for some reason / NO:ENTER CLA JMS USR,7,7 USR ERROR 7 is ENTER failed EJECT / / Here to handle packing of characters into the page buffer. Page / buffer format is simply one character per word. Field 2 is used / for the left column and field 3 is used for the right column. / CIF 0 Always return to field 0 FPAK SUB AND =0377 Remove flag bit DCA TEMP Save character TADI =LEFT Get # of lines left on this page CLL CMA IAC RAL Multiply by 2 and subtract from TADI =LINES total number of lines on page SMA CLA Skip if on left half of page JMP 2F Ok, on second column here / TAD TEMP Reget character CDF 2 To field of left column buffer DCAI COL1XR Store away 1H CDF 0 Return main field JMP FPAK-2 All done here / 2H TAD TEMP Reget character CDF 3 To field of right column buffer DCAI COL2XR Store away JMP 1B All done here / / Here to generate the number of spaces specified in the AC. Allow zero / value here. / FSPAC SUB SPA Should be positive value CLA If not, just use zero (and exit) CMA 1's complement in case 0 DCA CNTR Set loop counter JMP 7F Into loop below / 6H TAD =' Store a blank JMSX XPAKUP .. 7H LOOP 6B Loop till all blanks generated RET FSPAC All done here /