Trailing-Edge
-
PDP-10 Archives
-
cuspbinsrc_2of2_bb-fp63b-sb
-
10,7/smfile/gscn.mac
There is 1 other file named gscn.mac in the archive. Click here to see a list.
TITLE GSCN -- Command Scanner Interface for DIAGNOSTICS
SEARCH GMAC ;OPEN SYMBOLS NEEDED
SEARCH MACTEN
SEARCH UUOSYM
SALL
;This module emulates the command scanning and text input routines found
; in the TOPS-20 operating system. (Somewhat)
;SPECIAL DIAGNOSTIC DEFINITIONS, OVERRIDE GMAC
.PRIIN=100
.PRIOU=101
.FDSTR=2 ;STRUCTURE
.FDPPN=3 ;PPN
.FDNAM=4 ;NAME
.FDEXT=5 ;EXT
GJ%OLD=1B2
OPDEF GO [PUSHJ P,]
OPDEF RTN [POPJ P,]
OPDEF PUT [PUSH P,]
OPDEF GETIT [POP P,]
EXTERN $CCLIN
SUBTTL Table of Contents
; TABLE OF CONTENTS FOR GLXSCN
;
;
; SECTION PAGE
; 1. Table of Contents......................................... 2
; 2. Local Definitions......................................... 3
; 3. Module Storage............................................ 4
; 4. S%INIT -- Initialization of the Scanning Module......... 5
; 5. S%RCOC -- Read Character Output Control table.......... 6
; 6. S%WCOC -- Write Character Output Control table......... 6
; 7. S%STYP -- Set terminal type............................. 7
; 8. S%TXTI -- Handle Terminal Input......................... 8
; 9. TXTL -- Loop for inputting text......................... 9
; 10. Utilities for text handling............................... 10
; 11. SPCHK -- Check for special characters................... 15
; 12. CCU -- Handle ^U (Rubout entire line)................... 16
; 13. CCR -- Handle ^R (Re-type the line)..................... 17
; 14. CCDEL -- Handle Rubout (Delete one character)........... 18
; 15. CCW -- Handle ^W (Delete back to punctuation character). 19
; 16. BEGBUF -- Handle rubouts to beginning of buffer......... 19
SUBTTL Revision History
COMMENT \
Edit SPR/QAR/GCO Reason
---- ----------- -------------------------------------------
0001 Create GLXSCN module
0002 Fix a number of interrupt race problems and
start adding ESCape sequence code
0003 Add support for parsing of a string; fix bug in
.CMINI which caused prompts not at left margin
0004 TOTALLY HACKED UP FOR DIAGNOSTICS
\ ;END OF REVISION HISTORY
; Entry Points found in this module
ENTRY S%INIT ;INIT THE COMMAND SCANNER MODULE
ENTRY S%CMND ;SCAN A COMMAND
ENTRY S%SCMP ;COMPARE TWO STRINGS
ENTRY S%TBLK ;LOOK UP A STRING IN A TABLE
ENTRY S%ERR ;TYPE OUT SCANNER'S LAST ERROR
;SPECIAL DIAGNOSTICS MACROS
DEFINE $$DATA(NAM,SIZ<1>)<
NAM: BLOCK SIZ
>
DEFINE $$GDATA(NAM,SIZ<1>)<
NAM: BLOCK SIZ
>
SUBTTL Local Definitions
; Special Accumulator definitions
C==16 ;GLOBAL CHARACTER REGISTER
P5==P4+1 ;S%CMND NEEDS LOTS OF ACS
F==14 ;FLAG AC
Q1==15 ;
Q2==16 ;DON'T DEFINE Q3 OR Q4
; Special characters
.CHBSL=="\" ;BACKSLASH
; Control character former
DEFINE $C(A)<"A"-100> ;JUST ASCII MINUS LEAD BIT
; Bad parse return macro
DEFINE NOPARS(CODE,TEXT)<
MOVE T1,[XWD CODE,[ASCIZ /TEXT/]]
JRST XCOMNE > ;END OF NOPARS DEFINITION
; Special bit testing macros
DEFINE JXN(AC,FLD,ADDR)<
TXNN AC,FLD
SKIPA
JRST ADDR > ;END OF JXN DEFINITION
DEFINE JXE(AC,FLD,ADDR)<
TXNE AC,FLD
SKIPA
JRST ADDR > ;END OF JXE DEFINITION
DEFINE JXO(AC,FLD,ADDR)<
TXC AC,FLD
TXCN AC,FLD
JRST ADDR > ;END OF JXO DEFINITION
DEFINE RETSKP<JRST [AOS 0(P)
POPJ P,] >
; Bit table - 36. Words long with word N containing 1B<N>
XX==0
BITS: XLIST
REPEAT ^D36,<EXP 1B<XX>
XX==XX+1>
LIST
SUBTTL Module Storage
$$DATA RD,.RDSIZ ;INTERNAL ARGUMENT BLOCK
$$DATA PCALL ;PUSHDOWN LIST SAVE FOR COMND
$$DATA ATBPTR ;ATOM BUFFER POINTER (END)
$$DATA ATBSIZ ;ATOM BUFFER SIZE
$$DATA STKFEN ;FENCE FOR STACK RESTORATION
$$DATA FNARG ;FUNCTION ARGUMENT
$$DATA CMCCM,2 ;SAVED CC CODES
$$DATA CMRBRK ;POINTER TO BREAK SET TABLE
$$DATA CMCSF ;SAVED FLAGS
$$DATA CMCSAC,7 ;SAVED ACS DURING S%TXTI FROM S%CMND
$$DATA CMCSC ;
$$DATA CMCBLF ;
$$DATA TBA ;TABLE ARGUMENTS
$$DATA STRG ;TEMP STRING POINTER
$$DATA REMSTR ;"REMEMBER"ED STRING
$$DATA XXXPTR ;RE-USABLE STRING POINTER STORAGE
$$DATA CRBLK,CR.SIZ ;RETURNED BLOCK OF ANSWERS
$$DATA TABDON ;END OF TAB FOR "?"
$$DATA TABSIZ ;SIZE OF TAB LARGER THAN LARGEST KEYWORD
$$DATA LSTERR ;ERROR CODE RETURNED FROM NOPARS
$$DATA BIGSIZ ;LENGTH OF LONGEST KEYWORD
$$DATA KEYSIZ ;NOMINAL KEYWORD LENGTH
$$DATA PWIDTH ;TERMINAL'S WIDTH
$$DATA CURPOS ;LINE POSITION OF CURSOR
$$DATA Q3SAVE ;NO Q3 EXISTS
$$DATA IFOB ;INDIRECT FILESPEC FOB
$$DATA IIFN ;IFN OF INDIRECT FILE
$$DATA TI,.RDSIZ ;S%TXTI ARGUMENT BLOCK
$$DATA TRMUDX ;CONTROLLING TERMINAL'S UDX
$$DATA NODSIX ;SIXBIT NODE-ID
SUBTTL S%INIT -- Initialize the GLXSCN Module
IFN FTUUOS,<
S%INIT: MOVSI S1,'TTY' ;LOAD TTY NAME
IONDX. S1, ;GET THE I/O INDEX
JFCL ;IGNORE THE ERROR
MOVEM S1,TRMUDX ;AND STORE THE UDX
$RETT ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
S%INIT: $RETT ;RETURN
> ;END IFN FTJSYS
SUBTTL S%ERR - ERROR TYPEOUT ROUTINE
IFN FTUUOS,<;!!!BEGINNING OF TOPS10 ROUTINE
S%ERR: HRRZ S1,LSTERR ;GET ADDRESS OF ERROR
JUMPE S1,[POPJ P,0] ;RETURN IF NONE
OUTSTR [ASCIZ/
?/]
OUTSTR @S1
OUTSTR [ASCIZ /
/]
POPJ P,0
>; !!!END OF TOPS10 ROUTINE
IFN FTJSYS,<;!!!BEGINNING OF TOPS20 ROUTINE
S%ERR: MOVX S1,.PRIOU ;TO PRIMARY OUTPUT
MOVE S2,[.FHSLF,,-1] ;OUR LAST ERROR
ERSTR ;TYPE OUT THE ERROR STRING
HALTF ;UNDEFINED ERROR NUMBER
HALTF ;BAD DESTINATION DESIGNATOR
POPJ P,0
>;!!!END OF TOPS20 ROUTINE
SUBTTL S%CMND -- Scan a command
;The S%CMND routine provides a command scanner interface similar to the
; TOPS-20 COMND JSYS.
;CALL IS: S1/ Pointer to Command State Block
; S2/ Pointer to list of Function Descriptor Blocks
; See GMAC or MONSYM for a description of these
;TRUE RETURN: ALWAYS,
; S1/ Length of Command Reply block
; S2/ Address of the Command Reply block
;LOCAL FLAGS (RH OF F)
CMQUES==1B18 ;? TYPED
CMSWF==1B19 ;BEG OF SWITCH SEEN
CMUSRF==1B20 ;USER NAME REQUIRED
CMDEFF==1B21 ;DEFAULT FIELD GIVEN
CMCFF==1B22 ;^F RECOGNIZED FIELD
CMQUE2==1B23 ;IN SECOND OR SUBSEQUENT HELP POSSIBILITY
CMBOL==1B24 ;FIELD IS AT BEG OF LINE
CMTF1==1B25 ;INTERNAL TEMP FLAG
CMINDF==1B26 ;DOING GTJFN ON INDIRECT FILE
;FLAGS IN FUNCTION DISPATCH TABLE
CMNOD==1B0 ;NO DEFAULT POSSIBLE
NOIBCH=="(" ;NOISE WORD BEG CHARACTER
NOIECH==")" ;NOISE WORD END CHARACTER
CMSWCH=="/" ;SWITCH CHARACTER
CMSWTM==":" ;SWITCH TERMINATOR
CMHLPC=="?" ;HELP CHARACTER
CMCOM1=="!" ;COMMENT CHARACTER
CMCOM2==";" ;FULL LINE COMMENT CHARACTER
CMDEFC=="#" ;DEFAULT FIELD CHARACTER
CMFREC=="F"-100 ;FIELD RECOGNITION CHARACTER
CMINDC=="@" ;INDIRECT FILE CHARACTER
CMRDOC=="H"-100 ;REDO COMMAND CHARACTER
CMQTCH=="""" ;CHARACTER FOR QUOTED STRINGS
CMCONC=="-" ;LINE CONTINUATION CHARACTER
;NOPARSE ERROR CODES
NPXNSW==1
NPXNOM==2
NPXNUL==3
NPXINW==4
NPXNC==5
NPXICN==6
NPXIDT==7
NPXNQS==10
NPXAMB==11
NPXNMT==12
NPXCMA==13
NPXNNC==14 ;TOO MANY CHARACTERS IN NODE NAME
NPXNNI==15 ;ILLEGAL CHARACTER IN NODE NAME
NPXNSN==16 ;NO SUCH NODE
IFN FTJSYS,< ;BEGINNING OF COMND JSYS CALL
S%CMND: COMND
ERJMP .RETF
MOVEM S1,CRBLK+CR.FLG
MOVEM S2,CRBLK+CR.RES
MOVEM T1,CRBLK+CR.FNB
MOVEI S1,CR.SIZ
MOVEI S2,CRBLK
$RETT
>;END OF COMND JSYS CALL
;DIAGNOSTICS COMND JSYS EQUIVELANT
S%CMND: PUSHJ P,.S%CMND
MOVE 1,CRBLK+CR.FLG
MOVE 2,CRBLK+CR.RES
MOVE 3,CRBLK+CR.FNB
POPJ P,
F%IBYT: GO $CCLIN ;GET CHAR FROM TAKE FILE
$RETT
F%IOPN: $STOP(FSO,F%IOPN ERROR)
F%REL: $STOP(FSR,F%REL ERROR)
IFN FTUUOS,<;BEGINNING OF TOPS-10 COMND CALL ROUTINE
;!!!!!NOTE WELL - THIS CONDITIONAL RUNS TO THE END OF COMND ROUTINE
.S%CMND:HRRZM P,PCALL ;SAVE STACK POINTER
PUSHJ P,.SAVE4 ;SAVE P REGS
SAVE P5 ;P5 WON'T BE SAVED BY THAT
PUSHJ P,.SAVET ;AND T REGS
SAVE Q1 ;AND Q REGS
SAVE Q2
SAVE F ;AND F REGISTER
PUSHJ P,XCOMND ;DO THE WORK
HRRZ T4,.CMFLG(P2) ;GET REPARSE DISPATCH ADDRESS IF ANY
JUMPE T4,COMN1
TXNE F,CM%RPT ;REPARSE NEEDED?
HRRM T4,@PCALL ;YES, EFFECT TRANSFER
COMN1: POPJ P,0 ;NO RETURN
XCOMND::MOVEM S1,P2 ;SAVE BLOCK PTR
MOVEM S2,P1 ;SAVE FN BLOCK PTR
HRL P1,P1 ;SAVE COPY OF ORIGINAL
MOVEM P,STKFEN ;SAVE CURRENT STACK AS FENCE
MOVEI T1,[.CMRTY ;LIST OF BYTE POINTERS TO CHECK
.CMBFP
.CMPTR
.CMABP
0] ;MARK OF END OF LIST
PUSHJ P,CHKABP ;CHECK ALL BYTE PTRS
MOVE P3,.CMCNT(P2) ;SETUP ACTIVE VARIABLES
MOVE P4,.CMPTR(P2)
MOVE P5,.CMINC(P2)
HLLZ F,.CMFLG(P2) ;GET 'GIVEN' FLAGS
TXZ F,CM%PFE
TXZE F,CM%ESC ;PREVIOUS FIELD HAD ESC?
TXO F,CM%PFE ;YES
PUSHJ P,K%RCOC ;GET COC MODES
DMOVEM S1,CMCCM ;SAVE THEM
TXZ S1,3B<CMFREC*2+1> ;NO ECHO ^F
TXZ S1,3B<CMRDOC*2+1> ;OR ^H
TXO S1,3B<.CHLFD*2+1> ;PROPER HANDLING OF NL
TXZ S2,3B<.CHESC*2+1-^D36> ;SET ESC TO NO ECHO
PUSHJ P,K%WCOC ;AND WRITE THEM BACK
; ..
; ..
XCOMN0: MOVE P,STKFEN ;NORMALIZE STACK IN CASE ABORTED ROUTINES
TXZ F,CM%ESC+CM%NOP+CM%EOC+CM%RPT+CM%SWT+CMBOL+CMCFF+CMDEFF+CMINDF ;INIT FLAGS
CAMN P4,.CMBFP(P2) ;AT BEG OF LINE?
TXO F,CMBOL ;YES
XCOM1: LOAD T1,.CMFNP(P1),CM%FFL ;GET FUNCTION FLAGS
STORE T1,F,CM%FFL ;KEEP WITH OTHER FLAGS
HLRZ Q1,P1 ;GET CM%DPP FLAG FROM FIRST BLOCK ONLY
XOR F,.CMFNP(Q1)
TXZ F,CM%DPP
XOR F,.CMFNP(Q1)
MOVE T1,.CMDAT(P1) ;GET FUNCTION DATA IF ANY
MOVEM T1,FNARG ;KEEP LOCALLY
LOAD T1,.CMFNP(P1),CM%FNC ;GET FUNCTION CODE
CAIL T1,0 ;VALIDATE FN CODE
CAIL T1,MAXCFN
$STOP(BFC,Bad function code)
MOVE T1,CFNTAB(T1) ;GET TABLE ENTRY FOR IT
JXN T1,CMNOD,XCOM3 ;DISPATCH NOW IF NO DEFAULT POSSIBLE
PUSHJ P,INILCH ;SKIP SPACES AND INIT ATOM BUFFER
PUSHJ P,CMCIN ;GET INITIAL INPUT
CAIN T1,CMCONC ;POSSIBLE LINE CONTINUATION?
JRST [PUSHJ P,CMCIN ;YES, SEE IF NL FOLLOWS
CAIE T1,.CHLFD
PUSHJ P,CMRSET ;NO, RESET FIELD
PUSHJ P,CMCIN ;RE-READ FIRST CHAR
JRST .+1] ;CONTINUE
CAIN T1,CMCOM2 ;COMMENT?
JRST CMCMT2 ;YES
CAIN T1,CMCOM1
JRST CMCMT1 ;YES
CAIN T1,CMINDC ;INDIRECT INDICATOR?
JRST [TXNN F,CM%XIF ;YES, INDIRECT FILES ALLOWED?
JRST CMIND ;YES, DO IT
JRST .+1] ;NO, KEEP CHARACTER AS ORDINARY INPUT
CAIN T1,.CHLFD ;EOL BEGINS FIELD?
JRST [PUSHJ P,CMDIP ;YES, PUT IT BACK
LOAD T1,.CMFNP(P1),CM%FNC ;GET FUNCTION CODE
CAIN T1,.CMCFM ;CONFIRM?
JRST XCOM3 ;YES, DO IT
TXNE F,CM%DPP ;HAVE DEFAULT?
JRST XCOM5 ;YES, USE IT
TXNN F,CMBOL ;AT BGN OF BFR?
JRST XCOM3 ;NO, TRY NULL FIELD
PUSHJ P,CMRSET
SETZ P5,0 ;YES, EMPTY LINE. IGNORE
PUSHJ P,CMRTY1 ;REDO PROMPT
JRST XCOMN0] ;TRY AGAIN
CAIE T1,.CHESC ;ESC AT BEG OF FIELD?
CAIN T1,CMFREC
JRST XCOM4 ;^F AT BEG OF FIELD
; CAIN T1,CMDEFC ;OR DEFAULT REQUEST?
; JRST XCOM4 ;YES
XCOM2: PUSHJ P,CMDIP ;PUT CHAR BACK
XCOM3: LOAD T1,.CMFNP(P1),CM%FNC ;GET FUNCTION CODE
JRST @CFNTAB(T1) ;DO IT
;ESC OR ^F AT BEG OF FIELD
XCOM4: TXNN F,CM%DPP ;YES, HAVE DEFAULT STRING?
JRST XCOM2 ;NO
PUSHJ P,CMDCH ;FLUSH RECOG CHAR
XCOM5: HLRZ Q1,P1 ;GET PTR TO FIRST FLD BLOCK
MOVE T1,.CMDEF(Q1) ;GET DEFAULT STRING PTR
PUSHJ P,CHKBP ;CHECK POINTER
MOVEM T1,Q1
TXO F,CMDEFF ;NOTE FIELD ALREADY IN ATOM BFR
XCOM6: ILDB T1,Q1
JUMPE T1,[PUSHJ P,CHKLCH ;CHECK FOR NULL DEFAULT STRING
CAIG T1,0
$STOP(BDS,Bad Default String) ;NULL STRING ILLEGAL
PUSHJ P,TIELCH ;END OF STRING, TIE OFF ATOM BUFFER
TXNE F,CMCFF ;^F RECOG?
JRST XCOMRF ;YES, GO GET MORE INPUT
JXE F,CM%ESC,XCOM3 ;GO DIRECT TO FUNCTION IF NO RECOG
MOVEI T1,.CHESC
PUSHJ P,CMDIBQ ;YES, APPEND ESC TO BUFFER
PUSHJ P,CMRSET ;RESET LINE VARIABLES
JRST XCOMN0] ;TREAT AS ORDINARY INPUT
PUSHJ P,STOLCH ;STOR CHAR IN ATOM BUFFER
TXNE F,CM%ESC ;RECOGNIZING?
PUSHJ P,CMDIB ;YES, CHAR TO MAIN BUFFER ALSO
JRST XCOM6
;COMMENT
CMCMT2: SETO T1, ;SAY NO TERMINATOR OTHER THAN EOL
CMCMT1: MOVEM T1,Q2 ;REMEMBER MATCHING TERMINATOR
CMCOM: PUSHJ P,CMCIN ;GET NEXT CHAR
CAIN T1,CMCONC ;POSSIBLE LINE CONTINUATION?
JRST [PUSHJ P,CMCIN ;YES, CHECK FOR NL FOLLOWING
CAIN T1,.CHLFD
JRST CMCOM ;YES, STAY IN COMMENT
JRST .+1] ;NO, EXAMINE CHARACTER
CAIE T1,CMFREC ;RECOG REQUEST?
CAIN T1,.CHESC
JRST [PUSHJ P,CMAMB ;YES, DING
JRST CMCOM] ;KEEP GOING
CAIN T1,.CHLFD ;END OF LINE?
JRST [PUSHJ P,CMDIP ;YES, PUT IT BACK
JRST XCOM1] ;DO WHATEVER
CAMN T1,Q2 ;MATCHING TERMINATOR?
JRST XCOM1 ;YES, END OF COMMENT
JRST CMCOM ;NO, KEEP LOOKING
;TABLE OF COMND FUNCTIONS
CFNTAB: PHASE 0
.CMKEY::!XCMKEY ;KEYWORD
.CMNUM::!XCMNUM ;INTEGER
.CMNOI::!XCMNOI+CMNOD ;NOISE WORD
.CMSWI::!XCMSWI ;SWITCH
.CMIFI::!XCMIFI ;INPUT FILE
.CMOFI::!XCMOFI ;OUTPUT FILE
.CMFIL::!XCMFIL ;GENERAL FILESPEC
.CMFLD::!XCMFLD ;ARBITRARY FIELD
.CMCFM::!XCMCFM ;CONFIRM
.CMDIR::!XCMDIR ;DIRECTORY NAME
.CMUSR::!XCMUSR ;USER NAME
.CMCMA::!XCMCMA ;COMMA
.CMINI::!XCMINI+CMNOD ;INITIALIZE COMMAND
.CMFLT::!XCMFLT ;FLOATING POINT NUMBER
.CMDEV::!XCMDEV ;DEVICE NAME
.CMTXT::!XCMTXT ;TEXT
.CMTAD::!XCMTAD ;TIME AND DATE
.CMQST::!XCMQST ;QUOTED STRING
.CMUQS::!XCMUQS+CMNOD ;UNQUOTED STRING
.CMTOK::!XCMTOK ;TOKEN
.CMNUX::!XCMNUX ;NUMBER DELIMITED BY NON-DIGIT
.CMACT::!XCMACT ;ACCOUNT
.CMNOD::!XCMNOD ;NODE NAME
DEPHASE
MAXCFN==.-CFNTAB
;HERE TO GET MORE INPUT AND RETRY FIELD
XCOMRF: PUSHJ P,CMRSET ;RESET VARIABLES TO BEGINNING OF FIELD
PUSHJ P,CMCIN1 ;GET MORE INPUT
HLR P1,P1 ;RESET ALTERNATIVE LIST
JRST XCOMN0
;RESET VARIABLES TO BEGINNING OF CURRENT FIELD
CMRSET: SUB P5,P3 ;RESET VARIABLES TO BGN OF FIELD
ADD P5,.CMCNT(P2) ;KEEP ALL CURRENT INPUT
MOVE P3,.CMCNT(P2)
MOVE P4,.CMPTR(P2)
POPJ P,0
;STANDARD EXITS
;RETURN BECAUSE ENTIRE COMMAND DELETED
XCOMXL: TXO F,CM%RPT ;NOTE REPEAT PARSE NEEDED
MOVE T1,P4 ;BACK POINTER TO BEG OF BUFFER
MOVE T2,.CMBFP(P2)
MOVEM T2,P4
PUSHJ P,SUBBP ;SEE HOW MANY CHARS DELETED
ADDM T1,P3 ;UPDATE SPACE COUNT
SETZ P5, ;NOTE NO INPUT
PUSHJ P,CMRTY1 ;RETYPE PROMPT
JRST XCOMXI ;EXIT
;RETURN AND REPEAT PARSE BECAUSE USER DELETED BACK INTO ALREADY
;PARSED TEXT
XCOMRP: TXO F,CM%RPT ;REQUEST REPEAT
MOVE T1,P4 ;COMPUTE NUMBER CHARS IN BUFFER
MOVE T2,.CMBFP(P2)
MOVEM T2,P4 ;RESET PTR TO TOP OF BUFFER
PUSHJ P,SUBBP ;COMPUTE PTR-TOP
MOVEM T1,P5 ;SET AS NUMBER CHARS FOLLOWING PTR
ADDM T1,P3 ;RESET COUNT TO TOP OF BUFFER
JUMPE T1,XCOMXL ;JUMP IF LINE NOW EMPTY
JRST XCOMX1 ;OTHERWISE UPDATE VARIABLES AND EXIT
;GOOD RETURN
XCOMXR: TXNE F,CM%ESC ;RECOG CHARACTER TERMINATED?
PUSHJ P,CMDCH ;YES, FLUSH IT
XCOMXI: TXZN F,CM%ESC ;FIELD TERMINATED WITH RECOG?
JRST XCOMX1 ;NO
TXNE F,CMCFF ;^F RECOG?
JRST XCOMRF ;YES, GET MORE INPUT BEFORE RETURNING
TXO F,CM%ESC ;SET FLAG
MOVEI T1," " ;TERMINATE TYPESCRIPT WITH SPACE
PUSHJ P,CMDIB
XCOMX1: MOVEM P3,.CMCNT(P2) ;UPDATE VARIABLES
MOVEM P4,.CMPTR(P2)
MOVEM P5,.CMINC(P2)
XCOMX2: MOVE P,STKFEN ;RESET STACK
DMOVE S1,CMCCM ;GET SAVED CC MODES
PUSHJ P,K%WCOC ;RESTORE THEM
MOVEM P1,CRBLK+CR.FNB ;RETURN PTR TO FUNCTION BLOCK USED
TXZ F,CM%FFL ;FLUSH FUNCTION FLAGS
HLLM F,.CMFLG(P2) ;RETURN FLAGS
MOVEM P2,CRBLK+CR.FLG ;STORE BLK ADDRESS
HLLM F,CRBLK+CR.FLG ;AND THE FLAGS
MOVEI S1,CR.SIZ ;LOAD SIZE OF RETURNED BLOCK
MOVEI S2,CRBLK ;AND ITS LOCATION
$RETT ;AND TAKE A GOOD RETURN
;FAILURE RETURNS - FAILED TO PARSE
XCOMNE: MOVEM T1,LSTERR ;SAVE ERROR CODE
XCOMNP: JXN F,CMQUES,CMRTYP ;IF IN HELP, DON'T RETURN NOW
PUSHJ P,CMRSET ;RESET FIELD VARIABLES
MOVEM P5,.CMINC(P2) ;FIX USER BLOCK
LOAD T1,.CMFNP(P1),CM%LST ;GET PTR TO NEXT FN BLOCK
HRRM T1,P1 ;SAVE IT
JUMPN T1,XCOMN0 ;DISPATCH IF THERE IS ANOTHER FUNCTION
TXO F,CM%NOP ;NO OTHER POSSIBILITIES, SAY NO PARSE
JRST XCOMX2
;HERE AFTER EACH HELP OUTPUT
CMRTYP: PUSHJ P,CMRSET ;RESET FIELD VARIABLES
LOAD T1,.CMFNP(P1),CM%LST ;GET NEXT FUNCTION IN LIST
HRRM T1,P1
TXO F,CMQUES+CMQUE2 ;NOTE IN SECOND HELP POSSIBILITY
JUMPN T1,XCOMN0 ;DO SUBSEQUENT HELPS
MOVEI T1,.CHLFD ;START NEW LINE
PUSHJ P,CMCOUT
HLR P1,P1 ;END OF LIST, REINIT IT
SOS P5 ;FLUSH QMARK FROM INPUT
TXZ F,CMQUES+CMQUE2 ;NOTE NOT IN HELP
PUSHJ P,CMRTY1 ;RETYPE LINE
JRST XCOMN0 ;RESTART PARSE OF CURRENT FIELD
XCOMEO: TXO F,CM%NOP ;SET NO PARSE
MOVEI S2,CRBLK
MOVE P,STKFEN ;FIXUP STACK
$RETF
;RETYPE LINE INCLUDING ADVANCE INPUT IF ANY
CMRTY1:;** HRRZ T1,.CMIOJ(P2) ;GET OUT JFN
;** RFPOS
;** HRRZ T2,T2
;** JUMPE T2,CMRTY2 ;JUMP IF AT LEFT MARGIN
HRROI T1,[BYTE (7) .CHCRT,.CHLFD] ;NOT AT MARGIN, GIVE CRLF
PUSHJ P,CMSOUT ;
CMRTY2: SKIPE Q1,.CMRTY(P2) ;GET ^R PTR IF ANY
CMRTY3: CAMN Q1,.CMBFP(P2) ;UP TO TOP OF BFR?
JRST CMRTY4 ;DONE WITH ^R PTR
ILDB T1,Q1 ;TYPE ^R BFR
JUMPN T1,[PUSHJ P,CMCOUT
JRST CMRTY3]
CMRTY4: MOVE Q1,.CMBFP(P2) ;GET MAIN BFR PTR
CMRTY5: CAMN Q1,P4 ;UP TO CURRENT PTR?
JRST CMRTY6 ;YES, GO DO ADVANCE INPUT
ILDB T1,Q1 ;TYPE OUT COMMAND BFR
PUSHJ P,CMCOUT
JRST CMRTY5
CMRTY6: MOVE Q2,P5 ;GET INPUT COUNT
CMRTY7: SOJL Q2,[SETZ T1,0 ;ALL INPUT PRINTED, TIE OFF
IDPB T1,Q1 ;BUFFER
POPJ P,0]
ILDB T1,Q1
PUSHJ P,CMCOUT
JRST CMRTY7
;INDIRECT FILE HANDLING
CMIND: JXO F,CMQUE2,XCOMNP ;NO SECOND HELP POSSIBILITIES
PUSHJ P,CMATFI ;GET A JFN ON THE INDIRECT FILE
JRST CMINDE ;FAILED
PUSHJ P,CMCFM0 ;DO A CONFIRM
JRST [HRROI T1,[ASCIZ /
?Indirect file not confirmed.
/]
PUSHJ P,CMSOUT
TXO F,CM%NOP
JRST XCOMX2]
LOAD S1,.CMGJB(P2),CM%GJB ;GET ADDR OF FD
SKIPN S2,.FDSTR(S1) ;IF DEVICE HAS NOT BEEN SPECIFIED,
MOVSI S2,'DSK' ;DEFAULT TO DISK
MOVEM S2,.FDSTR(S1) ;
SKIPN S2,.FDEXT(S1) ;AND DEFAULT THE EXTENSION
MOVSI S2,'CMD' ;TO ".CMD"
MOVEM S2,.FDEXT(S1) ;
STORE S1,IFOB+FOB.FD ;STORE IT
MOVX S1,FB.LSN!<INSVL.(7,FB.BSZ)> ;IGNORE LINE NUMBERS
STORE S1,IFOB+FOB.CW ;STORE
MOVEI S1,2 ;SHORT FOB
MOVEI S2,IFOB ;AND ITS ADDRESS
PUSHJ P,F%IOPN ;OPEN FOR INPUT
JUMPF CMINDE ;IF FAILS,TELL WHY
MOVEM S1,IIFN ;STORE IFN
PUSHJ P,CMRSET ;FLUSH INDIRECT FILESPEC FROM BUFFER
CMIND1: MOVE S1,IIFN ;GET IFN
PUSHJ P,F%IBYT ;GET A BYTE
JUMPF CMIND2 ;IF FAILS FIND OUT WHY
CAIE S2,CMRDOC ;IGNORE ^H
CAIN S2,.CHCRT ;IGNORE CR
JRST CMIND1
CAIE S2,.CHLFD ;CONVERT EOL TO SPACE
CAIN S2,.CHESC ;DITTO ESC (BUT THERE SHOULDN'T BE ANY)
MOVEI S2," "
MOVE T1,S2 ;COPY CHARACTER
PUSHJ P,CMDIBQ ;PUT CHAR IN BUFFER WITHOUT TYPEOUT
JRST CMIND1
CMIND2: MOVE S1,IIFN ;CLOSE OFF THE FILE NOW
PUSHJ P,F%REL ;
MOVEI T1,.CHLFD ;TIE OFF LINE
PUSHJ P,CMDIBQ
JRST XCOMRP ;REPARSE LINE AS NOW CONSTITUTED
CMINDE: PUSHJ P,I%IOFF ;TURN OFF INTERRUPTS
PCRLF
MOVEI [ASCIZ/?PROBLEM WITH INDIRECT FILE:/]
PNTALF
PUSHJ P,I%ION ;THEN TURN THEM BACK ON
TXO F,CM%NOP ;RETURN FAILURE, NO CHECK ALTERNATIVES
JRST XCOMX2
;****************************************
;COMND - LOCAL SUBROUTINES
;****************************************
;READ NEXT FIELD ATOM
;ASSUMES ATOM BUFFER ALREADY SETUP
CMRATM: MOVEI T1,FLDBRK ;USE STANDARD FIELD BREAK SET
PJRST CMRFLD ;PARSE THE FIELD
FLDBRK: 777777,,777760 ;ALL CONTROL CHARS
777754,,001760 ;ALL EXCEPT - , NUMBERS
400000,,000760 ;ALL EXCEPT UC ALPHABETICS
400000,,000760 ;ALL EXCEPT LC ALPHABETICS
;READ FILESPEC FIELD - FILESPEC PUNCTUATION CHARACTERS
;ARE LEGAL ( :, <, >, ., ;)
CMRFIL: MOVEI T1,FILBRK ;USE FILE BREAK SET
PJRST CFRFLD
FILBRK: 777777,,777760 ;ALL CC
747504,,000520 ;PUNCT, NUMBERS
400000,,000260 ;UC, BRACKETS
400000,,000760 ;LC
;USERNAME BREAK SET. BREAKS ON EVERYTHING EXCEPT DOT AND ALPHABETICS.
USRBRK: -1,,777760 ;BREAK ON CONTROLS
777744,,001760 ;DON'T BREAK ON "-", ".", DIGITS
400000,,760 ;DON'T BREAK ON UPPERCASE LETTERS
400000,,760 ;OR LOWERCASE LETTERS
;READ TO END OF LINE
EOLBRK: 1B<.CHLFD> ;END OF LINE ONLY
EXP 0,0,0 ;THREE WORDS OF 0'S
;GENERAL FIELD PARSE ROUTINE - TAKES BREAK SET MASK
; T1/ ADDRESS OF 4-WORD BREAK SET MASK
; PUSHJ P,CMRFLD
; RETURNS +1, FIELD COPIED TO ATOM BUFFER, TERMINATOR BACKED UP
CMRFLD: MOVEM T1,CMRBRK ;SAVE BREAK TABLE ADDRESS
TXNE F,CMDEFF ;DEFAULT GIVEN?
JRST CMRATT ;YES, ALREADY IN BUFFER
CMRAT1: PUSHJ P,CMCIN ;GET A CHAR
CMRAT2: CAIE T1,CMFREC ;^F RECOGNITION?
CAIN T1,.CHESC ;ESC?
JRST [PUSHJ P,CHKLCH ;YES, RETURN IF ANYTHING NOW
JUMPG T1,CMRATT ;IN ATOM BFR
PUSHJ P,CMAMB ;NOTHING THERE, DING
JRST CMRAT1] ;KEEP TRYING
CAIE T1," " ;SPACE OR TAB?
CAIN T1,.CHTAB
JRST [PUSHJ P,CHKLCH ;YES, RETURN IF ANYTHING
JUMPG T1,CMRATT ;IN ATOM BFR
JRST CMRAT1] ;OTHERWISE IGNORE
CAIN T1,.CHLFD ;OR EOL?
JRST CMRATR ;YES
CAIN T1,CMHLPC ;HELP REQUEST?
JRST [TXO F,CMQUES ;YES, FLAG
JRST CMRATT]
move T2,t1 ;get copy of char
IDIVI T2,40 ;COMPUTE INDEX TO BIT MASK
MOVE T3,BITS(t3)
ADD T2,CMRBRK
TDNE T3,0(t2) ;BREAK CHARACTER?
JRST CMRATR ;YES
CMRAT3: PUSHJ P,STOLCH ;BUILD KEYWORD STRING
JRST CMRAT1
CMRATR: PUSHJ P,CMDIP ;PUT CHARACTER BACK IN BUFFER
CMRATT: PJRST TIELCH ;TIE OFF ATOM BUFFER AND RETURN
;FILE SPEC FIELD PARSE ROUTINE - TAKES BREAK SET MASK
; T1/ ADDRESS OF 4-WORD BREAK SET MASK
; PUSHJ P,CFRFLD
; RETURNS +1, FIELD COPIED TO ATOM BUFFER, TERMINATOR BACKED UP
CFRFLD: MOVEM T1,CMRBRK ;SAVE BREAK TABLE ADDRESS
TXNE F,CMDEFF ;DEFAULT GIVEN?
JRST CFRATT ;YES, ALREADY IN BUFFER
CFRAT1: PUSHJ P,CMCIN ;GET A CHAR
CFRAT2: CAIE T1,CMFREC ;^F RECOGNITION?
CAIN T1,.CHESC ;ESC?
JRST CFRATT ;YES
CAIE T1," " ;SPACE OR TAB?
CAIN T1,.CHTAB
JRST [PUSHJ P,CHKLCH ;YES, RETURN IF ANYTHING
JUMPG T1,CFRATT ;IN ATOM BFR
JRST CFRAT1] ;OTHERWISE IGNORE
CAIN T1,.CHLFD ;OR EOL?
JRST CFRATR ;YES
CAIN T1,CMHLPC ;HELP REQUEST?
JRST [TXO F,CMQUES ;YES, FLAG
JRST CFRATT]
move T2,t1 ;get copy of char
IDIVI T2,40 ;COMPUTE INDEX TO BIT MASK
MOVE T3,BITS(t3)
ADD T2,CMRBRK
TDNE T3,0(t2) ;BREAK CHARACTER?
JRST CFRATR ;YES
CFRAT3: PUSHJ P,STOLCH ;BUILD KEYWORD STRING
JRST CFRAT1
CFRATR: PUSHJ P,CMDIP ;PUT CHARACTER BACK IN BUFFER
CFRATT: PJRST TIELCH ;TIE OFF ATOM BUFFER AND RETURN
;ATOM READ FOR SPECIAL FIELDS - DOES NOT ALLOW RECOGNITION
;READ FIELD TO CR
CMRSTR: TXZA F,CMTF1 ;FLAG NO TERMINATE ON SPACE
; .. ;CONTINUE IN CMRSPC
;READ FIELD TO SPACE OR CR
CMRSPC: TXO F,CMTF1 ;FLAG TERMINATE ON SPACE
TXNE F,CMDEFF ;HAVE FIELD ALREADY?
POPJ P,0 ;YES
CMRSP1: PUSHJ P,CMCIN ;GET CHAR
CAIN T1,CMHLPC ;HELP?
JRST [TXO F,CMQUES ;YES
POPJ P,0]
CAIE T1,.CHESC ;RECOG REQUEST?
CAIN T1,CMFREC
JRST [PUSHJ P,CMAMB ;DING
JRST CMRSP1] ;CONTINUE
CAIE T1,.CHTAB
CAIN T1," " ;END OF FIELD?
JRST [JXE F,CMTF1,.+1 ;CONTINUE IF NOT TERMINATING ON BLANK
PUSHJ P,CHKLCH ;SEE IF ANY NON-BLANK SEEN
JUMPE T1,CMRSP1 ;JUMP IF LEADING BLANK
JRST CMRATT] ;TERMINATING BLANK
CAIN T1,.CHLFD ;END OF LINE?
JRST CMRATR ;YES
PUSHJ P,STOLCH ;NO, CHAR TO ATOM BUFFER
JRST CMRSP1 ;CONTINUE
;READ QUOTED STRING INTO ATOM BUFFER
;STRING DELIMITED BY ", "" MEANS LITERAL "
CMRQST: TXNE F,CMDEFF ;HAVE DEFAULT?
RETSKP ;YES
PUSHJ P,CMCIN ;GET FIRST CHAR
CAIN T1,CMHLPC ;FIRST CHAR IS HELP?
JRST [TXO F,CMQUES ;YES
RETSKP]
CAIE T1,CMQTCH ;START OF STRING?
POPJ P,0 ;NO, FAIL
CMRQS1: PUSHJ P,CMCIN ;READ NEXT CHAR
CAIN T1,.CHLFD ;LINE ENDED UNEXPECTEDLY?
JRST [PJRST CMDIP] ;YES, PUT LF BACK AND RETURN FAIL
CAIE T1,CMQTCH ;ANOTHER QUOTE?
JRST CMRQS2 ;NO, GO STORE CHARACTER
PUSHJ P,CMCIN ;YES, PEEK AT ONE AFTER
CAIN T1,CMQTCH ;PAIR OF QUOTES?
JRST CMRQS2 ;YES, STORE ONE
PUSHJ P,CMDIP ;NO, PUT BACK NEXT CHAR
PUSHJ P,TIELCH ;TIE OFF ATOM BUFFER
RETSKP ;GOOD
CMRQS2: PUSHJ P,STOLCH ;STOR CHAR IN ATOM BUFFER
JRST CMRQS1 ;KEEP LOOKING
;INIT ATOM BUFFER
INILCH: MOVE T1,.CMABP(P2) ;GET PTR
MOVEM T1,ATBPTR
MOVE T1,.CMABC(P2) ;GET SIZE
MOVEM T1,ATBSIZ
PJRST CMSKSP ;FLUSH INITIAL SPACES
;STORE CHARACTER IN ATOM BUFFER
STOLCH: SOSGE ATBSIZ ;ROOM?
$STOP(ABS,Atom buffer too small) ;NO
IDPB T1,ATBPTR
POPJ P,0
;CHECK NUMBER OF CHARACTERS IN ATOM BUFFER
CHKLCH: MOVE T1,.CMABC(P2) ;GET ORIG COUNT
SUB T1,ATBSIZ ;COMPUTE DIFFERENCE
POPJ P,0
;TIE OFF ATOM BUFFER
TIELCH: SKIPG ATBSIZ ;ROOM FOR NULL?
PUSHJ P,S..ABS ;NO, LOSE
SETZ T1,0
MOVE T3,ATBPTR ;GET POINTER
IDPB T1,T3 ;DEPOSIT WITHOUT CHANGING PTR
POPJ P,0
;GET NEXT INPUT CHARACTER FOR PROCESSING
;APPEND TEXT TO BUFFER IF NECESSARY WITH INTERNAL TEXTI
; PUSHJ P,CMCIN
; RETURNS +1 ALWAYS, T1/ CHARACTER
CMCIN: SOJL P5,[SETZ P5,0 ;MAKE INPUT EXACTLY EMPTY
PUSHJ P,CMCIN1 ;NONE LEFT, GO GET MORE
JRST CMCIN]
ILDB T1,P4 ;GET NEXT ONE
SOS P3 ;UPDATE FREE COUNT
CAIN T1,CMFREC ;^F?
JRST [TXO F,CM%ESC+CMCFF ;YES
POPJ P,0]
CAIN T1,.CHESC ;ESC?
JRST [TXO F,CM%ESC ;YES
POPJ P,0]
CAIN T1,.CHLFD ;END OF LINE?
TXO F,CM%EOC ;YES, MEANS END OF COMMAND
POPJ P,0
CMCIN1: MOVEM F,CMCSF ;SAVE F
SETZM CMCBLF ;INIT ACCUMULATED FLAGS
MOVE T1,[XWD P1,CMCSAC] ;PREPARE FOR BLT
BLT T1,CMCSAC+3 ;SAVE P1-P4
MOVX T1,RD%BRK+RD%PUN+RD%BEL+RD%CRF+RD%JFN+RD%BBG ;SETUP FLAGS
TXNE F,CM%NJF ;WERE JFN'S PASSED?
TXZ T1,RD%JFN ;NO, PASS THAT FACT
TXNE F,CM%RAI ;RAISE INPUT REQUESTED?
TXO T1,RD%RAI ;YES, PASS IT
MOVEM T1,TI+.RDFLG ;STORE FLAGS FOR TEXTI
MOVX T1,.RDBKL ;GET NUMBER OF WORDS TO PASS
MOVEM T1,TI+.RDCWB ;AND STORE IT
MOVE T1,.CMRTY(P2) ;SETUP ^R BUFFER
MOVEM T1,TI+.RDRTY ;FOR TXTI
MOVE T1,.CMBFP(P2) ;SETUP TOP OF BUFFER
MOVEM T1,TI+.RDBFP ;
SETZM TI+.RDBRK ;NO SPECIAL BREAK MASK
MOVEM P4,TI+.RDBKL ;STORE CURRENT PTR FOR BACK UP LIMIT
MOVEM P3,CMCSC ;SAVE CURRENT COUNT
SUB P3,P5 ;ADJUST COUNT FOR ADVANCE INPUT
MOVEM P3,TI+.RDDBC ;AND STORE FOR THE TEXT INPUT
SKIPE P5 ;PUSH POINTER PAST CURRENT INPUT
IBP P4 ;
SOJG P5,.-1 ;
MOVEM P4,TI+.RDDBP ;STORE FOR INPUT
MOVE S1,.CMIOJ(P2) ;GET THE JFNS
MOVEM S1,TI+.RDIOJ ;STORE FOR TEXTI
CMCIN2: SKIPG P3 ;ROOM IN BUFFER FOR MORE INPUT?
$STOP(TMT,Too much text) ;NO
MOVEI S1,TI ;GET LOCATION OF TEXTI BLOCK
PUSHJ P,K%TXTI ;DO INTERNAL TEXTI
JUMPF [MOVEI S1,EREOF$
JRST XCOMEO]
IOR F,TI+.RDFLG ;GET FLAGS
TXNE F,RD%BFE ;BUFFER EMPTY?
JRST CMCIN4 ;YES
IORB F,CMCBLF ;ACCUMULATE FLAGS (RD%BLR)
LDB T1,TI+.RDDBP ;GET LAST CHAR
MOVE P4,TI+.RDDBP ;REMEMBER POINTER
MOVE P3,TI+.RDDBC ;AND COUNT
CAIE T1,.CHLFD ;AN ACTION CHAR?
CAIN T1,.CHESC
JRST CMCIN3 ;YES
CAIE T1,CMHLPC
CAIN T1,CMFREC ;^F?
JRST CMCIN3 ;YES
JRST CMCIN2 ;NO, GET MORE INPUT
CMCIN3: TXNE F,RD%BLR ;BACKUP LIMIT REACHED?
JRST CMCIN4 ;YES, CLEANUP AND REPARSE
MOVE P5,CMCSC ;RECOVER PREVIOUS COUNT
SUB P5,P3 ;COMPUTE CHARACTERS JUST APPENDED
MOVSI T1,CMCSAC ;RESTORE ACS P1-P4, F
HRRI T1,P1
BLT T1,P4
MOVE F,CMCSF
POPJ P,0
;HERE ON RETURN FROM TEXTI WHICH REACHED BACKUP LIMIT OR WHICH RETURNED
;BECAUSE BUFFER EMPTY. MUST REPARSE LINE. RESTORE ACS, BUT LEAVE
;MAIN POINTER AS RETURNED BY TEXTI.
CMCIN4: DMOVE P1,CMCSAC ;RESTORE P1&P2
MOVE F,CMCSF ;RESTORE F
JRST XCOMRP ;RETURN REPEAT PARSE
;SKIP LEADING TABS OR SPACES
CMSKSP: PUSHJ P,CMCIN ;GET A CHAR
CAIE T1," " ;SPACE OR TAB?
CAIN T1,.CHTAB
JRST CMSKSP ;YES, KEEP LOOKING
PJRST CMDIP ;NO, PUT IT BACK
;LOCAL ROUTINE - SUBTRACT ASCII BYTE PTRS
; T1, T2/ ASCII BYTE PTRS
; PUSHJ P,SUBBP
; RETURNS +1 ALWAYS,
; T1/ T1-T2
SUBBP: HRRZ T3,T1 ;COMPUTE 5*(A1-A2)+(P2-P1)/7
SUBI T3,0(T2)
IMULI T3,5 ;COMPUTE NUMBER CHARS IN THOSE WORDS
LDB T1,[POINT 6,T1,5]
LDB T2,[POINT 6,T2,5]
SUBM T2,T1
IDIVI T1,7
ADD T1,T3
POPJ P,0
;LOCAL ROUTINE - DELETE LAST CHAR INPUT
CMDCH: MOVE T1,P4
PUSHJ P,DBP ;DECREMENT BYTE PTR
MOVEM T1,P4
AOS P3 ;ADJUST SPACE COUNT
SETZ P5,0 ;CAN'T BE ANY WAITING INPUT
POPJ P,0
;LOCAL ROUTINE - DECREMENT INPUT POINTER
CMDIP: LDB T1,P4 ;CHECK THE CHARACTER
CAIE T1,CMFREC ;A RECOG REQUEST CHAR?
CAIN T1,.CHESC
TXZ F,CM%ESC+CMCFF ;YES, RESET FLAGS
MOVE T1,P4 ;GET POINTER
PUSHJ P,DBP ;DECREMENT IT
MOVEM T1,P4 ;PUT IT BACK
AOS P5 ;ADJUST COUNTS
AOS P3
POPJ P,0
;LOCAL ROUTINE - DEPOSIT INTO INPUT BUFFER
CMDIB: PUSHJ P,CMCOUT ;TYPE THE CHAR
CMDIBQ: SETZ P5,0 ;CLEAR ADVANCE COUNT
SOSGE P3 ;ROOM?
PUSHJ P,S..ABS ;NO
IDPB T1,P4 ;APPEND BYTE TO USER'S BUFFER
POPJ P,0
;LOCAL ROUTINE - DECREMENT BYTE POINTER
DBP: SOS T1 ;BACK OFF ONE WORD
IBP T1 ;AND THEN GO FORWARD 4 TIMES
IBP T1
IBP T1
IBP T1
$RETT ;THEN RETURN
;APPEND CHARACTER TO INPUT BUFFER
; T1/ CHARACTER
CMAPC: MOVEM T1,T4 ;SAVE CHAR
MOVE T2,P5 ;ADVANCE COUNT
ADJBP T2,P4 ;COMPUTE POINTER TO END OF INPUT
IDPB T4,T2 ;APPEND THE CHAR
AOS P5 ;UPDATE ADVANCE COUNT
POPJ P,0
;DO CALLER-SUPPLIED HELP TEXT IF ANY
DOHLP: HRROI T1,[ASCIZ /
or/]
TXNE F,CMQUE2 ;IN ALTERNATE HELP POSSIBILITIES?
PUSHJ P,CMSOUT ;YES, NOT ALTERNATIVE
TXNN F,CM%HPP ;HAVE HELP POINTER?
POPJ P,0 ;NO
MOVEI T1," "
PUSHJ P,CMCOUT ;SPACE BEFORE USER TEXT
HRRZ T1,P1 ;LOAD ADDRESS
MOVE T1,.CMHLP(T1) ;YES, GET IT
PUSHJ P,CMUSOU ;YES, TYPE IT
POPJ P,0
;HANDLE AMBIGUOUS TYPEIN
CMAMB: TXZN F,CM%ESC ;ESC SEEN?
JRST [NOPARS (NPXAMB,UNRECOGNIZED CONTROL CHARACTER)] ;NO, SAME AS UNREC
PUSHJ P,CMDCH ;FLUSH RECOG CHAR FROM BUFFER
MOVEI T1,.CHBEL ;INDICATE AMBIGUOUS
PUSHJ P,CMCOUT
JRST XCOMRF ;GET MORE INPUT AND RESTART
;OUTPUT CHARACTER TO SPECIFIED DESTINATION
; T1/ CHAR
; PUSHJ P,CMCOUT
; RETURNS +1 ALWAYS
CMCOUT: OUTCHR T1 ;OUTPUT THE CHARACTER
POPJ P,0
;OUTPUT STRING FROM CURRENT CONTEXT
; T1/ STRING PTR
; PUSHJ P,CMSOUT
; RETURN +1 ALWAYS
CMUSOU:
CMSOUT: HLRZ S1,T1 ;GET LH OF POINTER TO S1
CAIN S1,-1 ;IS IT A -1?
MOVEI S1,(POINT 7,0) ;YES, MAKE IT POINT 7,
CAIN S1,(POINT 7,0) ;IS IT A WORD-ALIGNED POINTER?
JRST CMSO.2 ;YES, DO AN OUTSTR FOR EFFICIENCY
HRL T1,S1 ;NO, COMPLETE THE BYTE POINTER
CMSO.1: ILDB S1,T1 ;GET A CHARACTER
JUMPE S1,.POPJ ;TERMINATE ON NULL
OUTCHR S1 ;OUTPUT THE CHARACTER
JRST CMSO.1 ;AND LOOP FOR MORE
CMSO.2: OUTSTR 0(T1) ;TYPE OUT THE STRING
POPJ P, ;AND RETURN
;OUTPUT CHARACTER TO SPECIFIED DESTINATION
; T1/ CHAR
; PUSHJ P,XMCOUT
; RETURNS +1 ALWAYS
XMCOUT: OUTCHR T1
CAIN T1,^D9
JRST XMCS.1
JRST XMCS.2
;OUTPUT STRING FROM CURRENT CONTEXT
; T1/ STRING PTR
; PUSHJ P,XMSOUT
; RETURN +1 ALWAYS
XMSOUT: HLRZ S1,T1 ;GET LH OF POINTER TO S1
CAIN S1,-1 ;IS IT A -1?
HRLI T1,(POINT 7,0) ;YES, MAKE POINT 7
XMSO.1: ILDB S1,T1 ;GET A CHARACTER
JUMPE S1,.POPJ ;TERMINATE ON NULL
PUSHJ P,XMCSPC ;GO OUTPUT THE CHARACTER
JRST XMSO.1 ;AND LOOP FOR MORE
POPJ P,0
XMCSPC: OUTCHR S1 ;OUTPUT A CHARACTER
CAIE S1,^D9
JRST XMCS.2
XMCS.1: MOVE S1,CURPOS
ADDI S1,8
IDIVI S1,8
IMULI S1,8
MOVEM S1,CURPOS
SKIPA
XMCS.2: AOS CURPOS ;MAINTAIN POSITION
POPJ P,0
;CHECK ALL BYTE PTRS
; T1/ PTR TO LIST OF ADDRESSES, TERMINATED BY 0
CHKABP: SAVE Q1 ;SAVE ACS
SAVE Q2 ;THAT WE USE
MOVEM T1,Q1 ;SAVE LIST PTR
CHKAB1: MOVE Q2,0(Q1) ;GET NEXT ADDRESS
JUMPE Q2,.RETT ;DONE ON 0
ADDI Q2,0(P2) ;MAKE PTR TO BLOCK
MOVE T1,0(Q2) ;GET BYTE PTR
PUSHJ P,CHKBP ;CHECK AND NORMALIZE
MOVEM T1,0(Q2) ;PUT IT BACK
AOJA Q1,CHKAB1 ;DO NEXT
;CHECK A BYTE PTR
; T1/ BYTE PTR - IF LH IS -1, PTR IS FIXED
CHKBP: HLRZ T2,T1
CAIN T2,-1
HRLI T1,(POINT 7)
LDB T2,[POINT 6,T1,11] ;GET BYTE SIZE
IBP T1 ;INCREMENT AND DECREMENT TO NORMALIZE
PJRST DBP
;************************
;FUNCTIONS
;************************
;INITIALIZE LINE AND CHECK FOR REDO REQUEST
XCMINI: HRRZ T1,.CMIOJ(P2) ;DOING OUTPUT TO TERMINAL?
CAXE T1,.PRIOU ;..
JRST CMINI4 ;NO, SKIP REPAIR
MOVEI T1,[BYTE (7).CHCRT,.CHLFD] ;GET TO LEFT MARGIN
PUSHJ P,CMSOUT
CMINI1: SKIPE Q1,.CMRTY(P2) ;DO PROMPT IF ANY
CMINI2: CAMN Q1,.CMBFP(P2) ;STOP AT TOP OF BUFFER
JRST CMINI3
ILDB T1,Q1
JUMPN T1,[PUSHJ P,CMCOUT
JRST CMINI2]
CMINI3: CAMN P4,.CMBFP(P2) ;BUFFER EMPTY?
JRST CMINI4 ;YES, NO REDO POSSIBLE
LDB T1,P4 ;CHECK LAST CHAR
CAIN T1,.CHLFD ;END OF LINE?
JRST CMINI4 ;YES, LAST COMMAND OK, NO REDO
INCHRW T1 ;GET FIRST CHARACTER
CAIN T1,CMRDOC ;IS IT REDO?
JRST CMINI5 ;YES
MOVE T2,TRMUDX ;GET TERMINAL'S UDX
MOVE T4,T1 ;COPY CHARACTER
LSH T4,^D36-7 ;AND POSITION IT
MOVX T1,.TOTYP ;RE-INSERT INTO INPUT BUFFER
MOVEI T3,T4 ;POINT TO STRING
MOVE S1,[XWD 3,T1] ;POINT TO ARGUMENT BLOCK
TRMOP. S1, ;AND DO IT
$STOP(TRI,TRMOP RE-INSERT FAILURE)
CMINI4: MOVE T1,P4 ;RESET LINE VARIABLES
MOVE T2,.CMBFP(P2)
MOVEM T2,P4
PUSHJ P,SUBBP ;COMPUTE CHARACTERS IN LINE
ADDM T1,P3 ;UPDATE SPACE COUNT
SETZ P5,0 ;RESET ADVANCE COUNT
JRST XCOMXI ;RETURN GOOD
CMINI5: MOVE P3,.CMCNT(P2) ;RESET VARIABLES TO CURR FIELD
MOVE P4,.CMPTR(P2)
SETZ P5,0 ;NO INPUT
MOVEI T1,[BYTE (7).CHCRT,.CHLFD] ;START NEW LINE
PUSHJ P,CMSOUT ;
PUSHJ P,CMRTY1 ;RETYPE
JRST XCOMRP ;RETURN TO REPARSE
;SWITCH - LIKE KEYWORD BUT PRECEEDED BY SLASH
XCMSWI: TXO F,CMSWF ;NOTE DOING SWITCH
TXNE F,CMDEFF ;DEFAULT GIVEN?
JRST CMKEY0 ;YES, SLASH ALREADY ASSUMED
PUSHJ P,CMCIN ;GET FIRST CHAR
CAIE T1,CMFREC ;^F
CAIN T1,.CHESC ;ESC?
JRST [PUSHJ P,CMAMB ;YES, INDICATE AMBIGUOUS
JRST XCMSWI] ;TRY AGAIN
CAIN T1,CMHLPC ;HELP?
JRST [SETZ T1,0
MOVE T2,ATBPTR
IDPB T1,T2
MOVE T1,FNARG ;GET TABLE PTR
MOVEI T1,1(T1) ;POINT TO FIRST TABLE ENTRY
JRST CMQ2] ;TYPE OPTIONS
CAIE T1,CMSWCH ;THE SWITCH CHARACTER?
JRST [PUSHJ P,CMDIP ;NO, PUT IT BACK
NOPARS (NPXNSW,UNRECOGNIZABLE SWITCH CONSTRUCTION)] ;RETURN NO PARSE
JRST CMKEY0 ;CONTINUE LIKE KEYWORD
;KEYWORD LOOKUP FUNCTION
XCMKEY: TXZ F,CMSWF ;NOT SWITCH
CMKEY0:
KEYW1: PUSHJ P,CMRATM ;READ THE FIELD INTO LOCAL BUFFER
MOVE T1,FNARG ;GET TABLE HEADER ADDRESS
MOVE T2,.CMABP(P2) ;POINT TO KEYWORD BUFFER
PUSHJ P,XTLOOK ;LOOKUP
TXNE F,CMQUES ;HAD "?"
JRST CMQ1 ;YES, GO TYPE ALTERNATIVES
JXN T2,TL%NOM,[NOPARS (NPXNOM,NO KEYWORD MATCH)] ;NO MATCH
JXN T2,TL%AMB,[PUSHJ P,CMAMB ;AMBIGUOUS, DING OR FAIL
JRST KEYW1] ;GET MORE INPUT
MOVEM T1,T2 ;SAVE TABLE INDEX
MOVEM T1,CRBLK+CR.RES ;AS RESULT
JXE F,CM%ESC,KEYW4 ;DONE IF NO REC WANTED
MOVEM T3,Q1 ;SAVE PTR TO REMAINDER OF STRING
PUSHJ P,CMDCH ;FLUSH RECOG CHARACTER
KEYW2: ILDB T1,Q1 ;TYPE REMAINDER OF KEYWORD
JUMPE T1,KEYW3 ;DONE
PUSHJ P,CMDIB ;APPEND COMPLETION TO BUFFER
CAIN T1,CMSWTM ;A SWITCH TERMINATOR?
JRST [TXZ F,CM%ESC ;YES, OVERRIDES ESC
TXO F,CM%SWT ;NOTE SWITCH TERMINAOTR
TXNN F,CMSWF ;IN SWITCH?
PUSHJ P,CMDIP ;NO, PUT TERMINATOR BACK
JRST XCOMXI] ;DONE
JRST KEYW2
KEYW3: JXE F,CMSWF,XCOMXI ;DONE IF NOT SWITCH
MOVE Q1,FNARG ;CHECK FUNCTION FLAGS
JXE Q1,CM%VRQ,XCOMXI ;DONE IF NO VALUE REQUIRED
MOVEI T1,CMSWTM ;INCLUDE COLON IN RECOGNITION
PUSHJ P,CMDIB
TXO F,CM%SWT ;NOTE SWITCH TERMINATOR
JRST XCOMX1 ;INHIBIT ADDITIONAL SPACE
KEYW4: PUSHJ P,CHKLCH ;SEE IF ATOM NON-NULL
JUMPE T1,[NOPARS (NPXNUL,KEYWORD EXPECTED)] ;FAIL IF NULL
JXE F,CMSWF,XCOMXI ;DONE IF NOT SWITCH
PUSHJ P,CMSKSP ;SKIP SPACES
PUSHJ P,CMCIN ;GET NON-BLANK CHAR
CAIN T1,CMSWTM ;SWITCH TERMINATOR?
JRST [TXO F,CM%SWT ;YES, NOTE
JRST XCOMXI] ;DONE
PUSHJ P,CMDIP ;NO, PUT IT BACK
MOVE Q1,FNARG
JXN Q1,CM%VRQ,XCOMNP ;FAIL IF VALUE WAS REQUIRED
JRST XCOMXI ;OTHERWISE OK
;"?" TYPED, FIRST PARTIAL MATCH FOUND. TYPE ALL PARTIAL MATCHES
CMQ1: JXN T2,TL%NOM,[
JXN F,CMQUE2,CMRTYP ;DO NOTHING IF NOT FIRST ALTERNATIVE
HRROI T1,[ASCIZ / keyword (no defined keywords match this input)/]
PUSHJ P,CMSOUT ;TYPE MESSAGE
JRST CMRTYP] ;RETYPE LINE AND CONTINUE
CMQ2: MOVEM T1,Q2 ;SAVE TABLE INDEX
PUSHJ P,DOHLP ;DO USER HELP IF ANY
TXNE F,CM%SDH ;DEFAULT HELP SUPPRESSED?
JRST CMRTYP ;YES, DONE
MOVE T1,FNARG ;GET TABLE PTR
HLRZ Q1,0(T1) ;GET TABLE SIZE
ADDI Q1,1(T1) ;COMPUTE TABLE END ADDRESS FOR BELOW
HRROI T1,[ASCIZ / one of the following:
/]
PUSHJ P,CMSOUT
SETZM CURPOS ;CLEAR CURRENT POSITION
SOJ Q2,0 ;GETS INCREMENTED BEFORE EACH APPLICATION
MOVEM Q2,Q3SAVE ;SAVE SO IT CAN BE REINITIALIZED
SETZM TABSIZ ;START WITH TAB SIZE OF 0
SETOM PWIDTH ;MARK THAT WE DON'T KNOW WIDTH YET
CMTAB1: PUSHJ P,CMNXTE ;GET TO NEXT VALID KEYWORD IN TABLE
JRST CMTAB2 ;NO MORE IN TABLE
PUSHJ P,CMGTLN ;CALCULATE LENGTH OF KEYWORD
CAML T1,TABSIZ ;LONGEST SEEN SO FAR?
MOVEM T1,TABSIZ ;YES, REMEMBER IT
JRST CMTAB1 ;LOOK AT REST
CMTAB2: MOVE T1,TABSIZ
MOVEM T1,BIGSIZ ;REMEMBER LENGTH OF LONGEST KEYWORD
MOVEI T1,3+1 ;3 SPACES AFTER CRLF AND LEAVE AT LEAST
;ONE SPACE BETWEEN ITEMS
ADDM T1,TABSIZ
MOVE Q2,Q3SAVE ;RESTART TABLE POINTER FOR ACTUAL LISTING
CMQ3: PUSHJ P,CMNXTE ;GET TO NEXT KEYWORD
JRST CMRTYP ;NO MORE, REPEAT COMMAND SO FAR AND CONTINUE
PUSHJ P,KEYTAB ;JUSTIFY "TYPEBALL" FOR KEYWORD TYPEOUT
PUSHJ P,XMSOUT ;TYPE IT
JRST CMQ3 ;TRY NEXT
;ROUTINE WHICH TAKES POINTER TO TABLE IN Q2, POINTER TO END OF TABLE
;IN Q1, AND RETURNS POINTER TO KEYWORD NAME IN T1. SKIPS UNLESS TABLE
;IS EXHAUSTED. ONLY CONSIDERS PRINTABLE KEYWORDS, AND UPDATES Q2.
CMNXTE: AOS Q2 ;LOOK AT NEXT TABLE ENTRY
CAML Q2,Q1 ;BEYOND END OF TABLE?
POPJ P,0 ;YES, FINISHED LIST
HLRZ T2,0(Q2) ;GET STRING PTR FOR IT
PUSHJ P,CHKTBS ;GET FLAGS FROM STRING
JXN T1,CM%INV+CM%NOR,CMNXTE ;SKIP ENTRY IF INVISIBLE OR NOREC
MOVE T1,.CMABP(P2) ;PTR TO PARTIAL KEYWORD
PUSHJ P,USTCMP ;COMPARE
JUMPE T1,CMNXT1 ;OK IF EXACT MATCH
JXE T1,SC%SUB,.POPJ ;DONE IF NOT SUBSTRING
CMNXT1: HLRZ T2,0(Q2) ;GET PTR TO STRING FOR THIS ENTRY
PUSHJ P,CHKTBS
MOVE T1,T2
RETSKP
;ROUTINE TO CALL BEFORE TYPING KEYWORD IN RESPONSE TO "?". GIVE
;IT USER'S BYTE POINTER IN T1. IT DECIDES WHETHER KEYWORD WILL FIT
;ON THIS LINE, AND STARTS NEW LINE IF NOT. IT THEN OUTPUTS A TAB,
;FOLLOWED BY SWITCH DELIMITER (IF KEYWORD IS A SWITCH).
KEYTAB: PUSHJ P,.SAVET ;DON'T CLOBBER USER'S BYTE POINTER
PUSHJ P,CMGTLN ;COMPUTE LENGTH OF KEYWORD
MOVEM T1,KEYSIZ ;REMEMBER LENGTH
HRRZ T1,.CMIOJ(P2) ;GET OUTPUT CHANNEL
SKIPL PWIDTH ;DO WE ALREADY KNOW HOW WIDE PAPER IS?
JRST KEY2 ;YES, SO DON'T DO SYSTEM CALL
MOVEI T2,^D72 ;START DEFAULT
MOVEM T2,PWIDTH
MOVE T4,TRMUDX ;GET OUR UDX
MOVX T3,.TOWID ;FUNCTION FOR CARRIAGE POSITION
MOVE T2,[XWD 2,T3]
TRMOP. T2,0
; $STOP(TWF,TRMOP WIDTH FAILURE)
MOVEI T2,^D72 ;IF ERROR, MAKE WIDTH 72
KEY1: MOVEM T2,PWIDTH ;SAVE WIDTH, SO NO JSYS CALL NEXT TIME
JRST KEY4 ;FIRST TIME THROUGHM, ASSUME NO TAB NEEDED
KEY2: MOVE T2,CURPOS ;GET OUR CURRENT POSITION
PUSHJ P,[ CMTAB: ADD T2,TABSIZ ;FIGURE OUT MAXIMUM PLACE TAB CAN MOVE US TO
IDIV T2,TABSIZ ;SCALE DOWN TO REALLY WHERE
IMUL T2,TABSIZ ;TAB WILL BRING US TO
POPJ P,0]
ADD T2,BIGSIZ ;MAKE SURE WE HAVE ROOM FOR ANOTHER COLUMN
HRROI T1,[ASCIZ /
/]
CAMG T2,PWIDTH ;ROOM FOR ANOTHER KEYWORD ON THIS LINE?
JRST KEY3 ;YES, SO DON'T START NEW LINE
PUSHJ P,XMSOUT ;GET TO NEXT LINE
SETZM CURPOS ;CLEAR CURRENT POSITON
CAIA ;NO TAB NECESSARY AT BEGINNING OF LINE
KEY3: PUSHJ P,TYPTAB ;TYPE A TAB
KEY4: MOVX T1,CMSWCH
TXNE F,CMSWF ;IN SWITCH FIELD?
PUSHJ P,XMCOUT ;YES, TYPE SWITCH INDICATOR
POPJ P,0 ;READY TO TYPE KEYWORD ALL ON SAME LINE NOW
;ROUTINE TO TYPE TAB OF SIZE TABSIZ. IT ASSUMES HARDWARE TABS ARE OF
;SIZE 8 AND TRIES TO TYPE AS MANY REAL TABS AS IT CAN, AND THEN SPACES
;OVER REST OF THE WAY.
TYPTAB: MOVE T2,CURPOS ;SEE WHERE WE'RE STARTING ON LINE
PUSHJ P,CMTAB ;SEE WHERE WE WANT TO GET TO
MOVEM T2,TABDON ;REMEMBER WHERE WE WANT TO GET TO
TYPTB1: MOVE T1,CURPOS ;GET WHERE WE ARE
ADDI T1,8 ;HARDWARE TAB MIGHT GO THIS FAR
TRZ T1,7 ;BUT MAYBE NOT QUITE
CAMLE T1,TABDON ;WILL HARDWARE TAB GO TOO FAR?
JRST TYPTB2 ;YES
MOVEI T1,.CHTAB
PUSHJ P,XMCOUT ;AND TYPE IT
JRST TYPTB1 ;LOOP FOR AS MANY HARDWARE TABS AS WE CAN GET AWAY WITH
TYPTB2: MOVE T1,CURPOS
CAML T1,TABDON ;ARE WE THERE YET?
POPJ P,0 ;YES, SO TAB IS TYPED
MOVEI T1," " ;NO, SO SPACE OVER
PUSHJ P,XMCOUT
JRST TYPTB2 ;AND LOOP FOR REST OF SPACES
;ROUTINE TAKING POINTER TO KEYWORD IN T1. RETURNS KEYWORD LENGTH IN
;T1. GIVES EXTRA 1 FOR SWITCH, ASSUMING A SLASH WILL PREFIX ITS
;PRINTOUT.
CMGTLN: MOVEI T4,0 ;COUNT OF NUMBER OF CHARACTERS NEEDED FOR THIS KEYWORD
CMGT.1: ILDB T2,T1 ;PICK UP NEXT CHARACTER FROM KEYWORD
CAIE T2,0 ;ASSUME KEYWORD ENDS ON NULL
AOJA T4,CMGT.1 ;NOT OVER YET, ACCUMULATE ITS LENGTH
TXNE F,CMSWF ;IS THIS A SWITCH?
AOJ T4,0 ;YES, DELIMITER TAKES UP ANOTHER SPACE
MOVE T1,T4 ;RETURN LENGTH IN T1
POPJ P,0
;ARBITRARY TEXT TO ACTION CHARACTER
XCMTXT: PUSHJ P,CMRSTR ;READ STRING
JXN F,CMQUES,[PUSHJ P,DOHLP ;DO USER HELP
HRROI T1,[ASCIZ / text string/]
TXNN F,CM%SDH
PUSHJ P,CMSOUT ;TYPE HELP UNLESS SUPPRESSED
JRST CMRTYP] ;NO DEFAULT MESSAGE
JRST XCOMXI ;DONE
;NOISE WORD FUNCTION
XCMNOI: MOVE T1,FNARG ;GET STRING PTR
PUSHJ P,CHKBP ;CHECK AND NORMALIZE
MOVEM T1,XXXPTR
TXNN F,CM%PFE ;PREVIOUS FIELD ENDED WITH ESC?
JRST CMNOI3 ;NO
CMNOI1: TXO F,CM%ESC ;YES, MEANS THIS ONE DID TOO
MOVEI T1,NOIBCH ;TYPE NOISE BEG CHAR
PUSHJ P,CMDIB ; AND PUT IT IN BUFFER
CMNOI2: ILDB T1,XXXPTR ;GET NEXT NOISE CHAR
JUMPN T1,[PUSHJ P,CMDIB ;PUT IT IN BUFFER IF NOT END OF STRING
JRST CMNOI2]
MOVEI T1,NOIECH ;END OF STRING, TYPE END CHAR
PUSHJ P,CMDIB
JRST XCOMXI ;EXIT
;PREVIOUS FIELD NOT TERMINATED WITH ESC - PASS NOISE WORD IF TYPED
CMNOI3: PUSHJ P,CMSKSP ;BYPASS SPACES
PUSHJ P,CMCIN ;GET FIRST CHAR
CAIE T1,NOIBCH ;NOISE BEG CHAR?
JRST [PUSHJ P,CMDIP ;NO, NOT A NOISE WORD, PUT IT BACK
JRST XCOMXI] ;RETURN OK
CMNOI4: PUSHJ P,CMCIN ;GET NEXT NOISE CHAR
CAIE T1,CMFREC ;^F?
CAIN T1,.CHESC ;ESC?
JRST [PUSHJ P,CMDCH ;YES, FLUSH IT
JRST CMNOI2] ;COMPLETE NOISE WORD FOR USER
ILDB T2,XXXPTR ;COMPARE WITH GIVEN STRING
CAMN T1,T2
JRST CMNOI4 ;STILL SAME AS EXPECTED
CAIN T1,NOIECH ;NOT SAME, STRING ENDED TOGETHER?
JUMPE T2,XCOMXI ;YES, EXIT OK
NOPARS (NPXINW,BAD NOISE WORD) ;NO, PROBABLY BAD NOISE WORD
;CONFIRM
XCMCFM: PUSHJ P,CMCFM0 ;DO THE WORK
JRST [NOPARS (NPXNC,CONFIRMATION REQUIRED)] ;FAILED
JRST XCOMXI ;OK
CMCFM0: PUSHJ P,CMCIN ;GET CHAR
CAIE T1,.CHTAB ;BLANK?
CAIN T1," "
JRST CMCFM0 ;YES, IGNORE
CAIN T1,CMHLPC ;HELP?
JRST [PUSHJ P,DOHLP
HRROI T1,[ASCIZ / confirm with carriage return/]
TXNN F,CM%SDH
PUSHJ P,CMSOUT ;GIVE HELP MESSAGE
JRST CMRTYP] ;RETYPE AND TRY AGAIN
CAIE T1,CMFREC ;^F?
CAIN T1,.CHESC ;ESC?
JRST [PUSHJ P,CMAMB ;YES, DING
JRST CMCFM0] ;TRY AGAIN
CAIE T1,.CHLFD ;NL (NEW LINE, I.E. LINEFEED)
POPJ P,0 ;NO, FAIL
RETSKP ;YES
;FLOATING POINT NUMBER
XCMFLT: $STOP(SFP,Scanning floating point not implemented)
REPEAT 0,<
MOVEI T1,FLTBRK ;USE SPECIAL BREAK SET
PUSHJ P,CMRFLD ;READ FIELD
JXN F,CMQUES,[PUSHJ P,DOHLP
HRROI T1,[ASCIZ / number/]
TXNN F,CM%SDH ;SUPPRESS DEFAULT?
PUSHJ P,CMSOUT ;NO, DO IT
JRST CMRTYP]
MOVE T1,.CMABP(P2) ;NUMBER NOW IN ATOM BUFFER, GET PTR
MOVEM T1,T1
IMCALL .FLIN
JRST [MOVEM T3,T2 ;FAILED, RETURN ERROR CODE
JRST XCOMNP]
JRST CMNUMR ;DO NUMBER CLEANUP AND RETURN
;FLOATING POINT BREAK SET MASK, ALLOWS +, -, ., E, NUMBERS
FLTBRK: 777777,,777760
777644,,001760
400000,,000760
400000,,000760
>;END OF REPEAT 0
;NUMBER
XCMNUX: SKIPA T1,[NUXBRK] ;USE SPECIAL BREAK SET
XCMNUM: MOVEI T1,NUMBRK ;USE REGULAR BREAK SET
PUSHJ P,CMRFLD ;READ FIELD
TXNE F,CMQUES ;SAW "?"
JRST CMNUMH ;YES
MOVE T1,.CMABP(P2) ;SETUP NIN
MOVE T3,FNARG ;GET RADIX
PUSHJ P,NUMIN ;PARSE THE NUMBER
JRST CMNUM1 ;NO PARSE
CMNUMR: MOVEM T2,CRBLK+CR.RES ;STORE RESULT
MOVE T2,ATBPTR
IBP T2 ;BUMP PTR PAST TERMINATOR
CAMN T1,T2 ;NIN SAW WHOLE FIELD?
JRST [MOVE T2,CRBLK+CR.RES
JRST XCOMXR] ; YES, RECOVER RESULT AND RETURN
CMNUM1: NOPARS (NPXICN,NUMERIC CHARACTER EXPECTED) ;INVALID CHARACTER IN NUMBER
;NUMBER BREAK SET, ALLOWS +, -, NUMBERS
NUMBRK: 777777,,777760
777654,,001760
400000,,000760
400000,,000760
NUXBRK: 777777,,777760
777654,,001760
777777,,777760
777777,,777760
;NUMERIC INPUT ROUTINE
; T1/ BYTE POINTER TO STRING
; T3/ BASE TO USE
;
;RETURNS T1 UPDATED,T2 THE RESULT
NUMIN: SETZ S2,0 ;CLEAR MODIFIER
ILDB S1,T1 ;GET FIRST CHARACTER
CAIN S1," " ;A BLANK?
JRST NUMIN ;YES, IGNORE IT
CAIN S1,"-" ;IS IT MINUS SIGN?
MOVX S2,-1 ;YES, REMEMBER IT
CAIN S1,"+" ;IS IT PLUS SIGN?
MOVX S2,+1 ;YES, REMEMBER IT
SKIPE S2 ;IF WE HAD EITHER + OR -
ILDB S1,T1 ;GET NEXT BYTE
CAIG S1,"0"-1(T3) ;TOO BIG
CAIGE S1,"0" ;OR TOO SMALL?
POPJ P,0 ;YES, TAKE FAILURE RETURN
SETZ T2,0 ;CLEAR THE RESULT
NUMI.1: IMULI T2,0(T3) ;SHIFT OVER 1 DIGIT
ADDI T2,-"0"(S1) ;AND ADD IN THIS ONE
ILDB S1,T1 ;GET NEXT CHAR
CAIG S1,"0"-1(T3) ;IN RANGE?
CAIGE S1,"0"
JRST [SKIPE S2
IMUL T2,S2
RETSKP]
JRST NUMI.1 ;YES, REPEAT
CMNUMH: PUSHJ P,DOHLP ;DO USER SUPPLIED MESSAGE
JXN F,CM%SDH,CMRTYP ;SUPPRESS DEFAULT HELP IF REQUESTED
HRRZ T2,FNARG ;GET BASE
CAIL T2,^D2 ;LEGAL?
CAILE T2,^D10
$STOP(IBN,Illegal base for number)
CAIN T2,^D10 ;DECIMAL?
JRST CMNH10 ;YES
CAIN T2,^D8 ;OCTAL?
JRST CMNH8 ;YES
HRROI T1,[ASCIZ / a number in base /]
PUSHJ P,CMSOUT ;ARBITRARY BASE
HRRZ T1,.CMIOJ(P2)
HRRZ T2,FNARG
MOVEI T3,^D10
ADDI T2,"0" ;CONVERT BASE TO ASCII
OUTCHR T2 ;OUTPUT THE BASE
SUBI T2,"0" ;CONVERT IT BACK
JRST CMRTYP ;RETYPE LINE AND CONTINUE
CMNH8: HRROI T1,[ASCIZ / octal number/]
JRST CMNH
CMNH10: HRROI T1,[ASCIZ / decimal number/]
CMNH: PUSHJ P,CMSOUT
JRST CMRTYP
;DATE AND/OR TIME
;FLAGS IN ARG SPECIFY WHICH
XCMTAD: $STOP(SDT,Scanning date/time not implemented)
REPEAT 0,<
MOVE Q1,FNARG ;GET ARG
PUSHJ P,CMRSPC ;READ FIRST FIELD
JXN F,CMQUES,CMTADH ;DO HELP IF REQUESTED
JXN F,CMDEFF,CMTAD1 ;JUMP IF NOW HAVE FIELD DEFAULT
TXC Q1,CM%IDA+CM%ITM ;DATE AND TIME BOTH?
TXCN Q1,CM%IDA+CM%ITM
JRST [MOVEI T1," " ;YES, PUT SPACE IN ATOM BUFFER
PUSHJ P,STOLCH
PUSHJ P,CMRSPC ;READ SECOND FIELD
JXN F,CMQUES,CMTADH ;DO HELP
JRST .+1]
CMTAD1: MOVE T1,.CMABP(P2) ;POINT TO ATOM BUFFER
MOVEM T1,T1
MOVX T2,1B0+1B6 ;SETUP FLAGS FOR IDTNC
TXNE Q1,CM%IDA ;DATE WANTED?
TXZ T2,1B0 ;YES
TXNE Q1,CM%ITM ;TIME WANTED?
TXZ T2,1B6 ;YES
;** IMCALL .IDTNC
JRST XCOMNP ;FAILED
TXNE Q1,CM%NCI ;CONVERT TO INTERNAL FORMAT?
JRST [MOVSI T1,T2 ;NO, STORE DATA IN USER BLOCK
HRR T1,Q1
BLT T1,2(Q1)
JRST XCOMXR]
TXNN Q1,CM%IDA ;HAVE DATE?
JRST [SETO T2,0 ;NO, DEFAULT TO TODAY
SETZ T4,0
;** ODCNV ;GET TODAY
;** UMOVEM T3,T3
JRST .+1]
;** IMCALL .IDCNV ;CONVERT TO INTERNAL
JRST XCOMNP ;FAILED
MOVEM T2,CRBLK+CR.RES ;STORE RESULT
JRST XCOMXR ;OK, TAD ALREADY IN T2
;TIME/DATE HELP
CMTADH: PUSHJ P,DOHLP ;DO USER TEXT
JXN F,CM%SDH,CMRTYP ;CHECK SUPPRESS DEFAULT
LOAD T1,Q1,<CM%IDA+CM%ITM> ;GET FLAGS
HRRO T1,[[ASCIZ //]
[ASCIZ / time/]
[ASCIZ / date/]
[ASCIZ / date and time/]](T1)
PUSHJ P,CMSOUT ;PRINT APPROPRIATE MESSAGE
> ;END OF REPEAT 0
JRST CMRTYP
;DEVICE
XCMDEV: PUSHJ P,CMRATM ;GET THE FIELD
JXN F,CMQUES,CMDEVH ;HELP
JXN F,CM%ESC,[PUSHJ P,CMAMB ;NO ESC ALLOWED
JRST XCMDEV ] ;ON DEVICE
PUSHJ P,CMCIN ;CHECK TERMINATOR
CAIE T1,":" ;DEVICE?
JRST [NOPARS (NPXIDT,IMPROPER DEVICE SPECIFICATION)] ;NO, FAIL
CMDEV1: MOVE T1,.CMABP(P2) ;SETUP STDEV ARGS
MOVEM T1,XXXPTR ;STORE POINTER
PUSHJ P,FTOKEN ;GET TOKEN
JUMPE T1,XCOMNP ;IF NULL SPEC
CAIE T2,":" ; OR NOT TERMINATED WITH COLON
JRST XCOMNP ; THEN FAILED TO PARSE
MOVEM T1,CRBLK+CR.RES ;STORE RESULT
JXE F,CM%ESC,XCOMXR ;SUCCESS, DONE IF NO ESC
MOVEI T1,":" ;RECOG, APPEND TERMINATOR
PUSHJ P,CMDIB
JRST XCOMXI
CMDEVH: PUSHJ P,DOHLP ;DO USER HELP
HRROI T1,[ASCIZ / device name/]
TXNN F,CM%SDH ;SUPPRESS DEFAULT?
PUSHJ P,CMSOUT ;NO, DO IT
JRST CMRTYP
;QUOTED STRING
XCMQST: PUSHJ P,CMRQST ;READ THE STRING
JRST [NOPARS (NPXNQS,QUOTED STRING EXPECTED)] ;FAILED
JXN F,CMQUES,[PUSHJ P,DOHLP ;DO USER HELP
HRROI T1,[ASCIZ / quoted string/]
TXNN F,CM%SDH ;DEFAULT HELP?
PUSHJ P,CMSOUT ;YES
JRST CMRTYP]
JRST XCOMXI
;UNQUOTED STRING - TAKES BIT MASK (4 WORDS * 32 BITS) TO SPECIFY BREAKS.
XCMUQS:
CMUQS1: PUSHJ P,CMCIN ;GET A CHAR
IDIVI T1,^D32 ;COMPUTE INDEX TO BIT ARRAY
MOVE T2,BITS(T2)
ADD T1,FNARG
TDNN T2,0(T1) ;BIT ON?
JRST CMUQS1 ;NO, KEEP GOING
PUSHJ P,CMDIP ;YES, PUT CHAR BACK
JRST XCOMXI ;DONE
;ARBITRARY FIELD
XCMFLD: PUSHJ P,CMRATM
CMFLD1: TXNE F,CMQUES ;"?" SEEN?
JRST [PUSHJ P,DOHLP ;YES, DO USER MESSAGE
JRST CMRTYP]
JRST XCOMXR ;LEAVE FIELD IN ATOM BUFFER
;ACCOUNT
XCMACT: MOVEI T1,USRBRK ;SAME BREAK SET AS USER NAME FIELD
PUSHJ P,CMRFLD ;READ FIELD
JRST CMFLD1 ;FINISH LIKE ARBITRARY FIELD
;NODE NAME
XCMNOD: $STOP(NOD,SCANNING NODE NOT IMPLEMENTED)
REPEAT 0,<
PUSHJ P,CMRATM ;GET AN ATOM
JXN F,CMQUES,[PUSHJ P,DOHLP ;TYPE OUT USER'S HELP
HRROI T1,[ASCIZ / Node Name/] ;SET UP DEFAULT HELP
TXNN F,CM%SDH ;DOES USER NOT WANT IT
PUSHJ P,CMSOUT ;NO,TYPE IT
JRST CMRTYP] ;AND RETYPE COMMAND
MOVE T1,.CMABP(P2) ;POINT AT THE ATOM BUFFER
MOVEI T3,^D8 ;TRY AS AN OCTAL NUMBER
PUSHJ P,NUMIN ;READ IT
JRST XNOD1 ;LOST, TRY AS A SIXBIT NAME
MOVEM T2,CRBLK+CR.RES ;SAVE AS RESULT
MOVE T2,ATBPTR ;GET POINTER TO END OF ATOM BUFFER
IBP T2 ;POINT AT TERMINATOR
CAME T1,T2 ;OUR POINTER END THE SAME PLACE?
JRST XNOD1 ;NO, NOT A GOOD NUMBER
MOVE T3,CRBLK+CR.RES ;NODE NUMER WE JUST PARSED
TXNE F,CM%PO ;PARSE ONLY?
JRST [CAILE T3,77 ;ILLEGAL NODE NUMBER?
JRST XNOD1 ;YES, TRY A NAME
JRST XCOMXI] ;GOOD NODE NUMBER, RETURN
MOVE T1,[XWD .NDRNN,T2] ;CHECK TO MAKE SURE THAT THIS NODE NUMBER EXISTS
MOVEI T2,2 ;2 ARGS
NODE. T1, ;TRY IT FOR EXISTANCE
SKIPA ;NOT A NODE NUMBER, TRY AS A NAME
JRST XCOMXI ;A GOOD NODE NUMBER, RETURN
XNOD1: MOVE T1,.CMABP(P2) ;POINT AT THE ATOM BUFFER
MOVEI T2,6 ;GET MAX NUMBER OF CHARACTERS IN NAME
MOVE T4,[POINT 6,NODSIX]; BP TO NODE STORAGE
SETZM NODSIX ;START FRESH
XNOD2: ILDB T3,T1 ;GET NEXT CHARACTER FROM ATOM BUFFER
CAIL T3,"0" ;IS THE CHARACTER
CAILE T3,"Z" ;NUMERIC OR UPPER CASE?
JRST XNOD4 ;ITS NOT
CAILE T3,"9" ;...
CAIL T3,"A" ;...
CAIA ;GOOD CHARACTER, JUST SAVE IT
JRST XNOD4 ;TRY FOR LOWER CASE ALPHA
XNOD3: SUBI T3,"a"-"A" ;SIXBITIZE
IDPB T3,T4 ;FILL OUT SIXBIT NODE NAME
SOJGE T2,XNOD2 ;HAVE WE SEEN ENOUGH CHARACTERS?
NOPARS (NPXNNC,IMPROPER NODE NAME) ;TOO MANY CHARACTERS IN NODE NAME
XNOD4: CAIG T3,"z" ;BIGGER THAN LOWER CASE Z?
CAIGE T3,"a" ;OR LESS THAN LOWER CASE A?
JRST XNOD5 ;YES, GIVE ILLEGAL CHARACTER IN NODE NAME
SUBI T3,"a"-"A" ;CONVERT CHARACTER TO UPPER CASE
JRST XNOD3 ;SAVE IT AN LOOK FOR MORE
XNOD5: MOVE T2,ATBPTR ;GET POINTER TO END OF ATOM BUFFER
IBP T2 ;POINT AT TERMINATOR
CAMN T1,T2 ;OUR POINTER END THE SAME PLACE?
JRST XNOD6 ;GO DO NODE UUO
NOPARS (NPXNNI,NODE NAME EXPECTED) ;ILLEGAL CHARACTER IN NODE NAME
XNOD6: MOVEI T2,2 ;2 ARGS
MOVE T3,NODSIX
MOVE T1,[XWD .NDRNN,T2]
NODE. T1,0
JRST [NOPARS (NPXNSN,NO SUCH NODE)]
MOVEM T1,CRBLK+CR.RES ;STORE NUMBER
JRST XCOMXI ;AND RETURN
>
;INDIRECT FILESPEC (INTERNAL CALL)
CMATFI:
TXO F,CMINDF ;NOTE GETTING INDIRECT FILE
JRST XCMIFI ;AND HANDLE AS INPUT FILE
XCMOFI:
XCMIFI:
XCMFIL: PUSHJ P,CMRFIL ;GET FILE SPECIFICATION
JXN F,CMQUES,CMFHLP ;IF THEY WANT HELP, GIVE IT TO THEM
; JXN F,CM%ESC,[ PUSHJ P,CMAMB ;NO RECOGNITION AVAILABLE
; JRST XCMFIL]
PUSHJ P,FILIN ;GET FILE SPEC
JRST XCOMNP ;IF FAILS ITS A NO PARSE
MOVE T2,ATBPTR ;GET POINTER TO ATOM BUFFER END
IBP T2 ;BUMP PAST TERMINATOR
CAME T2,XXXPTR ;DOES IT MATCH?
JRST XCOMNP ;NO, TERMINATED PREMATURELY
TXZE F,CMINDF ;ARE WE DOING INDIRECT FILE?
RETSKP ;YES , RETURN FOR PROCESSING
JRST XCOMXI ;OTHERWISE, DONE
FILIN: SETZM DEVSUP#
SETZM PPNSUP#
PUSHJ P,.SAVE1 ;SAVE A REG
LOAD S2,.CMGJB(P2),CM%GJB ;GET ADDR OF FD
MOVEM S2,CRBLK+CR.RES ;SAVE IT FOR CALLER
MOVE P1,S2 ;AND REMEMBER IT
MOVX S1,FDXSIZ ;NOW ZERO IT OUT
STORE S1,.FDLEN(S2),FD.LEN ;STORE LENGTH INTO FD
MOVE T1,.CMABP(P2) ;GET ATOM BUFFER POINTER
MOVEM T1,XXXPTR ;STORE IT
PUSHJ P,FTOKEN ;GET FIRST FILE TOKEN
CAIE T2,':' ;IS FIRST PART A DEVICE
JRST FILI.1 ;NO
MOVEM T1,.FDSTR(P1) ;STORE STRUCTURE NAME
SETOM DEVSUP
PUSHJ P,FTOKEN ;YES, LOAD NEXT TOKEN
FILI.1: JUMPN T1,FILI.2 ;IF WE HAVE SOMETHING, IT MUST BE FILENAM
CAIE T2,'[' ;IF NOT, EXPECT A PPN HERE
CAIN T2,74 ;
SKIPA ;IT IS A PPN
JRST FILI.2 ;CHECK FOR SUFFICIENT FILE-SPEC
MOVE T1,XXXPTR ;GET POINTER TO PPN
PUSHJ P,DBP ;DECREMENT POINTER
MOVE T2,T1 ;GET INTO PLACE
PUSHJ P,PPNIN ;GET PPN
POPJ P, ;PASS ON FAILURE
MOVEM T1,XXXPTR ;STORE CORRECTED POINTER
STORE T2,.FDPPN(P1) ;STORE THE PPN NOW
SETOM PPNSUP
PUSHJ P,FTOKEN ;AND GET NEXT PART
FILI.2: SKIPN DEVSUP ;WAS DEVICE SUPPLIED ?
GO DEVSP1 ;NO, GET DEFAULT IF SUPPLIED
SKIPN PPNSUP ;WAS PPN SUPPLIED ?
GO PPNSP1 ;NO, GET DEFAULT IF SUPPLIED
SKIPN T1 ;ANY FILE NAME ?
GO NAMSP1 ;NO, GET DEFAULT
STORE T1,.FDNAM(P1) ;STORE NAME
CAIE T2,'.' ;IS THERE AN EXTENSION?
JRST EXTSUP ;NO, GET DEFAULT
PUSHJ P,FTOKEN ;GET EXTENSION
SKIPN T1 ;ANY EXT ?
GO EXTSP1 ;NO, GET DEFAULT IF SUPPLIED
STORE T1,.FDEXT(P1) ;AND STORE IT
FILI.3: CAIE T2,'[' ;HAVE WE GOT A PPN?
CAIN T2,74 ;NOW
SKIPA ;YES, WE HAVE
JRST FILI.4 ;CHECK FOR SUFFICIENT FILE-SPEC
MOVE T1,XXXPTR ;RELOAD THE POINTER
PUSHJ P,DBP ;DECREMENT IT
MOVE T2,T1 ;AND THEN PARSE THE
PUSHJ P,PPNIN ;PPN
POPJ P, ;RETURN A FAILURE
MOVEM T1,XXXPTR ;STORE CORRECTED POINTER
STORE T2,.FDPPN(P1) ;STORE PPN IF OK
IBP XXXPTR ;AND BUMP PAST IT
FILI.4: SKIPN S1,.FDSTR(P1) ;SEE IF USER SUPPLIED A DEFAULT DEVICE
MOVSI S1,'DSK' ;NO, SUPPLY DEFAULT DEVICE
STORE S1,.FDSTR(P1) ;STORE DEFAULT DEVICE
SKIPN .FDNAM(P1) ;MAKE SURE THERE IS A NAME
POPJ P, ;NO NAME, BAD FILE SPEC
RETSKP ;TAKE GOOD RETURN
;PROCESS FILE PARAMETER DEFAULTS
NAMSP1: HRRZ .FDNAM(P1) ;GET DEFAULT POINTER
SKIPN ;ANY SUPPLIED ?
$STOP(NNS,NO DEFAULT NAME SUPPLIED)
TLNE F,(CM%ESC) ;ESCAPE TERMINATE FIELD ?
PNTALF ;PRINT IT
PUT T2
PUT XXXPTR
HRRZ .FDNAM(P1)
HRLI 440700 ;MAKE BYTE POINTER
MOVEM XXXPTR
GO FTOKEN ;PROCESS FILE NAME
GETIT XXXPTR
GETIT T2
RTN
EXTSUP: SKIPN .FDEXT(P1) ;ANY DEFAULT EXT ?
JRST FILI.3
TLNE F,(CM%ESC) ;ESCAPE TERMINATE FIELD ?
PNTCIF "."
GO EXTSP1 ;PROCESS DEFAULT
JRST FILI.3-1
EXTSP1: HRRZ .FDEXT(P1) ;GET DEFAULT POINTER
TLNE F,(CM%ESC) ;ESCAPE TERMINATE FIELD ?
PNTALF ;PRINT IT
PUT T2
PUT XXXPTR
HRRZ .FDEXT(P1)
HRLI 440700 ;MAKE BYTE POINTER
MOVEM XXXPTR
GO FTOKEN ;PROCESS FILE EXT
GETIT XXXPTR
GETIT T2
RTN
DEVSP1: SKIPN .FDSTR(P1) ;ANY DEFAULT SUPPLIED ?
RTN ;NO
PUT T2
PUT XXXPTR
HRRZ .FDSTR(P1)
TLNE F,(CM%ESC) ;ESCAPE TERMINATE FIELD ?
PNTALF ;PRINT IT
HRRZ .FDSTR(P1)
HRLI 440700
MOVEM XXXPTR
GO FTOKEN ;PROCESS DEFAULT
STORE T1,.FDSTR(P1)
GETIT XXXPTR
GETIT T2
RTN
PPNSP1: SKIPN .FDPPN(P1) ;ANY DEFAULT SUPPLIED ?
RTN ;NO
PUT T1
PUT T2
HRRZ .FDPPN(P1)
TLNE F,(CM%ESC) ;ESCAPE TERMINATE FIELD ?
PNTALF ;PRINT IT
HRRZ .FDPPN(P1)
HRLI 440700
MOVEM T2
GO PPNIN ;PROCESS PPN
$STOP(DPP,DEFAULT PPN ERROR)
STORE T2,.FDPPN(P1)
GETIT T2
GETIT T1
RTN
FTOKEN: SETZM T1 ;CLEAR RESULT
MOVE T3,[POINT 6,T1] ;AND POINT TO STORAGE AREA
FTOK.1: ILDB T2,XXXPTR ;GET A BYTE
PUSHJ P,C7TO6 ;CONVERT TO SIXBIT
CAIG T2,'Z' ;IS IT IN RANGE?
CAIGE T2,'0' ;
POPJ P,0 ;NO
CAILE T2,'9' ;
CAIL T2,'A' ;
SKIPA
POPJ P,0
TXNE T3,<INSVL.(77,BP.POS)> ;IS THERE ROOM?
IDPB T2,T3 ;YES,STORE IT
JRST FTOK.1 ;TRY ANOTHER
C7TO6: CAIL T2,"a" ;IS IT LC?
SUBI T2,40 ;YES
SUBI T2," " ;CONVERT TO SIXBIT
ANDI T2,77 ;MASK IT AND
POPJ P, ;RETURN
;FILESPEC HELP
CMFHLP: JXO F,CMINDF,[HRROI T1,[ASCIZ / filespec of indirect file/]
JRST CMFH1] ;SPECIAL HELP IF INDIRECT FILESPEC
PUSHJ P,DOHLP ;DO USER MESSAGE
JXN F,CM%SDH,CMRTYP ;SUPPRESS DEFAULT HELP IF REQUESTED
; LOAD T2,.CMFNP(P1),CM%FNC ;GET FUNCTION CODE
; CAXE T2,.CMIFI ;INPUT FILE?
LOAD T2,.CMGJB(P2),CM%GJB ;GET ADDR OF FD
MOVE T2,(T2)
TLNN T2,(GJ%OLD)
SKIPA T1,[-1,,[ASCIZ / output filespec/]] ;NO, OUTPUT
HRROI T1,[ASCIZ \ input filespec\] ;YES,INPUT
CMFH1: PUSHJ P,CMSOUT
JRST CMRTYP
;TOKEN - ARBITRARY SYMBOL AS SPECIFIED BY FN DATA
XCMTOK: MOVE Q1,FNARG ;GET STRING ADDRESS
CMTOK1: ILDB Q2,Q1 ;GET NEXT CHAR IN STRING
JUMPE Q2,[PUSHJ P,TIELCH ;SUCCESS IF END OF STRING
JRST XCOMXI]
CMTOK2: PUSHJ P,CMCIN ;GET NEXT CHAR OF INPUT
CAMN T1,Q2 ;MATCH?
JRST [PUSHJ P,STOLCH ;YES, APPEND TO ATOM BUFFER
JRST CMTOK1] ;CONTINUE
CAIE T1,CMFREC ;RECOG REQUEST?
CAIN T1,.CHESC
JRST [PUSHJ P,CMAMB ;YES, CAN'T
JRST CMTOK2]
CAIN T1,CMHLPC ;HELP REQUEST?
JRST [PUSHJ P,DOHLP ;YES
JXN F,CM%SDH,CMRTYP
MOVEI T1,"""" ;TYPE "token"
PUSHJ P,CMCOUT
MOVE T1,FNARG
PUSHJ P,CMUSOU
MOVEI T1,""""
PUSHJ P,CMCOUT
JRST CMRTYP]
NOPARS (NPXNMT,INVALID TOKEN FOUND) ;NO MATCH OF TOKEN
; PPN (EITHER DIRECTORY OR USER NAME FUNCTION)
PPNBRK: 777777,,777760
777734,,007537
777777,,777277
777777,,777760
XCMDIR:
XCMUSR: ;EQUIVALENT
MOVEI T1,PPNBRK ;GET PROPER BREAK SET
PUSHJ P,CMRFLD ;GET FIELD
TXNE F,CMQUES ;HELP?
JRST CMDIRH ;YES
TXNE F,CM%ESC ;RECOGNITION WANTED?
JRST [ PUSHJ P,CMAMB ;YES, ALWAYS AMBIGOUS
JRST XCMUSR ]
MOVE T2,.CMABP(P2) ;PTR TO TYPEIN
PUSHJ P,PPNIN ;PARSE PPN
JRST XCOMNP ;ILLEGAL SYNTAX
MOVEM T2,CRBLK+CR.RES ;STORE RESULT
CAME T1,ATBPTR ;CHECK THAT WE SAW WHOLE FIELD
JRST XCOMNP ;IF NOT, PARSE FAILURE
JRST XCOMXI ;DONE NOW
;DIRECTORY/USER HELP
CMDIRH: PUSHJ P,DOHLP ;DO USER HELP
JXN F,CM%SDH,CMRTYP ;SUPPRESS DEFAULT HELP IF REQUESTED TO
HRROI T1,[ASCIZ / Project-Programmer number/]
PUSHJ P,CMSOUT
JRST CMRTYP ;RETYPE AND CONTINUE
PPNIN: PUSHJ P,.SAVE1 ;SAVE A REG
ILDB S1,T2 ;GET FIRST BYTE
CAIN S1," " ;SKIP LEADING BLANKS
JRST PPNIN ;
CAIE S1,74 ;BETTER BE A BRACKET OF SOME
CAIN S1,"[" ;KIND
SKIPA ;IT IS
POPJ P, ;IT IS NOT, FAIL NOW
MOVE T1,T2 ;COPY BP
MOVEI T3,^D8 ;AND MAKE IT OCTAL
PUSHJ P,NUMIN ;PARSE PROJECT NUMBER
POPJ P, ;IF IT FAILS, GIVE UP NOW
LDB S1,T1 ;GET TERMINATOR BYTE
CAIE S1,"," ;BETTER BE A COMMA
POPJ P, ;NOT, GIVE UP NOW
HRLZ P1,T2 ;REMEMBER PROJECT NR.
PUSHJ P,NUMIN ;GET 2ND HALF (PROGRAMMER NR.)
POPJ P, ;PASS ON FAILURE
HLL T2,P1 ;ASSEMBLE PPN
LDB S1,T1 ;GET TERMINATOR
CAIE S1,"]" ;AND CHECK IT
CAIN S1,76 ;FOR BRACKET
RETSKP ;ALL IS OK
POPJ P, ;OR FAIL
;COMMA, ARBITRARY CHARACTER
XCMCMA: MOVEI T1,"," ;SETUP COMMA AS CHARACTER TO FIND
MOVEM T1,FNARG
CMCHR: PUSHJ P,CMCIN ;GET A CHAR
CAIE T1,.CHTAB ;BLANK?
CAIN T1," "
JRST CMCHR ;YES, IGNORE
HRRZ T2,FNARG ;GET SPECIFIED CHAR
CAMN T1,T2 ;THE RIGHT ONE?
JRST XCOMXI ;YES, WIN
CAIE T1,CMFREC ;^F?
CAIN T1,.CHESC ;ESC?
JRST [PUSHJ P,CMAMB ;YES, DING
JRST CMCHR] ;TRY AGAIN
CAIN T1,CMHLPC ;HELP?
JRST [PUSHJ P,DOHLP
JXN F,CM%SDH,CMRTYP ;JUMP IF SUPPRESSING HELP
MOVEI T1,"""" ;TYPE "char"
PUSHJ P,CMCOUT
HRRZ T1,FNARG
PUSHJ P,CMCOUT
MOVEI T1,""""
PUSHJ P,CMCOUT
JRST CMRTYP]
NOPARS (NPXCMA,COMMA WAS EXPECTED) ;FAIL
;LOCAL ROUTINE TO SETUP BYTE PTR TO TABLE STRING AND GET FLAGS
; T2/ ADDRESS OF STRING
; PUSHJ P,CHKTBS
; T1/ FLAGS
; T2/ BYTE POINTER TO STRING
CHKTBS: HRLI T2,(POINT 7) ;SETUP P AND S FIELDS
SKIPE T1,0(T2) ;CHECK FIRST WORD OF STRING
TXNE T1,177B6 ;FIRST CHAR 0 AND WORD NOT ALL-0?
TDZA T1,T1 ;NO, MAKE FLAGS ALL 0
AOS T2 ;YES, HAVE FLAGS, ADJUST BYTE PTR
POPJ P,0
SUBTTL S%SCMP -- String Comparison Routine
;CALL IS: S1/ TEST STRING POINTER
; S2/ BASE STRING POINTER
;TRUE RETURN: S1/ COMPARE CODE:
; 1B0 (SC%LSS) - TEST STRING LESS THAN BASE STRING
; 1B1 (SC%SUB) - TEST STRING SUBSET OF BASE STRING
; 1B2 (SC%GTR) - TEST STRING GREATER THAN BASE STRING
; N.O.T.A. MEANS EXACT MATCH
; S2/ UPDATED BASE STRING POINTER, USEFUL IN CASE TEST STRING
; WAS SUBSET
S%SCMP: PUSHJ P,.SAVET ;SAVE T REGS
DMOVE T1,S1 ;COPY ARGUMENTS
HLRZ T3,T1
CAIN T3,-1
HRLI T1,(POINT 7)
HLRZ T3,T2
CAIN T3,-1
HRLI T2,(POINT 7)
PUSHJ P,USTCMP ;DO THE WORK
DMOVE S1,T1 ;PUT THE ARGUMENTS BACK
$RETT
;STRING COMPARE ROUTINE - REFERENCES PREVIOUS CONTEXT.
; T1/ TEST STRING POINTER
; T2/ BASE STRING POINTER
; PUSHJ P,USTCMP
;RETURN AS FOR .STCMP
USTCMP::ILDB T3,T1 ;GET NEXT BYTE FROM EACH STRING
CAIL T3,"A"+40 ;LC LETTER?
JRST [CAIG T3,"Z"+40
SUBI T3,40 ;YES, CONVERT TO UC
JRST .+1]
ILDB T4,T2
CAIL T4,"A"+40 ;LC LETTER?
JRST [CAIG T4,"Z"+40
SUBI T4,40 ;YES, CONVERT TO UC
JRST .+1]
CAME T3,T4 ;STILL EQUAL?
JRST STRC2 ;NO, GO SEE WHY
JUMPN T3,USTCMP ;KEEP GOING IF NOT END OF STRING
SETZ T1, ;STRINGS ENDED TOGETHER, EXACT MATCH.
POPJ P,0 ;RETURN 0
STRC2: JUMPE T3,[MOVX T1,SC%SUB ;TEST STRING ENDED, IS A SUBSET
ADD T2,[7B5] ;DECREMENT BASE POINTER ONE BYTE
POPJ P,0]
CAMG T3,T4 ;STRINGS UNEQUAL
SKIPA T1,[SC%LSS] ;TEST STRING LESS
MOVX T1,SC%GTR ;TEST STRING GREATER
POPJ P,0
SUBTTL S%TBLK -- Table lookup routine
;CALL IS: S1/ ADDRESS OF TABLE HEADER WORD
; S2/ STRING POINTER TO STRING TO BE FOUND
;
;TRUE RETURN: S1/ ADDRESS OF ENTRY WHICH MATCHED OR WHERE ENTRY WOULD BE
; IF IT WERE IN TABLE
; S2/ RECOGNITION CODE:
; 1B0 (TL%NOM) - NO MATCH
; 1B1 (TL%AMB) - AMBIGUOUS
; 1B2 (TL%ABR) - UNIQUE ABBREVIATION
; 1B3 (TL%EXM) - EXACT MATCH
S%TBLK: PUSHJ P,.SAVET ;SAVE SOME REGISTERS
DMOVE T1,S1 ;COPY INPUT ARGUMENTS
PUSHJ P,XTLOK0 ;DO THE WORK
DMOVE S1,T1 ;RE-COPY ARGUMENTS
$RETT ;AND RETURN
;WORKER ROUTINE - MAY BE CALLED INTERNALLY.
; RETURNS +1 SUCCESS, ACS AS ABOVE
;INTERNAL AC USAGE:
; T1/ TEST STRING FROM CALL
; T2/ STRING FROM TABLE
; T3/ CLOBBERED BY USTCMP
; T4/ " "
; P1/ CURRENT TABLE INDEX
; P2/ ADDRESS OF TABLE INDEXED BY P1 - USED FOR INDIRECTION
; P3/ INDEX INCREMENT FOR LOG SEARCH
; P4/ SIZE OF TABLE
XTLOOK:: PUSHJ P,.SAVE4 ;PRESERVE ACS
SAVE P5
XTLOK0: HLRZ T3,T2 ;CHECK STRING POINTER
CAIE T3,-1 ;LH 0 OR -1?
CAIN T3,0
HRLI T2,(POINT 7) ;YES, FILL IN
MOVEM T2,STRG
MOVEI P2,1(T1) ;CONSTRUCT ADDRESS OF FIRST ENTRY
HRLI P2,P1 ;MAKE IT INDEXED BY P1
HLRZ P4,0(T1) ;GET PRESENT SIZE
MOVE P3,P4 ;INITIAL INCREMENT IS SIZE
MOVE P1,P4 ;SET INITIAL INDEX TO SIZE/2
ASH P1,-1
JUMPE P4,TABLKX ;IF TABLE EMPTY THEN NO MATCH
TABLK0: HLRZ T2,@P2 ;GET STRING ADR FROM TABLE
PUSHJ P,CHKTBS ;CONSTRUCT POINTER
MOVE T1,STRG ;GET TEST STRING
PUSHJ P,USTCMP ;COMPARE
JUMPN T1,TABLK1 ;JUMP IF NOT EXACTLY EQUAL
TABLKF: HLRZ T2,@P2 ;GET STRING ADDRESS
PUSHJ P,CHKTBS ;GET FLAGS
JXN T1,CM%NOR,TABLKM ;MAKE IT AMBIG IF NOREC ENTRY
MOVX T2,TL%EXM ;EXACTLY EQUAL, RETURN CODE
JRST TABLKA
TABLKM: SKIPA T2,[TL%AMB] ;AMBIGUOUS RETURN
TABLKX: MOVX T2,TL%NOM ;NO MATCH RETURN
TABLKA: MOVEI T1,@P2 ;RETURN ADR WHERE ENTRY IS OR SHOULD BE
POPJ P,
;STRING MAY BE UNEQUAL OR A SUBSET, SEE WHICH
TABLK1: JXE T1,SC%SUB,TABLKN ;UNEQUAL, GO SETUP NEXT PROBE
TABLK3: MOVEM T2,REMSTR ;SUBSTRING, SAVE REMAINDER
JUMPE P1,TABLK2 ;JUMP IF THIS FIRST ENTRY IN TABLE
MOVEI T1,@P2 ;CHECK NEXT HIGHER ENTRY IN TABLE
HLRZ T2,-1(T1) ;GET ITS STRING ADDRESS
PUSHJ P,CHKTBS ;BUILD BYTE PTR
MOVE T1,STRG ;GET TEST STRING
PUSHJ P,USTCMP ;TEST PREVIOUS ENTRY
JUMPE T1,[SOJA P1,TABLKF] ;EXACTLY EQUAL, DONE. FIX INDEX.
JXN T1,SC%GTR,TABLK2 ;IF LESS THEN HAVE FOUND HIGHEST SUBSTR
SOJA P1,TABLK3 ;STILL A SUBSTR, CHECK HIGHER
;NOW POINT AT HIGHEST ENTRY WHICH IS A SUBSTR. IF THERE IS AN EXACT
;MATCH, IT IS BEFORE ALL SUBSETS AND HAS ALREADY BEEN FOUND
TABLK2: MOVEI T1,@P2 ;CHECK NEXT ENTRY FOR AMBIGUOUS
CAIL P1,-1(P4) ;NOW AT LAST ENTRY IN TABLE?
JRST TBLK2A ;YES, THIS ENTRY IS DISTINCT
HLRZ T2,1(T1) ;GET STRING ADR OF NEXT ENTRY
PUSHJ P,CHKTBS ;BUILD BYTE PTR
MOVE T1,STRG ;GET TEST STRING
PUSHJ P,USTCMP ;COMPARE NEXT LOWER ENTRY
JUMPE T1,[$STOP(BTF,Bad table format)] ;EXACT MATCH,TABLE IS BAD
JXN T1,SC%SUB,TABLKM ;NEXT ENTRY NOT DISTINCT, DO AMBIG RETURN
TBLK2A: HLRZ T2,@P2 ;CHECK FLAGS FOR THIS ENTRY
PUSHJ P,CHKTBS
JXN T1,CM%NOR,TABLKM ;FAIL IF NOREC BIT SET
MOVX T2,TL%ABR ;GIVE LEGAL ABBREVIATION RETURN
MOVE T3,REMSTR ;RETURN PTR TO REMAINDER OF STRING
JRST TABLKA
;HERE WHEN PROBE NOT EQUAL
TABLKN: CAIG P3,1 ;INCREMENT NOW 1?
JRST [JXN T1,SC%LSS,TABLKX ;YES, NO MATCH FOUND
AOJA P1,TABLKX] ;IF STRING GREATER, BUMP ADR FOR INSERT
AOS P3 ;NEXT INC = <INC+1>/2
ASH P3,-1
TXNE T1,SC%GTR ;IF LAST PROBE LOW, ADD INCREMENT
ADD P1,P3
TXNE T1,SC%LSS
SUB P1,P3 ;LAST PROBE HIGH, SUBTRACT INCR
TBLKN1: CAIL P1,0(P4) ;AFTER END OF TABLE?
JRST [MOVX T1,SC%LSS ;YES, FAKE PROBE TOO HIGH
JRST TABLKN]
JUMPGE P1,TABLK0 ;IF STILL WITHIN TABLE RANGE, GO PROBE
MOVX T1,SC%GTR ;BEFORE START OF TABLE, FAKE LOW PROBE
JRST TABLKN
SCN%L: ;LABEL THE LITERAL POOL
>;;!!!!!NOTE WELL - THIS CONDITIONAL STARTED AT LABEL S%CMND