; Append a date/time stamp and message to a file
;
; nSTAMP.LIT (see .HLP file for docs)
;
; (C)1988 By Ami Bar-Yadin.
; AMUS ID: AMI/AM
;
; All commercial rights reserved, etc.
;
; If you want to include STAMP with a commercial package,
; go right ahead so long as you include the UNCHANGED source (.m68) with it.
;
; No warranties and/or guarranties of any kind, etc.
;
; Not responsible for damages resulting from the use of this program, etc.
;
; My employer (United Fashions) has nothing to do with this program and
; should not be blamed for it.
;
; I can be reached at:
; United Fashions of Texas, Inc.
; 200 Ash Ave.
; McAllen, TX 78501
; (512) 631-2277/2276
; 8am-6pm
;
;
; Revision history (latest to earliest):
;
; [102] 04/22/88 aby Released to AMUS
; Added alternate allocation of output buffer
; If there is not enough memory, STAMP will
; allocate the rest of memory except 8 bytes.
; STAMP will quit if there are not at least
; BUFMIN bytes available for the buffer.
; STAMP will now abort if the buffer gets full
; This could not really have happend before
; because of the 4Kb buffer size.
; Added buffer space countdown to text line prompt
;
; [101] 04/22/88 aby Added "An" pad type WOW!
;
; [2.1] 04/21/88 aby STAMP will now build the output in memory and will
; not write to the output file at all if there are
; ANY command line errors,
; The size of the buffer is controled by BUFSIZ.
;
; [2.0] 04/20/88 aby Major overhaul
; Redefined output and switches behavior
; Added various output switches
; Restructured mode switches to new specs
; Added text input line continuation
; with CR/LF suppress option
;
; [1.2] 10/20/86 aby Changed Default mode to Whole, added Brief mode
; Added CR after "Enter Message:" prompt
;
; CREDITS: GINDTA.SV offsets for AlphaBASE user name and user ID were
; plucked from LSTUSR.M68 available on the AMUS network.
; Unfortunatly the source does not include the author's name.
;
; And anyone else whose code I've seen for anything that may
; have been included here.
;
;
L0:
VMAJOR=2
VMINOR=1
VEDIT=102.
SYM
SEARCH SYS
SEARCH SYSSYM
SEARCH TRM
RADIX 16.
DEFAULT VEDIT,1
DEFAULT $$MFLG,PV$RSM!PV$WSM
DEFAULT $$SFLG,PH$REE!PH$REU
DEFAULT $$SFLG,0
DEFAULT $$LFLG,-1
PHDR $$LFLG,$$MFLG,$$SFLG
EXTERN $ODTIM,$CMDER
;[102]
; offset of module name from module's (real) base
;
M.NAM = 6
;
; ascii chars
;
CR = 13.
LF = 10.
;[102]
; IMPGET macro (GETIMP with module name)
;
IF NDF,IMPGET
DEFINE IMPGET SIZE,IDX,NOMEM,MODNM1,MODNM2,MODEXT
PUSH SIZE ; NOTE: MAC:SYS.M68 has PUSH #SIZE)
PUSH
GETMEM @SP
IF B,NOMEM
BEQ 10$$
EXIT
10$$:
IFF
JNE NOMEM
ENDC
POP IDX
POP
IF NB,MODNM1, MOVW #[MODNM1],M.NAM-ZID(IDX)
IF NB,MODNM2, MOVW #[MODNM2],M.NAM+2-ZID(IDX)
IF NB,MODEXT, MOVW #[MODEXT],M.NAM+4-ZID(IDX)
ENDM
; allocate memory
ENDC
SM$D = 512.
SM$T = 1
SM$W = 2
SM$N = 18678.
SM$B = 0
SM$DEF = SM$W
;
;
PAD$S = -1 ; pad with one space
PAD$C = -2 ; comma
PAD$T = -3 ; TAB
PAD$A = -4 ; to field width+n [101]
BUFSIZ=4*1024. ; define size of output buffer to be 4Kb
; (51 lines of 80 chars, fill this up!)
BUFMIN=80 ; define minimum buffer size as one line of 80 chars
DSECT
DDB: BLKB D.DDB ; output file
DDB2: BLKB D.DDB ; 2nd ddb for /F use
STMODE: BLKL 1 ; stamp output mode
GINPTR: BLKL 1 ; pointer to MEM:GINDTA.SV
OUTBUF: BLKL 1 ; pointer to beginning of output buffer
OUTPTR: BLKL 1 ; pointer to next byte in output buffer
OUTFRE: BLKL 1 ; number of bytes free in output buffer
PADMOD: BLKB 1 ; 1..50 fixed width
; 0 natural fixed width
; PAD$S one space pad (-1)
; PAD$C comma pad (-2)
; PAD$T TAB pad (-3)
PADADD: BLKB 1 ; will be added to width for PAD$A [101]
; total width must be 1..50
ECHOF: BLKB 1 ; non zero if terminal echo is on
; =2 if file output is (see /E)
SNTL: BLKB 1 ; MUST be just before BUFFER and set to a non space.
BUFFER: BLKB 51. ; (any value except 32.)
IMPSIZ:
PSECT
STAMP:
CALL SETUP ; allocate memory; init output buffer;
; plus misc
BYP
LIN
JEQ USAGE ; type usage message if command line is blank
CMPB @A2,#'? ; or ?
JEQ USAGE ; i.e. "STAMP<cr>" or "STAMP ?<cr>"
FSPEC DDB(A5),LOG ; process log file spec
; will abort on error
; output will be built in memory buffer [2.1]
CALL SWITCH ; process switches
CALL TXT ; process rest of command line for text
CALL WRTBUF ; write buffer to file [2.1]
EXIT: EXIT
SETUP:
IMPGET #IMPSIZ,A5,,STA,MP,IMP ; allocate impure memory
INIT DDB(A5) ; initilize DDB (allocate IO buffer)
INIT DDB2(A5) ; initilize DDB2
MOVB #0FF,SNTL(A5) ; set backscan stopgap for BUFFER
MOV SM$DEF,STMODE(A5) ; set default stamp mode
CALL INIBUF ; allocate/init output buffer [102]
; will abort on error [102]
TRMRST D1 ; read terminal status
OR #T$ILC,D1 ; enable lower case input
TRMWST D1 ; write terminal status
PUSH A2 ; save command line pointer
LEA A2,PRGNAM ; set pointer to program name buffer
LEA A1,L0-ZID+M.NAM ; set poitner to program name in MEM:
UNPACK ; unpack program name to ASCII
UNPACK
POP A2 ; restore command line pointer
RTN
;
;[102] added routine INIBUF
;
; Allocate and initilize output buffer
;
;
INIBUF:
; try the easy way first, use standard allocate macro
IMPGET #BUFSIZ,A3,10$,STA,MP,BUF ; allocate output buffer
MOV #BUFSIZ,D2 ; allocated BUFSIZ bytes succesfully
JMP 99$
10$:
; gets here if simple allocation of BUFSIZ bytes fails
; now got to do it the hard way
;
; find out how much memory we've got left (everything else is already in)
;
USRFRE D6 ; address of first free byte
; (just past last 0L in MEM: chain)
USREND D2 ; address of last word in memory
SUB D6,D2 ; D2 is bytes free
SUB #8,D2 ; leave 8 bytes as safety margin
; check
CMP D2,#BUFMIN ; have we got the minimum?
JLOS 20$ ; YEAH
TYPE <?Not enough memory for minimum buffer size (>
MOV #BUFMIN,D1
DCVT 0,OT$TRM!OT$TSP
TYPECR <bytes).>
EXIT
20$:
PUSH D2 ; I want it all!
PUSH
GETMEM @SP
BEQ 30$
TYPE <?Error allocating rest of memory (>
MOV D2,D1
DCVT 0,OT$TRM!OT$TSP
TYPECR <bytes) for output buffer.>
EXIT
30$:
POP A3
POP
99$:
MOV A3,OUTBUF(A5) ; initilize output buffer
MOV A3,OUTPTR(A5) ; init pointer to next byte
MOV D2,OUTFRE(A5) ; init free bytes count
RTN
;
; terminate output buffer stream and write to output file
;
WRTBUF:
MOV OUTPTR(A5),A6 ; get pointer to next position in
; output buffer stream
CLRB @A6 ; terminate output buffer stream
MOV OUTBUF(A5),A3 ; get pointer to start of buffer
CMPB ECHOF(A5),#2 ; output buffer to file?
BEQ 10$
CALL OPNFIL ; open (append or create) output file
LEA A2,DDB(A5) ; address output file
OUTL @A3,OT$DDB ; output buffer to file
CLOSE DDB(A5) ; close output file
10$:
TSTB ECHOF(A5) ; echo to terminal?
BEQ 99$ ; no
OUTL @A3,OT$TRM ; echo output buffer to terminal
99$: RTN
; process command line switches
SWITCH:
0$: BYP
LIN
JEQ 99$ ; exit if end of command line
CMPB @A2,#'/
JNE 99$ ; exit if not switch introducer ("/")
INC A2
10$:
LIN
JEQ 99$ ; exit if end of command line
MOVB @A2,D7
CMPB D7,#SPACE
BEQ 0$ ; reenter switches loop at top if blank switch
CMPB D7,#'/ ; switch introducer again?
BEQ 0$ ; yes, reenter switches loop at top
LEA A6,SWTBL
CLR D6 ; use D6 to index thru table
11$:
CMPB D7,(A6)+ ; search switches table
BEQ 15$ ; match! jump thru table
INC D6 ; count table entries
TSTB @A6 ; end of table?
BNE 11$ ; no; loop till end of table
13$: LEA A1,SWERR1 ; unknown switch
CALL $CMDER
JMP EXIT
15$:
INC A2 ; advance command line pointer
LEA A6,SWJTBL
ASL D6 ; computer address of jump table entry
ADD D6,A6
MOVW @A6,D6 ; get offset to routine
ADD D6,A6 ; compute subroutine address
DEFINE TOBUF STRING
LEA A0,STRING ; get address of string
CALL TOBUF ; call actual code
ENDM
;
; Type string (@A0) to Output Buffer
; string must be null terminated
; updates A0 to past end of string
;
; ALL output to buffer goes thru here
;
TOBUF:
MOV OUTPTR(A5),A6 ; ->next byte in output buffer stream
MOV OUTFRE(A5),D6 ; how many free bytes in buffer
DEC D6 ; (for DBxx opcode)
10$: MOVB (A0)+,D7 ; copy string....
CMPB D7,#LF ; (skip line feeds)
BEQ 10$
MOVB D7,(A6)+ ; ....to output buffer
DBNE D6,10$ ; until terminating null OR buf full
TST D6
BMI BUFULL ; BUFFER IS FULL
DEC A6 ; next character will overlay
; terminating null
ADD #2,D6 ; one for null one for DBxx
DEFINE DOPAD PADTYP
POP A2
IF NB,PADTYP, MOV #PADTYP,D2 ; set default pad type
CALL DOPAD ; process pad specs
PUSH A2
ENDM
;
; process A switch: Abort if output file does not exists
;
PSWA:
LOOKUP DDB(A5) ; output file exists?
BNE 1$
RTN ; file exists, continue as usual
1$: LEA A1,NOFILE ; file does not exits
CALL $CMDER
JMP EXIT
;
; process E switch: Echo output to terminal
;
PSWE:
MOVB #1,ECHOF(A5) ; enable terminal echo
CMPB @A2,#'X ; if "/EX"
BNE 99$ ; no
INC A2 ; bypass "X"
MOVB #2,ECHOF(A5) ; disable file output
99$: RTN
;
; process C switch: Output CR/LF pair
;
PSWC:
TOBUF CRLF ; place CR/LF in output buffer
RTN
;
; process G switch: Set global padding default
; /G[ n | C | S |T ]
;
PSWG:
CALL PADSPC ; process padding specification (return D1)
MOVB D1,PADMOD(A5) ; set global default padding mode
CLRB PADADD(A5) ; clear additional width [101]
CMPB D1,#PAD$A ; "An" pad type? [101]
BNE 99$ ; no [101]
MOVB D3,PADADD(A5) ; yes, set additional width value [101]
99$: RTN
;
; process S switch: Output date/time stamp with optinal format specification
; /S[ n | Fs | [ D | T | W | N | B ] ]
;
PSWS:
NUM
BEQ 20$ ; process numeric specs
CMPB @A2,#'^
BEQ 30$ ; process string flags
;
; process mode character
;
MOVB @A2,D7
LEA A6,SWSTBL ; S switch mode characters/value table
10$: MOVB (A6)+,D6 ; get next valid mode char from table
BEQ 15$ ; end of table - error
CMPB D6,D7 ; search mode char/value table
BEQ 13$ ; match
ADD #3,A6 ; adjust to next table entry
BR 10$
13$: INC A2 ; adjust pointer past mode character
MOVB (A6)+,D2 ; get padding type
MOVW @A6,D1 ; match, get flags value
BR 90$ ; set output mode and output stamp
15$: LEA A1,SWERR2 ; invalid mode character
CALL $CMDER
JMP EXIT
;
; process numeric mode specification
;
20$:
GTOCT
BMI 25$ ; if numeric error
MOV #PAD$S,D2 ; pad with one space
BR 90$ ; set output mode and output stamp
25$: LEA A1,SWERR3 ; invalid character in number
CALL $CMDERR
JMP EXIT
;
; process bit string mode specification
;
30$:
MOV #PAD$S,D2 ; pad with one space
INC A2
CLR D1
31$: BYP ; skip space(s)
LIN
JEQ 90$ ; end of line, set output mode and exit
CMPB @A2,#'1
BEQ 33$
CMPB @A2,#'Y ; 1 or Y represent an ON bit
BEQ 33$
CMPB @A2,#'0 ; 0 or N represent an OFF bit
BEQ 32$
CMPB @A2,#'N
BNE 90$ ; any other character terminates scan
32$: ASL D1 ; append a zero bit to mode value
BR 31$ ; loop
33$: ASL D1 ; append a zero bit to mode value
BSET #0,D1 ; change it to a one bit
BR 31$ ; loop
;
; set output mode, output stamp and exit subroutine
;
90$: MOV D1,STMODE(A5) ; set STAMP output mode
CALL ODTIM ; OUTPUT DATE/TIME STAMP
99$: RTN ; return to switches loop
; define switch /Sx table entry macro
DEFINE SWSENT CHAR,ODTFLG,PADTYP ; mode char, $ODTIM format, pad type
BYTE CHAR,PADTYP
WORD ODTFLG
ENDM
SWSTBL: SWSENT 'D,SM$D,9. ; date only stamp, width 9
SWSENT 'T,SM$T,8. ; time only stamp, width 8
SWSENT 'W,SM$W,22. ; whole stamp, width 22
SWSENT 'N,SM$N,42. ; normal (full) stamp, width 42
SWSENT 'B,SM$B,18. ; brief stamp, width 18
;
; Process J switch: Output job name with optional padding specification
; /J[ n | C | S | T ]
;
PSWJ:
PUSH A2 ; save command line pointer
; setup job's name in BUFFER
LEA A2,BUFFER(A5) ; address work buffer
JOBIDX ; get JCB pointer
LEA A1,JOBNAM(A6) ; point to job name in JCB
UNPACK ; unpack job name to ASCII
UNPACK
CLRB @A2 ; terminate job name string
DOPAD 6 ; process pad specs
TOBUF BUFFER(A5) ; copy work buffer to output buffer
POP A2 ; restore command line pointer
RTN ; return to switches loop
;
; Process T switch: Output terminal name with optional padding spcification
; /T[ n | C | S | T ]
;
PSWT:
PUSH A2 ; save command line pointer
; setup terminal name in BUFFER
LEA A2,BUFFER(A5)
JOBIDX ; get JCB pointer
MOV JOBTRM(A6),A6 ; get TCB pointer
LEA A1,-4(A6) ; point to terminal name before TCB
UNPACK
UNPACK
CLRB @A2
DOPAD 6 ; process pad specs
TOBUF BUFFER(A5) ; send to output buffer
POP A2 ; restore command line pointer
RTN ; return to switches loop
;
; Process D switch: Output terminal driver name with optional padding spcification
; /D[ n | C | S | T ]
;
PSWD:
PUSH A2 ; save command line pointer
; setup terminal driver name in BUFFER
LEA A2,BUFFER(A5)
JOBIDX ; get JCB pointer
MOV JOBTRM(A6),A6 ; get TCB pointer
MOV T.TDV(A6),A6 ; get TDV poiner
LEA A1,-4(A6) ; point to driver name before TDV entry point
UNPACK
UNPACK
CLRB @A2
DOPAD 6 ; process pad specs
TOBUF BUFFER(A5) ; copy to output buffer
POP A2 ; restore command line pointer
RTN ; return to switches loop
;
; Process L switch: Output login location with optional padding specification
; /L[ n | C | S | T ]
;
PSWL:
PUSH A2 ; save command line pointer
DOPAD 15. ; process pad specs
TOBUF BUFFER(A5) ; copy to output buffer
POP A2 ; restore command line pointer
RTN ; return to switches loop
OPPN:
PUSHW JOBTYP(A3) ; save radix
MOVW #^CJ.HEX,D7
ANDW D7,JOBTYP(A3) ; set octal
MOVW JOBUSR(A3),D1
PUSHW D1 ; save D1
LSRW D1,#8
OCVT 0,OT$MEM ; unpack project number
MOVB #COMMA,(A2)+ ; a comma
POPW D1 ; get original D1
AND #0FF,D1
OCVT 0,OT$MEM ; unpack programmer number
POPW JOBTYP(A3) ; restore radix
RTN
;
; Process P switch: Output program name with optional padding specification
; /P[ n | C | S | T ]
;
; of course, program name will always be the name of the STAMP program;
; that is "STAMP" unless the program is renamed.
;
PSWP:
PUSH A2 ; save command line pointer
; setup program name in BUFFER
LEA A2,BUFFER(A5)
JOBIDX ; get JCB pointer
LEA A1,JOBPRG(A6) ; point to program name in JCB
UNPACK
UNPACK
CLRB @A2
DOPAD 6 ; process pad specs
TOBUF BUFFER(A5) ; copy to output buffer
POP A2 ; restore command line pointer
RTN ; return to switches loop
;
; Process U switch: Output User name with optional padding specification
; /U[ n | C | S | T ]
;
; AMOSL 1.3 or latter ONLY
;
PSWU:
PUSH A2 ; save command line pointer
; setup user name in BUFFER
LEA A2,BUFFER(A5)
JOBIDX ; get JCB pointer
LEA A1,JOBUSR(A6) ; point to user name in JCB
MOV #20.-1,D6 ; 2
0 chars is max user name (-1 for DBxx)
1$: MOVB (A1)+,(A2)+ ; copy user name to buffer
DBEQ D6,1$
CLRB @A2
DOPAD 20. ; process pad specification
TOBUF BUFFER(A5) ; copy to output buffer
POP A2 ; restore command line pointer
RTN ; return to switches loop
;
; Process V switch: Output AlphaBase user name with optional padding specification
; /V[ n | C | S | T ]
;
; ONLY if GINDTA.SV is in MEM:
;
;
PSWV:
CALL FGINDT ; find MEM:GINDTA.SV (return A3)
BNE 10$
LEA A1,SWERR4 ; Can't find MEM:GINDTA.SV
CALL $CMDER
JMP EXIT
10$:
PUSH A2 ; save command line pointer
; setup user name in BUFFER
LEA A2,BUFFER(A5)
LEA A1,4C4(A3) ; point to user name in GINDTA
MOV #30.-1,D6 ; 30 chars is max user name (-1 for DBxx)
20$: MOVB (A1)+,(A2)+ ; copy user name to buffer
DBEQ D6,20$
CLRB @A2
DOPAD 30. ; process pad specification
TOBUF BUFFER(A5) ; copy to output buffer
POP A2 ; restore command line pointer
RTN ; return to switches loop
;
; Process I switch: Output AlphaBase user ID with optional padding specification
; /I[ n | C | S | T ]
;
; ONLY if GINDTA.SV is in MEM:
;
;
PSWI:
CALL FGINDT ; find MEM:GINDTA.SV (return A3)
BNE 10$
LEA A1,SWERR4 ; Can't find MEM:GINDTA.SV
CALL $CMDER
JMP EXIT
10$:
PUSH A2 ; save command line pointer
; setup user ID in BUFFER
LEA A2,BUFFER(A5)
LEA A1,4BE(A3) ; point to user name in GINDTA
MOV #6-1,D6 ; 6 chars is max user name (-1 for DBxx)
20$: MOVB (A1)+,(A2)+ ; copy user name to buffer
DBEQ D6,20$
CLRB @A2
DOPAD 6 ; process pad specification
TOBUF BUFFER(A5) ; copy to output buffer
POP A2 ; restore command line pointer
RTN ; return to switches loop
;
; process F switch: Output file name and version (if any)
; /Ffile
; Default extension is .LIT
;
PSWF:
FSPEC DDB2(A5),LIT ; process file spec (abort on error)
OPENI DDB2(A5)
PUSH A2 ; save command line pointer
LEA A2,BUFFER(A5) ; address work buffer
; output file name to work buffer
OFILE DDB2(A5),OT$MEM!OT$OFD!OT$OFN!OT$OFP
CLRB @A2 ; terminate file name string
DOPAD PAD$S ; pad buffer with one space
TOBUF BUFFER(A5) ; copy to output buffer
INPUT DDB2(A5),,0 ; Get first block
MOV D.BUF+DDB2(A5),A4 ; get address of disk IO buffer
ADD D.IDX+DDB2(A5),A4 ; adjust according to index
CMPW @A4,#-1 ; program header exists?
BEQ 10$ ; yes
CMPW @A4,#-2 ; the other header prefix
JNE 90$ ; no header
10$:
LEA A2,BUFFER(A5) ; address work buffer
VCVT 2(A4),OT$MEM ; output version to work buffer
CLRB @A2 ; terminate file name string
DOPAD PAD$S ; pad buffer with one space
TOBUF BUFFER(A5) ; copy to output buffer
90$:
POP A2 ; restore command line pointer
RTN
; process text
;
TXT:
MOV OUTPTR(A5),A3 ; get pointer to output buffer stream
MOV OUTFRE(A5),D3 ; get free bytes count
BYP
LIN
BEQ 30$ ; no text on command line, prompt user
CMPB (A2)+,#'!
BNE TXT
;
; output text
;
0$:
10$: MOVB (A2)+,D1
BEQ 99$ ; end of text
CMPB D1,#CR ; CR is end of text
BEQ 99$
CMPB D1,#LF ; LF is end of text
BEQ 99$
CMPB D1,#'+ ; + is end of text line/continue
BEQ 20$
MOVB D1,(A3)+
DEC D3
BNE 10$ ; buffer still has room
JMP BUFULL ; buffer is full
;
; process "+" or "++"
;
20$:
CMPB @A2,#'+ ; (2nd "+") suppress CR/LF?
BEQ 30$ ; yes
MOVB #CR,(A3)+ ; output CR(/LF) to output buffer
DEC D3
JEQ BUFULL ; buffer is full
;
; prompt user for continuation line
;
30$:
TYPE <Enter next text line (>
MOV D3,D1
DCVT 0,OT$TRM!OT$TSP
TYPECR <bytes free in buffer):>
KBD EXIT
BR 0$
99$: MOVB #CR,(A3)+
DEC D3 ; no buffer full check is done here
MOV A3,OUTPTR(A5) ; update output buffer stream pointer
MOV D3,OUTFRE(A5)
CLRB @A3
RTN
;
; process padding mode specification
; return pad type in D1
; return n in D3 for "An" (i.e. /GA3)
;
PADSPC:
NUM
BNE 10$ ; process non-numeric specs
;
; process numeric field width
;
GTDEC
BPL 1$
LEA A1,SWERR3 ; invalid number
CALL $CMDER
EXIT
1$: CMPB D1,#50
BLE 99$ ; ok, exit
LEA A1,SWERR5 ; fixed field width greater than 50
CALL $CMDER
EXIT
;
; process non-numeric padding specification
;
10$: LEA A6,PADTBL ; padding character/value table
MOVB @A2,D7
13$: CMPB D7,(A6)+ ; search padding table
BEQ 16$ ; match; get value, set mode and exit
INC A6 ; skip value byte
TSTB @A6 ; end of table?
BNE 13$ ; loop until end of table
; if end of table reached, set natural mode
; (neat little shortcut here: A6 points to the NULL table terminator
; and natural mode is a zero, so...)
BR 17$
16$: INC A2 ; advance A2 past padding spec
17$: CLR D1
MOVB @A6,D1 ; (match) get value from table and...
CMPB D1,#PAD$A ; pad type "An"? [101]
BNE 99$ ; no [101]
PUSH D1 ; [101]
GTDEC ; get n value [101]
MOV D1,D3 ; [101]
POP D1 ; [101]
99$: RTN
PADTBL: BYTE 'A,PAD$A,'C,PAD$C,'S,PAD$S,'T,PAD$T,0 ; [101]
EVEN
;[101]
; Override field padding type (D2)
; D1 is overriding padding type
; D3 is (optional: only if D1=PAD$A) additional field width
;
SETPAD:
TSTB D1 ; is there an override?
BEQ 99$ ; no (or /G0 which is the same anyway)
CMPB D1,#PAD$A ; is override a "An" type?
BNE 90$ ; no
TSTB D2 ; is default field padding a fixed field?
BMI 99$ ; no, IGNORE /G value
ADDB D3,D2 ; add /GAn value to field width
BEQ 10$ ; erorr if resulting width = 0
BMI 10$ ; error if <0 (signed byte)
CMPB D2,#50.
BLE 99$ ; ok if <=50.
10$: LEA A1,SWERR6 ; field width out of range (<=0 or >50)
CALL $CMDER
JMP EXIT
90$: MOVB D1,D2 ; override natural pad type
99$: RTN
;
; processing optional padding spec for an output switch
; modify BUFFER as needed
; D2 is natural field width
;
DOPAD:
; override natural width with global default if set up
PUSH D2 ; save default padding for field
MOVB PADMOD(A5),D1 ; get global default [101]
MOVB PADADD(A5),D3 ; get optional additional width [101]
CALL SETPAD ; override field pad if global default exists
CALL PADSPC ; process padding spec (return D1)
TSTB D1 ; user supplied padding type?
BEQ 20$ ; no
POP D2 ; restore original field padding type
CALL SETPAD ; override field pad with user specs
; (if supplied)
PUSH D2
20$: TSTB D2
BMI 30$ ; process S C or T modes
;
; process fixed width
;
LEA A6,BUFFER(A5)
DEC D2
22$: TSTB (A6)+ ; scan BUFFER to NULL or end of field
DBEQ D2,22$
TSTW D2
BMI 99$ ; end of field reached, terminate string
DEC A6
23$: MOVB #SPACE,(A6)+
DBEQ D2,23$
BR 99$ ; terminated string and exit
;
; process C S or T
;
; first, find end of string in BUFFER
;
30$: LEA A6,BUFFER(A5)
31$: TSTB (A6)+ ; scan BUFFER to terminating NULL
BNE 31$ ; (A STATEMENT WITH INFINITE POTENTIAL)
DEC A6 ; back to terminating null
;
; now scan BACKWARDS past any (trailing) spaces
;
32$: CMPB -(A6),#SPACE ; backscan past any trailing spaces
BEQ 32$ ; will stop >for sure< on SNTL(impure)
;
; now append a space, a comma or a TAB to the string
;
INC A6 ; move back to first of the trailing spaces
CMPB D2,#PAD$C ; comma?
BNE 33$
MOVB #COMMA,(A6)+ ; append a comma
BR 99$ ; terminate string and exit
33$: CMPB D2,#PAD$S ; space?
BNE 34$
MOVB #SPACE,(A6)+ ; append a space
BR 99$
34$: MOVB #TAB,(A6)+ ; append a TAB
99$: CLRB @A6 ; terminate string
POP D2 ; restore field padding type
RTN
HLPCMD: ASCII /HELP /
PRGNAM: ASCIZ /123456/ ; will be overlayd with program's name
EVEN ; at startup
;
; OPEN OUTPUT FILE FOR APPEND, OR CREATE IF FILE DOES NOT EXISTS
;
OPNFIL:
LOOKUP DDB(A5)
BEQ 1$
OPENO DDB(A5)
BR 99$
1$: OPENA DDB(A5)
99$: RTN
;
; find MEM:GINDTA.SV return A3
;
FGINDT:
TST GINPTR(A5) ; have we located GINDTA?
BEQ 10$ ; no, search for it
MOV GINPTR(A5),A3 ; yes, get address
RTN ; return with NE for success
10$: SRCH GINDTA,A3,F.USR
BEQ 20$ ; BRANCH IF FOUND MEM:GINDTA.SV
CLR GINPTR(A5) ; can't find GINDTA
RTN ; return with EQ for fail
20$: MOV A3,GINPTR(A5) ; save address in case we need it again
TST GINPTR(A5)
RTN ; return with NE for success
GINDTA: RAD50 /GINDTASV /
;
; OUTPUT DATE/TIME STAMP ACCORDING TO MODE IN STMODE(impure)
;
ODTIM:
PUSH A2 ; save command line pointer
PUSH D2 ; save padding type
LEA A2,BUFFER(A5) ; ODTIM will output to this buffer
CLR D3
CLR D4
CLR D5
MOV STMODE(A5),D5
AND #07FFF,D5 ; FORCE BITS 15-31 OFF
CALL $ODTIM
CLRB @A2 ; terminated date/time stamp string
POP D2 ; restore padding type
DOPAD ; pad according to stamp type
; (unless /Gx override)
TOBUF BUFFER(A5) ; place BUFFER in output buffer
POP A2 ; restore command line pointer
RTN
;
; ASCII TEXT AREA
;
; General purpose text
;
CRLF: BYTE CR,0 ; (LF will be inserted by OUTL in
; WRTBUF routine)
;
; Error messages text
;
NOFILE: BYTE CR,LF
ASCIZ /%Output file not found; aborting as requested./
SWERR1: BYTE CR,LF
ASCIZ /?Unknown switch/
SWERR2: BYTE CR,LF
ASCIZ /?Invalid date output mode character/
SWERR3: BYTE CR,LF
ASCIZ /?Invalid number/
SWERR4: BYTE CR,LF
ASCIZ /?AlphaBASE user data requested but GINDTA.SV is not in MEM:/
SWERR5: BYTE CR,LF
ASCIZ /?Fixed field width greater than 50/
SWERR6: BYTE CR,LF
ASCIZ /?Resulting field width is less than zero or greater than 50/
