+++ /dev/null
-/ SPEAK - Types out messages from the database\r
-/ Also includes TTY output routines that unpack\r
-/ packed sixbit into mixed case ASCII.\r
-/\r
- FIELD1 ADVTTY\r
-\r
-TTY, 0 / TTY Output routine, dupe of FRTS\r
- IOF / Protect from race conditions\r
- SNA / Input or output?\r
- JMP KBD / Input - read character\r
- DCA HANGPT / Output - save char\r
- RDF\r
- TAD CDIF00\r
- DCA CDFX\r
- CDF 0\r
- TAD% TOCHR / Output character status in FRTS\r
- SMA SZA CLA / If gt 0, char backed up\r
- JMP BUSY / Else must wait\r
-LOOP, TAD% TOCHR / Get the status\r
- CLL RAL /Busy flag in link\r
- CLA CML RAR /Complement of busy in sign\r
- TAD HANGPT\r
- SPA /If tty not busy, \r
- TLS /Send it\r
- DCA% TOCHR /Store pos or neg, backed up or busy\r
-TTYRET, ION /Interrupts back on\r
-CDFX, HLT /Caller's field\r
- JMP% TTY /Return\r
-\r
-CDIF00, CIF CDF\r
-\r
-BUSY, CDF 10 /Busy, must wait. Call Field 0 HANG routine\r
- CIF 0\r
- JMS% HANGPT+1\r
- 0451 / TTUHNG\r
- CDF 0\r
- JMP LOOP / Try output again\r
-\r
-KBD, RDF\r
- TAD CDIF00\r
- DCA CDFX\r
- CDF 0\r
- TAD% TICHR / Any input?\r
- SNA CLA\r
- JMP WAIT / No, wait\r
-GETIN, TAD% TICHR / Get character\r
- DCA HANGPT / Save\r
- DCA% TICHR / Clear buffer\r
- TAD HANGPT\r
- JMP TTYRET / Return\r
-\r
-WAIT, CDF 10\r
- CIF 0\r
- JMS% HANGPT+1 /Hang\r
- 465 /KBUHNG\r
- CDF 0\r
- JMP GETIN /Get input\r
-TOCHR, 4\r
-TICHR, 5\r
-HANGPT, ADDR #HANG\r
-/\r
-/ Terminal line input routine. Used because the FRTS input is quite limited.\r
-/ This one handles scope rubouts and allows lower case input.\r
-/ Inputs: Array Returned characters, stored one sixbit per array word\r
-/ (The FORTRAN input routine is set up this way to unpack)\r
-/ Size Number of characters to allow\r
-/ Prompt Prompt string\r
- FIELD1 RDLIN\r
-/\r
- ENTRY RDLINE\r
-RDLINE, JA #RLST\r
-#RLXR, ORG .+10\r
- TEXT +RDLINE+\r
-#RLRET, SETX #RLXR\r
- SETB #RLBAS\r
- JA .+3\r
-#RLBAS, ORG .+6\r
-BUFPT, ORG .+3\r
-BUFLEN, ORG .+3\r
-\r
- ORG #RLBAS+30\r
- FNOP\r
- JA #RLRET\r
- FNOP\r
-#RGOBK, 0;0\r
-#RLRTN, BASE #RLBAS\r
- JA #RGOBK\r
-#RLST, STARTD\r
- 0210\r
- FSTA #RGOBK,0\r
- 0200\r
- SETX #RLXR\r
- SETB #RLBAS\r
- LDX 0,1\r
- FSTA #RLBAS\r
- FLDA% #RLBAS,1+\r
- FSTA BUFPT\r
- FLDA% #RLBAS,1+\r
- FSTA BUFLEN\r
- STARTF\r
-/\r
-/ Pass down size to '8' code\r
-/\r
- SETX BUFSIZ \r
- FLDA% BUFLEN\r
- FNEG / Make it negative\r
- ATX 0 / Pass buffer len\r
- SETX #RLXR\r
- TRAP4 GETLIN / Get input line\r
- JA #RLRTN / And return\r
-/ Input reader\r
-\r
- FIELD1 GETLN\r
-\r
-GETLIN, 0\r
- CLA\r
- DCA OFFSET / Start at offset zero\r
- TAD% SCOPT\r
- AND K200\r
- DCA SCOPE\r
- TAD% BUFFLD+1 / Get CDF for buffer\r
- AND FLDMSK\r
- CLL RTL\r
- RAL\r
- TAD CDFG\r
- DCA BUFCDF\r
-/\r
-/ Go get an input character\r
-/\r
-GETNXT, JMS% PTTY+1 / Called with zero to get char\r
- DCA INCH / Save input\r
-/\r
-/ Specials?\r
-/\r
- TAD INCH\r
- TAD MDEL / Delete?\r
- SNA CLA\r
- JMP DELETE / Handle that\r
- TAD INCH\r
- TAD MCR / CR?\r
- SNA CLA\r
- JMP ENTER / End of line, let's go.\r
- TAD INCH\r
- TAD MSPC / Less than space?\r
- SPA CLA\r
- JMP BELL / Nope, ignore\r
- TAD OFFSET\r
- TAD BUFSIZ / Room left?\r
- SMA CLA\r
- JMP BELL / Bell if not\r
- TAD INCH\r
- JMS% PTTY+1 / Echo it\r
- TAD INCH\r
- TAD LWRA / Is it lowercase?\r
- SPA CLA\r
- JMP UPPER / No, store it\r
- TAD INCH\r
- TAD LWRZ\r
- SMA CLA\r
- JMP UPPER / More than lowercase z\r
- TAD INCH\r
- TAD AMINA / Adjust to uppercase\r
- DCA INCH\r
-UPPER, JMS STORE / Store this character\r
- JMP GETNXT / Get more\r
-/ Store a character in the output buffer\r
-/ using the current offset\r
-/\r
-\r
-STORE, 0\r
- TAD OFFSET\r
- TAD OFFSET\r
- TAD OFFSET / Count FPP words\r
- TAD% BUFPTR+1 / Pointer to exponent word\r
- DCA BPT\r
- TAD K27 / Exponent 27 for integer\r
- JMS STO\r
- JMS STO / Zero high word\r
- TAD INCH / Char value\r
- AND SIXMSK / Convert to sixbit\r
- JMS STO / Store in buffer\r
- CDF 10 / Back to my field\r
- ISZ OFFSET / One more in the buffer\r
-SPC, 240 / Really shouldn't overflow; harmless AND\r
- JMP% STORE / Return\r
-STO, 0\r
-BUFCDF, HLT / Gets CDF for buffer field\r
- DCA% BPT\r
- ISZ BPT / Next word\r
- JMP% STO / Return if no skip\r
- TAD BUFCDF\r
- TAD BS / Next field\r
- DCA BUFCDF\r
- JMP% STO\r
-\r
-BELL, TAD BEL / Warn the user\r
- JMS% PTTY+1\r
- JMP GETNXT\r
-\r
-DELETE, TAD OFFSET / How far into the buffer are we?\r
- SNA CLA\r
- JMP BELL / Ignore extra deletes\r
- TAD SCOPE\r
- SNA CLA\r
- JMP DUMBDL / Simple fortran-format delete\r
- TAD BS\r
- JMS% PTTY+1\r
- TAD SPC\r
- JMS% PTTY+1\r
- TAD BS\r
- JMS% PTTY+1\r
- JMP FIXOFF / Fix the offset\r
-DUMBDL, TAD K334 / Backslash\r
- JMS% PTTY+1\r
-FIXOFF, CLA CMA\r
- TAD OFFSET\r
- DCA OFFSET\r
- JMP GETNXT\r
-\r
-ENTER, TAD CR / Send a RETURN\r
- JMS% PTTY+1\r
-CLRLP, TAD OFFSET / Is there space available?\r
- TAD BUFSIZ\r
- SMA CLA\r
- JMP CLRDN\r
- TAD SPC\r
- DCA INCH\r
- JMS STORE\r
- JMP CLRLP\r
-CLRDN, CIF CDF 0\r
- JMP% GETLIN\r
-\r
-BUFSIZ, 0\r
-SCOPT, 7726 / Scope flag in OS/8\r
-K200, 200\r
-MDEL, -377 / Delete \r
-MCR, -215\r
-CR, 215\r
-MSPC, -240\r
-BEL, 207\r
-LWRA, -341\r
-LWRZ, -373\r
-AMINA, -40 / Add to "a" to make "A"\r
-BPT,\r
-BUFFLD, ADDR BUFPT+1\r
-SCOPE,\r
-BUFPTR, ADDR BUFPT+2\r
-OFFSET,\r
-PTTY, ADDR TTY\r
-BS, 10\r
-K334, 334\r
-CDFG, CDF 0\r
-K27, 27\r
-SIXMSK, 77\r
-FLDMSK, 7\r
-INCH, 0\r
-\r
-/\r
-/ Fortran-callable message printer\r
-/ Put here to avoid wasting the rest of the page.\r
-/ Arguments:\r
-/ BUF Buffer pointer\r
-/ COUNT Number of characters to write, zero to look for end\r
-/ CRFLAG Carriage return flags.\r
-/ Bit 11 (1) = no lead LF\r
-/ Bit 10 (2) = no trail CR\r
-/ Bit 9 (4) = start lowercase\r
-/\r
- ENTRY SIXOUT\r
-SIXOUT, JA #STRT\r
-#SXR, ORG .+10\r
- TEXT +SIXOUT+\r
-#SRET, SETX #SXR\r
- SETB #SBASE\r
- JA .+3\r
-#SBASE, ORG .+6\r
-CNT, ORG .+3\r
-SFLAG, ORG .+3\r
-\r
- ORG #SBASE+30\r
- FNOP\r
- JA #SRET\r
- FNOP\r
-#SGOBK, 0;0\r
-#SRTN, BASE #SBASE\r
- JA #SGOBK\r
-#STRT, STARTD\r
- 0210\r
- FSTA #SGOBK,0\r
- 0200\r
- SETX #SXR\r
- SETB #SBASE\r
- LDX 0,1\r
- FSTA #SBASE\r
- FLDA% #SBASE,1+\r
- FSTA BUF / Buffer pointer\r
- FLDA% #SBASE,1+ / Count\r
- FSTA CNT\r
- FLDA% #SBASE,1+ / Carriage control flag\r
- FSTA SFLAG\r
- STARTF\r
- FLDA% CNT\r
- SETX COUNT\r
- ATX 0\r
- FLDA% SFLAG\r
- ATX 1\r
- SETX #SXR\r
- TRAP4 SIX8 /Call the 8-mode output routine\r
- JA #SRTN\r
-\r
- FIELD1 SXOUT\r
- ENTRY SIX8 / Mixed case output routine\r
-\r
-SIX8, 0\r
- TAD CRFLAG /Suppresss carriage control?\r
- RAR /Low bit suppresses lead LF\r
- SZL CLA\r
- JMP .+4 /No leading LF\r
- CDF 10 / My field\r
- TAD LF /Linefeed\r
- JMS% TTYPTR+1 /Output it\r
- TAD CRFLAG\r
- AND K4 /Start in lower case?\r
- SZA CLA\r
- TAD K40 /Yes\r
- TAD HUN /Reset conversion factor\r
- DCA SHIFT\r
- TAD BUF /Buffer field\r
- AND K7 /Just the field bits\r
- CLL RAL\r
- RTL /Into place\r
- TAD CDF0 /Into CDF instruction\r
- DCA CDF1\r
- TAD CDF1\r
- DCA CDF2\r
- TAD COUNT /Get buffer length\r
- SNA\r
- JMP NOTRIM /Zero means it has a terminating "@"\r
-/\r
-/ Find the end of the string\r
-/\r
- CLA CMA /End is start + len - 1\r
- TAD COUNT /String len in words\r
- TAD BUF+1 /End of the string\r
- DCA PTR /Pointer to end\r
- TAD COUNT /Invert count\r
- CMA IAC\r
- DCA COUNT\r
-CDF1, HLT\r
-FNDEND, TAD% PTR\r
- TAD K3740 / - ' ' (two spaces)\r
- SZA CLA / Skip if blank\r
- JMP NONBLK\r
- ISZ COUNT /Count another\r
- SKP\r
- JMP NONBLK /If empty, done\r
- CLA CMA / -1\r
- TAD PTR\r
- DCA PTR /Back pointer up\r
- JMP FNDEND /Keep looking\r
-\r
-NONBLK, TAD COUNT\r
- SNA CLA /Skip if output left\r
- JMP DONE /Nothing if count zero already\r
-NOTRIM, TAD BUF+1 /Reset pointer to start\r
- DCA PTR\r
-CDF2, HLT\r
- TAD% PTR /Get word\r
- DCA STEMP /Save\r
- TAD STEMP\r
- RTR\r
- RTR\r
- RTR /First sixbit\r
- JMS OUTONE /Convert and output it\r
- TAD STEMP /Second sixbit\r
- JMS OUTONE\r
- ISZ PTR /Bump pointer\r
- SKP /OK if no skip\r
- JMP NEWFLD /Next field otherwise\r
-INCCNT, ISZ COUNT\r
- JMP CDF2 /Keep outputting\r
-DONE, CLA\r
- TAD CRFLAG /Suppress trailing CR?\r
- RTR /2 bit suppresses trailing CR\r
- SZL CLA /If zero, write it.\r
- JMP OUT /Yes, leave now\r
- CDF 10 /My field\r
- TAD CRTN\r
- JMS% TTYPTR+1\r
-OUT, CIF CDF 0\r
- JMP% SIX8\r
-\r
-NEWFLD, TAD CDF1\r
- TAD K10 /Next field\r
- DCA CDF1\r
- TAD CDF1\r
- DCA CDF2\r
- JMP INCCNT\r
-\r
-OUTONE, 0\r
- AND K77 /Mask\r
- SNA\r
- JMP DONE / End of string\r
- TAD K7743 / minus '['\r
- SNA\r
- JMP SETLWR /Set to lowercase shift\r
- TAD K2 / ok, ']'?\r
- SNA\r
- JMP SETUPR /Set to uppercase\r
- TAD K7773 /Restore\r
- SPA\r
- TAD SHIFT /For positive, shift it\r
- TAD K40 /Else it's not alphabetic\r
- CDF 10 /My field\r
- JMS% TTYPTR+1 /Output it\r
- JMP% OUTONE /Done\r
-\r
-SETLWR, TAD K40 /Reset shift\r
-SETUPR, TAD HUN /For upper/lower\r
- DCA SHIFT\r
- JMP% OUTONE\r
-\r
-TTYPTR, ADDR TTY\r
-SHIFT, 140 /Shift value\r
-/ COUNT and CRFLAG must stay together\r
-COUNT, 0 /Num words to output. \r
-CRFLAG, 0 /1 - no leading LF, 2 no trailing CR\r
-PTR, 0\r
-CRTN, 15\r
-LF, 12\r
-K3740, 3740 /minus blank\r
-BUF, 0;0;0 /Buffer 15-bit address\r
-STEMP, 0\r
-K77, 77 /sixbit mask\r
-K7, 7\r
-K4, 4\r
-K40, 40\r
-CDF0, CDF\r
-HUN, 100\r
-K7743, 7743\r
-K7773, 7773\r
-K10, 10 /Field increment\r
-K2, 2\r
-\r
- SECT SPEAK\r
-/C\r
-/ SUBROUTINE SPEAK(N)\r
-/C\r
-/C PRINT THE MESSAGE IN RECORD N OF THE RANDOM ACCESS MESSAGE FILE.\r
-/C\r
-/ IMPLICIT INTEGER (A-Z)\r
-/ COMMON /TXTCOM/ RTEXT,LINES,ASCVAR\r
-/ COMMON /ALPHAS/ BLANK,EOF\r
-/ DIMENSION RTEXT(205),LINES(36)\r
-/C\r
- EXTERN IO\r
- EXTERN #HANG\r
- JA #ST\r
-#XR, ORG .+10\r
- TEXT +SPEAK+\r
-#RET, SETX #XR\r
- SETB #BASE\r
- JA .+3\r
-#BASE, ORG .+6\r
-N, ORG .+3\r
-#DOTMP, ORG .+3\r
-BLANK, TEXT + +\r
-EOF, TEXT +>$< +\r
-ONE, F 1.0\r
-FOUR, F 4.0\r
- ORG #BASE+30\r
- FNOP\r
- JA #RET\r
- FNOP\r
-#GOBAK, 0;0\r
-I, ORG .+0003\r
-L, ORG .+0003\r
-OLDLOC, ORG .+0003\r
- #LBL=.\r
- COMMON TXTCOM\r
-RTEXT, ORG .+1147\r
-LINES, ORG .+0044\r
-ASCVAR, ORG .+0003\r
-TXTLOC, ORG .+0003\r
-DATA, ORG .+0352\r
- ORG #LBL\r
-#RTN, BASE #BASE\r
- JA #GOBAK\r
-#ST, STARTD\r
- 0210\r
- FSTA #GOBAK,0\r
- 0200\r
- SETX #XR\r
- SETB #BASE\r
- LDX 0,1\r
- FSTA #BASE\r
- FLDA% #BASE,1+\r
- FSTA N\r
- STARTF\r
-/ IF(N.EQ.0)RETURN\r
- FLDA% N\r
- JEQ #RTN\r
-/ READ(2'N) LOC,LINES\r
- FLDA N\r
- STARTD\r
- FSTA #G0002\r
- STARTF\r
- JSR IO\r
- JA .+0004\r
-#G0002, JA .\r
-/ IF(LINES(1).EQ.EOF)RETURN\r
- FLDA ONE\r
- ATX 7\r
- FLDA LINES-0003,7\r
- FSUB EOF\r
- JEQ #RTN\r
-/1 OLDLOC = LOC\r
-#1, FLDA TXTLOC\r
- FSTA OLDLOC\r
- FLDA ONE\r
- FSTA I\r
-\r
-/ DO 3 I=36,1,-1\r
-/ Set COUNT to the number of words (36 or 44 octal)\r
- SETX COUNT\r
- LDX 44,0 /44 words\r
- LDX 0,1 /With carriage control\r
- SETX #XR\r
-/ L=I\r
-/3 CONTINUE\r
-/5 TYPE 2,(LINES(I),I=1,L)\r
-#5, FLDA LINEPT\r
- FSTA BUF /Set buffer pointer\r
- TRAP4 SIX8\r
-\r
- FLDA% N\r
- FADD ONE\r
- FSTA% N\r
- FLDA N\r
-/ READ(2'ASCVAR) LOC,LINES\r
- STARTD\r
- FSTA #G0006\r
- STARTF\r
- JSR IO\r
- JA .+0004\r
-#G0006, JA .\r
-/ IF(LOC .EQ. OLDLOC) GO TO 1\r
- FLDA TXTLOC\r
- FSUB OLDLOC\r
- JEQ #1\r
- EXTERN #WRITO\r
- TRAP3 #WRITO\r
- JA FOUR\r
- JA #10+2\r
- EXTERN #RENDO\r
- TRAP3 #RENDO\r
-\r
-/10 RETURN\r
-#10, JA #RTN\r
-/ (1X)\r
- 5061\r
- 3051\r
-/2 FORMAT(' ',36A2) PDP/8: (' ',12A6)\r
-LINEPT, ADDR LINES\r
- 0\r
- END\r
projects / pdp8.git / blobdiff