;SRCA:<BBOARD>BBOARD.MAC.93 6-Dec-85 12:53:07, Edit UT-3 by CAW
; Add changes from UTEXAS
; Add switch for no MM or PUSH - /SECURE. To prevent a user from
; getting below this program.
; THE FOLLOWING IS UTEXAS ONLY
; Make /MORE default, output blank lines before header
; Eliminate More? prompt in the middle of a message
; <GERGELY.EXP>BBOARD.MAC.91, 3-May-85 08:22:05, Edit by GERGELY
;Increase command line interpretation to 10 lines
;<SU-UTILITIES>BBOARD.MAC.72, 18-Dec-85 12:09:28, Edit by PIERRE
; Add the ability to remove PUSHing ability when PUSHSW==0
;<SU-UTILITIES>BBOARD.MAC.71, 1-Aug-85 16:18:12, Edit by FMF
; Make use POBOX: instead of PS:
; Note that SYSTEM:MAIL.TXT is replaced with POBOX:<SYSTEM>MAIL.TXT
;<SU-UTILITIES>BBOARD.MAC.70, 14-Jun-85 09:04:30, Edit by FMF
; Make sure "X" in More? really exits
;<SU-UTILITIES>BBOARD.MAC.69, 8-Jun-85 15:30:12, Edit by FMF
; Turn on output (undo ^O) before More?
;<SU-UTILITIES>BBOARD.MAC.68, 3-Jun-85 15:33:09, Edit by FMF
; X in More? exits all bboards
;<SU-UTILITIES>BBOARD.MAC.67, 31-May-85 14:09:46, Edit by FRANK
; Give help for all commands in "More?"
;<SU-UTILITIES>BBOARD.MAC.66, 28-May-85 13:10:30, Edit by FMF
; "^" synonym for "B"
; In MORPMT, "P" for push, "H" to redisplay header
;<SU-UTILITIES>BBOARD.MAC.65, 3-May-85 11:45:56, Edit by FMF
; From Gergely at DREA:
; More generous command line input
;<SU-UTILITIES>BBOARD.MAC.64, 2-May-85 10:59:02, Edit by FMF
; Make sure initial message about old bboards seen if default bboard
; Fix the way site compilation switches are done
; Define WHITSW to give lots of whitespace around and in headers
; From Gergely at DREA:
; WMSR uses ARMYSW
; Fix Datamedia 2500 clear line sequence
; Fondle counts to calls of MORCHK
; Clean out "More? " on a negative answer
;<SU-UTILITIES>BBOARD.MAC.63, 1-May-85 13:34:27, Edit by FMF
;<SU-UTILITIES>BBOARD.MAC.62, 1-May-85 13:23:44, Edit by FMF
; Change terminal type definitions to include just standard DEC types and
; define site-dependent types in site switches
; Change JHLT and JERR to DEFINEs from OPDEFs
; Changes from Gergely at DREA:
; Output name of the bboard in the error routine
; SMSGSW to treat system messages differently
; DREA wants a little extra space before the subject line
; From WSMR:
; SHDRSW to select "standard" headers
; Add WSMRSW
;<SU-UTILITIES>BBOARD.MAC.61, 30-Apr-85 09:35:02, Edit by FMF
; From Gergely at DREA:
; Fix error-checking in PRSMSG
;<SU-UTILITIES>BBOARD.MAC.60, 30-Apr-85 08:40:56, Edit by FMF
; ERJMP after the JFNS% in OPNDAT
;<SU-UTILITIES>BBOARD.MAC.59, 29-Apr-85 13:30:33, Edit by FMF
; Fix problem that SCROLL-MORE would set /LAST
;<SU-UTILITIES>BBOARD.MAC.58, 28-Apr-85 18:08:19, Edit by FMF
; Bugfixes from Gergely at DREA:
; Don't open the .IDX file until we really need to use it
; Fix where /CHECK reports whether there are bboards available
;<SU-UTILITIES>BBOARD.MAC.57, 24-Apr-85 14:40:07, Edit by FMF
; ^R is a synonym for H (repeat header)
;<SU-UTILITIES>BBOARD.MAC.56, 24-Apr-85 14:38:12, Edit by FMF
; LOTS and GSB have the same selections as other Stanford sites
;<SU-UTILITIES>BBOARD.MAC.55, 24-Apr-85 10:42:00, Edit by FMF
; Don't use AC16...it trashes the last read date
;<SU-UTILITIES>BBOARD.MAC.54, 23-Apr-85 16:55:53, Edit by FMF
; Clean up code
; Flush ancient edit history
; Don't print out extra CRLF before message header
;<SU-UTILITIES>BBOARD.MAC.52, 18-Apr-85 14:04:06, Edit by FMF
; Enable DREA edits for Sierra
; Make sure no leading tab if header on next line
; Allow DEL for non-confirmation in "More?"
;<GERGELY.EXP>BBOARD.MAC.100, 11-Apr-85 17:17:13, Edit by GERGELY
TITLE BBOARD - BBOARD reader
SEARCH MONSYM,MACSYM
REQUIRE SYS:MACREL ;Load useful things, don't copy
REQUIRE SYS:BLANKT ;Get mailsystem screen blank code
ASUPPRESS
SALL
TEXT "BBOARD/SAVE"
EXTERN $BLANK ;Tell MACRO about these symbols
VWHO==4 ;4 = Customer
VMIN==0
VMAJ==1
VEDIT==123 ;Edit in bits 18-26
CODORG=1000 ;Beginning of CODE PSECT
DATORG=7000 ;Beginning of DATA PSECT
IFNDEF RUTSW,<RUTSW==0> ;Rutgers University
IFNDEF FAIRSW,<FAIRSW==0> ;Fairchild AI Lab
IFNDEF DREASW,<DREASW==0> ;Defense Research Establishment Atlantic
IFNDEF ARMYSW,<ARMYSW==0> ;WSMR
IFNDEF STANSW,<STANSW==0> ;Stanford University
IFNDEF UTEXSW,<UTEXSW==0> ;[UT-2] University o' Texas
;Compilation flags
IFNDEF FACSW,<
FACSW==0 ;Default to no /FACULTY or /CLASS
IFN RUTSW,<FACSW==1> ;Rutgers wants it
>;IFNDEF FACSW
IFNDEF OLDSW,<
OLDSW==1 ;Want old messages (beyond a month)
IFN DREASW!ARMYSW,<OLDSW==0> ;Those who don't want it
>;IFNDEF OLDSW
IFNDEF ENDMSW,<
ENDMSW==1 ;Most people want end message
IFN ARMYSW!STANSW,<ENDMSW==0> ;Doesn't want the end message
>;IFNDEF ENDMSW
IFNDEF NEWRSW,<
NEWRSW==1 ;Most people want new readers treated specially
IFN FAIRSW,<NEWRSW==0> ;Doesn't want them treated specially
>;IFNDEF NEWRSW
IFNDEF SHDRSW,<
SHDRSW==0 ;Most want bboard-style headers
IFN ARMYSW,<SHDRSW==1> ;Wants standard headers
>;IFNDEF SHDRSW
IFNDEF SMSGSW,<
SMSGSW==0 ;Most don't want special system message stuff
IFN DREASW,<SMSGSW==1> ;Those who want system messages differently
>;IFNDEF SMSGSW
IFNDEF WHITSW,<
WHITSW==0 ;Most people don't like lots of whitespace
IFN DREASW!UTEXSW,<WHITSW==1> ;But DREA and Texas want it
>;IFNDEF WHITSW
IFNDEF PUSHSW,<
PUSHSW==1 ;Most people want to be able to push
>;IFNDEF PUSHSW
IFE PUSHSW,<IF1,<PRINTX %Assembling without PUSH command>>
;Macro definitions
;Dynamically generate a flag. Argument is flag name, no argument initializes
DEFINE FLAG. (LABEL) <
IFB <LABEL>,<
..FLAG==1B0 ;;Start off with the leftmost bit
>;IFB
IFNB <LABEL>,<
IFE ..FLAG,<
IF2,<
PRINTX Too many flags, not creating LABEL
>;IF2
>;IFE
IFN ..FLAG,<
LABEL==..FLAG ;;Create the flag
..FLAG==..FLAG_<-1> ;;Shift to the right one bit
>;IFN
>;IFNB
>;FLAG.
;Define first word in table
DEFINE TABTOP <
TABLC==.
0 ;;We'll fill this in later
>;TABTOP
;Fill in first word of table
DEFINE TABBOT <
TABSV==.
RELOC .TABLC
.TABSV-.TABLC-1,,.TABSV-.TABLC-1
RELOC .TABSV
>;TABBOT
;Macros for CMD system
;Prompt for command
DEFINE PROMPT (MESSAGE) <
HRROI A,[ASCIZ \MESSAGE\]
CALL DPROMPT
>;PROMPT
;Print guidewords
DEFINE NOISE (SHT) <
MOVEI A,[FLDDB. .CMNOI,,<-1,,[ASCIZ \SHT\]>]
CALL RFIELD
>;NOISE
;Require confirmation
DEFINE CONFRM <
MOVEI A,[FLDDB. .CMCFM]
CALL RFIELD
>;CONFRM
;Make table entry
DEFINE T (WORD,ADDRES) <
IFB <ADDRES>,<
[ASCIZ \WORD\],,.'WORD
>;IFB ADDRES
IFNB <ADDRES>,<
[ASCIZ \WORD\],,ADDRES
>;IFNB ADDRES
>;T
;Macro for defining abbreviations in tables
DEFINE TA (TEXT,ADDR) <
IFNB <ADDR>,<%%X==ADDR>
IFB <ADDR>,<%%X==.'TEXT>
[CM%INV!CM%ABR
ASCIZ \TEXT\],,%%X
>;TA
DEFINE MAKPTR (AC) <
TLC AC,-1 ;;Change -1 to 0 in left half
TLCN AC,-1 ;;Check if result is 0 and then change back
HRLI AC,(<POINT 7,0>) ;;Yes
>;MAKPTR
DEFINE JHLT <
ERCAL JSHLT0
>;JHLT
DEFINE JERR <
ERCAL JSERR0
>;JERR
;Constant definitions
F=0 ;Flags (of course)
A=1
B=2
C=3
D=4
E=5
G=6
BBN=7 ;Bboard number
T=10
U=11
V=12
W=13
DAT=14
X=15
P=17
PG.RD==0 ;Offset for last read message
PG.WRT==1000 ;Offset for last write message
;Flag bit definitions
FLAG. ;Initialize flags macro
FLAG. F%NAM ;Type file name at start
FLAG. F%ACT ;Type file name if reading file
FLAG. F%PAUS ;Want to pause afterwards
FLAG. F%MSGB ;Some msgs were output for this bboard
FLAG. F%MSGS ;Some msgs were output for any bboard
FLAG. F%LAST ;He wants last message
FLAG. F%DEF ;It is the default bboard
FLAG. F%ERR ;Marks errors
FLAG. F%QUIT ;Says he wants to quit
FLAG. F%SYS ;Wants to see system messages
FLAG. F%1ST ;Have shown first message (Differs from F%MSGB
; when going to the last msg)
FLAG. F%CMA ;Have seen a comma in last thing
FLAG. F%CHK ;Add the /CHECK switch
FLAG. F%MORE ;Add the /MORE switch
FLAG. F%SCMR ;Add the /SCROLL-MORE switch
FLAG. F%EXIT ;Really wants to be done with all bboards
FLAG. F%SECU ;[UT-3] On to indicate no PUSH or MM
MMRPAG==20 ;Read data page in MM
MMWPAG==40 ;Write data page
BBNMAX==^D50 ;Maximum number of bboards
BAKMAX==^D100 ;How many back ups are allowed
INTCH1==1 ;Interrupt channel 1
IFE OLDSW,<
DAYAGO==^D30 ;Max old msg
>;IFE OLDSW
JBSA==120 ;Here is the word set by the loader
OPDEF SKPA [TRNA]
;Block definitions
PSECT DATA,DATORG
;Impure storage
PDLL==50 ;Max size of PDL
PDL: BLOCK PDLL
TTYPE: -1 ;Current terminal type
CURJFN: BLOCK 1 ;The current JFN
CURFIL: BLOCK 20 ;The current filename
DFLTBK: GJ%OLD+GJ%DEL+GJ%FLG+GJ%IFG ;Allow deleted files here
0 ;JFNs (supplied by COMND%)
-1,,DEVICE ;Device
-1,,DIRECT ;Directory
-1,,[ASCIZ \MAIL\] ;Filename
-1,,[ASCIZ \TXT\] ;Extension
DFLTLN==.-DFLTBK
FILNMS==0 ;Will count to BBNMAX
FILNAM:
REPEAT BBNMAX,<
FILNMS==FILNMS+^D8*4
EXP FILNMS+FILNAM ;Where FILNAM to be stored
>;REPEAT BBNMAX
REPEAT BBNMAX,< ;Enough space for all names
BLOCK ^D8*4 ;Space to save file specified by user
>;REPEAT BBNMAX
;Build device and directory from BBD: if exists, and default filenames
DEVICE: BLOCK 2
DIRECT: BLOCK 10
DEFDAT: BLOCK 10
DEFBBD: BLOCK 10
;Level table for ^C trap stuff
LEVTAB: PC1
0
0
PC1: BLOCK 1
;Channel table for ^C trap
CHNTAB: 0
1,,CTRLC ;Channel 1 is ^C
BLOCK ^D34 ;Rest of channels unused
;COMND% CSB
CMDBLN==:<^D80*10>/5+1 ;Room for six line command
ATMBLN==:CMDBLN
CMDBUF::BLOCK CMDBLN
CMDACS::BLOCK 20 ;Saved AC's from beginning of command line
ATMBUF::BLOCK ATMBLN ;Holds last parsed field
SBK:: BLOCK 20 ;COMND% state block
CJFNBK::BLOCK 20 ;GTJFN% block for COMND%
REPARA::0 ;Reparse address for COMND%
CMDFRM::0 ;Marks bottom of stack
CMDPDL::BLOCK 200 ;Room to save PDL
MESLN==30
VALUES:
ERMES: BLOCK MESLN
;Data for Fork handling/MM calling
RSCSIZ==^D150-1
ERRSIZ==^D100-1
FORK: BLOCK 1 ;Fork handle
FRKJFN: BLOCK 1 ;JFN on program being run
JOBNAM: BLOCK 1 ;Jobname (so we can restore it)
ERRFLG: BLOCK 1 ;0 = no error, -1 = run error, 1 = fork error
RSCBUF: BLOCK <<RSCSIZ/5>+1> ;Buffer for text to rescan
INTTIM: BLOCK 1 ;-1 or date and time to start at
NEWTIM: BLOCK 1 ;New time to reset to
OLDTIM: BLOCK 1 ;Time to compare msgs with
IFE OLDSW,<
LNGAGO: BLOCK 1 ;Stores a date of 30 days ago
>;IFE OLDSW
SAVHD: BLOCK 1
HDCNT: BLOCK 1
CURPOS: BLOCK 1
NUMCHR: BLOCK 1
;Data for backup capabilities
STRTPT: BLOCK 1 ;Byte pointer at first shown msg
BAKPTR: BLOCK BAKMAX ;Place to store byte pointers
BAKCNT: BLOCK 1 ;Index into BAKPTR
STRTCN: BLOCK 1 ;Count at initial message for today
DATPAG: BLOCK 1 ;Page to map data stuff
DATPG1: BLOCK 1 ;Page for last file write
TXTPAG: BLOCK 1 ;Where .TXT file will be mapped
TXTPGS: BLOCK 1 ;Number of pages in .TXT file
TXTPTR: BLOCK 1 ;Pointer into in-core .TXT file
TXTEOF: BLOCK 1 ;Address of last word in TXT file
EOF: BLOCK 1 ;Tells when EOF has been reached
MSGPTR: BLOCK 1 ;Pointer to this message
HDRPTR: BLOCK 1 ;Pointer to header of the message
DJFN: BLOCK 1 ;JFN of data file
IJFN: BLOCK 1 ;Input JFN of message file
BBOFIL: BLOCK BBNMAX ;0 or jfn of BBOARD file
BBDFIL: BLOCK BBNMAX ;0 or jfn of .DAT file
DASHPT: BLOCK 1
MSGLEN: BLOCK 1
MSGCNT: BLOCK 1 ;Message number in the file
DATE: BLOCK 30 ;Place to put date
BUFSIZ==200 ;Max num of chars in buf
BUF: BLOCK <BUFSIZ/5+1>
TMPBUF=BUF ;Use the same buffer for both
FDB: BLOCK .FBLEN
;For building the keyword table
BLDJFN: BLOCK 1
FILKEY: BLOCK 40
KEYWDS: BLOCK 40*10*2
FLDDAT: BLOCK 40
FLDFRM: BLOCK 40
FLDSUB: BLOCK 100
HEAD1: BLOCK 200
LINBUF: BLOCK 40 ;Should hold .gt. big tty line
NLINES: BLOCK 1 ;Number of lines on tty
NCOLS: BLOCK 1 ;Number of columns on tty
SAVMOD: BLOCK 1 ;Save terminal mode
ENDPS ;End of impure data
PSECT CODE,CODORG
;Pure storage
IFN PUSHSW,<
HELP: ASCIZ \
Legal commands are:
<SPACE>, <CR>, or Y Show the rest of this bulletin
<DEL> or N Skip this bulletin, go to the next one
B Back up one message
E or Q Quit this bulletin board, and go to the next one
H Show the header again
M Call MM on this bulletin board
P Push to a new Exec
R Restart this bulletin board
X Exit BBOARD, skipping all remaining bulletin boards
\
>;IFN PUSHSW
IFE PUSHSW,<
HELP: ASCIZ \
Legal commands are:
<SPACE>, <CR>, or Y Show the rest of this bulletin
<DEL> or N Skip this bulletin, go to the next one
B Back up one message
E or Q Quit this bulletin board, and go to the next one
H Show the header again
R Restart this bulletin board
X Exit BBOARD, skipping all remaining bulletin boards
\
>;IFE PUSHSW
;Matching targets for From:, Subject:, and Date: fields, and where to store
DEFINE FLDLST <
XX <Date:>,FLDDAT
XX <DATE:>,FLDDAT
XX <From:>,FLDFRM
XX <FROM:>,FLDFRM
XX <Sende>,FLDFRM
XX <SENDE>,FLDFRM
XX <Subje>,FLDSUB
XX <SUBJE>,FLDSUB
XX <Re:>,FLDSUB
XX <RE:>,FLDSUB
>;FLDLST
;Get the target table
DEFINE XX (STR,LOC) <
ASCII \STR\
>;XX
FIELDS: FLDLST ;Expand it
FLDNUM==.-FIELDS ;Length of this block
;The destination table
DEFINE XX (STR,LOC) <
LOC
>;XX
DEST: FLDLST ;Expand it
HEAD1+FLDNUM ;This is for when it is unknown
SWTTAB: TABTOP ;Switches to BBOARD
T <ACTION> ;Want file name output before reading
T <CHECK> ;Check if there are new messages
IFN FACSW,<
T <CLASS> ;Want the class bboard
>;IFN FACSW
T <DATE> ;Set the date and time
IFN FACSW,<
T <FACULTY>,.FAC ;Want the class bboard
>;IFN FACSW
T <FROM> ;See message from this time forth
T <LAST> ;Want to see the last message at least
T <MORE> ;Use more processing
T <NAME> ;Want the file name output at the start
IFN UTEXSW,< ;[UT-2]
T <NOMORE>,.SMORE ;[UT-2] Don't use more processing
>;IFN UTEXSW
T <PAUSE> ;Want to pause at the end of the bboards
T <SCROLL-MORE>,.SMORE ;Use scroll more
T <SECURE>,,.SECUR ;[UT-3] /SECURE switch
T <SET-TIME>,.DATE ;Set date and time
T <USE-TIME>,.FROM ;See messages from this time forth
TABBOT
PGMTAB: TABTOP ;Program name keyword table
T <BBOARD>,1
T <ERUN>,0
T <R>,0
T <REENTER>,0
T <RUN>,0
T <START>,0
T <TBBD>,1 ;For test purposes
T <TBBOARD>,1
TABBOT
;Define BBoard commands
;Macro to define a (1-character) BBoard command. SWITCH indicates
;whether or not to update time-last-read when the command is given.
DEFINE BBCMD (CHAR,ROUTINE,SWITCH) <
IFIDN <SWITCH>,<UPDATE>,<.UPD==-1>
IFDIF <SWITCH>,<UPDATE>,<.UPD==0>
RELOC CMD+CHAR ;Get to appropriate spot in CMD table
.UPD,,ROUTINE ;If uppercase letter, do same for lowercase
IFLE "A"-CHAR,<IFGE "Z"-CHAR,<BBCMD (CHAR!40,ROUTINE,SWITCH)>>
>;BBCMD
CMD: REPEAT .CHDEL,<CONFM> ;Reprompt on any command not define here
BBCMD .CHBSP,NOCR,UPDATE ;Backspace = skip message and update
BBCMD .CHLFD,CFMOK,UPDATE ;Linefeed = show message and update
BBCMD .CHCRT,OKSKLF,UPDATE ;Carriage return = eat lf, show msg, update
BBCMD .CHSPC,OKCR,UPDATE ;Space = show msg and update
BBCMD "?",HELPEM
BBCMD "E",DONEQ
BBCMD "Q",DONEQ
BBCMD "X",DONEX
BBCMD "Y",OKCR,UPDATE
BBCMD "N",NOCR,UPDATE
IFN PUSHSW,<
BBCMD "P",.PUSH
BBCMD "M",.MM
>;IFN PUSHSW
BBCMD "H",HEADER
BBCMD .CHCNR,HEADER
BBCMD "R",RESTRT
BBCMD "B",BACKUP
BBCMD "^",BACKUP
BBCMD .CHDEL,NOCR,UPDATE ;Delete = skip msg and update
RELOC CMD+200 ;Make sure we are at right spot
;Defaults for BBOARD file
SYSDAT: ASCIZ \POBOX:<SYSTEM>MAIL.IDX\ ;SYSTEM data file name
SYSBBD: ASCIZ \POBOX:<SYSTEM>MAIL.TXT\ ;SYSTEM BBOARD file name
DEFINE CTL (CHAR) <"CHAR"-100>
DEFINE BLKVT52 <BYTE (7) .CHESC,"K",0>
DEFINE BLKVT1 <BYTE (7) .CHESC,"[","K",0>
DEFINE BLKADM <-1,,[BYTE (7) CTL (M),.CHSPC,.CHSPC,.CHSPC,.CHSPC
BYTE (7) .CHSPC,.CHSPC,CTL (M),0]>
CLRLIN: 0 ;0 TTY 33
0 ;1 TTY 35
0 ;2 TTY 37
0 ;3 TI / Execuport
REPEAT ^D4,<0> ;4-7 reserved for customer
0 ;8 System default
0 ;9 Ideal
BYTE (7) CTL (^),0 ;10 VT05
BLKVT52 ;11 VT50
0 ;12 LA30
0 ;13 GT40
0 ;14 LA36
BLKVT52 ;15 VT52
BLKVT1 ;16 VT100
0 ;17 LA38
0 ;18 LA 120
REPEAT ^D16,<0> ;19-34 Reserved for customer
BLKVT1 ;35 VT125
BLKVT1 ;36 VK100
BLKVT1 ;37 VT102
BLKVT52 ;38 H19
BLKVT1 ;39 VT131
BLKVT1 ;40 VT200
REPEAT ^D10,<0> ;41-50 Reserved for customer
REPEAT ^D10,<0> ;51-60 Reserved for Digital
NCLRLN==.-CLRLIN
SAVLOC==. ;So we can bounce around the table
;Define a terminal type in the table
DEFINE TRMTYP (NUM,STR) <
RELOC CLRLIN+NUM ;;Go to the right position in the table
STR ;;And expand the string
>;TRMTYP
;Now expand the different terminal types for each location
IFN DREASW!ARMYSW,<
TRMTYP ^D4,BLKADM ;4 Adm-3A
TRMTYP ^D5,<BYTE (7) CTL (W),0> ;5 Datamedia
TRMTYP ^D6,BLKVT1 ;6 VT100 in native mode
TRMTYP ^D7,<BYTE (7) .CHESC,CTL (U),0> ;7 Concept 100
TRMTYP ^D19,<BYTE (7) "~",17,0> ;19 Hazeltine 1500
TRMTYP ^D20,<BYTE (7) .CHESC,CTL(U),0> ;20 Concept 100
TRMTYP ^D21,<BYTE (7) .CHESC,CTL(U),0> ;21 Concept 100
TRMTYP ^D22,<BYTE (7) 35,0> ;22 Datamedia 1520
TRMTYP ^D23,<BYTE (7) .CHESC,"T",0> ;23 SOROC IQ120
TRMTYP ^D24,<BYTE (7) .CHESC,113> ;24 HP26XX
TRMTYP ^D25,<BYTE (7) 26> ;25 VC404
TRMTYP ^D26,BLKVT1 ;26 WICAT/T7000
TRMTYP ^D27,BLKVT1 ;27 ANSII
TRMTYP ^D28,BLKADM ;28 R Adm-3A
TRMTYP ^D29,BLKVT1 ;29 S1-VT100
TRMTYP ^D30,BLKVT1 ;30 R1-VT100
TRMTYP ^D31,BLKVT1 ;31 R2-VT100
TRMTYP ^D32,BLKVT52 ;32 ADDS Viewpoint
TRMTYP ^D33,<-1,,[BYTE (7) "`","D","C","H","9"
BYTE (7) "9",";",0]> ;33 Tektronix 4025
TRMTYP ^D34,<BYTE (7) .CHESC,"T",0> ;34 Televideo 912
>;IFN DREASW!ARMYSW
IFN STANSW,<
TRMTYP ^D4,BLKADM ;4 Adm-3
TRMTYP ^D5,<BYTE (7) CTL (W),0> ;5 Datamedia
TRMTYP ^D6,BLKVT52 ;6 HP26XX
TRMTYP ^D7,<BYTE (7) "~",17,0> ;7 Hazeltine 1500
TRMTYP ^D20,<BYTE (7) .CHESC,"T",0> ;20 SOROC IQ120
TRMTYP ^D21,<BYTE (7) 34,0> ;21 Gillotine
TRMTYP ^D22,BLKVT52 ;22 Teleray 1061
TRMTYP ^D23,<-1,,[BYTE (7) "`","D","C","H","9"
BYTE (7) "9",";",0]> ;23 Tektronix 4025
TRMTYP ^D25,BLKVT52 ;25 Heath 19
TRMTYP ^D26,<BYTE (7) .CHESC,CTL(U),0> ;26 Concept 100
TRMTYP ^D27,<BYTE (7) .CHESC,"I",0> ;27 IBM3031
TRMTYP ^D28,<BYTE (7) .CHESC,"T",0> ;28 Televideo 912
TRMTYP ^D30,<BYTE (7) 35,0> ;30 Datamedia 1520
TRMTYP ^D31,BLKVT1 ;31 Ann Arbor Ambassador
TRMTYP ^D32,<BYTE (7) "~",17,0> ;32 Hazeltine Esprit
TRMTYP ^D33,<BYTE (7) .CHESC,"T",0> ;33 Freedom-100
TRMTYP ^D34,<BYTE (7) .CHESC,"T",0> ;34 Freedom-200
TRMTYP ^D41,BLKVT1 ;41 ANSI
TRMTYP ^D42,BLKVT1 ;42 Concept AVT
TRMTYP ^D43,BLKVT1 ;43 Concept GVT
>;IFN STANSW
RELOC SAVLOC ;Go back to the right place in compilation
;Entry to BBOARD
;Entry vector
EVEC: JRST START ;Normal entry
JRST START ;Reenter entry
BYTE (3) VWHO (9) VMAJ (6) VMIN (18) VEDIT ;Version
JRST SYSMSG ;Show system messages
JRST SYSALL ;Show all system messages
EVECL==.-EVEC
;This entry point is only done by the system when a new user logs on for
;the first time. Must clear the old user's date/time
SYSALL: SKIPA A,[1] ;Show all system messages (can't be 0)
;Normal system message entry point
SYSMSG: SETO A, ;Show normal system messages
MOVEM A,NEWTIM ;Remember which
IFE SMSGSW,<
MOVX F,F%SYS ;Say we want the system msgs
>;IFE SMSGSW
IFN SMSGSW,<
IFE ENDMSW,<
MOVX F,F%SYS!F%NAM!F%SCMR!F%SECU ;We want the system messages (special mode)
>;IFE ENDMSW
IFN ENDMSW,<
MOVX F,F%SYS!F%NAM!F%SCMR!F%PAUS!F%SECU
;If want ending message, be sure to pause
>;IFN ENDMSW
>;IFN SMSGSW
JRST GO
;Normal entry point
START: SETZ F, ;Clear flags
SETOM NEWTIM ;No new time specified yet
GO: RESET% ;Traditional, true?
MOVE P,[IOWD PDLL,PDL] ;Set stack up
CALL INIT ;Do intializations
TXNN F,F%SYS ;Don't rescan if for SYSTEM:
CALL RESCAN ;Rescan command line for date/time
;Loop for each bboard
DOBBDS: SETZ BBN, ;Start off with first
NXTBBD: CALL DOBBD ;Go do the next bboard
TXNE F,F%EXIT ;Done with everything
JRST BYE ;Yes
SKIPN BBOFIL+1(BBN) ;Is there another bboard?
JRST BYE ;No, then give it all up
TXNE F,F%MSGB ;Yes, did we show something
CALL OCRLF ;Yes, go to a new line
AOJA BBN,NXTBBD ;Go on to next bboard
;DOBBD - Get the bboard BBN
DOBBD: CALL BBDINI ;Initialize for this bboard
CALL OPNDAT ;Open the data file, A <- JFN
IFNSK.
CALL DATFAI ;Exit on errors
JRST DOBBDX ;But be sure to clean up
ENDIF.
CALL GTDATU ;Get the dates for this user
CALL CPFTIM ;Compare file times
JRST DONEMG ;File was too old (or error)
CALL OPNBBD ;Open bboard file
JRST DOBBDX ;It didn't open
DOMSGS: CALL DOMSG ;Do the next message
SKPA ;If have more to do...
JRST DOMSGS ;Do them
TXNE F,F%CHK ;If we're checking
JRST DOBBDX ;Then we're done
TXNN F,F%ERR ;In case of error
TXNE F,F%MSGB ;Or he saw some messages
SKPA ;Then done with this bboard
TXNN F,F%LAST ;Or if he didn't want last msg
JRST DONEMG ;Then done with this bboard
TXO F,F%MSGB ;Say you have seen some
CALL LAST ;So you can back up to last one
JHLT ;In case of error, stop
JRST DOMSGS ;Loop for next message
JHLT ;If can't find it, just halt
DONEMG: TXNN F,F%QUIT ;Did he quit?
CALL ENDMSG ;No, so show a message
DOBBDX: CALL CLNUP ;Close open files and such
RET ;Done with this bboard
;OPNDAT - Open the data file
;Returns +2, successful with JFN of data file in A
; +1 if not
OPNDAT: SKIPE A,BBDFIL(BBN) ;If we have jfn on data file,
JRST OPNDA1 ;Go open it
HRRZ B,BBOFIL(BBN) ;Get the JFN of the bboard file
JUMPE B,OPNDA0 ;If nothing there, go around
HRROI A,CURFIL ;Create a subname of the file
MOVX C,FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!FLD(.JSAOF,JS%NAM)!JS%PAF
JFNS% ;Output all but the extension
ERJMP R ;Failed, say so
HRROI B,[ASCIZ \.IDX\] ;Want to add the extension
SETZ C,
SOUT%
IDPB C,A ;Make sure it's null terminated
MOVX A,GJ%SHT!GJ%OLD ;Short form, old file
HRROI B,CURFIL ;Point to the name we made
GTJFN% ;Try to get a JFN on it
IFNJE.
MOVEM A,BBDFIL(BBN) ;If we win, save it away
JRST OPNDA1 ;And go on
ENDIF.
OPNDA0: MOVX A,GJ%OLD!GJ%SHT ;Try to get data file
HRROI B,DEFDAT ;Use the default data file name
TXNE F,F%SYS ;If wants SYSTEM bboard,
HRROI B,SYSDAT ;Give it
GTJFN%
RET ;Take the error return
OPNDA1: MOVX B,FLD(^D36,OF%BSZ)!OF%RD!OF%WR!OF%THW
;Want to read and write it in Thawed mode
OPENF%
RET ;Take the error return
HRRZM A,DJFN ;Stores the JFN for DATA file here
RETSKP ;Other take the normal exit
;GTDATU - Get the dates for this user
;Maps in the page of the data file that contains dates for this user
;Returns X/ first of the two word date field
GTDATU: GJINF% ;Get dir number
TLZ A,-1 ;I said dir number...
;;;Fix this to use the real operator number!
CAIN A,5 ;If it's operator,
HALTF% ;Don't bother (continue if really wanted)
IDIVI A,1000 ;Calculate page no and index
PUSH P,A
ADDI A,MMRPAG ;Offset to MM IDX file date
MOVE X,DATPAG ;Page to use
LSH X,^D9
ADDI X,(B) ;X/ address of d&t of last bboard read time
HRL A,DJFN ;Map in that page
MOVE B,DATPAG ;Map in that page to here
HRLI B,.FHSLF
MOVX C,PM%RD!PM%WR
PMAP%
HRRS PG.RD(X) ;Make sure it exists
POP P,A
ADDI A,MMWPAG ;Add the offset for the write time
HRL A,DJFN ;Map in that page
MOVE B,DATPG1 ;Map in that page to here
HRLI B,.FHSLF
MOVX C,PM%RD!PM%WR
PMAP%
HRRS PG.WRT(X) ;Make sure it exists
MOVE A,NEWTIM ;If the user specified to use a new-time
CAMN A,[-1] ;If not -1, then specified
RET ;Otherwise exit now
MOVEM A,PG.RD(X) ;Else set file and msg times
MOVEM A,PG.WRT(X) ;To what he wants
RET ;Then return
;CPFTIM - Compare times of access with times of file
;Takes INTTIM/ -1 or time input by user
; PG.RD(X) and PG.WRT(X)/ last access times
; BBOFIL(BBN)/ if <> 0, bboard JFN
;Returns +1, nothing to read
; +2, something to read
; IJFN/ JFN of bboard file
; FDB+.FBWRT/ file write date
CPFTIM:
IFE OLDSW,< ;If wants only msgs in last month
SKIPL A,INTTIM ;If no initial time given
IFSKP.
MOVE A,PG.RD(X) ;Get his old time
CAMGE A,LNGAGO ;OK if more recent than 1 month
MOVE A,LNGAGO ;Otherwise use 1 month ago
ENDIF.
>;IFE OLDSW
IFN OLDSW,<
SKIPGE A,INTTIM ;If no initial time given
MOVE A,PG.RD(X) ;Use previously stored time
>;IFN OLDSW
MOVEM A,OLDTIM ;To compare with new times
SKIPE A,BBOFIL(BBN) ;If we already have jfn on bboard file,
JRST CPFTI1 ;Don't need another
MOVX A,GJ%OLD!GJ%SHT ;Try to get at mail file
HRROI B,DEFBBD ;Use the default name
TXNE F,F%SYS ;If wants SYSTEM bboard
HRROI B,SYSBBD ;Give it to him
GTJFN%
RET ;No file or something, fine
IFN SMSGSW,<
TXNN F,F%SYS ;Don't set default if system bboard
>;IFN SMSGSW
TXO F,F%DEF ;Say it is default bboard
CPFTI1: HRRZM A,IJFN ;Save JFN
MOVSI B,.FBLEN ;Get date of last write of mail file
MOVEI C,FDB
GTFDB%
ERJMP R ;Go back +1 if we failed
MOVE T,FDB+.FBWRT ;Pick up the write date and time
IFN NEWRSW,<
SKIPN OLDTIM ;Check for new readers
CALL NEWRDR ;And handle them
>;IFN NEWRSW
TXNE F,F%ACT ;want filename printed on reading start?
CALL PRTNAM ;Print the name of the bboard
SKIPGE INTTIM ;Initial time given?
IFSKP.
CAMLE T,INTTIM ;Yes, compare to that, instead
AOS (P) ;If not too old, do good return
RET ;File too old, just be done with it
ENDIF.
MOVE A,OLDTIM ;Get the old time
SKIPE PG.WRT(X) ;If no entry, then assume read
CAMLE A,PG.WRT(X) ;Greater than last write?
MOVEM A,PG.WRT(X) ;Update the last write
CAMG T,PG.WRT(X) ;Get file if not too old
TXNE F,F%LAST ;If /LAST, get file even if too old
AOS (P) ;Take good skip return
RET ;File too old, just be done with it
;OPNBBD - Open the BBOARD file
;Takes IJFN/ bboard file's JFN
;Returns +1, an error happened
; +2, no error, file opened
OPNBBD: MOVE A,IJFN ;Get input JFN
MOVX B,FLD(7,OF%BSZ)!OF%RD!OF%PDT ;Don't update the read date
OPENF%
ERJMP OPNERR ;In case of error during opening BBD
;Check to make sure file is a good one
HRLZ A,IJFN
FFUFP%
IFJER.
CAIE A,FFUFX3 ;In case of error
CALLRET PRSFAI ;Not an empty file, complain
RET ;But if empty, just exit without complaining
ENDIF.
TRNN A,-1
IFSKP.
HRROI A,[ASCIZ \Text does not start on first page of file\]
ESOUT%
RET ;Take the error return
ENDIF.
CALLRET MAPTXT ;Map in the .TXT file
;OPNERR - Check out error during opening of BBD file
;Takes IJFN/ BBoard file's JFN
;Returns +1, Real error
; +2, File was deleted and permanent (like a mail file), then do
OPNERR: MOVE A,IJFN ;Pick up JFN
MOVE B,[1,,.FBCTL] ;In FDB, get descriptor bits
MOVEI C,T ;Store result here
GTFDB%
ERJMP OPNER1 ;If this fails, just report open err
TXC T,FB%PRM!FB%DEL ;Look for perm, deleted file
TXNN T,FB%PRM!FB%DEL
RET ;Deleted and permanent. Then done without error
OPNER1: HRROI A,[ASCIZ \Can't OPEN the bboard mail file\]
CALLRET ESOERR ;Take the error return
;MAPTXT - Maps the text file into core
;Returns +1, failure
; +2, success
MAPTXT: LOAD A,FB%PGC,FDB+.FBBYV ;Page count
MOVEM A,TXTPGS
HRRZ A,IJFN ;Make sure file long enough
FFFFP%
HRRZS A
CAMLE A,TXTPGS ;Take the bigger count
MOVEM A,TXTPGS
MOVEI A,^D36 ;Bits per word
LOAD B,FB%BSZ,FDB+.FBBYV ;Bits per byte
CAIG B,^D36
IFSKP.
HRROI A,[ASCIZ \BBoard file has bad byte size\]
JRST ERROUT
ENDIF.
SKIPN B ;Don't zerodivide
SKIPA A,[1]
IDIVI A,(B) ;Bytes per word
MOVE B,FDB+.FBSIZ ;Calculate CEILING(bytes/bytes per word)
IDIVI B,(A)
MOVEM B,TXTEOF
ADDI B,777 ;Get the page count we will actually use
LSH B,-9
CAMG B,TXTPGS ;Check number of pages for consistency
IFSKP.
HRROI A,[ASCIZ \BBoard size in bytes won't fit in page count\]
JRST ERROUT
ENDIF.
MOVEM B,TXTPGS
MOVEI A,1000 ;Check for enough space
SUB A,TXTPAG
CAMLE A,TXTPGS
IFSKP.
HRROI A,[ASCIZ \BBoard file too big\]
JRST ERROUT
ENDIF.
GOTCOR: HRLZ A,IJFN ;Map in the text file
MOVE B,TXTPAG
HRLI B,.FHSLF
MOVE C,TXTPGS
TXO C,PM%CNT!PM%RD
PMAP%
MOVE A,TXTPAG ;Init TXTPTR
LSH A,^D9
XMOVEI A,(A) ;Offset end of file pointer according to
ADDM A,TXTEOF ;Global address of TXTPAG
HRLI A,(<POINT 7,0>)
MOVEM A,TXTPTR
SETZM EOF ;Not at end of file
RETSKP ;Skip return if no error
;BBDINI - Initialize for a new BBoard file
;Clears message count, all flags, back pointers.
BBDINI: SETZM MSGCNT ;Clear the count of messages
TXZ F,F%DEF!F%MSGB!F%ERR!F%QUIT!F%1ST
;Say it isn't default bboard
;Clear the flag for this file
; saying nothing has been shown
;Say no error
;Say he hasn't quit
;Say haven't seen first msg
; CALLRET BAKCLR ;Clear the back pointers and exit
;BAKCLR - Clear the back pointer array for this bboard
BAKCLR: SETOM BAKPTR ;Set them to -1
MOVE A,[BAKPTR,,BAKPTR+1] ;Set to BLT
BLT A,BAKPTR+BAKMAX-1 ;Set them all to -1
MOVEI A,BAKMAX-1 ;Start off at the top and count down
MOVEM A,BAKCNT ;Set the counter to point at top
RET
;DOMSG - Handle the next message
;Takes IJFN (or TXTPTR)/ pointer to message about to be parsed. Pointing right
; at normal TOPS-20 MM-type header (date,time,count,flags)
DOMSG: CALL SAVBAK ;Save the pointer for backing up
RET ;Error during RFPTR
AOS MSGCNT ;Increment message count
CALL PRSMSG ;Go parse the message
RET ;Error during Parsing
RET ;Done with messages
CALL CHKMSG ;Check to see if to show or not
IFNSK.
CALL SKPMSG ;Do not show
RET ;Strange error
RETSKP ;Go to next
ENDIF.
IFXN. F,F%CHK ;Check for new messages?
HRROI A,[ASCIZ \[New mail in bboard:\]
CALL TYPNAM
MOVEI A,"]"
PBOUT%
CALL OCRLF
RET
ENDIF.
TXZ F,F%ERR ;Clear out any error flag
CALLRET SHOWIT ;Show it to user
;PRSMSG - Parse a message
;Returns +1, parse error
; +2, EOF
; +3, Success, DAT/ date
; T/ length
; B/ flag bits
PRSMSG: SETZ B, ;Parse standard format time
MOVE A,TXTPTR ;Get the pointer to the text
CALL INTIME ;Go read the time
IFNSK.
SKIPE EOF ;On an error, check for EOF
JRST RET2 ;EOF is ok. Do skip return
JRST PRSFAI ;Not EOF, must be garbage
ENDIF.
MOVEM B,DAT ;Save date&time of this msg in dat
MOVEI C,^D10 ;Parse length of message
CALL NUMIN ;Get a number from the file (NIN)
JRST PRSFAI
MOVEI T,(B) ;Save length in t
MOVEM T,MSGLEN ;Save length of msg
MOVEM T,HDCNT ;Save this as head count in case EOH not found
MOVEI C,(T) ;Check if count puts us beyond eof
IDIVI C,5 ;Number of words in msg
MOVEI D,TXTPTR ;File pointer
ADDI D,(C)
CAMG D,TXTEOF
IFSKP.
HRROI A,[ASCIZ \Message extends beyond end of file\]
JRST ERROUT
ENDIF.
MOVEI C,^D8 ;Parse flag bits
CALL NUMIN ;Get number from the file
IFNSK.
CAIE C,IFIXX3 ;If the 400000,,000000 bit isn't set
JRST PRSFAI ;It's an error
ENDIF.
MOVEM A,TXTPTR ;Save the pointer to the text
JRST RET3 ;Normal exit
;CHKMSG - Decide if to skip or show message
;Takes B/ MM Flag bits DAT/ message's date/time
;Returns +1, message not to be shown
; +2, message to be shown
CHKMSG: TRNE B,2 ;If deleted message
RET ;Skip over msg
TXNN F,F%MSGB ;If msgs already seen
CAMLE DAT,OLDTIM ;Or if after initial or stored time
AOS (P) ;Show all (skip return)
RET
;SKPMSG - Skip over the message
;Takes T bytes to skip
;Returns +1, error
; +2, all ok
SKPMSG: MOVE B,TXTPTR ;Get the file/core pointer
MOVEI A,(T) ;Increment by byte count
ADJBP A,B ;Adjust the byte pointer from B
MOVE B,A ;Restore into B
MOVEM B,TXTPTR ;Set the file/core pointer
RETSKP ;And try the next msg
;SHOWIT - Show the message
;Takes IJFN or TXTPTR/ pointer to just after the date/byte count/flags line
; T/ number of bytes in the message
;Returns +2, Go on to next message
; +1, exit this bboard
SHOWIT: CALL SHOINI ;Initialize
CALL GTHEAD ;Get the header
JRST NOHEAD ;If it fails, show the entire thing
CALL GTFLDS ;Get the fields from the header
IFNSK.
NOHEAD: TXNE F,F%ERR ;If an error,
RET ;Then take error return. Else
MOVE B,HDRPTR ;Show the entire header
;HDCNT contains the entire header
JRST SHOWI1
ENDIF.
HRROI B,HEAD1+FLDNUM ;Show the interesting stuff
SHOWI1: MOVEM B,SAVHD ;Save the header for showing again
CALL OUTON ;Turn off ^O
MOVEI A,5 ;Say to check for 5 lines
IFE UTEXSW,< ;[UT-2] We don't like this
CALL MORCHK ;Go do it
>;IFE UTEXSW
IFN WHITSW,<
CALL OCRLF ;Make sure to have a blank line
>;IFN WHITSW
MOVEI A,.PRIOU ;Output to primary output
MOVE B,SAVHD ;Restore header
MOVE C,HDCNT ;No more than this to show
SETZ D, ;Don't stop for any byte but null
SOUT% ;Show the header
CALL CONFM ;What does he want to do?
RET ;Exit the bboard
JRST RET2 ;Go on to next
JRST [MOVE B,SAVHD ;Reshow header
JRST SHOWI1]
TXNE F,F%MORE ;Want more processing?
TXNE F,F%SCMR ;Yes, want scroll more?
SKPA ;Yes
CALL $BLANK ;Here if more and not scroll, clear screen
MOVE C,MSGLEN ;Number of characters in entire msg
SUB C,HDCNT ;Minus number of characters in header
MOVEI A,.PRIOU ;Output to the primary output
MOVE B,T ;Pick up the pointer to the body
MOVN C,C ;Now make count negative for byte count
SKIPN C ;Have some characters to print?
IFSKP. ;Yes
IFXN. F,F%MORE ;Want more processing?
CALL MORE ;Yes, do "sout" with more processing
ELSE.
SOUT% ;Else do it the boring way
ENDIF.
ENDIF.
TXNE F,F%QUIT ;Want to exit?
RET ;Yes, make sure we do
JRST RET2 ;Otherwise go to the next message
;MORE - routine to do "sout" with unix-style more processing
;Takes: B/ pointer to source string
; C/ number of characters in string
;Returns: +1 always
MORE: ACVAR <SRC,COUNT,COLCNT,LINCNT>
MAKPTR B ;Make sure it's a byte pointer
MOVEM B,SRC
SKIPG C
MOVMS C ;Make positive
MOVEM C,COUNT
MOVEI A,.PRIOU ;Get tty designator
RFPOS% ;Read row,,column
HRRZM B,COLCNT ;Put column position in counter
HLRZM B,LINCNT ;Put row position in counter
MORE0: MOVE A,SRC ;Get pointer at input buffer
MOVE B,COUNT ;Get character count
CALL GETLIN ;Try to get a line of text
RET ;Couldn't, so quit
MOVEM B,COUNT ;Save updated char count
MOVEM A,SRC ;Save updated pointer
AOS LINCNT ;Bump lines-printed count
IFE UTEXSW,<
CAMLE LINCNT,NLINES ;Printed enough lines?
IFSKP. ;No
>;End of IFE UTEXSW
HRROI A,LINBUF
CALL PRTLIN ;Dump the line out
JRST MORE0 ;And go for more
IFE UTEXSW,<
ENDIF.
>;END of IFE UTEXSW
CALL MORPMT ;Prompt "More?"
IFNSK.
CALL BLKLIN ;Make sure to clear the line
RET ;Didn't want more
ENDIF.
IFXN. F,F%SCMR
CALL BLKLIN
ELSE.
CALL $BLANK ;Blank screen
ENDIF.
SETZM LINCNT ;Say we are at top of screen
HRROI A,LINBUF
CALL PRTLIN ;Dump the line out
AOS LINCNT
JRST MORE0 ;Go for more
ENDAV.
;GETLIN - get a line of characters to print into LINBUF
;Takes: A/ pointer to text buffer
; B/ count of characters remaining in string
;Returns: +2 if successful, +1 if not
; B/ updated count of characters remaining in string
GETLIN: SAVEAC <E>
MOVE E,B
SKIPG E ;Any characters left?
RET ;Nope, non-skip return
MOVE B,[POINT 7,LINBUF] ;Point to destination buffer
MOVE D,NCOLS
SOS D ;D now counts down to 0 for EOL
GETLN0: ILDB C,A ;Get character
SKIPE C
IFSKP.
SETZM E ;Say no more chars left
JRST GETLN1 ;Quit if we hit a null
ENDIF.
IDPB C,B ;Put it in output
CAIE C,.CHCRT ;Is it CR?
IFSKP.
IBP A ;Advance over presumed LF
MOVEI C,.CHLFD ;Presume it into output
IDPB C,B
SUBI E,2 ;Account for characters read
JRST GETLN1 ;Exit from GETLIN
ENDIF.
SOSG D ;Bump off another column
IFSKP. ;More left?
SOSLE E ;Haven't exhausted buffer
JRST GETLN0 ;Loop back for them or EOL
ELSE. ;Nope, no more left
SOS E
ENDIF.
;Here to punt - we hit EOL or EOF or something
GETLN1: SETZ C, ;Mark off that we ate another char
IDPB C,B ;Tie off return string
MOVE B,E ;Restore updated count
RETSKP
PRTLIN: PSOUT%
RET
;Prompt with "More?" at bottom of screen
;Returns: +2 if user wants next screen, +1 to skip to next message
MORPMT: CALL OUTON ;Turn on output
MOVEI A,.CTTRM ;For our terminal
RFMOD% ;Get the terminal mode
MOVEM B,SAVMOD ;And save it
TXZ B,TT%DAM!TT%PGM ;Want binary mode
SFMOD% ;Set it
STPAR%
MOVEI B,.MOXOF
MOVEI C,.MOOFF
MTOPR%
MOVEI A,.PRIOU ;Start on a fresh line
RFPOS% ;If not already
TXNE B,.RHALF
CALL OCRLF
MORPM0: HRROI A,[ASCIZ/More? /]
CALL PRTLIN
MORPM1: MOVEI A,.PRIIN ;For our terminal
CFIBF% ;Clear the input buffer
PBIN% ;Snarf a char
ANDI A,177 ;Just in case parity or 8-bit
CAIN A,.CHSPC ;Space?
JRST MRETSK ;Next screenful
CAIN A,.CHCRT ;CR?
JRST MRETSK ;Next screenful
CAIE A,"?" ;'?'
IFSKP. ;Print short help text
IFN PUSHSW,<
HRROI A,[ASCIZ \
Type <SPACE> or <CR> to continue reading this message
Q, N, or <DEL> to skip to next message
X to exit all bboards
H to display header again
P to Push to a new Exec
\]
>;IFN PUSHSW
IFE PUSHSW,<
HRROI A,[ASCIZ \
Type <SPACE> or <CR> to continue reading this message
Q, N, or <DEL> to skip to next message
X to exit all bboards
H to display header again
\]
>;IFE PUSHSW
PSOUT% ;Don't use TMSG because of <>'s
JRST MORPM0 ;Loop back
ENDIF.
CAIL A,"a"
CAILE A,"z"
SKPA
TRZ A,40 ;Uppercase lowercase letters
CAIN A,"Q" ;Quit?
JRST MRET ;Non-skip return
CAIN A,"Q"-100 ;Check for real losers (^Q)
JRST MRETSK
CAIN A,"N"
JRST MRET
CAIN A,.CHDEL ;Delete?
JRST MRET ;Yes, synonym for "N"
CAIE A,"X" ;Exit all bboards?
IFSKP. ;Yes...
TXO F,F%QUIT!F%EXIT ;Say we want to quit and exit
JRST MRET ;And go back
ENDIF.
IFN PUSHSW,<
CAIE A,"P" ;Push?
IFSKP.
PBOUT% ;Yes, output the char first
CALL MRET ;Restore terminal mode
CALL .PUSH ;Do the push
NOP ;Account for multiple returns
NOP
NOP
JRST MORPMT
ENDIF.
>;IFN PUSHSW
CAIE A,"H" ;Want to see the header again?
IFSKP. ;Yes...
TMSG <
> ;Start off with a CRLF
CALL MRET ;Restore terminal mode
MOVEI A,.PRIOU ;To the terminal
MOVE B,SAVHD ;Get the pointer to the header
MOVE C,HDCNT ;How many words we can handle
SETZ D, ;Stop on null
SOUT% ;Output it
TMSG <
>
JRST MORPMT ;Prompt again for more
ENDIF.
MOVX A,.CHBEL ;Beep the loser
PBOUT%
JRST MORPM1 ;Go for anohter char
MRETSK: AOS (P) ;Skip return
MRET: MOVEI A,.CTTRM ;Non-skip return
MOVEI B,.MOXOF
MOVEI C,.MOONX
MTOPR%
MOVE B,SAVMOD ;Get our terminal mode again
STPAR%
SFMOD%
RET
;SHOINI - Initialize to show the message
;Takes T/ number of bytes in msg
;Returns T/ start of msg, W/ where HEAD is stored
SHOINI: ADJBP T,TXTPTR ;Update TXTPTR to point after this message
EXCH T,TXTPTR ;Save it away and get pointer to this msg
MOVEM T,MSGPTR ;Save this pointer
TXO F,F%MSGS!F%MSGB ;Set this flag each new msg
TXOE F,F%1ST ;First message for this bboard?
RET ;No - skip all this
MOVE A,BAKCNT ;Pick up index to bakptr
MOVE A,BAKPTR(A) ;Pick up byte count
MOVEM A,STRTPT ;Save the starting point
MOVE A,MSGCNT ;Save the message count here
MOVEM A,STRTCN
TXNE F,F%ACT ;say /ACTION?
CALL OCRLF ;Yes, get back to margin
IFXN. F,F%NAM ;Say /NAME?
CALL OUTON ;Make sure we see the banner
MOVEI A,4 ;Say to check for 4 lines
CALL MORCHK ;Go do it
CALL OCRLF ;With a separator line
HRROI A,[ASCIZ \Messages from:\] ;Yes, type it then
CALL TYPNAM ;And the file name (if one specified)
CALL OCRLF
ENDIF.
RET
;GTHEAD - Process the header
;Count characters in header while looking for the end (first blank line)
;Takes T/ start of header, W/ where to store the header
; MSGLEN/ total length
;Returns +1, error
; +2, header where W pointed to
; T/ after header
; HDCNT/ number of characters in header
GTHEAD: MOVEM T,HDRPTR ;Save pointer to header
MOVEI C,1 ;Count the chars in head
SETZ V, ;Say previous char was not LF
HEADLP: CAMN C,MSGLEN ;In case no blank line at all
RET ;If we run out, go on
ILDB U,T
CAIN U,15 ;<CR>?
CAIE V,12 ;Yes, after <LF>?
SKIPA V,U ;No, Set V to this char for next loop
JRST PARSHD ;Found blank line, exit
AOJA C,HEADLP ;Count the chars in head
PARSHD: ILDB U,T ;Snarf up <LF>
CAIE U,12 ;It had better be a LF!
CALLRET PRSFAI ;If not, complain and take error exit
ADDI C,1 ;Add 1 for the LF
MOVEM C,HDCNT ;Count of chars in header
RETSKP
;GTFLDS - Get the fields from the header
;Returns +1, can't get the header set up right (so show all)
; +2, all ok HEAD1+FLDNUM/ pointer to header info
GTFLDS: CALL GTFLDI ;Do initialization
FLDLP: CALL FLDNAM ;Get the field name before the :
IFNSK.
TXZE F,F%ERR ;Whoops, was it real error?
RET ;Yes, so act as if no header
SKIPE NUMCHR ;Is there more to the header?
JRST FLDLP ;Yes, go to next line
JRST FLDEND ;No, just ran out
ENDIF.
JUMPE C,FLDLP ;If nothing else on line, forget this one
CALL FLDMAT ;Go match up that field
CALL FLDVAL ;Get the value for the field (after :)
RET ;In case of error, act as if no header
SKIPE FLDSUB ;Check wheter we have SUBJECT:
SKIPN FLDDAT ;And DATE:
JRST NOFLDS ;Not yet, try for more
SKIPE FLDFRM ;And FROM:
CALLRET GOTFLD ;Have all fields, will process them
NOFLDS: ILDB E,A ;Pick up the LF at end
CAIE E,.CHLFD ;Check to make sure LF
CALLRET PRSFAI ;Ooops....
JRST FLDLP ;Try for more
;We ran out of header without finding all fields. Maybe enough?
FLDEND: SKIPE FLDDAT ;Did we get date
SKIPN FLDFRM ;And sender? Maybe no subject?
RET ;We failed to find all!
CALLRET GOTFLD ;Found enough
;GTFLDI - Initialization for GTFLDS
;Takes HEAD/ header part
; HDCNT/ number of chars in it
;Returns CURPOS/ pointer to start of the header
; NUMCHR/ number of characters in the header
; FLDDAT, FLDFRM, and FLDSUB/ 0
GTFLDI: MOVE A,HDRPTR ;Set A to point to beginning of header
MOVEM A,CURPOS ;Save so we always know where we were
MOVE C,HDCNT ;# of chars in header
MOVEM C,NUMCHR ;Save this
SETZM FLDDAT ;Clear first word of fields
SETZM FLDFRM ;So we know when they're filled
SETZM FLDSUB
RET
;FLDNAM - Get a field name (the stuff before the :) in the header
;Takes CURPOS/ start of the line
; NUMCHR/ number of characters left in the header
;Returns +1, line is not as expected (possible error flag)
; +2, Success, HEAD1+FLDNUM/ with line up to :
; C is non-zero if : was found on the line
;Have to do all this in case each line doesn't have a colon
FLDNAM: MOVE A,CURPOS ;Restore where we start
HRROI B,HEAD1+FLDNUM ;Gets Date: or whatever
MOVEI D,.CHLFD ;Grab next line
MOVE C,NUMCHR ;Count of characters left
JUMPE C,NERRET ;In case no chars left, go back +1
SIN% ;Grab the line
ERJMP ERRRET ;An error?
MOVEM A,CURPOS ;Save A
MOVE A,NUMCHR ;Pick up old count
SUBI A,(C) ;Get the characters read
MOVEM C,NUMCHR ;Save C
MOVEI C,(A) ;The number of characters read
HRROI A,HEAD1+FLDNUM ;Read from the line just grabbed
HRROI B,HEAD1+FLDNUM ;Output to here
;Note that we are now just scanning until the :
;The end of the this patch (mostly)
MOVEI D,":" ;Grab up to :
SIN% ;Grab the string to :
ERJMP ERRRET ;Give up on errors
JUMPN C,RET2 ;If was a colon, take normal skip rtn
NERRET: TXZA F,F%ERR ;Otherwise take non-skip rtn but no error
ERRRET: TXO F,F%ERR ;On an error set flag
RET ;And return
;FLDMAT - Find the match to the field
;Takes HEAD1+FLDNUM/ string with the field name
;Returns HEAD1(G)/ matching field
FLDMAT: MOVE E,HEAD1+FLDNUM ;Pick up first word
SETZ G, ;Will look through for possible fields
CAME E,HEAD1(G) ;Look until equal
;Note that this terminates when FIELDS+F = HDTMP
AOJA G,.-1 ;Keep looping
RET
;FLDVAL - Get the value after the colon
;Takes A/ pointer to just after the colon
; C/ count of characters left in the line
; DEST(G) where to store the value (as a string)
;Returns +1, give up on doing header
; +2, good value with value at DEST(G)
FLDVAL: MOVE B,A ;Save the byte pointer
ILDB E,A ;Check next byte
SOJE C,RET1 ;Quit if end
CAIE E,.CHTAB ;Flush tabs
CAIN E,.CHSPC ;and blanks
JRST FLDVAL
MOVE A,B ;Restore the byte pointer
ADDI C,1 ;Readjust counter too
HRRO B,DEST(G) ;Pick up the destination according to field
SKIPE (B) ;Have we already gotten this?
HRROI B,HEAD1+FLDNUM ;Yes. Maybe Sender and From or just messed up
;In any case, don't overwrite
MOVEI D,.CHCRT ;Stop at a CR
SIN% ;Grab another string
ERJMP RET1 ;Give up if it fails
SETZ E, ;Want to terminate string with null
DPB E,B ;So overwrite last byte (CR)
RETSKP
;GOTFLD - Builds the summary line beginning at HEAD1+FLDNUM
;Takes FLDDAT, FLDFRM, FLDSUB/ where those fields begin
;Returns HEAD1+FLDNUM/ concatenated string.
GOTFLD: ACVAR <PTOT>
SETZ PTOT, ;An accumulator
IFN SHDRSW,<
HRROI A,[ASCIZ \Date: \]
HRROI B,HEAD1+FLDNUM ;Output it to here
SETZ C, ;Will transfer all of date
SIN%
JHLT
>;IFN SHDRSW
HRROI A,FLDDAT ;Start off with date
IFE SHDRSW,<
HRROI B,HEAD1+FLDNUM ;Output it to here
>;IFE SHDRSW
SETZ C, ;Will transfer all of date
SIN%
JHLT ;This shouldn't fail
IFE SHDRSW,<
PUSH P,B
HRROI B,FLDDAT ;Pointer to the date
CALL SUBBP
IDIVI A,10
AOS A
IMULI A,10
MOVE PTOT,A
POP P,B
MOVEI G,.CHTAB ;Use a tab between fields
IDPB G,B ;Write it out
>;IFE SHDRSW
IFN SHDRSW,<
HRROI A,[ASCIZ \
From: \]
SIN%
JHLT
>;IFN SHDRSW
HRROI A,FLDFRM ;Now give who from
SIN%
JHLT
IFE SHDRSW,<
PUSH P,B
HRROI B,FLDFRM
CALL SUBBP
ADD PTOT,A
MOVE A,PTOT
IDIVI A,10
AOS A
IMULI A,10
MOVE PTOT,A
MOVEI A,.NULIO
HRROI B,FLDSUB ;Subject
SETZB C,D
SOUT%
JHLT
MOVE A,B
HRROI B,FLDSUB
CALL SUBBP
ADD PTOT,A
POP P,B
CAIG PTOT,^D72
IFSKP.
MOVE A,B
IFN WHITSW,<
FMSG <
> ;DREA wants the extra space on the left
>;IFN WHITSW
IFE WHITSW,<
FMSG <
>
>;IFE WHITSW
MOVE B,A
ELSE.
IDPB G,B ;Only drop in the tab if on the same line
ENDIF.
>;IFE SHDRSW
IFN SHDRSW,<
HRROI A,[ASCIZ \
Subj: \]
SIN%
JHLT
>;IFN SHDRSW
HRROI A,FLDSUB ;And the subject field
SIN%
JHLT
RETSKP ;Now go print this out
ENDAV.
;CONFM - Tell the user how long the msg is and process his response
;Returns +1, an error occured (with error flag set) or
; user wants to quit (with F%QUIT set)
; +2 user wants to skip the message
; +3 user wants to see the header again
; +4 user wants to see the message
CONFM: TMSG <
(>
MOVEI A,.PRIOU ;To the terminal
MOVE B,MSGLEN ;How long the message is
SUB B,HDCNT ;But make it how long the text is
MOVEI C,^D10 ;Radix decimal
NOUT% ;Output it
CAI
TMSG < chars; more?) >
MOVEI A,.PRIIN
CFIBF% ;Clear the input buffer
PBIN% ;Input the char
MOVE B,CMD(A) ;Pick up the command to do
TLNE B,-1 ;Left half negative for update, else zero
CALL SAVDAT ;Update the date of last message seen
JRST (B) ;Go execute the code for it
;Routines for handling responses to MORE?
;See CONFM for exit details
;For <CR>
OKCR: CALL OUTON
CALL OCRLF
; JRST CFMOK
;For blank
CFMOK: MOVEI A,.PRIIN ;Pretend to be one line lower so
RFPOS% ;That the next header won't scroll
IFE SHDRSW,<
ADD B,[(1)] ;Part of the message off the screen
>;IFE SHDRSW
IFN SHDRSW,<
ADD B,[(3)] ;Part of the message off the screen
>;IFN SHDRSW
SFPOS%
RET4: AOS (P)
RET3: AOS (P)
RET2: AOS (P)
RET1: RET
;For <LF>
OKSKLF: PBIN% ;Eat the LF
JRST CFMOK
;For <BS>
NOCR: CALL OUTON ;Turn on output and
TXZ F,F%MSGS ;Don't pause if he said NO
AOS (P) ;Want to take a skip return
OCRLF: TMSG <
> ;Output a CRLF and return
RET ;Exit to skip message
;For H
HEADER: CALL OCRLF ;Go to next line
JRST RET3
;For ?
HELPEM: CALL OUTON
HRROI A,HELP
PSOUT%
JRST RET3 ;Exit to show header again
;For Q
DONEQ: CALL OUTON ;A precaution
TXO F,F%QUIT ;Say he wants to quit
RET ;Uncurl our way up the stack
;For X
DONEX: CALL OUTON ;A precaution
TXO F,F%QUIT!F%EXIT ;Say he wants to quit and exit
RET ;Uncurl our way up the stack
;For R
RESTRT: CALL OCRLF
MOVE B,STRTPT ;Pick up starting point
MOVEM B,TXTPTR ;Set the pointer to B
MOVE A,STRTCN ;Pick up starting count
SOS A ;Already added one, so subtract it
MOVEM A,MSGCNT ;And reset MSGCNT
CALL BAKCLR ;Clear the back pointers
JRST RET2 ;Go to next message
;For B - backup to previous messages
BACKUP: CALL OCRLF ;Output a crlf
LAST: ;Come here when backing up to last msg
;LAST presumes it does a RET2 or RET3
PUSH P,BAKCNT ;Save present BAKCNT
CALL DECBAK ;Decrement the BAKCNT
POP P,A ;Get old BAKCNT into A
MOVE B,BAKPTR(B) ;Pick up previous one
CAME B,[-1] ;Was it cleared
IFSKP.
MOVEM A,BAKCNT ;Oops! Too far. Don't do it.
TMSG <
Can not back up further. Try "R" to restart this BBoard.
> ;Warn user
JRST RET3 ;And continue by showing header again
ENDIF.
SETOM BAKPTR(A) ;Say we were never at present one
MOVEM B,TXTPTR ;Set the file pointer to B
SOS MSGCNT ;Decrement message count
SOS MSGCNT ;and once more for good measure
CALL DECBAK ;Decrement BAKCNT to previous so
; next advance will be correct
JRST RET2 ;Exit as though skipping present msg
;Do a PUSH when "P" is read
;See CONFM for exit details.
PUSH: TXNE F,F%SECUR ;[UT-3] Don't push if SECUREd
JRST [SECURD: TMSG <
% Can't run MM or Push
> ;[UT-3] Say nothing will happen
JRST RET3] ;[UT-3] Reprompt for this msg
TMSG <ush
[Type POP to continue reading messages]
>
MOVEI A,0 ;Invoke an inferior exec
HRROI B,[ASCIZ \SYSTEM:EXEC.EXE\]
CALL $RUN
NOP
JRST RET3 ;Reprompt for this msg
;Call MM when "M" is read
;See CONFM for exit details
MM: TXNE F,F%SECUR ;[UT-3] Can't run MM if /SECUREd
JRST SECURD ;[UT-3] Say so and exit
PBOUT% ;Cough, hack... make "M" echo as "MM"
; or "m" as "mm"
TMSG <
[Type QUIT to get back to BBoard]
Please wait a moment for MM to start up...
>
HRROI A,RSCBUF ;First part of command to MM
HRROI B,[ASCIZ \MM EXAMINE \]
MOVEI E,RSCSIZ
CALL $SCOPY
MOVE B,IJFN ;Input JFN
SETZB C,D ;Use full format, no prefix
JFNS% ;Give it dev:<dir>file.ext.n
HRROI B,[ASCIZ \
Header \]
CALL $SCOPY ;Once it gets the file, pick the msg
MOVE B,MSGCNT ;By its number
CALL DECOUT
MOVEI D,.CHLFD ;End the line
JUMPG E,MM1
MOVEI D,.CHCNR ;No room, overwrite preceding with ^R
ADD A,[7B5]
MM1: IDPB D,A
MOVEI D,.CHNUL ;Terminate string
IDPB D,A
HRROI A,RSCBUF ;Now invoke MM
HRROI B,[ASCIZ \SYS:MM.EXE\]
CALL $RUN
NOP
JRST RET3 ;Reprompt for current msg
;$RUN - Run a program as an inferior
;Takes A/ Ptr to string to rescan (0 means don't setup rescan)
; B/ Ptr to program name
;Returns +1, failure, error code in errflg (-1 = run error, 1 = fork error)
; +2, success
$RUN: CALL ACSAVE ;Save everything
SETZM ERRFLG ;Assume no error
SETZM FORK ;Make sure no fork
GETNM% ;Save jobname
MOVEM A,JOBNAM
MOVX A,GJ%OLD!GJ%SHT ;Look up the file
GTJFN%
ERJMP SERR
MOVEM A,FRKJFN
MOVEI A,.FHSLF ;Enable all possible capabilities
RPCAP%
MOVE C,B
EPCAP%
MOVX A,CR%CAP ;Create a new fork with all capabilities
CFORK%
ERJMP RSERR
MOVEM A,FORK ;Save fork handle
MOVSS A ;Put handle in left half
HRR A,FRKJFN ;JFN in right half
GET% ;Read program into fork
ERJMP KRSERR
SKIPN A,A-17(P) ;Recover the rescan buffer pointer
JUMPE A,$RUN1 ;Don't rescan anything if it's 0
RSCAN% ;Rescan it
ERJMP KRSERR ;Bad arg
MOVEI A,.RSINI ;Put it into input stream
RSCAN%
ERJMP KRSERR ;Can't happen
$RUN1: MOVE A,FORK ;Retrieve handle
MOVEI B,0 ;Normal start address
SFRKV% ;Start the fork
ERJMP KRSERR
RFORK% ;Resume, in case it didn't get going
ERJMP KRSERR
WFORK% ;Sleep until fork is finished
ERJMP KRSERR
HRRZ A,FORK ;Short form rfsts to see if fork succeeded
RFSTS%
ERJMP KRSERR
LOAD A,RF%STS,A
CAIE A,.RFHLT ;Better be normal halt condition
JRST INFERR
KRSR: MOVE A,FORK ;Kill!
KFORK%
ERJMP RSERR
RSR: HRRZ A,FRKJFN ;Release the jfn
RLJFN%
ERJMP SR ;Probably released by KFORK%
SR: MOVE A,JOBNAM ;set back original jobname
SETNM%
SKIPN ERRFLG ;If have had an error, skip the skip
AOS (P) ;Increment return address to return +2
RET
SERR: SETOM ERRFLG ;Run error
MOVEI B,.FHSLF
CALL ERRPRT
JRST SR ;Go set jobname
RSERR: SETOM ERRFLG ;Run error
MOVEI B,.FHSLF
CALL ERRPRT
JRST RSR ;Release jfn and set jobname
KRSERR: SETOM ERRFLG ;Run error
MOVEI B,.FHSLF
CALL ERRPRT
JRST KRSR ;Kill fork, release jfn, and set jobname
INFERR: AOS ERRFLG ;Fork error
MOVE B,FORK
CALL ERRPRT
JRST KRSR ;Kill fork, release jfn, and set jobname
;$SCOPY - Copy strings
;Takes A/ destination string pointer
; B/ source string pointer
; E/ chars remaining in destination buffer
;Returns updated string pointers in A and B, number of characters remaining in
;in destination buffer in C and E, last byte transferred in D
$SCOPY: JUMPLE E,RET1 ;A no-op if destination buffer full
MOVEI C,(E) ;Remember destination buff size
MOVEI D,0 ;End on null byte
CALL $SOUT ;Output to buffer
MOVEI E,(C) ;Update destination buff size
RET
;$SOUT - Copy one string to the end of another. Essentially core-to-core SOUT,
;except never copies break char.
;Takes AC1/ destination pointer
; AC2/ source pointer
; AC3/ maximum byte count
; AC4/ break char
;Returns: +1 always, updated pointers in AC1 and AC2, updated count in AC3,
; last byte transferred in AC4
$SOUT: PUSH P,E
MAKPTR A ;Make fake pointers real
MAKPTR B
JUMPE C,$SOUT0 ;Zero byte count, zerobyte terminates
JUMPG C,$SOUT1 ;Positive byte count, use count and break
$SOUT2: ILDB E,B ;Negative byte count, use count only
IDPB E,A
AOJL C,$SOUT2 ;Loop while count negative
$SOUT3: MOVEI D,(E)
POP P,E
RET
$SOUT4: IDPB E,A ;Zero byte count, zerobyte terminates
$SOUT0: ILDB E,B
JUMPN E,$SOUT4 ;Loop while not a zerobyte
JRST $SOUT3
$SOUT1: ILDB E,B ;Positive byte count, use break char and count
CAIN E,(D) ;Check for break char
JRST $SOUT3
IDPB E,A
SOJG C,$SOUT1 ;Loop while count positive
JRST $SOUT3
;DECOUT - Outputs a decimal number.
;Takes A/ destination string pointer
; B/ number
; E/ count of bytes remaining in destination buffer
DECOUT: IDIVI B,^D10 ;Fetch rightmost digit into C.
PUSH P,C ;Store retval in LH of retaddr.
CAIE B,0 ;Have we reached 0 yet?
CALL DECOUT ;No, call recursively for next digit.
POP P,C ;Fetch retval.
JUMPE E,RET1 ;Check for overflow.
SUBI E,1 ;Ok, account for new char.
ADDI C,"0" ;Convert digit to ascii.
IDPB C,A ;Send digit.
RET ;Return, back to DECOUT, or eventually, out.
;ACSAVE - Saves all acs on stack with automatic restore
ACSAVE: ADJSP P,17 ;Allocate 17 more spaces on stack
MOVEM 16,16-16(P) ;Save ac 16 at top of stack
MOVEI 16,0-16(P) ;16/ 0,,<space on stack for ac 0>
BLT 16,15-16(P) ;Save acs 0 through 15
MOVE 16,16-16(P) ;AC, what ac? i didn't use any ac
CALL @-1-16(P) ;Call caller
SKPA ;Caller returned +1, skip incrementing
AOS -2-16(P) ;Returned +2, increment return for skip
MOVSI 16,0-16(P) ;16/ <space on stack with ac 0>,,0
BLT 16,16 ;Restore acs 0 through 16
ADJSP P,-20 ;Deallocate space allocated, plus caller
RET ;Return to caller's caller
;Error routines
DATFAI: HRROI A,[ASCIZ \Can't get at BBOARD's MAIL.IDX - \]
CALLRET ESOERR
PRSFAI: HRROI A,[ASCIZ \Bboard mail file format funny - \]
CALLRET ESOERR
PTRERR: HRROI A,[ASCIZ \Error during file pointer manipulation - \]
; CALLRET ESOERR ;Falls through
ESOERR: ESOUT% ;Print error message
; CALLRET ERRF ;Falls through
ERRF: TXO F,F%ERR ;Say there was an error
JSMSG0: MOVEI B,.FHSLF ;Error in self
CALLRET ERRPRT ;Go print last error for this fork
ERROUT: ESOUT% ;Print error message
CALLRET ERRRET ;Exit with error flag
STOP: MOVX A,.FHSLF ;Current file handle
CLZFF% ;Close anything we can
ERJMP .+1
HRROI A,-1 ;-1 for all JFNS
RLJFN% ;Release anything we can
ERJMP .+1
RESET% ;Reset
HALTF% ;Must halt here... Can't continue
HRROI A,[ASCIZ \Can't continue\]
ESOUT%
JRST STOP
;ERRPRT - Prints latest system error for specified process
;Takes B/ fork handle (.FHSLF for current process)
ERRPRT: MOVEI A,.PRIOU ;Output to primary output
HRLOS B ;Tell which fork from parameter
SETZ C,
ERSTR%
ERJMP .+2
ERJMP .+1
TMSG < --> ;Get ready to output which bboard bombed
CALL TYPNAM ;Do it
CALLRET OCRLF ;End the output line
;ENDMSG - Print the message at the end of a bboard
ENDMSG:
IFN ENDMSW,< ;Some don't want to know when bboard done
IFXE. F,F%MSGB ;Skip output if no msgs offered, clear flg
HRROI A,[ASCIZ \ - nothing new
\] ;Message for /ACTION
TXNE F,F%ACT ;Did we request that?
PSOUT% ;Yes, say we're finished reading
RET ;Then continue
ENDIF.
MOVEI A,5 ;Say to check for 5 lines
CALL MORCHK ;Go do it
CALL OCRLF
TMSG <(End of> ;The old message
SETZ A, ;No optional leading string
TXNE F,F%NAM!F%ACT ;Want name output?
CALL TYPNAM ;Type out the filename (if specified)
TMSG < bulletins.)
>
>;IFN ENDMSW
RET
;CLNUP - Clean up after doing a bboard
;You get here when you have seen all the messages there are.
; Thus you can safely ignore this file until its write date
; changes. Note that Q and E don't get here.
CLNUP: MOVE A,FDB+.FBWRT ;Get file write date
TXNN F,F%QUIT!F%CHK ;Don't update if quitting or checking
MOVEM A,PG.WRT(X) ;Save it
SETO A, ;Unmap data page
MOVE B,DATPAG ;Page for DATA file
HRLI B,.FHSLF
SETZ C,
PMAP%
SETO A, ;Unmap data page
MOVE B,DATPG1 ;Page for DATA file
HRLI B,.FHSLF
SETZ C,
PMAP%
HRR B,TXTPAG ;Pages for the TXT file
MOVE C,TXTPGS
TXO C,PM%CNT
PMAP%
MOVE A,BBOFIL(BBN) ;Close the files (but retain others)
CLOSF%
TRN
MOVE A,BBDFIL(BBN)
CLOSF%
TRN
RET
;BYE - End of running BBOARD program. Say bye-bye
BYE: TXNE F,F%PAUS ;Does user want to pause
TXNN F,F%MSGS ;Only do that if any msgs output
JRST STOP ;Didn't want to pause or didn't need to
TXNE F,F%QUIT ;If he last said Quit,
JRST STOP ;Just halt
CALL OUTON ;Make sure we see this
MOVEI A,3 ;Allow for 3 lines
CALL MORCHK
IFE SMSGSW,<
TMSG <
[Bboards done, press any key to proceed...]> ;Be less confusing
>;IFE SMSGSW
IFN SMSGSW,<
TXNN F,F%SYS
IFSKP.
TMSG <
[SYSTEM Bulletins done, press any key to proceed...]> ;Be less confusing
ELSE.
TMSG <
[Bboards done, press any key to proceed...]> ;Be less confusing
ENDIF.
>;IFN SMSGSW
MOVEI A,.PRIIN ;For the primary input
CFIBF% ;Clear input buffer
PBIN% ;Now read a char
MOVEI A,.PRIIN ;For the primary input
CFIBF% ;Clear input buffer
JRST STOP
;INTIME - Jacket routine for IDTIM%
;Takes A/ pointer to the date/time in the Date/Byte count/Flags line
;Returns +1 - error
; +2 - success, B/ time of the message
INTIME: IDTIM% ;Read the time from mapped memory
TDZA D,D ;Error? ok, we won't skip
MOVEI D,1
SETZM EOF ;Clear any EOF flag
MOVEI C,@A ;Find out how far it went
CAMGE C,TXTEOF ;But set it if went too far
JRST INTIM2
SETOM EOF
RET
INTIM2: SKIPE D
AOS (P)
RET
;NUMIN - Translates a string into a number
;Takes A/ address of source string
; B/ positive number
; C/ radix (two through ten)
;Returns +1, error
; +2, success, @A/ updated, D/ break char
NUMIN: ILDB D,A
CAIE D," " ;Skip spaces
CAIN D,.CHTAB ;And tabs
JRST NUMIN
CAIL D,"0" ;Better be a digit
CAIL D,"0"(C)
IFNSK.
HRROI A,[ASCIZ \Error during parsing a number\]
ESOUT%
RET
ENDIF.
MOVEI B,-"0"(D) ;Convert first digit
NUMLP: ILDB D,A ;Read another
CAIL D,"0" ;Digit or break char?
CAIL D,"0"(C)
JRST NUMRET
IMULI B,(C) ;Update number
ADDI B,-"0"(D)
JRST NUMLP
NUMRET: CAIE D,.CHCRT ;On <CR> need to check for <LF>
JRST RET2
PUSH P,B ;This one's our retval
PUSH P,C ;Might as well not destroy the radix
MOVE B,A ;Look at next byte
ILDB D,B
CAIN D,.CHLFD ;If it's a <LF> then skip it, else return <CR>
MOVEM B,A
POP P,C
POP P,B
MOVEI D,.CHCRT
RETSKP
;CTLCON - Turns on Control-C interrupt catching
CTLCON: MOVEI A,.FHSLF ;Set up ^C trap
MOVE B,[LEVTAB,,CHNTAB] ;Interrupt tables
SIR%
EIR% ;Enable system
MOVX B,1B<INTCH1> ;Activate channels
AIC%
MOVE A,[.TICCC,,INTCH1] ;Assign ^C to channel 1
ATI%
ERJMP .+1 ;Don't care if no ^C's allowed
RET
;Jump here on a Control-C
CTRLC: PUSH P,A ;Save A
MOVEI A,.PRIOU
CFOBF% ;Clear output buffer
TMSG <^C
> ;Inform user
CIS% ;Clear system
HALTF% ;Stop for now
POP P,A ;Restore A
SOS PC1 ;This is just a stop-gap measure!
JRST @PC1 ;But continue if he wants to
;INIT - One-time initialization
INIT: CALL CTLCON ;Trap on Control-C
IFN UTEXSW,< ;[UT-2]
CALL .MORE ;[UT-2] Blanking is default
>;IFN UTEXSW
HRROI A,[ASCIZ \POBOX:\] ;See if POBOX: is defined here
STDEV% ;Is it?
IFJER. ;Nope...
MOVEI A,.CLNJB ;Want to create the logical
HRROI B,[ASCIZ \POBOX:\] ;The logical
HRROI C,[ASCIZ \PS:\] ;What to make it
CRLNM% ;Create it
ERJMP .+1 ;Ignore errors
ENDIF.
MOVE A,[FIELDS,,HEAD1] ;Move from FIELDS to HEAD1
BLT A,HEAD1+FLDNUM-1 ;Move FLDNUM (=8) of them
SETZM BBOFIL ;Zero out the files list from possible
MOVE BBN,[BBOFIL,,BBOFIL+1] ;Previous session (i.e. make this
BLT BBN,BBDFIL+BBNMAX-1 ;Program serially re-usable)
SETZM BBN ;Init flags
MOVEI A,.PRIOU ;For the current terminal
SETZ B,
SFPOS% ;Fake the monitor
HRROI A,[ASCIZ \BBD:\] ;See if BBD: exists
STDEV%
TDZA X,X ;Use X as a flag saying "bbd: exists or not"
SETO X, ;Zero means doesn't exist. This routine only
JUMPE X,INIT0 ;If it doesn't exist, go around
MOVX A,GJ%SHT!GJ%OFG ;Get parse only JFN
HRROI B,[ASCIZ \BBD:\]
GTJFN%
ERJMP INIT0
HRRZ B,A ;Get JFN in right place
HRROI A,DEVICE ;Store device name for GTJFN% later
MOVX C,FLD(.JSAOF,JS%DEV)
JFNS%
HRROI A,DIRECT
MOVX C,FLD(.JSAOF,JS%DIR)
JFNS%
HRROI A,DEFBBD
HRROI B,[ASCIZ \BBD:MAIL.TXT\]
SETZ C,
SOUT%
HRROI A,DEFDAT
HRROI B,[ASCIZ \BBD:MAIL.IDX\]
SOUT%
JRST INIT1 ;And go on
INIT0: HRROI A,DEVICE
HRROI B,[ASCIZ \PS\]
SETZ C,
SOUT%
HRROI A,DIRECT ;Default names if BBD: not defined
HRROI B,[ASCIZ \BBOARD\]
SOUT%
HRROI A,DEFBBD
HRROI B,[ASCIZ \POBOX:<BBOARD>MAIL.TXT\]
SETZ C,
SOUT%
HRROI A,DEFDAT
HRROI B,[ASCIZ \POBOX:<BBOARD>MAIL.IDX\]
SOUT%
INIT1: SKIPN X ;BBD?
SKIPA B,[POINT 7,[ASCIZ \POBOX:<BBOARD>\]]
HRROI B,[ASCIZ \BBD:\]
HRRO A,FILNAM(BBN) ;Set up the default filename
SETZ C,
SOUT%
SETOM INTTIM ;Say no time seen yet
IFE OLDSW,<
GTAD% ;Get the present time
SUB A,[DAYAGO,,0] ;Calculate 30 days ago
MOVEM A,LNGAGO ;Store for later usage
>;IFE OLDSW
CALL BLDKEY ;Build the list of keywords for comnd
;Figure out where to put DATPAG
HLRZ A,.JBSA ;Find end of file
ADDI A,777 ;Find first free page after everything
LSH A,-<^D9>
MOVEM A,DATPAG ;Here it is
ADDI A,1
MOVEM A,DATPG1 ;Data page for write access is next
;TXTPAG is the next page
ADDI A,1
MOVEM A,TXTPAG
MOVEI A,.PRIOU ;From our tty
MOVEI B,.MORLW ;Read the line width
MTOPR%
SKIPN C ;Does luser have width set?
MOVEI C,^D80 ;Nope, assume ^D80 for them
MOVEM C,NCOLS ;Save it away
MOVEI B,.MORLL ;Read the page length
MTOPR%
SKIPN C ;Luser have a length set?
MOVEI C,^D24 ;Assume ^D24 for them
SOS C ;Avoid fencepost
MOVEM C,NLINES ;Save it away
RET
;NEWRDR - Tell new users how to see older messages
;Returns PG.RD(X) and PG.WRT(X)/ time representing yesterday at 12:01AM
NEWRDR: TXNE F,F%CHK ;If checking, no message
RET ;Skip it
PUSH P,A ;Save JFN
MOVEI A,^D8 ;Say to check for 8 lines
CALL MORCHK ;Go do it
HRROI A,[ASCIZ \
Messages on BBoard older than yesterday are suppressed for new readers. Use
BBOARD 1-JAN-80\]
IFXN. F,F%DEF
PSOUT% ;If using the default, be sure to displaly msg
ELSE.
CALL TYPNAM ;If not the default, also display the name
ENDIF.
TMSG <
to read older messages. From now on, you will get all new messages.
> ;Explain to neophytes
GTAD% ;Get current time and date
LSH A,-<^D18> ;Get day into right half
SUBI A,1 ;Go to yesterday at 12:00:01AM
LSH A,^D18 ;Realign
MOVEM A,PG.RD(X) ;Set all his times to this
MOVEM A,PG.WRT(X)
MOVEM A,OLDTIM ;Set it as time to compare with
POP P,A ;Restore jfn
RET
;PRTNAM - Print the name of the bboard file
;Takes FILNAM(BBN)/ File name
PRTNAM: PUSH P,A ;Save JFN
PUSH P,B ;If not in the first column
MOVEI A,3 ;Say to check for 3 lines
CALL MORCHK ;Go do it
MOVEI A,.PRIOU ;Then put in a crlf
RFPOS%
TXNE B,.RHALF
CALL OCRLF
HRROI A,[ASCIZ \Reading file:\]
CALL TYPNAM ;Type file name
CALL OCRLF ;Tie off with a nice, clean crlf
POP P,B ;Restore B
POP P,A ;Restore JFN
RET
;TYPNAM - Routine to type out the file name (and leader) if one was specified
;Takes A/ either 0 or a string to print before the file name
TYPNAM: SKIPE A ;A leader?
PSOUT% ;Yes, then type it
IFE SMSGSW,<
TXNE F,F%DEF ;Default BBD is a special case
>;IFE SMSGSW
IFN SMSGSW,<
TXNE F,F%DEF!F%SYS ;Default BBD and SYSBBD are a special case
>;IFN SMSGSW
JRST TYPNA0
SKIPN FILNAM(BBN) ;If nothing here, then done
RET
MOVEI A," " ;Output a leading space
PBOUT%
HRRO A,FILNAM(BBN) ;And not the file name specified
TXNE F,F%DEF ;Use a nicer name
TYPNA0: HRROI A,[ASCIZ \ BBoard\]
IFN SMSGSW,<
TXNE F,F%SYS ;System messages?
HRROI A,[ASCIZ \ SYSTEM:\] ;Yes
>;IFN SMSGSW
PSOUT%
RET
;SAVBAK - Save the present file pointer
;Normally does a skip return. Non-skip return on a pointer error
SAVBAK: MOVE B,TXTPTR ;Get the file pointer
SOSL C,BAKCNT ;Find where to stash it
IFSKP.
MOVEI C,BAKMAX-1 ;If we have to wrap around
MOVEM C,BAKCNT ;Then reset things
ENDIF.
MOVEM B,BAKPTR(C) ;Stash it in right spot
RETSKP
;DECBAK - Decrement BAKCNT by one
;Returns B/ new value for BAKCNT
DECBAK: MOVE B,BAKCNT ;Get the position in the back pointer array
MOVEI B,1(B) ;Get the previous position
CAIL B,BAKMAX ;Need to wrap around?
MOVEI B,0 ;Yes.
MOVEM B,BAKCNT ;Reset count
RET
;SAVDAT - Save date, if needed
;Takes DAT/ date/time of present msg
; (X)/ date/time of newest message read
;Returns (X)/ updated if necessary
SAVDAT: CAMLE DAT,(X) ;If date and time gt saved time,
MOVEM DAT,(X) ;Save it
RET
;OUTON - Clears any ^O condition on primary output
OUTON: PUSH P,A ;Don't want ^O suppression
PUSH P,B ;Use no AC's
MOVEI A,.PRIOU
RFMOD%
TXZE B,TT%OSP ;Maybe don't have to set mode
SFMOD%
POP P,B
POP P,A
RET
RESCAN: MOVEI A,.RSINI ;Select rescan buffer
RSCAN%
JSERR
JUMPE A,R ;Return if nothing there
CALL CMDINI ;Init COMND% package
PROMPT (BBoard>) ;Init COMAND% (does .CMINI)
MOVEI A,[FLDDB. .CMKEY,,PGMTAB]
CALL RFLDE ;Collect program name, start, etc.
IFNSK.
HRROI A,[ASCIZ \Unrecognized program name\]
ESOUT%
JRST ERREAT ;Garbage...
ENDIF.
HRRZ B,(B) ;Get indicator
JUMPE B,EAT ;If not program name, forget this line
RSCLUP: HRLI A,DFLTBK ;Build a blt pointer
HRRI A,CJFNBK ;For defaults
BLT A,CJFNBK+DFLTLN-1 ;Set up default bboard file
MOVEI A,[FLDDB. .CMTAD,,<CM%IDA!CM%ITM>,,,[ ;Date and time
FLDDB. .CMTAD,,CM%IDA,,,[ ;Or just date
FLDDB. .CMTAD,,CM%ITM,,,[ ;Or just time
FLDDB. .CMCFM,,,,,[ ;Or confirm
FLDDB. .CMSWI,,SWTTAB,,,[ ;Or a switch
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ |/|]>,,,[ ;Or a slash
FLDDB. .CMCMA,,,,,[ ;Might be comma
FLDDB. .CMKEY,,FILKEY,,,[ ;Or keyword
FLDDB. .CMFIL,,]]]]]]]]] ;Or filename (.CMFIL must be last)
CALL RFLDE
JRST ERREAT ;What's wrong?
LOAD A,CM%FNC,<(C)> ;Get function which matched
CAIN A,.CMCMA ;Was it a comma?
JRST RSCCMA ;Yes, process it
TXZ F,F%CMA ;Clear "seen a comma before" bit
CAIN A,.CMTAD ;Did we get a date?
JRST RSCTAD ;Yes, go process that
CAIN A,.CMFIL ;Did we get a filespec?
JRST RSCFIL ;Yes, do that up
CAIN A,.CMKEY ;Did we get a keyword?
JRST RSCKEY ;Yes, do that up
CAIE A,.CMTOK ;A / (bad switch)
IFSKP.
MOVX A,-1 ;Backup .CMPTR to point to the /
ADJBP A,SBK+.CMPTR
MOVEM A,SBK+.CMPTR
JRST ERREAT ;Simulate a bad parse
ENDIF.
CAIE A,.CMSWI ;A switch?
RET ;No, must be a confirm - return
MOVE A,(B) ;Get the switch routine address
CALL (A) ;Go do it
JRST RSCLUP ;Go parse more
IFN FACSW,<
FAC: MOVX A,GJ%SHT!GJ%OLD ;Short old GTJFN%
HRROI B,[ASCIZ \<FACULTY>MAIL.TXT\] ;Faculty MAIL.TXT
GTJFN% ;Find it
JHLT ;Quit if cant find
MOVEM A,BBOFIL(BBN) ;Save JFN allowing for more than 1
MOVX A,GJ%SHT!GJ%OLD ;Short and old
HRROI B,[ASCIZ \<FACULTY>MAIL.IDX\] ;MAIL.IDX too
GTJFN% ;Find it
JHLT
MOVEM A,BBDFIL(BBN) ;Save JFN allowing for more than 1
HRRO A,FILNAM(BBN)
HRROI B,[ASCIZ \POBOX:<FACULTY>\] ;Save name for end message
SETZ C,
SOUT%
RET
CLASS: SETO A,
SETZM ATMBUF+1 ;Clear
SETZM ATMBUF+2
HRROI B,ATMBUF
GACCT% ;Get users account
MOVEI A,"<" ;Start of file name
DPB A,[POINT 7,BUF,6] ;Start build of file name
MOVX A,GJ%SHT!GJ%OLD
HRROI B,[ASCIZ \<ACCOUNTS>FACULTY.LIST\]
GTJFN% ;FACULTY/CLASS file
ERJMP QERA ;Go on err
MOVX B,FLD(7,OF%BSZ)!OF%RD
OPENF% ;Open it up
ERJMP QERA ;Go on err
QLPB: MOVE B,[POINT 7,BUF,6] ;Build area for file name
MOVEI C,^D40 ;Max len
MOVEI D,^D13 ;CR
SIN% ;Read in faculty name
CAIN C,^D40 ;EOF?
JRST QERA ;Yes, err
MOVE E,B ;Save
BIN% ;Skip LF
MOVE B,E ;Restore
MOVEI C,"." ;Put dot in file name
DPB C,B
MOVEI C,^D40 ;Max len
MOVEI D,^D13 ;CR
SIN% ;Read in associated account
SETZ C,
DPB C,B ;Terminate
SETZM DASHPT ;Indicate no subsection # found
MOVE D,[POINT 7,ATMBUF] ;Ptr to logged in acct
QLPA: ILDB B,E ;Compare accts
ILDB C,D ;Damn what a stupid instr. set
TRZ B,40 ;make upper case
TRZ C,40 ;make upper case
CAME B,C ;Same?
JRST NXTENT ;No, br
CAIN B,^O15 ;Start of sub-section #(upper case -)
MOVEM E,DASHPT ;Yes, save
JUMPN B,QLPA ;Loop if not fini
CLOSF% ;Close file
NOP
QLPC: MOVE B,E ;Restore pointer
MOVEI A,">" ;Overlay CR
DPB A,B ;With end of deirectory name symbol
MOVE A,B ;Get end of file name so far
MOVE E,B ;Save ptr to name so far
HRROI B,[ASCIZ \MAIL.TXT\]
SETZ C, ;No max
SOUT% ;Finish building file name
IDPB C,A ;Drop in a closing null
MOVX A,GJ%OLD!GJ%SHT ;Short old JFN
HRROI B,BUF ;Name of MAIL.TXT file
GTJFN% ;JFN
ERJMP QERA ;Go on err
MOVEM A,BBOFIL(BBN) ;Save JFN allowing for more than 1
MOVE A,E ;Restore ptr
HRROI B,[ASCIZ \MAIL.IDX\] ;Build MAIL.IDX filename
SETZ C,
SOUT%
IDPB C,A ;Drop in a null
MOVX A,GJ%OLD!GJ%SHT ;Short old JFN
HRROI B,BUF ;Name of MAIL.IDX file
GTJFN% ;JFN
ERJMP QERA ;Go on err
MOVEM A,BBDFIL(BBN) ;Save JFN allowing for more than 1
HRRO A,FILNAM(BBN)
HRROI B,ATMBUF ;Get account
SETZ C,
SOUT% ;Save for end message
RET
NXTENT: MOVE B,E ;Read in area
MOVEI C,^D150 ;Max len
MOVEI D,^D13 ;CR
SIN% ;Read in faculty name
SIN% ;Skip quota info
SIN%
SIN%
SIN%
BIN%
JRST QLPB ;Loop
QERA: SKIPN E,DASHPT ;Was there a section #
JRST QSKC ;No, give up
SETZM DASHPT ;Only once
JRST QLPC ;Yes, try stripping it off
QSKC: HRROI A,[ASCIZ \Can't get class BBoard\]
ESOUT% ;Errmsg out
JSHLT ;Quit
>;End of IFN FACSW
;We've rescanned a filename
RSCFIL: SKIPN BBOFIL(BBN) ;No comma between file names
IFSKP.
TMSG <
% Error in specifying bboard file name (Missed comma?). Continuing
> ;Tell him he goofed
ENDIF.
MOVEM B,CURJFN
RSCWFL: CAIL BBN,BBNMAX ;Create the loop for wildcards
JRST RSFLUP ;If at maximum, then go to the file incrementer
HRROI A,CURFIL ;Create the filename
HRRZ B,CURJFN ;From the current Jfn
MOVX C,JS%SPC
JFNS%
SETZ C, ;Get a null
IDPB C,A ;Drop it in
MOVX A,GJ%OLD!GJ%SHT ;Short form, old file
HRROI B,CURFIL
GTJFN%
ERJMP RSFLUP ;File doesn't exist
MOVEM A,BBOFIL(BBN) ;Save bboard file name
HRROI A,CURFIL ;Create a subname of the file
HRRZ B,CURJFN
MOVX C,FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!FLD(.JSAOF,JS%NAM)!JS%PAF
JFNS% ;All but extension
MOVE E,BBN ;Create a pointer
CFILLP: SOJL E,CFILDN ;Check if we have this name
HRRO A,FILNAM(E) ;Before through the tables
HRROI B,CURFIL
STCMP%
JUMPN A,CFILLP ;If no match than continue
HRRZ A,BBOFIL(BBN) ;Got a match means we do
RLJFN% ;Release the current JFN
JFCL
SETZM A,BBOFIL(BBN) ;Zero the entry
JRST RSFLUP
CFILDN: HRROI A,BUF ;Point to buffer
HRROI B,CURFIL ;Create the data file
SETZ C,
SOUT%
HRROI B,[ASCIZ \.IDX\] ;Here is the extension
SOUT% ;Complete filename
IDPB C,A ;Drop in a null
HRRO A,FILNAM(BBN) ;Copy the file name specified here to
HRROI B,CURFIL ;From the one already created
SOUT%
IDPB C,A ;Drop in a null
MOVX A,GJ%OLD!GJ%SHT ;Old file, short GTJFN% form
HRROI B,BUF ;Point to name we constructed
GTJFN% ;Get a JFN on it
IFJER. ;On error
HRRZ A,BBOFIL(BBN) ;Release the current JFN
ENDIF.
RLJFN% ;Release the JFN
ERJMP .+1
RSFLUP: MOVE A,CURJFN ;Get the next file in the list
GNJFN%
IFNJE.
SKIPE BBOFIL(BBN) ;If we have an entry
AOS BBN ;Then update the counter
JRST RSCWFL ;Loop back and continue
ENDIF.
SKIPN BBOFIL(BBN) ;If no entry when we are done
SOS BBN ;The kill the last one
JRST RSCLUP
;Handle built keyword parse
RSCKEY: SKIPN BBOFIL(BBN) ;No comma between file names
IFSKP.
TMSG <
% Error in specifying bboard keyword (Missed comma?). Continuing
> ;Tell him he goofed
ENDIF.
HLRO B,(B) ;B had addr, addr had keywd-addr,,0
PUSH P,B ;Save for future reference
HRLI A,DFLTBK ;Build a blt pointer
HRRI A,CJFNBK ;For defaults
BLT A,CJFNBK+DFLTLN-1 ;Set up default bboard file
MOVX A,GJ%OLD
MOVEM A,CJFNBK+.GJGEN
MOVE A,[.NULIO,,.NULIO]
MOVEM A,CJFNBK+.GJSRC
MOVEI A,CJFNBK ;Where to find our data
GTJFN%
ERCAL [HRROI A,[ASCIZ \Can't GTJFN% \]
ESOUT%
HRRO A,(P) ;Output keyword
PSOUT%
HRROI A,[ASCIZ \ bboard file \]
PSOUT%
JSHLT] ;Die
MOVEM A,BBOFIL(BBN)
HRRO A,FILNAM(BBN) ;Copy the file name specified here
HRRO B,(P) ;Use saved keyword, not user's input
SETZB C,D
SOUT%
HRROI B,[ASCIZ \IDX\] ;Here is the extension
MOVEM B,CJFNBK+.GJEXT ;Make it the default extension
POP P,B ;Restore keyword as filename
MOVX A,GJ%OLD
MOVEM A,CJFNBK+.GJGEN
MOVE A,[.NULIO,,.NULIO]
MOVEM A,CJFNBK+.GJSRC
MOVEI A,CJFNBK ;Re-use GTJFN% block from before
GTJFN%
ERCAL [HRROI A,[ASCIZ \Can't GTJFN \]
ESOUT%
HRRO A,B ;Output keyword
PSOUT%
HRROI A,[ASCIZ \ bboard data file \]
PSOUT%
JSHLT] ;Die
MOVEM A,BBDFIL(BBN) ;Save data file jfn allow for 2+
JRST RSCLUP
;Handle a comma
;Want to say if a bare comma (no file before it) then act like
; the default file was read. Otherwise look for next
; file
;Right now, will just loop back
;now, we check if we had ",," and insert appropriate jfns if so
RSCCMA: TXNE F,F%CMA ;Already seen a comma?
IFSKP. ;No...
TXO F,F%CMA
CAIGE BBN,BBNMAX ;See if will be too many
IFSKP.
HRROI A,[ASCIZ \Too many bboards requested\]
ESOUT% ;Complain if too many
CALL ERRF
JRST STOP
ELSE. ;Else see if will be too many
AOS BBN
ENDIF.
JRST RSCLUP ;And go on
ENDIF.
TXZ F,F%CMA
MOVX A,GJ%OLD!GJ%SHT ;Try to get data file
HRROI B,DEFDAT ;Use the default data file name
GTJFN%
ERCAL [HRROI A,[ASCIZ \Can't GTJFN \]
ESOUT%
HRROI A,DEFDAT ;Output default filename
PSOUT%
JSHLT] ;And die
MOVEM A,BBDFIL(BBN) ;Save data file jfn
MOVE B,A
HRRO A,FILNAM(BBN) ;Keep file name here
MOVX C,FLD(.JSAOF,JS%NAM) ;Name only
JFNS% ;Output string
ERCAL [CALL ERRF ;Die with error
JRST STOP]
SETZ C, ;Get a null
IDPB C,A ;Drop it in
MOVX A,GJ%OLD!GJ%SHT ;Try to get .TXT file
HRROI B,DEFBBD ;Default bboard
GTJFN%
ERCAL [HRROI A,[ASCIZ \Can't GTJFN \]
ESOUT%
HRROI A,DEFBBD ;Output default filename
PSOUT%
JSHLT] ;And die
MOVEM A,BBOFIL(BBN) ;Save text file JFN
AOS BBN ;Bump up pointer
JRST RSCLUP
;Set magic flags according to switches given
ACTIO: TXOA F,F%ACT ;Set flag
NAME: TXO F,F%NAM ;Set the flag
RET
CHECK: TXOA F,F%CHK ;Light the right bit
PAUSE: TXO F,F%PAUS ;Set pause flag
RET
SMORE: TXO F,F%SCMR ;Light the bit
MORE: TXOA F,F%MORE ;Light the bit
LAST: TXO F,F%LAST
RET
;Scan the next token(s) for time and/or date
TAD: MOVEI A,[FLDDB. .CMTAD,,<CM%IDA!CM%ITM>,,,[
FLDDB. .CMTAD,,CM%IDA,,,[
FLDDB. .CMTAD,,CM%ITM,,,]]]
CALL RFLDE
IFNSK.
HRROI A,[ASCIZ \Expecting a date/time\]
ESOUT%
ADJSP P,-2 ;Pop off the return address here
JRST ERREAT
ENDIF.
RET
;Handle the /SET-TIME switch (or /DATE)
DATE: CALL .TAD ;Get the time and day
MOVEM B,NEWTIM ;Save the time to set to
RET
;Handle the /USE-TIME switch (or /FROM)
FROM: CALL .TAD ;Get the time and day
MOVEM B,INTTIM ;Save date and time to start at
RET
;[UT-3] Handle the /SECURE switch
SECUR: TXO F,F%SECU ;[UT-3] Indicate we want to be secure
RET
;We've rescanned a date and time without a switch
RSCTAD: MOVEM B,INTTIM ;Save date and time to start at
JRST RSCLUP
;Error routines for parsing
ERREAT: CALL OUTON ;Make sure it's seen
HRROI A,[ASCIZ \Can't parse: \]
ESOUT%
MOVE A,SBK+.CMPTR ;The unparsed stuff
PSOUT%
TMSG <
Expected command line of the form
BBOARD {bbdnam1 {,bbdnam2 ...}} {time and/or date} {/sw1} {/sw2 ...}
where bbdnam1 is the name of a file (the directory defaults to BBD: and the
extension defaults to TXT). All the items are optional. The allowed switches
are: /NAME, /PAUSE, /LAST, /USE-TIME:{date} {time}, /FROM:{date} {time}
/SET-TIME:{date} {time}, /DATE:{date} {time}, /ACTION, /CHECK, /MORE,
/SCROLL-MORE, /SECURE> ;[UT-3] Added /SECURE
IFN FACSW,<
TMSG <, /CLASS, /FACULTY>
>;IFN FACSW
CALL OCRLF ;End the line
MOVEI A,.PRIIN ;Clear input buffer
CFIBF%
JRST EAT1
EAT: MOVEI A,[FLDDB. .CMTXT] ;Swallow to eol
CALL RFIELD
JFCL
EAT1: SETOM INTTIM ;Forget any time specified
SETZM BBOFIL(BBN) ;And any files
SETZM BBDFIL(BBN)
RET
;Build the keyword table by GNJFNing down the world
BLDKEY: HRLI A,DFLTBK ;Build a blt pointer
HRRI A,CJFNBK ;For defaults
BLT A,CJFNBK+DFLTLN-1 ;Set up default bboard file
MOVX A,GJ%OLD!GJ%IFG!GJ%FLG+1 ;Default generation of 1
MOVEM A,CJFNBK+.GJGEN
HRROI A,[ASCIZ \*\]
MOVEM A,CJFNBK+.GJNAM ;Make it *.TXT (.GJEXT is already .TXT)
MOVE A,[.NULIO,,.NULIO]
MOVEM A,CJFNBK+.GJSRC
MOVEI A,CJFNBK ;Where to find our data
SETZ B,
GTJFN%
JSHLT
MOVEM A,BLDJFN ;Store JFN
MOVEI X,1 ;Count of keywords
MOVE W,[POINT 7,KEYWDS] ;Beginning of spare string space
BLDLP: MOVE A,W ;Get next keyword space
HRLZM A,FILKEY(X) ;Put address in left half of table
HRRZ B,BLDJFN
MOVX C,FLD(.JSAOF,JS%NAM) ;Output only filename
JFNS%
MOVEM A,W ;Put back string pointer
IBP W ;Move over null for paranoia
AOS W ;Increment to next word boundary
HRLI W,(<POINT 7,>) ;Make initial pointer again
MOVE A,BLDJFN ;Get JFN back
GNJFN%
ERJMP ENDBLD
AOJA X,BLDLP ;Go get more
ENDBLD: MOVEM X,FILKEY ;When no more, make x,,x in filkey for comnd
HRLM X,FILKEY
RET ;And return
;Command parsing routines
P1=10 ;P1-P4 supposedly preserved through calls
P2=11
P3=12
P4=13
;Get here on COMND% error. Let user try again.
CMDERR: HRROI A,ERMES ;Point to message area
MOVE B,[.FHSLF,,-1] ;Ourself, most recent error
MOVSI C,-MESLN*5 ;Maximum string we've room for
ERSTR% ;Get error string
JFCL
JFCL ;Unexpected errors
HRROI A,ERMES ;Point at string
ESOUT% ;Print it in standard manner
;Come here to let user fix his error (by typing ^h) or issue another command
;Print error message before transferring here
CMDER1: SOS REPARA ;Modify reparse address so reprompt happens
JRST REPARS
;Place to transfer if user edits previously parsed fields
REPARS: MOVE P,CMDACS+P ;First restore P, how much stack to restore
HRLI A,CMDPDL ;Restore stack from saved stack
HRR A,CMDFRM ;Copy to bottom of stack
BLT A,(P) ;Restore the stack
MOVSI 16,CMDACS ;Make BLT pointer
BLT 16,16 ;Restore rest of AC's
JRSTF @REPARA ;Transfer back to just after .CMINI call
;Come here to prompt for new command or new prompt line of command.
;Call this routine with pointer to prompt in A, or 0 if no prompt.
DPROMP: CAIN A,0 ;Any prompt?
HRROI A,[0] ;No, point to a null string
MOVEM A,SBK+.CMRTY ;Save pointer to prompt
POP P,REPARA ;Remember reparse address
DMOVEM 0,CMDACS+0 ;Save AC's
MOVE 1,[2,,CMDACS+2]
BLT 1,CMDACS+17
HRL A,CMDFRM ;Save from bottom of stack
HRRI A,CMDPDL ;Move data to COMND% pdl area
HRRZ B,P ;See where top of stack is now
SUB B,CMDFRM ;Calculate number of words
BLT A,CMDPDL(B) ;Save the stack
PUSH P,REPARA ;Make stack like it was
PUSH P,SBK+.CMIOJ ;Save I/O JFNS
MOVE B,[.NULIO,,.NULIO] ;Get null JFNS
MOVEI A,.RSCNT ;Find count of rscan characters
RSCAN%
JSHLT ;Invalid function code?
SKIPE A ;If we're reading from rescan buffer
MOVEM B,SBK+.CMIOJ ;Do I/O to null this time
MOVEI A,[FLDDB. .CMINI] ;Type prompt
CALL RFIELD
POP P,SBK+.CMIOJ ;Restore I/O JFNS
RET ;Return to caller
;Read a field routine. Give it address of function block in A.
;JRSTs to CMDERR if error. A and B will have result of COMND% in them.
RFIELD: CALL RFLDE ;Read field, skip if success
JRST CMDERR ;Failed, go process error
RET ;Success
;Routine to read a field and skip iff successful. A, B, and C will have
;result of COMND% in them upon return.
RFLDE: MOVE B,A ;Put function block pointer in B
MOVEI A,SBK ;Pointer to state block in A
COMND% ;Read field of COMND%
ERJMP R ;Error in COMND%
TXNE A,CM%NOP ;Did command parse correctly?
RET ;No, single return
RETSKP ;Yes, skip return
;Read a field and require carriage return after it for confirmation
CFIELD: CALL RFIELD ;Read the field
DMOVEM A,VALUES ;Save data from field
CONFRM ;Get confirmation
DMOVE A,VALUES ;Get values of field
RET ;Return to caller
;COMND% initialization routine. Call only once at beginning of program
;Always call this routine at a less-than-or-equally nested location
; within the program in comparison with any subsequent call to the COMND%
; execution routines
CMDINI: MOVEI A,REPARS ;Reparse address
MOVEM A,SBK+.CMFLG
HRLI A,100 ;Set up I/O JFNS
HRRI A,101
MOVEM A,SBK+.CMIOJ
HRROI A,CMDBUF ;Pointer to command buffer
MOVEM A,SBK+.CMBFP
MOVEM A,SBK+.CMPTR ;Pointer to next field
MOVEI A,CMDBLN*5 ;Room for typin
MOVEM A,SBK+.CMCNT
SETZM SBK+.CMINC ;No unparsed characters yet
HRROI A,ATMBUF ;Pointer to atom buffer
MOVEM A,SBK+.CMABP
MOVEI A,ATMBLN*5
MOVEM A,SBK+.CMABC ;Room in atom buffer
MOVEI A,CJFNBK ;Pointer to JFN block
MOVEM A,SBK+.CMGJB
MOVEM P,CMDFRM ;Remember beginning of stack
RET
BLKLIN: SAVEAC <A,B,C> ;Save the AC's.
MOVEI A,.PRIOU ;To the terminal.
RFMOD% ;Get the tty info word.
PUSH P,B
TXZ B,TT%DAM ;Binary mode.
SFMOD%
MOVEI A,.CHCRT ;Get a carriage return.
PBOUT%
SKIPL TTYPE
IFSKP.
MOVEI A,.PRIOU ;Get terminal type index
GTTYP%
MOVEM B,TTYPE ;Save the terminal type
ELSE.
MOVE B,TTYPE ;Get terminal type
ENDIF.
CAIGE B,NCLRLN ;If more than table
SKIPE A,CLRLIN(B) ;Don't clear if wrong terminal type
IFSKP.
TMSG <
> ;Just print a crlf and finish.
JRST BLKLN2
ENDIF.
TLOE A,-1 ;More than 5 chars?
HRROI A,CLRLIN(B) ;No, use immediate.
PSOUT%
MOVEI A,.PRIOU
RFPOS% ;Get page position.
HLLZS B
SFPOS%
BLKLN2: MOVEI A,.PRIOU
POP P,B
SFMOD% ;Restore things.
RET
;MORCHK - Checks to see if there is AC1 lines left in the screen
MORCHK: TXNN F,F%MORE ;If using more processing
RET
PUSH P,A ;Save line count
MOVEI A,.PRIOU ;If previous message was long
RFPOS% ;Allow the user to be prompted
POP P,A ;Restore this counter
HLRZ C,B ;If we are past the number
ADD C,A ; of lines on the screen after
CAMG C,NLINES ; the four display lines
IFSKP.
CALL MORPMT ;Get the more prompt
JFCL ;Accept any answer
CALL BLKLIN ;Clear the line
ENDIF.
RET
;SUBBP - Subtracts the second byte pointer from the first resulting in
; the number of characters between them
;Takes A/ Byte pointer 1
; B/ Byte pointer 2
;Returns A/ 1-2 characters
SUBBP: SAVEAC <B,C,D>
MAKPTR A ;Make sure this is a byte pointer
MAKPTR B ;And this one too
MOVEI C,1
ADJBP C,B ;Put second pointer incremented in C
IBP A ;Now neither pointer is "44xx00,,"
MULI A,5 ;Multiply pointer by bytes per word
SUBI B,-4(A) ;B holds character address
MULI C,5 ;Do same to other pointer
SUBI D,-4(C)
SUB B,D ;Calculate difference
HRRE A,B ;Return answer in A.
RET
END <EVECL,,EVEC>
-------
