Trailing-Edge
-
PDP-10 Archives
-
decuslib20-10
-
decus/20-184/mlib.mac
There are no other files named mlib.mac in the archive.
IFNDEF REL,<REL==1> ;1=assemble REL, 0=assemble UNV
;To make MLIB.REL & MLIB.UNV use the following command:
; @TAKE LIB:MLIB.CMD
;WHO DATE MODIFICATIONS
;=== ========= ================================================
;DLW 18-Feb-85 -genesis
SUBTTL MISCELLANIOUS SYMBOLS
IFE REL,<
UNIVERSAL MLIB - common routine library
SEARCH MONSYM,MACSYM
.DIRECTIVE .NOBIN ;don't generate a REL file
DEFINE SPTR (A,$STR) < HRROI A,[ASCIZ\$STR\]>
DEFINE PX ($MSG)< IF1 <PRINTX $MSG>>
;; macro to display a comment during assembly only if PASS1
PX <Assembling universial file MLIB.UNV>
SUBTTL DIRECT ASSIGNMENTS
STDAC. ;use standard accumulator definitions
;character codes
.CTRLJ==12 ;^J - line feed
.CTRLM==15 ;^M - carrage return
.CTRLL==14 ;^L - form feed
.CHDQT==42 ;double quote
.CHDEL==177 ;<del> character
;flags used in register "F"
F%ECHO==1B35 ;1=echo commnads from the TAKE command file
F%RSCN==1B34 ;1=input comming from RSCAN buffer
F%NO==1B33 ;1=negate (general purpose negate flag)
F%RNOP==1B32 ;1=DOCMD ignores setting of CM%NOP and returns to caller
; F%____==1B31 ;reserve for future expansion
; F%____==1B30 ;reserve for future expansion
SUBTTL MACROS DEFINITIONS
;===============================================================================
;this macro will send a message to user's terminal if nessary. F%ECHO
;F%RSCN and TAKJFN are taking into consideration.
DEFINE TAKMSG ($MSG)<
IFDIF <$MSG><->,<HRROI T1,[ASCIZ\$MSG\]>
CALL [IFXE. F,F%ECHO
TXNN F,F%RSCN
SKIPE TAKJFN
TRNA
ENDIF.
PSOUT
RET]
>
;===============================================================================
; This macro checks whether the terminal terminal is VT100 type terminal
; and set the flag provided by the user
DEFINE CKTTY (F%FLAG,$AC) <
CAIN T2,.TT100 ;is it a VT100?
IFSKP.
CAIE T2,.TT102 ;no, is it a VT102?
CAIN T2,.TT131 ;no, is it a VT131?
TRNA ;yes, it is a VT102
CAIN T2,.TT200 ;is it a VT200
ENDIF.
IFNB <F%FLAG>,<
IFNB <$AC>,<
IFNSK.
TXO F,F%FLAG ;yes, it is a VT100 or VT102
MOVEI $AC,.TT100 ;or VT131 or VT200
ENDIF.
>
>
IFB <F%FLAG>,<IFNB <$AC><MOVEI $AC,.TT100>>
IFB <$AC>,<IFNB <F%FLAG><TXO F,F%FLAG>>
>
DEFINE RELJFN ($JFN) <
;; macro to release JFN's
IRP $JFN,<
SKIPE T1,$JFN ;any JFN's around from last command?
RLJFN% ;yes - release it (JFN already in T1)
JERR (%,,PC)
SETZM $JFN ;zero so I don't do it again
>
>;end of RELJFN
DEFINE ZERO ($FROM,$TO) <
;; macro to zero a range of memory from $FROM to $TO
SETZM $FROM
MOVE T1,[XWD $FROM,$FROM+1]
BLT T1,$TO
>;end of ZERO
DEFINE BLTMOV ($FROM,$TO,$DEST) <
;; macro to move a block of words from $FROM to $TO to the
;; destination $DEST
IFLE <$TO-$FROM>,<PRINTX Bad arguments for BLTMOV macro>
IFG <$DEST-17>,< ;;destination is not an accumulator
IFG <$TO-17>,< ;;source is not the accumulators
MOVE T1,[$FROM,,$DEST]
BLT T1,$DEST+$TO-$FROM>
IFLE <$TO-17>,< ;;source is the accumulators
MOVEM $TO,$DEST+$TO-$FROM ;;save BLT register
IFE <$FROM>,<MOVEI $TO,$DEST>
IFN <$FROM>,<MOVE $TO,[$FROM,,$DEST]>
BLT $TO,$DEST+$TO-$FROM-1 ;;save rest of registers
MOVE $TO,$DEST+$TO-$FROM ;;restore BLT register>>
IFLE <$DEST-17>,< ;;destination is the accumulators
IFG <$TO-17>,< ;;source is not the accumulators
IFE <$DEST>,<MOVSI $DEST+$TO-$FROM,$FROM>
IFN <$DEST>,<MOVE $DEST+$TO-$FROM,[$FROM,,$DEST]>
BLT $DEST+$TO-$FROM,$DEST+$TO-$FROM>>
>;end of BLTMOV
DEFINE SETNAM (PRINAM,SYSNAM<(PRIV)>) <
;; macro to set the system and private name of the program. Normally you
;; won't need to do this unless you want to set the system name because
;; the EXEC will do it when it runs a program
IFDIF <SYSNAM><(PRIV)>,<
DMOVE T1,[SIXBIT /SYSNAM/ ;;system name of program
SIXBIT /PRINAM/] ;;private name of program
SETSN%
TRN ;;no currently defined errors
>
IFIDN <SYSNAM><(PRIV)>,<
MOVE T1,[SIXBIT /PRINAM/] ;;private name of program
SETNM%
>
>
DEFINE CMD.DA ($MYNAME,$TOPCLP,$PDLEN<30>,$CMDBLN<60>,$ATMBLN<20>) <
;;macro to set up the storage required by programs using the
;;COMND% jsys. It will also define CMD.ZV which should be placed
;;in the area that will be zeroed on warm restarts and CMD.WM
;;which should be executed for warm restarts
DEFINE CMD.ZV <
;;variables required by COMND% that need to be zeroed upon startup
;;and restart must be placed here
TMPJFN:: 0 ;JFN got by using COMND% saved here
TAKJFN:: 0 ;JFN of of "TAKE" file
>;end of CMD.ZV
DEFINE CMD.WM <
;;this code needs to be executed at program startup for warm restarts
MOVE T1,CMNDIO ;reset I/O designators for COMND
MOVEM T1,CMDBLK+.CMIOJ
>;end of CMD.WM
PDLEN==$PDLEN
PDL: BLOCK PDLEN ;push down list
BLOCK 4 ;some routines temporarly save data on data by DMOVEM ,1(P)
;maximum # words saved this way are 4 so allow space incase
;stack is full
STWARM: 0 ;non-zero means program was previouly started so I know...
; ...when to do a warm restart
SAVEP:: 0 ;saves stack pointer for reparse and changing command levels
CMDBLN==:$CMDBLN
CMDBUF::BLOCK CMDBLN ;command buffer
ATMBLN==:$ATMBLN
ATMBUF::BLOCK ATMBLN ;atom buffer
;NOTE: The RCNINP routine requires that ATMBUF must follow CMDBUF
IFN CMDBUF+CMDBLN-ATMBUF,<PRINTX ?ATMBUF must follow CMDBUF>
CMNDIO::.PRIIN,,.PRIOU ;the normal I/O JFN's for CMDBLK
RSCNIO::.CTTRM,,.NULIO ;I/O JFN's for CMDBLK when RSCAN in progress
MYNAME::ASCIZ \$MYNAME\
TOPCLP: ASCIZ \$TOPCLP\
;Command State Block for COMND%
CMDBLK::0,,RPARSE## ;flags,,address of reparse routine
.PRIIN,,.PRIOU ;JFNs for command I/O
POINT 7,TOPCLP ;^R buffer (top command level prompt string)
POINT 7,CMDBUF ;pointer to start of text buffer
POINT 7,CMDBUF ;pointer to start of next input
CMDBLN*5-1 ;size of command buffer in bytes
0 ;number of unparsed characters
POINT 7,ATMBUF ;pointer to start of atom buffer
ATMBLN*5-1 ;size of atom buffer in bytes
GTJBLK ;address of GTJFN block
GTJBLK::BLOCK .GJATR+1 ;GTJFN block
>;end of CMD.DA
;===========================================================================
DEFINE ERRMSG ($CAL,$ERHAN,$C,$MSG,$PC,$RET) <
;; $ERHAN -address of the error handler routine
;; $C -first byte of the line output (usually a "?" or "%")
;; $MSG -message to be displayed
;; $PC -if nonblank the PC of the error will be displayed
;; $RET -address to return to after the error message is
;; displayed leave blank to return +1
;;for this macro to work properly there must be a call on the
;;stack prior to executing this code otherwise the word before the
;;the stack will be corrupted. If $PC is used the address reported
;;by the error handler will be the address of the call.
IFB <$C>,< PRINTX First byte of error message is missing>
IFB <$MSG>,< $O==2 ;;force first byte to a "?" if message blank
IFIDN <$C><%>,<$O==0>
IFIDN <$C><?>,<$O==2>
IFB <$RET>,< $CAL $ERHAN'##+5+$O>
IFNB <$RET>,< $CAL [>
>
IFNB <$MSG>,< $O==3
IFNB <$PC>,< $CAL [HRRZI T1,[ASCIZ \$C'$MSG\]>
IFB <$PC>,< $CAL [HRROI T1,[ASCIZ \$C'$MSG\]>
IFB <$RET>,< CALLRET $ERHAN'##+5+$O]>
>
IFNB <$RET>,< MOVEI T2,$RET
CALLRET $ERHAN'##+0+$O]>
PURGE $O ;;purge the temporary symbol
>
DEFINE ERR ($C,$MSG,$PC,$RET) <ERRMSG (CALL ,ERMSGH,$C,<$MSG>,$PC,$RET)>
DEFINE JERR ($C,$MSG,$PC,$RET) <ERRMSG (ERCAL,ERMSGH,$C,<$MSG>,$PC,$RET)>
DEFINE ERRC ($C,$MSG,$PC,$RET) <ERRMSG (CALL ,CMDERH,$C,<$MSG>,$PC,$RET)>
DEFINE JERRC ($C,$MSG,$PC,$RET) <ERRMSG (ERCAL,CMDERH,$C,<$MSG>,$PC,$RET)>
; The routines JERR and JERRC are for use with jsys calls. ERR and ERRC can
; be used to handle all other errors. Use ERRC and JERRC for command errors
; where you want to abort processing of a TAKE file or the RSCAN buffer if
; they are in progress. If neither of these are in progress then ERRC and
; JERRC are functionaly equivalent to ERR and JERR - HOWEVER THIS MAY CHANGE
; IN THE FUTURE.
;===========================================================================
DEFINE C.HELP <
;; server for the help command - if your message is very long you should
;; put the help text in a file and use the .HELP routine in MLIB.REL
.HELP: NOISE (me please)
CONFIRM
HRROI T1,HLPTXT
PSOUT%
JRST ENDCMD ;go get another command
>;end of C.HELP
DEFINE C.INFO ($MORE) <
.INFOR: NOISE (about program)
CONFIRM
TMSG < Program version is >
CALL OVERSI##
TMSG <
>
HRROI T1,[ASCIZ/ ***** Commands are currently comming from the RESCAN buffer *****
/]
TXNE F,F%RSCN ;is RSCAN buffer being processed?
PSOUT% ;yes
SKIPN TAKJFN ;is a TAKE in progress?
IFSKP. ;no
TMSG < ***** Commands are currently comming from >
FILSTR (TAKJFN)
TMSG <
>
ENDIF.
TMSG < Commands from TAKE files will >
HRROI T1,[ASCIZ/NOT /]
TXNN F,F%ECHO
PSOUT%
TMSG <be echoed
>
$MORE ;;assemble INFO commands specific to program here
JRST ENDCMD ;go get another command
>;end of C.INFO
;=============================================================================
DEFINE C.EXIT ($MORE) <
.EXIT: NOISE (from this program)
CONFIRM
DIE: TXNE F,F%RSCN ;am I processing the rscan buffer?
CALL RCNCLR## ;yes, clear any unread characters
$MORE ;;assemble EXIT commands specific to program here
HALTF%
JRST START ;"@CONTINUE" - begin again
>;end of C.EXIT
;=============================================================================
DEFINE PARSE (ARG1,ARG2,ARG3) <
IFNB <ARG1>,< MOVEI T1,ARG1>
IFNB <ARG2>,< MOVEI T2,[FLDBK. ARG2]
IFNB <ARG3>,<PRINTX ?Invalid arguments to PARSE >>
IFNB <ARG3>,< MOVEI T2,ARG3>
CALL DOCMD## ;;do the COMND% jsys
>
DEFINE NOISE (STRING) <
PARSE (,<.CMNOI,,<POINT 7,[ASCIZ\STRING\]>>)
>
DEFINE CONFIRM <
;;Wait for user to confirm line with <crlf>
CALL DOCFM##
>
DEFINE TBL (NAME,FLAGS,DISP) <
;;Used to build the command table
IFNB <DISP>,<..DISP==DISP> ;;if a dispatch given use it
IFB <DISP>,<..DISP==.'NAME> ;;if none the default is .NAME
IFB <FLAGS>,<[ASCIZ\NAME\],,..DISP> ;;if no flags assemble just name
IFNB <FLAGS>,<[FLAGS!CM%FW ;;if flags use them and set CM%FW
ASCIZ\NAME\],,..DISP>
PURGE ..DISP
>
;=============================================================================
DEFINE FILSTR (FJFN,FORMAT,DESTD) <
;; macro to output file specs do no alter without also changing FILST*
IFNB <FJFN>,<IFDIF <FJFN><->,< HRRZ T2,FJFN>>
IFB <FORMAT'DESTD>,< CALL FILST1##>
IFNB <DESTD>,<
IFDIF <DESTD><->,< HRROI T1,DESTD>
IFB <FORMAT>,< CALL FILST3##>
IFNB <FORMAT>,< MOVX T3,FORMAT
CALL FILST4##>
>
IFB <DESTD>,<
IFNB <FORMAT>,< MOVX T3,FORMAT
CALL FILST0##>
>
>;end of FILSTR
DEFINE NUMOUT ($NUM,FORMAT,DESTD) <
;; macro to output a number
IFNB <$NUM>,<IFDIF <$NUM><->,< MOVE T2,$NUM>>
IFB <FORMAT'DESTD>,< CALL NUMOU1##>
IFNB <DESTD>,<
IFDIF <DESTD><->,< HRROI T1,DESTD>
IFB <FORMAT>,< CALL NUMOU3##>
IFNB <FORMAT>,<
IFDIF <FORMAT><->,< MOVX T3,FORMAT>
CALL NUMOU4##>
>
IFB <DESTD>,<
IFNB <FORMAT>,<
IFDIF <FORMAT><->,< MOVX T3,FORMAT>
CALL NUMOU0##>
>
>;end of NUMOUT
DEFINE RET.1 <RET>
DEFINE RET.2 <JRST RET2##>
DEFINE RET.3 <JRST RET3##>
DEFINE PSOUTL <CALL TCRLF##>
DEFINE TMSGL ($MSG) <
IFB <$MSG>,< CALL TCRLF1##>
IFNB <$MSG>,< HRROI T1,[ASCIZ\$MSG\]
PSOUTL>
>
;=============================================================================
;macros of software interrupt handling
DEFINE IP.SAVE <
;; This macro will call the IP.SAV1 routine to save registers prior to
;; interrupt processing. Since some subroutines may temporarly save
;; upto 4 words past the top of the stack I must take this into account
;; so as not to corrupt anything
ADJSP P,4+CX+1 ;;ingore 4 words past top of stack...
CALL IP.SA1## ;; ...and get space to save F to CX
>
DEFINE P.LVT <
;; macro to define the LEVTAB
LEVTAB::LEV1PC ;PC and flags stored here for level 1 interrupts
LEV2PC ;PC and flags stored here for level 2 interrupts
LEV3PC ;PC and flags stored here for level 3 interrupts
LEV1PC: BLOCK 2
LEV2PC: BLOCK 2
LEV3PC: BLOCK 2
>;end of P.LVT
DEFINE DCW ($CLEV,$CADR,$DNUM,$DLEV) <
;; Defines the channel word where:
;; $CLEV=interrupt priority level
;; $CADR=address of intrrupt routine
;; $DNUM=channel number name (its value is defined by this macro)
IFE .-CHNTAB,<$ONCHN==0> ;;initialize the first time through
$ONCHN==<1B<.-CHNTAB>!$ONCHN> ;;define "on" channel word
IFNB <$DNUM>,<$DNUM==.-CHNTAB>
IFNB <$DLEV>,<$DLEV==$CLEV>
<$CLEV>B5!<$CADR> ;;assemble word for channel table
>;end of DCW
REPEAT 0,<
;; this is an example of how to define the CHNTAB - you may copy this over
;; to your program and modify it to suit you
CHNTAB::DCW (3,CTRLA,.CACH) ;0 ^A interrupts
DCW (3,CTRLE,.CECH,.CELV) ;1 ^E interrupts
0 ;2 free
0 ;3 free
0 ;4 free
0 ;5 free
0 ;6 arithmetic overflow
0 ;7 arithmetic floating pt overflow
0 ;8 reserved for DEC
0 ;9 PANIC - pushdown list overflow
0 ;10 end of file condition
0 ;11 PANIC - data error file condition
0 ;12 PANIC - disk full or quota exceeded
0 ;13 reserved for DEC
0 ;14 reserved for DEC
0 ;15 PANIC - illegal instruction
0 ;16 PANIC - illegal memory read
0 ;17 PANIC - illegal memory write
0 ;18 reserved for DEC
0 ;19 inferior process termination
0 ;20 PANIC - system resources exhausted
0 ;21 reserved for DEC
0 ;22 nonexistent page reference
REPEAT ^D13,<0> ;23-35 free
ONCHNL:: $ONCHN
PURGE $ONCHN
>;end of CHNTAB sample
;=============================================================================
IF2 < PURGE REL>
END
>;end of IFE REL to assemble universal file
;=============================================================================
;start of assembly for REL file
SALL
SEARCH MLIB
PX <Assembling routines for MLIB.REL>
SUBTTL SUBROUTINES FOR THE COMND% JSYS
TITLE BEGCML
SEARCH MONSYM,MACSYM,MLIB
ENTRY BEGCML,GETCMD,RPARSE,.QUIT,ENDCML,RMVCML
;=============================================================================
;Routines to manage command levels, initialize for the getting
;of a new command, and to handle the reparsing of an existing command.
; CALL BEGCML -setup to start a new command level
;ACCEPTS:
; T1 - must contain the address of the exit routine for
; the current command level. This routine will be called
; by ENDCML. It must do any cleanup required to end the
; current command level as well as any reinitialization
; necessary to return to the next higher command level. If
; there is no cleanup that needs to be done then you can use
; "ENDCMD or GETCMD" as the exit routine.
; T2 - byte pointer to the prompt string for the new command level.
; The prompt for the previous command level (in CMDBLK+.CMRTY)
; will be saved and this new one put in its place
;RETURNS: +1 always
; JRST GETCMD -start the processing of a new command
;ACCEPTS: no AC's need to be initialized
;RETURNS: to last caller of BEGCML
; JRST RPARSE -reparse a command (normally this address is placed in
; word CMDBLK+.CMFLG - if this is done COMND% will then
; determine when it needs to jump here)
;ACCEPTS: no AC's need to be initialized
;RETURNS: to last caller of BEGCML
; JRST ENDCML -end the current command level and return to the
; next higher command level. It will restore the prompt
; for the next higher command level and call the exit
; routine set up by last call to BEGCML. The exit
; routine can return to the next higher command level by
; either using "POPJ P," or "JRST ENDCMD or GETCMD"
; whichever is more convenient.
;ACCEPTS: -no AC's need to be initialized
;RETURNS: -to exit routine for current command level which was setup by last
; call to BEGCML (see discussion for BEGCML), P pointing to
; routine for next higher command level, and CMDBLK+.CMRTY
; reinitialized
;Trashes T1
; JRST RMVCML -removes the current command level from the stack
;ACCEPTS: -no AC's need to be initialized
;RETURNS: +1 always with address of exit routine for the current command
; level in T1, P pointing to routine for next higher command
; level, and CMDBLK+.CMRTY reinitialized
;Trashes T1
BEGCML: EXCH T1,(P) ;save command level's exit routine
PUSH P,CMDBLK##+.CMRTY ;save prompt for previous command level
MOVEM T2,CMDBLK##+.CMRTY ;use prompt for new command level
PUSH P,SAVEP## ;save stack pointer for previous level
PUSH P,T1 ;save address of caller on stack
MOVEM P,SAVEP## ;save P for error recorvery and reparse
GETCMD: TXNE F,F%RSCN ;am I processing the rescan buffer?
SKIPE TAKJFN## ; ...and is TAKE also finished?
JRST GETCM3 ;no, skip some code
MOVEI T1,.RSCNT ;get # of characters...
RSCAN% ; ...left in rescan buffer
JERR (?,,PC)
JUMPN T1,GETCM3 ;jump if rescan buffer not empty
TXZ F,F%RSCN ;say rescan buffer is empty
MOVE T1,CMNDIO## ;reset I/O designators for COMND
MOVEM T1,CMDBLK+.CMIOJ
GETCM3: PARSE (CMDBLK,<.CMINI>) ;initialize for next command...
; ...output prompt text - watch for ^H
RPARSE: MOVE P,SAVEP ;restore stack for reparse
ZERO (<GTJBLK##+.GJDEV>,<GTJBLK+.GJACT>) ;initialize GTJFN block
RELJFN (TMPJFN##) ;release any temporary JFN's
MOVEI T1,CMDBLK ;initialize for COMND%
JRST @(P) ;return to caller
;=============================================================================
;Server for the QUIT command. QUIT will switch to the next higher command level
.QUIT: NOISE (current command level)
CONFIRM
ENDCML: CALL RMVCML ;remove current command level from stack
CALL (T1) ;call exit routine to do cleanup
JRST GETCMD ;return to the next higher command level
; ...incase exit routine ends with a RET
RMVCML: POP P,T1 ;get address of caller
MOVE P,SAVEP ;restore stack incase got here via error
ADJSP P,-1 ;ignore address of current command level
POP P,SAVEP## ;restore stack pointer for last level
POP P,CMDBLK+.CMRTY ;restore prompt for last command level
EXCH T1,(P) ;put return address on stack and...
RET ; ...get command level's exit routine
PRGEND ;end of BEGCML
TITLE DOCMD
SEARCH MONSYM,MACSYM,MLIB
ENTRY DOCMD,DOCMDE
;===========================================================================
;Routine to do the COMND% jsys all executions of COMND% should go through
;here so that the end TAKE of a command file (see .TAKE) can be determined.
; CALL DOCMD
DOCMD: COMND%
ERJMP DOCMD5 ;COMND% failed - go check out why
TXZN F,F%RNOP ;return to caller even in CM%NOP ?
TXNN T1,CM%NOP ;no, check to see if it parsed OK
RET ;yes, I'm done
DOCMDE: TMSGL <? "> ;start message on new line
HRROI T1,ATMBUF## ;output atom buffer because it will...
PSOUT% ; ...usually contain the stuff...
TMSG <"> ; ...that I couldn't parse
CALL ERSTRI## ;output last error string
CALL CMDATR## ;abort TAKE or RSCAN if necessary
JRST ENDCMD## ;go get another command
; Program gets here when the COMND% jsys fails. If I'm doing a TAKE it may
; not be a "real" error but rather just the EOF of the command file.
DOCMD5: SKIPN TAKJFN## ;am I doing a TAKE ?
ERR (?,<COMND%>,PC,DIE##) ;no, real error
MOVEI T1,.FHSLF ;get ready for GETER%
GETER% ;get most recent error
TLZ T2,-1 ;zero left half to compare
CAIE T2,IOX4 ;is error "End of file reached" ?
ERR (?,<COMND%>,PC,DIE##) ;no, real error
TMSGL < End of >
FILSTR (TAKJFN)
TMSG <
>
CALL UNTAKE## ;clean up after the TAKE command
CALL ERESET## ;reset "End of file reached" error
JRST ENDCMD## ;go get another command
PRGEND ;end of DOCMD
TITLE DOCFM
SEARCH MONSYM,MACSYM,MLIB
ENTRY DOCFM,DOECHO
INTERN CONFRM
;===========================================================================
;Routine to confirm a command using the COMND% jsys. All command
;confirmations should go through here so TAKE file commands can be echoed
;if necessary.
; CALL DOCFM
CONFRM: FLDBK. .CMCFM
DOCFM: MOVEI T2,CONFRM
CALL DOCMD## ;do the COMND% jsys
DOECHO: TXNN F,F%ECHO ;is echo required
RET ;no, so I'm done
TXNN F,F%RSCN ;am I processing the rscan buffer?
SKIPE TAKJFN## ; ...or is a TAKE in progress?
TRNA ;yes, echo the command
RET ;no, so nothing to echo
MOVE T1,CMDBLK##+.CMRTY ;get prompt string
PSOUTL ;start message on new line
HRROI T1,CMDBUF## ;get command buffer
PSOUT% ;output it
RET ;return to caller
PRGEND ;end of DOCFM
SUBTTL Server for TAKE command
TITLE .TAKE
SEARCH MONSYM,MACSYM,MLIB
ENTRY .TAKE,UNTAKE,TAKFIL
;=============================================================================
.TAKE: NOISE (commands from file)
HRLZI T4,(GJ%OLD!GJ%ACC)
MOVEM T4,GTJBLK##+.GJGEN ;parse existing file
HRROI T4,MYNAME##
HRROI Q1,[ASCIZ/CMD/]
DMOVEM T4,GTJBLK+.GJNAM ;use this default file name.ext
PARSE (,<.CMFIL,CM%SDH,,<file name or confirm with carriage return>>)
MOVEM T2,TMPJFN## ;save JFN
CONFIRM
CALL TAKFIL ;set up to take the file
JRST ENDCMD## ;go get another command
;=============================================================================
;Routine to setup for having the input for the COMND% come from a file
; CALL TAKFIL
;ACCEPTS:
; TMPJFN - JFN of file to take
;RETURNS:
; +1 always
;Trashes T1-T4
TAKFIL: SKIPE TAKJFN ;is another TAKE in progress
ERRC (?,<Can't nest TAKE command files>,,DIE##)
MOVE T1,TMPJFN ;get the file jfn COMND% parsed
MOVE T2,[^D7B5+OF%RD] ;Open the file, ascii read
OPENF%
JERRC (?,,PC,DIE)
MOVEM T1,TAKJFN ;save it and zero it to prevent it from
SETZM TMPJFN## ;being released when next command parsed
HRLZ T1,T1 ;reset input JFN for COMND%
HRRI T1,.NULIO ;reset output JFN for COMND%
MOVEM T1,CMDBLK##+.CMIOJ
RET
;-----------------------------------------------------------------------------
;Routine to clean up after a TAKE.
; CALL UNTAKE
UNTAKE: SKIPE T1,TAKJFN## ;get JFN of TAKE command file (if any)
CLOSF ;close it
JERRC (%,,PC)
SETZM TAKJFN ;say TAKE done
MOVE T1,CMNDIO## ;reset I/O JFN's for COMND
TXNE F,F%RSCN ;am I processing the rscan buffer?
MOVE T1,RSCNIO## ;yes, use these I/O JFN's for COMND
MOVEM T1,CMDBLK+.CMIOJ
RET
PRGEND ;end of .TAKE
TITLE TAKINI
SEARCH MONSYM,MACSYM,MLIB
ENTRY TAKINI
;=============================================================================
;Routine to setup for TAKEing the file from PS:<user-name>myname.INI
;If this file does not exist there will be no warning given.
; CALL TAKINI
;ACCEPTS:
; no registers need to be initialized
;RETURNS:
; +1 always
;Trashes T1-T4
TAKINI: SETO T1, ;get logged-in directory # for this job
HRROI T2,T4 ;put info in T4
MOVEI T3,.JILNO ;start at this offset
GETJI%
JERR (?,,PC,DIE##)
MOVE T2,T4 ;get logged-in-dir #
HRROI T1,ATMBUF## ;put string here
DIRST%
JERR (?,,PC,DIE)
HRROI T2,MYNAME## ;get name of program
CALL MOVSTR
HRROI T2,[ASCIZ/.INI/] ;use this file extension
CALL MOVSTR##
HRROI T2,ATMBUF
CALL FGTJFN## ;check to see if file exists
RET ;no couldn't find it
MOVEM T1,TMPJFN## ;save JFN
CALLRET TAKFIL## ;setup to take the file
PRGEND ;end of TAKINI
TITLE FGTJFN
SEARCH MONSYM,MACSYM,MLIB
ENTRY FGTJFN
;============================================================================
;Routine to check to see whether or not a file exists.
; CALL FGTJFN
;ACCEPTS:
; T1 - byte pointer to file specs
;RETURNS:
; +1 - find not found
; +2 - file found with T1,T2 as left by GTJFN%
;Trashes T1,T2
FGTJFN: MOVSI T1,(GJ%SHT!GJ%OLD)
GTJFN%
IFSKP. ;failed - check out why
AOS (P) ;found it - set +2 return
RET
ENDIF.
; program get here when GTJFN% failed - if it failed because it can't
; find the file that's OK but if it failed for some other reason report it
CAIE T1,GJFX24 ;file not found?
CAIN T1,GJFX19 ;no such file type?
RET ;yes, that's ok
CAIN T1,GJFX18 ;no such file name?
RET ;yes, that's ok
ERR (?,,PC,DIE##) ;no, some other error
PRGEND ;end of FGTJFN
SUBTTL Server for the SET command
TITLE .SET
SEARCH MONSYM,MACSYM,MLIB
ENTRY .SET
INTERN .SNO,.SECHO
;=============================================================================
.SET: TXZ F,F%NO ;initialize "NO" switch
.SET1: PARSE (,<.CMKEY,,SETTAB##>)
HRRZ T2,(T2) ;get address of service routine
JRST (T2) ; ....dispatch to the handler
;-----------------------------------------------------------------------------
;Server for SET NO
.SNO: TXC F,F%NO ;toggle "NO" switch
JRST .SET1 ;go get another set command
;-----------------------------------------------------------------------------
;Server for SET ECHO
.SECHO: NOISE (when TAKEing command files)
CONFIRM
TXO F,F%ECHO ;assume echo
TXNE F,F%NO ;user want NO echo?
TXZ F,F%ECHO ;yes
JRST ENDCMD## ;go get another command
PRGEND ;end of .SET
SUBTTL Server for HELP command
TITLE .HELP
SEARCH MONSYM,MACSYM,MLIB
ENTRY .HELP,.HELP1
;=============================================================================
.HELP: NOISE (me please for I am confused!!)
CONFIRM
.HELP1: MOVX T4,GJ%OLD
MOVE Q1,[.NULIO,,.NULIO] ;no input/output JFN
DMOVEM T4,GTJBLK##+.GJGEN ;parse existing file
HRROI T4,[ASCIZ/HLP:/]
MOVEM T4,GTJBLK+.GJDEV ;use this default device
HRROI T4,MYNAME##
HRROI Q1,[ASCIZ/HLP/]
DMOVEM T4,GTJBLK+.GJNAM ;use this default file name.ext
MOVEI T1,GTJBLK ;address of argument table
SETZB T2,Q1 ;no ascii file string
GTJFN%
ERJMP [TMSGL <%Sorry, can't get HLP:>
HRROI T1,MYNAME##
PSOUT%
TMSG <.HLP>
CALL ERSTRI##
JRST HELP7]
TLZ T1,-1 ;isolate 0,,JFN
MOVX T2,<FLD(7,OF%BSZ)>!OF%RD ;Open the file, ascii read
OPENF%
JERR (?,,PC,HELP7)
MOVEM T1,Q1 ;save JFN
CALL PTRECB## ;get size of buffer I have to work with
MOVE Q3,T1 ;save # bytes available
MOVE Q2,T2 ;save pointer
SETZ T4, ;set flag
HELP3: DMOVE T1,Q1 ;get JFN + pointer
MOVN T3,Q3 ;read this many bytes
SIN%
ERCAL [MOVEI T1,.FHSLF
GETER% ;get last error
TLZ T2,-1 ;remove process handle
CAIE T2,IOX4 ;was it "End of file reached"
ERR (?,,PC,HELP7) ;no, something else
SETO T4, ;set end-of-file flag
CALLRET ERESET##] ;reset last error
MOVEI T1,.PRIOU
MOVE T2,Q2 ;get ptr to string
ADD T3,Q3 ;calc the number of bytes...
MOVN T3,T3 ; ...to output
SOUT%
JERR (?,,PC,HELP7)
JUMPE T4,HELP3 ;loop for all bytes in help file
TMSGL < End of >
FILSTR (Q1)
TMSG <
>
HELP7: SKIPE T1,Q1 ;get jfn
CLOSF% ;close the file and release JFN
JERR (?,,PC)
JRST ENDCMD## ;go get another command
PRGEND ;end of .HELP
SUBTTL ERROR HANDLING ROUTINES
TITLE CMDER
SEARCH MONSYM,MACSYM,MLIB
ENTRY CMDER,CMDERH,CMDATR
;=============================================================================
;Routine to process command errors. All command errors should go through here
;since if the error occured during a "TAKE" of a command file, or while
;processing the RSCAN buffer then it will be aborted. Other than that it will
;report errors exactly the same way as ERMSG.
; CALL CMDER,CMDERH ;see discussion for ERMSG counterparts
; CALL CMDATR ;aborts TAKE or RSCAN if they are active
;ACCEPTS: -see writeup for ERMSG
;Trashes T1-T4
CMDERH: HRRZI T1,[ASCIZ/%/] ;refer to the ERRC and JERRC macros
TRNA
HRRZI T1,[ASCIZ/?/]
EXCH T2,0(P) ;put return address on stack and get PC
JRST CMDER
HRRZI T1,[ASCIZ/%/]
TRNA
HRRZI T1,[ASCIZ/?/]
HRRZ T2,0(P) ;get PC of error
CMDER: CALL ERMSG## ;output error message
CMDATR: SKIPE TAKJFN## ;am I doing a TAKE ?
CALL TAKERR ;yes, abort it
TXNE F,F%RSCN ;am I processing the rscan buffer?
CALL RCNERR ;yes, abort it
RET ;no, I'm done
TAKERR: TMSGL <?Aborting > ;routine to abort TAKE command
FILSTR (TAKJFN)
TMSG < due to errors
>
CALLRET UNTAKE## ;clean up after the TAKE command
;routine to abort command being processed from rscan buffer
RCNERR: TMSGL <?Aborting commands left in RSCAN buffer due to errors
>
CALLRET RCNCLR## ;clear the rscan buffer
PRGEND ;end of CMDER
TITLE ERMSG
SEARCH MONSYM,MACSYM,MLIB
ENTRY ERMSG,ERMSGH,ERSTRI
;=============================================================================
;Routine to handle errors. It will output the name of the program, the PC
;which the error occured at (optional), and the last error string for the
;process. If the last error is "Process has encountered no errors" then this
;error string will not be output. You should use the ERRMSG, ERR, or ERRJ macros
;to call this routine - they handle the complexities of calling these routines.
; CALL ERMSGH ;base entry point for ERRMSG, ERR, and ERRJ macros
; +0+0 ;output "%", PC, T2 has return address
; +0+2 ;output "%", PC, T2 has return address
; +0+3 ;output PC depending on LH of T1 and user message...
; ; ...in RH of T1, T2 has return address
; +5+0 ;output "%", PC, return address on stack
; +5+2 ;output "%", PC, return address on stack
; +5+3 ;output PC depending on LH of T1 and user message...
; ; ...in RH of T1, return address on stack
; CALL ERMSG ;you must supply both the message in T1 and PC in T2
;ACCEPTS:
; T1 - byte pointer to string to be displayed. First byte should be
; either a "%" or a "?". A value of "0,,address" will cause
; the message at "address" to be displayed and then the PC
; of where the error occured (useful for JSYS errors)
; T2 - PC to be displayed
;Trashes T1-T4
ERMSGH: HRRZI T1,[ASCIZ/%/] ;refer to the ERR and JERR macros
TRNA
HRRZI T1,[ASCIZ/?/]
EXCH T2,0(P) ;put return address on stack and get PC
JRST ERMSG
HRRZI T1,[ASCIZ/%/]
TRNA
HRRZI T1,[ASCIZ/?/]
HRRZ T2,0(P) ;get PC of error
ERMSG: HLRZ T3,T1 ;check for symbolic byte pointer
CAIE T3,777777 ;is it a symbolic byte pointer?
CAIN T3,0 ;does user want PC of error?
HRLI T1,(POINT 7) ;yes, convert it to a valid pointer
MOVEM T1,T4 ;save byte pointer
TMSGL ;start a new line
ILDB T1,T4 ;get first byte of message
PBOUT%
HRROI T1,MYNAME## ;get the name of this program
PSOUT%
TMSG <: >
JUMPN T3,ERNOPC ;jump if caller doesn't want PC of error
TMSG <PC=>
MOVEI T1,.PRIOU
SUBI T2,1 ;back PC up to the "CALL" address
TLZ T2,777740 ;remove PC flags
MOVEI T3,^D8 ;write it in octal
NOUT%
ERCAL ERESET##
TMSG <, >
ERNOPC: MOVE T1,T4 ;display rest of user supplied message
PSOUT%
;-----------------------------------------------------------------------------
; CALL ERSTRI ;output the last process error if there was one
;ACCEPTS: no AC's need to be initialized
;Trashes T1-T3
ERSTRI: MOVEI T1,.FHSLF ;get ready for GETER%
GETER% ;get most recent error
TLZ T2,-1 ;zero left half to compare
CAIN T2,LSTRX1 ;has process encountered errors?
IFSKP. ;no, so skip next part
TMSG < - >
MOVEI T1,.PRIOU
HRLOI T2,.FHSLF ;this-fork,,last-error
SETZ T3,
ERSTR%
TRNA ;ignore error
TRNA ;ignore this error too
CALL ERESET## ;reset most recent error message
ENDIF.
TMSG <
> ;write <CRLF>
RET
PRGEND ;end of ERMSG
TITLE ERESET
SEARCH MONSYM,MACSYM,MLIB
ENTRY ERESET,RET1,RET2,RET3
;=============================================================================
;Routine to set the most recent TOPS-20 error message to
; "Process has not encountered any errors"
; CALL ERESET
;Trashes no AC's
ERESET: DMOVEM T1,1(P) ;save T1,T2
MOVEI T1,.FHSLF ;get ready for SETER%
MOVEI T2,LSTRX1 ;Process has not encountered any errors
SETER%
DMOVE T1,1(P) ;restore T1,T2
RET
;-----------------------------------------------------------------------------
;Routines to do skip returns
RET3: AOS 0(P) ;return +3
RET2: AOS 0(P) ;return +2
RET1: RET ;return +1
PRGEND ;end of ERESET
SUBTTL MISCELLANIOUS SUBROUTINES
TITLE RCNINP
SEARCH MONSYM,MACSYM,MLIB
ENTRY RCNINP,RCNINS,RCNIN,PTRECB,RCNRD,RCNHLD,RCNCLR
;===========================================================================
;Routine to process data in the RSCAN buffer (set up by the EXEC when it runs
;a program)
; CALL RCNINP
;ACCEPTS:
; CMDBLK needs to be initialized and CMDBUF must be followed by ATMBUF
;RETURNS:
; +1 always with F%RSCN and CMDBLK+.CMIOJ updated if necessary
;Trashes T1-T4
RCNINP: MOVEI T1,.RSINI ;make data in rscan buffer available...
RSCAN% ; ...for input to this job
JERR (?,,PC,DIE##)
SKIPG T1 ;any characters in rscan buffer?
RET ;no so I'm done
MOVEM T1,T3 ;save # bytes in rscan buffer
CALL PTRECB ;get pointer to end of command buffer
SUBI T1,5 ;leave room for "EXIT," to be added
CAML T3,T1
ERR (?,<Buffer too small to hold RSCAN>,PC,DIE)
MOVN T3,T3 ;get ready for SIN%
MOVEI T1,.CTTRM
MOVEM T2,T4 ;save pointer for later
SIN% ;read in string in RSCAN buffer
MOVE T1,[POINT 7,[ASCIZ/EXIT,/]] ;add this to end of string...
ILDB T3,T1 ; ...so program will quit...
IDPB T3,T2 ; ...after processing RSCAN buffer
JUMPG T3,.-2 ;loop until null is found
; see if first word in the buffer is the name of the current program. If
; not then user started up program with @RUN, @R, @START, etc
MOVE T2,[POINT 7,MYNAME##] ;ptr to name of current program
RCNIN2: ILDB T3,T4 ;get a byte from rescan
ILDB T1,T2 ;get a byte from program name
JUMPE T1,RCNIN3 ;quit if end of program name string
CAME T1,T3 ;strings the same so far?
RET ;no, don't process rescan buffer
JRST RCNIN2 ;yes, loop for more bytes
RCNIN3: CAIN T3,.CTRLJ ;is it a <lf>?
RET ;yes, - nothing in RSCAN buffer to get
CAIE T3," " ;found a space?
CAIN T3," " ; ...or a tab?
TRNA ;yes, rescan buffer ok to process
RET ;no, don't process rescan buffer
; now examine string and convert all "," to <lf>
MOVE T1,T4 ;save pointer
MOVEI T2,.CTRLJ ;replace all "," in string with this
RCNIN4: ILDB T3,T4 ;get a byte
CAIN T3,"," ;is it a ","
DPB T2,T4 ;yes, replace it
JUMPG T3,RCNIN4 ;loop back until null is reached
;=============================================================================
;Routine to place a string in the RSCAN buffer and then make it available for
;input for anything reading from the controlling terminal
; CALL RCNINS
;ACCEPTS:
; T1 - byte pointer to string to place in RSCAN buffer. The flag F%RSCN
; will be set and output JFN for CMDBLK will be set to .NULIO
;RETURNS: +1 always
;Trashes T1
;------------------------------------
;Routine to make the data already in the RSCN buffer available for input
; CALL RCNIN
;ACCEPTS: no AC's need to be initialized
;RETURNS: +1 always
;Trashes T1
RCNINS: RSCAN% ;put new string back in rscan buffer
JERR (?,,PC,DIE)
RCNIN: MOVEI T1,.RSINI ;make data in rscan buffer available...
RSCAN% ; ...for input to this job
JERR (?,,PC,DIE)
MOVE T1,RSCNIO## ;change the I/O JFN's for COMND
SKIPN TAKJFN## ;am I doing a take?
MOVEM T1,CMDBLK##+.CMIOJ ;no, reset I/O JFN's for COMND
TXO F,F%RSCN ;say rscan buffer being processed
RET ;return to caller
;=============================================================================
;Routine to calulate the pointer to the end of the current command buffer (the
;command buffer is CMDBUF+ATMBUF). The number of bytes available in this area
;will be returned as well.
; CALL PTRECB
;ACCEPTS: no AC's need to be initialized
;RETURNS: +1 always with
; T1 - length of command buffer area in bytes
; T2 - pointer to first free byte in buffer area
;Trashes no AC's
PTRECB: MOVE T1,CMDBLK+.CMCNT ;get # bytes left in CMDBUF
ADD T1,CMDBLK+.CMABC ;add # bytes in ATMBUF
MOVE T2,CMDBLK+.CMINC ;get # of unparsed characters in CMDBUF
ADDI T2,1 ;make it point past null
ADJBP T2,CMDBLK+.CMPTR ;make pointer to last byte after null
RET
;=============================================================================
;Routine to read the remaining bytes in the RSCAN buffer and place them
;in a string in memory.
; CALL RCNRD
;ACCEPTS:
; T1 - length of buffer area pointed to by T2 (in bytes)
; T2 - destination byte pointer to where you want RSCAN buffer placed
;RETURNS:
; +1 -always
;Trashes T1-T3
RCNRD: MOVEM T1,T3 ;save size of buffer
MOVEI T1,.RSCNT ;get # of characters...
RSCAN% ; ...left in rscan buffer
JERR (?,,PC,DIE)
JUMPE T1,RCNRD3 ;jump if RSCAN was empty
CAML T1,T3 ;enough rooom hold rscan buffer?
ERR (?,<Buffer too small to hold RSCAN>,PC,DIE)
MOVNM T1,T3 ;get ready for SIN%
MOVEI T1,.CTTRM
SIN% ;read in RSCAN buffer
SETZ T1, ;null byte
RCNRD3: HLRZ T3,T2 ;check for symbolic byte pointer
CAIN T3,777777 ;is it a symbolic byte pointer?
HRLI T2,(POINT 7) ;yes - convert to a valid pointer
MOVEM T2,T3 ;make sure string user gave me...
IDPB T1,T3 ; ...ends with a null
RET
;=============================================================================
;Routine to hold the the processing of input from the RSCAN buffer temporarly.
;It will read the remaining data from the buffer and place it back in it. A
;call to RCNIN will make it again available for input
; CALL RCNHLD
;ACCEPTS: no registers need to be initialized
;RETURNS: +1 always
;Trashes T1-T3
RCNHLD: CALL PTRECB ;get pointer to end of command buffer
PUSH P,T2 ;save pointer for later
CALL RCNRD ;save all commands in RSCAN buffer
POP P,T1 ;get pointer to start of string
RSCAN% ;put new string back in rscan buffer
JERR (?,,PC,DIE)
RET
;=============================================================================
;Routine to clear any unread characters in the RSCAN buffer.
; CALL RCNCLR
;ACCEPTS: no registers need to be initialized
;RETURNS: +1 always
;Trashes T1-T2
RCNCLR: HRROI T1,T2 ;make pointer to null string
SETZ T2,
RSCAN% ;clear the rscan buffer
ERJMP .+1
RET ;done
PRGEND ;end of RCNINP
TITLE TCRLF
SEARCH MONSYM,MACSYM,MLIB
ENTRY TCRLF,TCRLF1
;===========================================================================
;Routine to test column position of terminal. If terminal not at the
;beginning of a new line then a <crlf> is output. Normally these routines
;are called by the TMSGL and PSOUTL macros.
; CALL TCRLF ;do TCRLF1 and then output message in T1
; CALL TCRLF1 ;no AC's need to be initialized, Trashes none
;RETURNS:
; +1 always
TCRLF: CALL TCRLF1
PSOUT%
RET
TCRLF1: DMOVEM T1,1(P) ;save T1,T2
MOVEI T1,.PRIOU
RFPOS%
ERJMP [CALL ERESET## ;ignore error
JRST TCRLF9]
HRROI T1,[ASCIZ/
/]
TRNE T2,-1 ;at column 0 (beginning of new line)?
PSOUT% ;no, output <crlf>
TCRLF9: DMOVE T1,1(P) ;restore T1,T2
RET
PRGEND ;end of TCRLF
TITLE B2D
SEARCH MONSYM,MACSYM,MLIB
ENTRY B2D
;===========================================================================
;Routine to convert a binary number to a decimal string
; CALL B2D
;ACCEPTS:
; T1 - byte pointer to where to place string
; T2 - number to convert
;RETURNS:
; +1 always with T1 updated
;Trashes no registers
B2D: PUSH P,T2 ;save T2
DMOVEM T1+3,1(P) ;save T1+3,T1+4
HLRZ T1+3,T1 ;get left half of the byte ptr.
CAIN T1+3,777777 ;is T1 is an implicit byte ptr?
HRLI T1,(POINT 7) ; yes, convert it to a real byte ptr.
MOVEI T1+3,^D22 ;initialize string length
MOVEM T1,T1+4 ;get byte pointer
SETZ T1,
EXTEND T1,[CVTBDO 60] ;convert the number to a string
ERR (?,<CVTBDO failed>,PC,DIE##)
MOVE T1,T1+4 ;restore byte pointer
IDPB T1+3,T1+4 ;terminate string with a null
DMOVE T1+3,1(P) ;restore T1+3,T1+4
POP P,T2 ;restore T2
RET
PRGEND ;end of B2D
TITLE D2B
SEARCH MONSYM,MACSYM,MLIB
ENTRY D2B
;===========================================================================
;Routine to convert an decimal string to a binary number
; CALL D2B
;ACCEPTS:
; T1 - byte pointer to string
;RETURNS:
; +1 always with T1 updated and T2 containing the binary number
;Trashes no registers
D2B: DMOVEM T1+2,1(P) ;save registers
MOVEM T1+4,3(P)
HLRZ T1+3,T1 ;get left half of byte ptr
CAIN T1+3,777777 ;is it a implicit byte ptr
HRLI T1,(POINT 7) ; yes, convert it to a valid byte ptr
MOVEM T1,T1+1 ;put string pointer here
MOVEI T1,777777 ;initialize string length
SETZ T1+2, ;use local byte pointer
EXTEND T1,[CVTDBO -60] ;convert the string to a binary number
SETO T1, ;always will quit when digit not 0-9
ADJBP T1,T2 ;backup byte pointer 1 byte
MOVE T2,T1+4 ;get binary number
DMOVE T1+2,1(P) ;restore registers
MOVE T1+4,3(P)
RET
PRGEND ;end of D2B
TITLE CMPSTR
SEARCH MONSYM,MACSYM,MLIB
ENTRY CMPSTR
;===========================================================================
;Routine to compare two strings
; CALL CMPSTR
;ACCEPTS:
; T1 - byte pointer to 1st string
; T2 - byte pointer to 2nd string
; T3 - length of strings (both must be the same length
;RETURNS:
; +1 - strings are not equal, T1-T3 are updated
; +2 - strings are equal, T1-T3 are updated
;Trashes no registers
CMPSTR: DMOVEM T1+3,1(P) ;save T1+3,T1+4
MOVEM T1+5,3(P) ;save T1+5
MOVEM T1,T1+4 ;initialize byte pointer to 2nd string
MOVEM T3,T1+3 ;initialize length of 2nd string
MOVE T1,T3 ;initialize length of 1st string
SETZB T1+2,T1+5 ;initialize for local byte pointers
EXTEND T1,[CMPSN] ;compare the strings
AOS (P) ;strings are equal so set +2 return
MOVE T1,T1+4 ;restore byte pointer to 2nd string
MOVE T3,T1+3 ;restore bytes left
DMOVE T1+3,1(P) ;restore T1+3,T1+4
MOVE T1+5,3(P) ;restore T1+5
RET
PRGEND ;end of CMPSTR
TITLE MOVSTR
SEARCH MONSYM,MACSYM,MLIB
ENTRY MOVSTR
;=============================================================================
;Will move an ASCIZ string from one area to another area in memory.
; CALL MOVSTR
;ACCEPTS:
; T1 - destination byte pointer
; T2 - source byte pointer
;RETURNS:
; +1 -always. Upon exit T1 and T2 will be updated. The destination pointer
; will be left so that a IDPB will overwrite the terminating null.
;Trashes no AC's
MOVSTR: PUSH P,T3 ;save needed AC's
HLRZ T3,T1
CAIN T3,777777 ;is it a symbolic byte pointer?
HRLI T1,(POINT 7) ;yes - convert to a valid pointer
HLRZ T3,T2
CAIN T3,777777 ;is it a symbolic byte pointer?
HRLI T2,(POINT 7) ;yes - convert to a valid pointer
MOVLUP: ILDB T3,T2 ;get byte from source
IDPB T3,T1 ;move it to destination
JUMPN T3,MOVLUP ;loop until I find a null byte
MOVNI T3,1 ;adjust destination pointer so
ADJBP T3,T1 ;that the next IDPB will
MOVE T1,T3 ;overwrite terminating null
POP P,T3 ;restore AC's
RET ;done
PRGEND ;end of MOVSTR
TITLE MOVST3
SEARCH MONSYM,MACSYM,MLIB
ENTRY MOVST3
;=============================================================================
;Will move an ASCIZ string from one area to another area in memory.
; CALL MOVST3
;ACCEPTS:
; T1 - destination pointer
; T2 - source byte pointer
; T3 - number of byte going to transfer
;RETURNS:
; +1 -always. Upon exit T1 and T2 will be updated. The destination pointer
; will be left so that a IDPB will overwrite the terminating null.
;Trashes no acs
MOVST3: DMOVEM T1+2,1(P) ;save T1+2,T1+3
DMOVEM T1+4,3(P) ;save T1+4,T1+5
HLRZ T1+5,T1 ;get left half of byte ptr in T1
CAIN T1+5,777777 ;is it a symbolic byte pointer?
HRLI T1,(POINT 7) ;yes - convert to a valid pointer
HLRZ T1+5,T2 ;get left half of byte ptr in T2
CAIN T1+5,777777 ;is it a symbolic byte pointer?
HRLI T2,(POINT 7) ;yes - convert to a valid pointer
MOVE T1+4,T1 ;set up source byte ptr for EXTEND
MOVEM T1+2,T1 ;set up source byte length
MOVEM T1+2,T1+3 ;set up destination byte length
SETZB T1+2,T1+5 ;initialize for local byte pointers
EXTEND T1,[MOVSLJ]
0 ;program should never get here!!!
MOVE T1,T1+4 ;restore update destination byte ptr
DMOVE T1+2,1(P) ;restore T1+2,T1+3
DMOVE T1+4,3(P) ;restore T1+4,T1+5
RET
PRGEND ;end of MOVST3
TITLE TXIDO
SEARCH MONSYM,MACSYM,MLIB
ENTRY TXIDO,TXINI,TXIEND,QMHLP,QMHLP2
;=============================================================================
;Routine to initialize the TXIBLK from the CMDBLK. It will echo <esc> and
;^F if necessary since COMND% does not.
; CALL TXINI
;ACCEPTS:
; CMDBLK - as left by COMND%
;RETURNS:
; +1 always with much of TXIBLK initialized
;Trashes T1-T4
TXINI: MOVE T4,CMDBLK##+.CMINC ;get # of unparsed characters in buffer
ADJBP T4,CMDBLK+.CMPTR ;make pointer to last byte
MOVEM T4,TXIBLK##+.RDDBP ;save pointer to last byte
SETZ T1,
IDPB T1,T4 ;insure field ends with a null
MOVNI T1,1 ;calculate backup limit for reparse
ADJBP T1,CMDBLK+.CMPTR
MOVEM T1,TXIBLK+.RDBKL ;save backup limit
MOVE T1,CMDBLK+.CMIOJ
MOVEM T1,TXIBLK+.RDIOJ ;input,,output designatior for command
LDB T2,TXIBLK+.RDDBP ;get the last byte input
TLZ T1,-1 ;0,,output-designator
CAIE T2,"" ;was last byte an <esc>?
CAIN T2,"" ; ...or was it this?
BOUT% ;yes, echo it because COMND doesn't
; initialize some more stuff for TEXTI argument block
MOVE T1,CMDBLK+.CMCNT
SUB T1,CMDBLK+.CMINC
MOVEM T1,TXIBLK+.RDDBC ;# bytes available in destination
MOVE T1,CMDBLK+.CMBFP
MOVEM T1,TXIBLK+.RDBFP ;pointer to start of CMDBUF
MOVE T1,CMDBLK+.CMRTY
MOVEM T1,TXIBLK+.RDRTY ;^R prompt
RET
;=============================================================================
;Routine to perform the TEXTI jsys. It will look after reparsing if required
; CALL TXIDO
;ACCEPTS:
; TXIBLK must be initialized (you can use TXINI to do this)
;RETURNS:
; +1 unless reparse needed of TEXTI% fails
;Trashes T1-T2
TXIDO: HRROI T1,TXIBLK ;argument block for TEXTI
TEXTI%
JERRC (?,,PC,DIE##)
MOVE T2,TXIBLK+.RDFLG ;get flag word
TXNE T2,RD%BLR ;user tried to delete beyond .RDBKL ?
JRST [MOVX T1,CM%RPT ;yes, tell COMND to reparse
IORM T1,CMDBLK+.CMFLG
MOVE T1,CMDBLK+.CMBFP
MOVEM T1,CMDBLK+.CMPTR ;start reparsing at beginning
MOVEI T1,<CMDBLN##*5-1>
MOVEM T1,CMDBLK+.CMCNT ;this much space after .CMPTR
SUB T1,TXIBLK+.RDDBC
MOVEM T1,CMDBLK+.CMINC ;# unparsed bytes in buffer
JRST RPARSE##] ;go reparse the command
TXNN T2,RD%BTM ;run out of room?
CALL [MOVEI T1,.FHSLF ;yes, get ready for SETER%
MOVEI T2,COMNX2 ;"field too long for internal buffer"
SETER%
ERRMSG (JRST,CMDERH,?,,PC,DIE)]
RET
;=============================================================================
;Routine to cleanup after the TEXTI%. It will echo the command line if
;necessary and overwrite the terminating ^M^J or ^J will a null. It will then
;ignore all leading spaces and tabs and process all the ^V characters in
;the string
; CALL TXIEND
;ACCEPTS:
; TXIBLK as left by TEXTI%
;RETURNS:
; +1 there was no string or string contained only spaces and/or tabs
; and T1 will point to start of string
; +2 with T1 pointing to start of string
;Trashes T1-T3
; program gets here when I've got the string input by TEXTI - and it will be
; terminated by a ^J or a ^M^J. Now process any ^V characters in the string
TXIEND: CALL DOECHO## ;echo command line if necessary
SETZ T3, ;null byte
DPB T3,TXIBLK+.RDDBP ;overwrite ^J with a null
MOVNI T1,1
ADJBP T1,TXIBLK+.RDDBP ;backup byte pointer
LDB T2,T1 ;get the 2nd last byte input
CAIN T2,.CTRLM ;was it this?
DPB T3,T1 ;yes, overwrite ^M with a null
MOVE T1,TXIBLK+.RDBKL ;get backup limit
IBP T1 ;adjust pointer to start of field
CALL SKPST## ;skip all leading spaces and tabs
MOVEM T1,T3 ;save last byte
MOVNI T2,1 ;get ready for PCTRLV
ADJBP T2,T1 ;backup byte pointer
MOVE T1,T2
JUMPE T3,TXIEN9 ;string contained only spaces/tabs
PUSH P,T1 ;save pointer for later
CALL PCTRLV## ;process all ^V in string
POP P,T1 ;restore pointer to start of string
AOS (P) ;set +2 return
TXIEN9: RET
;=============================================================================
;Routine to give help message for field when user types a "?".
; CALL QMHLP -only give help if the "?" is the first non-separator
; (space or tab) in the field
; CALL QMHLP2 -always give help no matter where "?" is entered
;ACCEPTS:
; T2 - byte pointer to help message
;RETURNS:
; +1 always
;Trashes T1-T4
QMHLP: MOVEM T2,T3 ;save help message
MOVE T1,TXIBLK+.RDBKL ;get backup limit
IBP T1 ;make it point to start of field
CALL SKPST## ;skip all leading spaces and tabs
CAIE T2,"?" ;is "?" the first byte in the field?
RET ;no, don't give help
MOVE T2,T3 ;restore help message
QMHLP2: HRRZ T1,TXIBLK+.RDIOJ ;get output JFN from for command
SETZ T3,
SOUT%
MOVE T2,TXIBLK+.RDRTY ;output command prompt
SOUT%
DPB T3,TXIBLK+.RDDBP ;make "?" a null
MOVE T2,TXIBLK+.RDBFP ;output command text parsed so far
SOUT%
AOS TXIBLK+.RDDBC ;since "?" deleted adjust # bytes
MOVNI T4,1 ;have ADJBP backup byte pointer...
ADJBP T4,TXIBLK+.RDDBP ; ...since "?" deleted
MOVEM T4,TXIBLK+.RDDBP ; ...and save new pointer
RET
PRGEND ;end of TXIDO
TITLE CKCV
SEARCH MONSYM,MACSYM,MLIB
ENTRY CKCV
;=============================================================================
;Routine to check the 2nd last byte for a ^V. In the case that the 2 last
;bytes are a <crlf> pair then the 3rd last byte is checked for ^V.
; CALL CKCV
;ACCEPTS:
; T1 - byte pointer to last byte such that "LDB" will get last byte
;RETURNS:
; +1 - ^V was found before the last byte or before a <crlf> pair
; +2 - no ^V found before last byte or before <crlf> pair
;Trashes T1-T2
CKCV: MOVNI T2,1
ADJBP T2,T1 ;backup byte pointer
LDB T2,T2 ;get the 2nd last byte input
CAIE T2,"" ;was it a ^V?
AOS 0(P) ;no, set up for +2 return
CAIE T2,.CTRLM ;was it a ^M?
RET ;no, return +2
; gets here when 2nd last byte was a ^M so check to see if last was a ^J
; if is is then look for the ^V before the ^M^J <crlf> pair
LDB T2,T1 ;get last byte written
CAIE T2,.CTRLJ ;was it this?
RET ;no, return +2
MOVNI T2,2 ;yes, backup 2 bytes
ADJBP T2,T1 ;backup byte pointer
LDB T2,T2 ;get the 3rd last byte input
CAIN T2,"" ;was it a ^V?
SOS 0(P) ;yes, cancel +2 return
RET
PRGEND ;end of CKCV
TITLE SKPST
SEARCH MONSYM,MACSYM,MLIB
ENTRY SKPST
;=============================================================================
;Routine to skip all spaces at tabs in a string
; CALL SKPST
;ACCEPTS:
; T1 - pointer to string
;RETURNS:
; +1 always with updated pointer in T1 and first non-space/tab in T2
;Trashes T2
SKPST: ILDB T2,T1 ;ignore all leading separators
CAIE T2," " ;a space?
CAIN T2," " ;a tab?
JRST SKPST ;yes, loop back for more
RET ;found a non-space/tab
PRGEND ;end of SKPST
TITLE PCTRLV
SEARCH MONSYM,MACSYM,MLIB
ENTRY PCTRLV
;=============================================================================
;Routine to process all ^V characters in a string (^V is used by the COMND% and
;TEXTI% jsys calls to cause the next character to be accepted without regard to
;it usual meaning)
; CALL PCTRLV
;ACCEPTS:
; T1 - source byte pointer to ASCIZ string
; T2 - destination byte pointer
;RETURNS:
; +1 always with T1, T2 updated
;Trashes T3
PCTRLV: ILDB T3,T1 ;get a byte
CAIN T3,"" ;is it a ^V?
ILDB T3,T1 ;yes, get next byte from buffer
IDPB T3,T2 ;write byte to destination
JUMPN T3,PCTRLV ;loop until null is reached
RET
PRGEND ;end of PCTRLV
TITLE FILST0
SEARCH MONSYM,MACSYM,MLIB
ENTRY FILST0,FILST1,FILST3,FILST4
;=============================================================================
;Routine to output file specs - it was designed to be called by the FILSTR macro
FILST0: MOVEI T1,.PRIOU
JRST FILST4
FILST1: MOVEI T1,.PRIOU
FILST3: SETZ T3,
FILST4: JFNS% ;;output name of file
ERJMP ERESET## ;;ignore errors
RET
PRGEND ;end of FILST0
TITLE OVERSI
SEARCH MONSYM,MACSYM,MLIB
ENTRY OVERSI
;=============================================================================
;Routine to output the version number of program
; CALL OVERSI
;Trashes T1-T4
OVERSI: HRRZ T4,.JBSA## ;get address of entry vector
MOVE T4,2(T4) ;get version (3rd word of entry vector)
; MOVEI T1,.FHSLF ;this fork
; XGVEC% ;get entry vector
; MOVE T4,T3 ;save address of entry vector
LDB T2,[POINT 9,T4,11] ;VMAJOR
NUMOUT (-,^D8)
MOVEI T1,"."
PBOUT%
LDB T2,[POINT 6,T4,17] ;VMINOR
NUMOUT (-,-)
MOVEI T1,"("
PBOUT%
HRRZ T2,T4 ;VEDIT
NUMOUT (-,-)
MOVEI T1,")"
PBOUT%
LDB T2,[POINT 3,T4,2] ;VWHO
JUMPE T2,OVERS8 ;jump if no VWHO
MOVEI T1,"-"
PBOUT%
NUMOUT (-,-)
OVERS8: RET
PRGEND ;end of OVERSI
TITLE NUMOU0
SEARCH MONSYM,MACSYM,MLIB
ENTRY NUMOU0,NUMOU1,NUMOU3,NUMOU4
;=============================================================================
;Routine to output a number - it was designed to be called by the NUMOUT macro
NUMOU0: MOVEI T1,.PRIOU
JRST NUMOU4
NUMOU1: MOVEI T1,.PRIOU
NUMOU3: MOVEI T3,^D10 ;;output a decimal number
NUMOU4: NOUT%
JERR (?,,PC) ;;ignore errors
RET
PRGEND ;end of NUMOU0
TITLE CNTBYT
SEARCH MONSYM,MACSYM,MLIB
ENTRY CNTBYT
;=============================================================================
;Calulates the number of bytes between two byte pointers (those bytes
; pointed to by each byte pointer are included).
;ACCEPTS:
; T1 - "higher" byte pointer
; T2 - "lower" byte pointer
;RETURNS:
; +1 - always with byte count in T3. Registers T1,T2 are preserved.
;Trashes none
CNTBYT: MOVEM T4,1(P) ;save registers
DMOVEM Q1,2(P)
HLRZ T3,T1
CAIN T3,777777 ;is it a symbolic byte pointer
HRLI T1,(POINT 7) ;yes - convert to a valid pointer
HLRZ T3,T2
CAIN T3,777777 ;is it a symbolic byte pointer
HRLI T2,(POINT 7) ;yes - convert to a valid pointer
LDB Q1,[POINT 6,T1,11] ;get byte size for "higher" ptr
LDB Q2,[POINT 6,T2,11] ;get byte size for "lower" ptr
CAME Q1,Q2 ;are they the same?
ERR (?,<CNTBYT problem>,PC,DIE##) ;no, byte size must be the same
TLNN T1,27 ;skip if I or X field of address not = 0
TLNE T2,27 ;skip if I or X field of address = 0
ERR (?,<CNTBYT problem>,PC,DIE##) ;can't handle index/indirect...
; ...addressing
HRRZ T3,T1 ;get address of "higher" pointer
HRRZ T4,T2 ;get address of "lower" pointer
SUB T3,T4 ;subtract them
SUBI T3,1 ;sub 1 to get number of complete words
MOVEI T4,^D36 ;get # of bits/word
IDIV T4,Q2 ;div. by # bits/byte to get # bytes/word
IMUL T3,T4 ;conv. # complete words to # bytes
LDB T4,[POINT 6,T2,5] ;get P of "lower" byte pointer
LDB Q1,[POINT 6,T1,5] ;get P of "higher" byte pointer
SUB T4,Q1 ;add P's together
ADDI T4,^D36 ;add number bits/word
IDIV T4,Q2 ;divide by num. of bits/byte
ADDI T4,1 ;add fudge factor
ADD T3,T4 ;add to previous calculation
MOVE T4,1(P) ;restore registers
DMOVE Q1,2(P)
RET ;return to caller
PRGEND ;end of CNTBYT
TITLE ENAPSI
SEARCH MONSYM,MACSYM,MLIB
ENTRY ENAPSI
;=============================================================================
;This routine will initialize, for the current process, the software interrupt
;channels as specified in CHNTAB (channel table) and LEVTAB (priority level
;table - PC stored here)
; CALL ENAPSI
;ACCEPTS: no registers need to be initialized
;RETURNS: +1 alwyas
;Trashes T1-T2
ENAPSI: MOVEI T1,.FHSLF ;this fork
MOVEI T2,[ 3 ;length of this argument block
LEVTAB## ;location of level table
CHNTAB##] ;location of channel table
XSIR%
JERR (?,,PC,DIE##)
EIR% ;enable interrupt system
JERR (?,,PC,DIE##)
MOVE T2,ONCHNL## ;activate all the channels I use
AIC%
JERR (?,,PC,DIE##)
RET
;NOTE: No programs I have currently use this so I'll comment it out
;;=============================================================================
;;Routine to disable the software interrupt system.
;; CALL DISPSI
;;ACCEPTS: no registers need to be initialized
;;RETURNS: +1 alwyas
;;Trashes T1-T2
;
;DISPSI: MOVEI T1,.FHSLF ;disable the PI system
; DIR%
; ERCAL ERESET##
; SETO T2, ;disable all channels
; DIC%
; ERCAL ERESET##
; RET
PRGEND ;end of ENAPSI
TITLE IP.SA1
SEARCH MONSYM,MACSYM,MLIB
ENTRY IP.SA1
;=============================================================================
;Routine to save registers F to P for interrupt handling processing. This
;routine is reentrant so a higher level interrupt routine can use it even though
;a lower level interrupt routine is in progress. THIS ROUTINE SHOULD ONLY BE
;CALLED BY USING THE IP.SAVE MACRO.
; IP.SAVE
;ACCEPTS: no registers need to be initialized
;RETURNS:
; -always to instruction following "JSR IP.SAV".
;To restore the ACs and DEBRK% the interrupt use "RET". If you want to change
;the location DEBRK% will return to then you must use "AOS (P)" prior to
;"RET" and initialize the ACs as follows:
; T1 - level of the interrupt (1, 2 or 3)
; T3 - address of routine to return to
;Trashes none
IP.SA1: MOVEM CX,-1(P) ;save BLT register on stack
HRRZ CX,P ;calc source,,destination for BLT
SUBI CX,CX+1
BLT CX,-2(P) ;save registers F to CX-1
MOVE CX,-1(P) ;restore BLT register
CALL @(P) ;recall calling routine
JRST IP.SA5 ;restore regsiters and quit
MOVE T2,@LEVTAB##-1(T1) ;get PC flags
TXO T2,PC%USR ;abort JSYS if I was executing one
DMOVEM T2,@LEVTAB##-1(T1) ;save new PC and flags
IP.SA5: HRRZ CX,P ;calc source,,destination for BLT
SUBI CX,CX+1
LSH CX,^D18
BLT CX,CX ;restore registers F to CX
ADJSP P,-<4+CX+1+1> ;reclaim space on stack to save F to CX
; ...and remove call to IP.SA1
DEBRK% ;dismiss interrupt
; PRGEND ;end of IP.SA1
END