Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50441/scnner.mac
There are no other files named scnner.mac in the archive.
TITLE SCNNER
SUBTTL COMMAND SCANNING MODULE
SALL
COMMENT ^
SCNNER CAN BE CALLED TO INPUT A FILE SPEC FROM THE USER'S TTY.
THE CALL IS: PUSHJ P,SCNNER##
IF NO COMMAND IS IN THE BUFFER, THE PROGRAM WAITS FOR INPUT
WHEN CALLING SCNNER, BE SURE TO SET UP AC 1 WITH THE FOLLOWING BITS
SET UP PROPERLY:
1B0 TO RETURN CONTROL TO CALLER ON "=" OR "_"
1B1 TO RETURN CONTROL ON ","
1B2 TO ACCEPT PROTECTION
1B3 TO ACCEPT "*" WILDCARDS
1B8 TO ACCEPT SWITCHES
1B14 TO ACCEPT "?" WILDCARDS
1B31 TO FILL IN WILD CARDS IF FILE NAME OR EXT NOT GIVEN
1B32 TO FORCE SCAN OF NEW COMMAND LINE
ALL OTHER BITS SHOULD BE ZERO ON THE CALL!!
CONTROL IS ALWAYS RETURNED ON A BREAK CHARACTER.
IF CONTROL IS RETURNED ON A CHARACTER OTHER THAN A BREAK, THE REST
OF THE COMMAND IS LEFT IN THE BUFFER. IT CAN BE RECOVERED
BY ANOTHER PUSHJ TO SCNNER.
THE LAST CHARACTER IN THE RH OFPUT BY SCNNER IF RETURNED IN AC 1.
SCNNER RETURNS WITH A NON-SKIP RETURN IF THERE IS AN ERROR IN THE
COMMAND LINE, AND AN APPROPRIATE MESSAGE IS TYPED ON THE TTY.
IF A NULL COMMAND IS INPUT, THE SUCCESSFUL RETURN IS TAKEN, BUT THE
SIGN BIT OF AC 1 WILL BE SET. BIT 1 IS SET IF NO FILENAME HAS BEEN
SPECIFIED EXPLICITLY, BIT 2 IS SET IF NO EXT HAS BEEN SPECIFIED, BIT 3
FOR NO PPN, BIT 4 FOR NO DEVICE, AND BIT 5 FOR NO PROTECTION.
ON SUCCESSFUL RETURN, THE DATA IS RETURNED IN THE FOLLOWING FORMAT:
THE ADDRESS "FILSPC" IS THE HEAD OF AN EXTENDED LOOKUP OR ENTER ARG.
IT WILL BE EXTENDED TO THREE OR FOUR PLACES, DEPENDING ON WHETHER
PROTECTION IS SPECIFIED.
THE THREE POSSIBLE MASKS, USED ONLY FOR WILDCARDS, ARE RETURNED
IN ADDRESSES "FILMSK","EXTMSK","PPNMSK".
IF SFD'S ARE INCLUDED IN THE PATH SPECS, FILSPC+.RBPPN WILL
CONTAIN A POINTER TO THE PATH LIST.
SFD MASKS WILL BE FOUND IN THE FIVE LOCATIONS STARTING AT "SFDMSK"
AN OPEN BLOCK IS SET UP, WITHOUT BUFFERS, AT ADDRESS "DEVSPC". AN
APPROPRIATE MODE IS SPECIFIED.
IF SWITCHES ARE TO BE ACCEPTED, AC 2 MUST BE SET UP WITH
XWD -TABLE LENGTH, TABLE ADDR FOR A TABLE OF SIXBIT ONE-WORD SWITCHES.
THE DISPATCH TABLE MUST IMMEDIATELY FOLLOW THIS NAME TABLE. WHEN
A SWITCH IS FOUND, THE PROPER USER ROUTINE WILL BE PUSHJ'D TO. WHEN
IT IS DONE, IT MUST POPJ. THE LAST CHARACTER INPUT WILL BE IN AC1
WHEN THE ROUTINE IS CALLED.
^ ;END OF COMMENT
;DETERMINE WHETHER TO BE HIGH OR LOW
IFNDEF CITPPN,<CITPPN==0> ;ON FOR CIT-TYPE PPN'S
IFNDEF .HI.,<.HI.==-1> ;DEFAULT TO HI SEG
IFN .HI.,< TWOSEG 400000> ;TWO SEGMENTS IF HIGH
IFNDEF SUBS,<SUBS==0> ;ON FOR EXTRA SUBROUTINES
;AC'S DEFINED
F=0 ;FLAGS
CH=1 ;LAST CHARACTER IN FROM TTY
T1=2 ;TEMPORARY
T2=3 ; ..
T3=4 ; ..
T4=5 ; ..
RK=6 ;RETURN KEY BITS
CNT=7 ;COUNTER FOR LOOPS
P=17 ;PUSH DOWN POINTER
;OTHER DEFINITIONS
;USEFUL OPDEF'S
OPDEF PJRST [JRST]
MAXCHR==^D135 ;MAXIMUM NUMBER OF CHARACTERS IN A LINE
;RIB LOCATIONS RELATIVE TO FIRST WORD
.RBPPN==1 ;PPN
.RBNAM==2 ;FILE NAME
.RBEXT==3 ;EXTENSION
.RBPRV==4 ;PRIVILIGE BITS
;POSSIBLE MODES
.IOASL==1 ;ASCII LINE MODE
.IOIMG==10 ;IMAGE MODE
.IOBIN==14 ;BINARY MODE
;DEVCHR BITS
DV.M1==1B34 ;MODE 1 LEGAL
DV.M10==1B27 ;MODE 10 LEGAL
DV.M14==1B23 ;MODE 14 LEGAL
;F IS USED AS A FLAG AC.
;THE RH OF F IS USED FOR PERMANENT FLAGS
;THE LH HOLDS A BIT REPRESENTING THE LAST CHARACTER INPUT
;THIS IS SET BY "GETCH" -- THE ROUTINE TO GET A CHARACTER
;FLAGS ARE AS FOLLOWS:
;TEMPORARY FLAGS
F$EQAL==1B0 ;FOR "=" OR "_"
F$COMA==1B1 ;FOR ","
F$LABR==1B2 ;FOR "<"
F$STAR==1B3 ;FOR STAR
F$RABR==1B4 ;FOR ">"
F$LSBR==1B5 ;FOR "["
F$RSBR==1B6 ;FOR "]"
F$DOT==1B7 ;FOR "."
F$SLSH==1B8 ;SLASH "/"
F$COLN==1B9 ;FOR ":"
F$ALPH==1B10 ;ALPHABETIC
F$NMBR==1B11 ;NUMBERIC
F$NULL==1B12 ;NULL CHARACTER -- TAB OR SPACE
F$BRK==1B13 ;BREAK CHARACTER
F$QUST==1B14 ;QUESTION MARK
F$DASH==1B15 ;FOR "-"
F$QUOT==1B16 ;FOR QUOTE
;PERMENANT FLAGS
F$PPN==1B18 ;SET IF PPN INPUT
F$EXT==1B19 ;SET IF EXTENSION INPUT
F$DEV==1B20 ;SET IF DEVICE INPUT
F$NLOK==1B21 ;SET TO EXPECT AND IGNORE NULL CHARACTERS
;(OTHERWISE ERROR MESSAGE GIVEN)
F$CMNT==1B22 ;INDICATES A COMMENT IS IN PROGRESS
F$NAM==1B24 ;FILE NAME IN
F$PROT==1B25 ;SET IF PROTECTION IN
F$SWCH==1B26 ;SWITCH IN
F$ALOK==1B27 ;ACCEPT ALL CHARACTERS
F$NGNM==1B28 ;FLAG A NEGATIVE NUMBER
F$NUM==1B29 ;FLAG NUMBER INPUT
F$WRD==1B30 ;FLAG WORD HAS BEEN INPUT
F$DWLD==1B31 ;WILD CARDS SUBTITUTED IF NAME AND EXT BLANK
F$NWLN==1B32 ;SCAN NEW COMMAND LINE
;RANDOM MACROS
;THE ERROR MACRO WILL TELL THE USER OF THE ERROR OF HIS WAYS
;THE CALL IS:
; ERROR <TEXT OF ERROR MESSAGE>
;THIS CAUSED THE ERROR MESSAGE TO BE TYPE AND THE REST OF THE
;COMMAND LINE IS EATEN. THEN CONTROL IS RETURNED TO THE CALLING
;ROUTINE, WITH THE ERROR RETURN TAKEN.
;IF, IN PLACE OF AN ERROR MESSAGE, THERE IS SIMPLY THE WORD,
;"BADCHR", THEN THE MESSAGE, "ILLEGAL CHARACTER " FOLLOWED BY THE
;LAST CHARACTER INPUT IS TYPED.
DEFINE ERROR(MSG),<
IFIDN<MSG><BADCHR>,< JRST BADCHR>
IFDIF<MSG><BADCHR>,< JRST [ MOVEI T1,[ASCIZ\MSG\]
JRST GIVERR]>
>
;ERROR MESSAGE ROUTINES
;HERE TO GIVE AN ERROR MESSAGE. ADDRESS OF ERROR MESSAGE IS IN T1.
ENTRY BADSWC,GIVERR,BADCHR
BADSWC: TDZA T3,T3 ;ZERO T3 AND SKIP
GIVERR: SETO T3, ;-1 IN T3
SETZM $NEWLN ;DON'T READ MORE FROM BAD LINE
OUTSTR [ASCIZ/? /] ;INTRODUCTION
OUTSTR @T2(T3) ;GIVE MESSAGE
JUMPL T3,CRLF ;DONE IF NOT SWITCH ERROR
BADS1: SETZ T2, ;CLEAR SPACE
ROTC T1,6 ;GET NEXT CHAR
ADDI T2,40 ;MAKE ASCII
OUTCHR T2 ;TYPE IT
JUMPN T1,BADS1 ;AND LOOP
CRLF: OUTSTR [ASCIZ/
/] ;GIVE CRLF
MOVE P,$SAVEP ;RESTORE ORIGINAL P
POPJ P, ;AND ERROR RETURN TO CALLER
BADCHR: OUTSTR [ASCIZ/? Unexpected character: /]
LDB T1,$COMBP ;GET THE BAD CHARACTER
SETZ T2, ;CLEAR AN AC
DPB T2,$COMBP ;AND ZERO THE BAD ONE
OUTSTR $COMBF ;TYPE BAD COMMAND LINE TO ERROR
CAIE T1," " ;DON'T ECHO ^I
CAIL T1,40 ;CHECK FOR CONTROL CHARACTER
JRST BADCH1 ;NOT CONTROL, SKIP UP ARROW
OUTCHR ["^"] ;TYPE UP ARROW
MOVEI T1,100(T1) ;MAKE PRINTING CHARACTER
BADCH1: OUTCHR T1 ;TYPE THE OFFENDING CHAR
PJRST CRLF ;AND QUIT
;DATA STORAGE
IFN .HI.,< RELOC> ;BACK TO LOW SEG IF MULTIPLE
;FILE SPECS RETURNED HERE
INTERN DEVSPC,FILSPC,FILMSK,EXTMSK,PPNMSK,SFDMSK,$NXTCH,$SAVEP
FRSDAT==. ;FIRST WORD IN DATA
DEVSPC: BLOCK 3 ;OPEN BLOCK
FILSPC: BLOCK .RBPRV+1 ;MAXIMUN NO. OF EXTENDED ARGS
PTHSPC: BLOCK 10 ;PATH BLOCK, IF NEEDED
FILMSK: BLOCK 1 ;MASK FOR FILE NAME
EXTMSK: BLOCK 1 ;MASK FOR EXTENSION
PPNMSK: BLOCK 1 ;MASK FOR PPN
SFDMSK: BLOCK 5 ;MASKS FOR SFD'S
;RANDOM DATA
$SAVEP: BLOCK 1 ;SAVE ORIGINAL P, FOR ERROR
$SWCHS: BLOCK 1 ;SAVE IOWD TO SWITCHES
LSTDAT==.-1 ;LAST WORD IN DATA
$SAV0: BLOCK 1 ;SAVE AC 0
$SAVAC: BLOCK 3 ;SAVE AC'S 5-7
$NXTCH: BLOCK 1 ;NEXT CHAR TO RETURN
$NEWLN: BLOCK 1 ;0 IF NEW COMMAND LINE NEEDED
$COMBF: BLOCK <<MAXCHR+4>/5>+1 ;SPACE FOR COMMAND
$COMBP: BLOCK 1 ;BYTE POINTER TO COMMAND BUFFER
IFN .HI.,< RELOC> ;NOW BACK TO HI SEG
;HERE TO SAVE RK. AUTOMATICALLY RESTORED ON A POPJ P,.
;CAN BE RESTORED THROUGH A MOVE RK,-1(P)
ENTRY SAVERK
SAVERK: EXCH RK,(P) ;SAVE AC, GET CALLER
MOVEM RK,1(P) ;SAVE CALLER
MOVE RK,(P) ;RESTORE AC
PUSHJ P,@1(P) ;CALL CALLER
JRST .+2 ;NONSKIP RETURN
AOS -1(P) ;SKIP RETURN
POP P,RK ;RESTORE AC
POPJ P, ;AND RETURN
;HERE ON ENTRY TO SAVE ALL AC'S EXCEPT TEMPS. HURTS NO AC'S, RESTORE ON POPJ
SAVACS: MOVEM 0,$SAV0 ;SAVE AC 0
MOVE 0,[5,,$SAVAC] ;POINT TO AC'S AND SAVE AREA
BLT 0,$SAVAC+2 ;SAVE THROUGH AC 7
MOVEI 0,RSTACS ;GET ADDR OF RESTORING ROUTINE
EXCH 0,(P) ;PUT IN PLACE OF GUY WHO CALLED US
JRST @0 ;RETURN TO CALLER
RSTACS: JRST .+2 ;NO SKIP
AOS (P) ;SKIP RETURN
MOVS 0,[5,,$SAVAC] ;SET UP
BLT 0,7 ;RESTORE
MOVE 0,$SAV0 ;AC 0 ALSO
POPJ P, ;RETURN
IFN SUBS,< ;ONLY IF WE ASK FOR THESE ROUTINES
;MINOR ENTRY POINTS
;THESE RETURN DATA IN AC 2, MASK IN AC 3
;LAST CHAR TYPED IN RETURNED IN AC 1
;TAKE ARGS IN THE STANDARD FORM
;NOTE THAT FOR PPNIN, ARGS MAY BE RETURNED IN THE FORM OF A PATH
;POINTER, IF THE USER SPECIFIES SFD'S. IN THIS CASE, THE MASKS WILL
;BE FOUND IN LOCATIONS PPNMSK AND SFDMSK - SFDMSK+4.
ENTRY PPNIN,DECIN,OCTIN,WRDIN
PPNIN: MOVEI T3,3 ;OFFSET OF 3
JRST SOMEIN ;GO GET PPN
WRDIN: MOVEI T3,2 ;OFFSET OF 2
JRST SOMEIN ;GET SOMETHING
DECIN: TDZA T3,T3 ;ZERO AC AND SKIP
OCTIN: MOVEI T3,1 ;PUT 1 IN AC
SOMEIN: PUSHJ P,SAVACS ;SAVE AC'S
SETZB F,$THSCH ;ZERO LAST CHARACTER AND FLAGS
MOVE RK,1 ;SAVE RETURN KEYS
MOVEM P,$SAVEP ;AND INITIAL PDL POINTER
CAIE T3,3 ;PPNIN FUNCTION?
JRST SOMEI1 ;NO, SKIP AHEAD
TLO RK,(F$LSBR!F$COMA!F$NMBR) ;EXPECT THESE
PUSHJ P,GETCH ;GET NEXT CHAR
TLZ RK,(F$LSBR!F$COMA!F$NMBR) ;DON'T EXPECT
TLNN F,(F$LSBR) ;GET "["
MOVEM CH,$NXTCH ;NO, PUT IT BACK
SOMEI1: PUSH P,T3 ;SAVE FUNCTION
PUSHJ P,@[EXP DECINX ;DISPATCH PROPERLY
EXP OCTINX
EXP WRDINX
EXP PPNINX](T4)
POP P,T4 ;RESTORE FUNCTION
CAIN T4,3 ;PPN IN FUNCTION?
JRST [MOVE T1,FILSPC+.RBPPN ;YES, RESTORE PPN
MOVE T2,PPNMSK ;AND MASK
JRST CPOPJ1] ;AND RETURN
TDNN F,[EXP F$NUM ;ELSE SEE IF ANY DATA IN
EXP F$NUM
EXP F$WRD](T4)
TLO CH,400000 ;NO, SET SIGN BIT TO INDICATE
JRST CPOPJ1 ;AND RETURN
> ;END CONDITIONAL ON SUBS
;HERE IS THE ENTRY POINT!
ENTRY SCNNER,PPNINX,OCTINX,WRDINX,GETCH
IFN CITPPN,< ENTRY DECINX,R64INX>
SCNNER: PUSHJ P,SAVACS ;SAVE AC'S
HLLZ RK,1 ;GRAB RETURN KEYS
HRRZ F,1 ;GRAB USER SPECIFIED FLAGS
AOS T2,$NEWLN ;NEW LINE WORD
CAIN T2,1 ;WAS IT ZERO?
TRO F,F$NWLN ;YES, FLAG NEW LINE NEEDED
SETZM FRSDAT ;CLEAR DATA AREA
MOVE T2,[FRSDAT,,FRSDAT+1] ; ..
BLT T2,LSTDAT ; ..
MOVEM T1,$SWCHS ;SAVE SWITCH IOWD
MOVEM P,$SAVEP ;SAVE P FOR ERROR
PUSHJ P,SPCIN ;GET SPECS
MOVEI T1,.RBEXT ;SIZE OF EXTENDED LOOKUP
TRNE F,F$PROT ;SKIP IF NO PROTECTION
MOVEI T1,.RBPRV ;IN WHICH CASE ADD PROT
MOVEM T1,FILSPC ;SAVE AT HEAD
MOVSI T1,'DSK' ;DEFAULT DEVICE
TRNN F,F$DEV ;DEVICE IN YET?
MOVEM T1,DEVSPC+1 ;NO, USE DEFAULT
MOVE T1,DEVSPC+1 ;GET DEVICE
DEVCHR T1, ;GET CHARACTERISTICS
MOVEI T2,.IOIMG ;FIRST ASSUME IMAGE MODE
TRNE T1,DV.M1 ;ASCII MODE OK?
MOVEI T2,.IOASL ;YES, USE IT
TRNE T1,DV.M14 ;HOW ABOUT BINARY?
MOVEI T2,.IOBIN ;YES, TAKE THAT INSTEAD
HRRM T2,DEVSPC ;SAVE BEST MODE
MOVE T1,[3,,T2] ;POINTER TO PATH ARGS
MOVE T2,DEVSPC+1 ;WANT PATH OF OUR DEVICE
PATH. T1, ;GET IT
JRST SCN1 ;DON'T KNOW, IGNORE IT
TRNN T3,1B30 ;IGNORE USER PPN ON I/O?
JRST SCN1 ;NO, SKIP ON
MOVEM T4,PTHSPC+2 ;YES, USE THIS INSTEAD
SETZM PTHSPC+3 ;NO SFD'S
SETZM PPNMSK ;DON'T MASK PPN
SETZM SFDMSK ;OR SFD'S
TRO F,F$PPN ;FLAG PPN EXPLICITLY SPECIFIED
SCN1: TRNN F,F$PPN ;PPN IN?
PUSHJ P,GETDEF ;NO, READ IN DEFAULT PATH
MOVEI T1,PTHSPC ;GET PATH PTR
MOVEM T1,FILSPC+.RBPPN ;SAVE POINTER OR PPN
SCN2: TRNN F,F$NAM ;NAME IN?
TLO CH,(1B1) ;NO, SET BIT
TRNN F,F$EXT ;EXTENSION?
TLO CH,(1B2) ;NO, SET BIT
TRNN F,F$PROT ;PROTECTION TYPED?
TLO 1,(1B5) ;NO, FLAG IT
TRNN F,F$PPN ;PPN TYPED
TLO CH,(1B3) ;IF NOT, FLAG FOR RET
TRNN F,F$DEV ;IF NO DEVICE
TLO CH,(1B4) ;FLAG THAT ALSO
TRNN F,F$DWLD ;FILL IN DEFAULTS?
JRST SCN3 ;NO, SKIP ON
TRNN F,F$NAM ;FILE NAME IN?
SETOM FILMSK ;NO, ASSUME WILD
TRNN F,F$EXT ;EXT?
SETOM EXTMSK ;NO, ASSUME WILD
SCN3: TRNN F,F$DEV!F$NAM!F$PPN!F$PROT!F$EXT!F$SWCH ;ANYTHING IN?
TLO 1,400000 ;NO, SET SIGN BIT
HLRZ T1,FILSPC+.RBEXT ;GET EXT.
SKIPN FILSPC+.RBNAM ;BLANK NAME?
CAIE T1,'UFD' ;AND A UFD?
CPOPJ1: AOSA (P) ;NO, INCREMENT PC
TLZA CH,(1B1) ;YES, FLAG NAME SPECIFIED
CPOPJ: POPJ P, ;AND RETURN
SKIPE T2,PPNMSK ;GET OLD PPN MASK
MOVEM T2,FILMSK ;USE AS FILE MASK
SETZB T1,PPNMSK ;NO PPN MASK
AOBJN T1,.+1 ;GET MFDPPNIN T1
EXCH T1,PTHSPC+2 ;SAVE MFDPPN
TDZ T1,FILMSK ;IN CASE DEFAULTS FILLED IN
MOVEM T1,FILSPC+.RBNAM ;SAVE PPN AS NEW NAME
JRST CPOPJ1 ;AND SKIP RETURN
GETDEF: SETOM PTHSPC ;WANT TO RETURN PATH
MOVE T1,[10,,PTHSPC] ; ..
PATH. T1, ;GET IT
EXIT 0,
SETZM PTHSPC+1 ;DEFAULT SCAN SWITCH IN LOOKUP
POPJ P, ;RETURN
;HERE TO INPUT ALL FILE SPECS
SPCIN: TLO RK,(F$BRK) ;DIDDLE FLAGS
PUSHJ P,SAVERK ;AND SAVE THEM
TLO RK,(F$COLN!F$DOT!F$LSBR!F$NULL) ;PART OF COMMAND
SPCLOP: TLNE F,(F$DOT) ;EXTENSION COMING?
JRST EXT ;YES, GET IT
TLNE F,(F$LSBR) ;PPN COMING?
JRST PPN ;YES
TLNE F,(F$LABR) ;PROTECTION?
JRST PROT ;YES
TLNE F,(F$SLSH) ;SWITCH?
JRST SWITCH ;YES
TLNE F,(F$COLN) ;DEVICE?
ERROR <Device improperly specified>
SPCIN1: TDNE F,-1(P) ;CHECK FOR EXPECTED FLAGS
POPJ P, ;YES, QUIT
PUSHJ P,WRDINX ;GET INITIAL WORD
TLNE F,(F$COLN) ;GET COLON?
JRST DEV ;YES, EAT DEVICE
FILE: TRNN F,F$WRD ;WORD IN?
JRST SPCLOP ;NO, LOOP BACK
TROE F,F$NAM ;NOTE NAME IN
ERROR <Multiple file name illegal>
MOVEM T1,FILSPC+.RBNAM ;SAVE NAME
MOVEM T2,FILMSK ;AND MASK
JRST SPCLOP ;WHAT NEXT?
EXT: TROE F,F$EXT ;NOTE EXT IN
ERROR <Multiple extension illegal>
PUSHJ P,WRDINX ;GO GET EXT
HLLZM T1,FILSPC+.RBEXT ;AND SAVE IT
HLLZM T2,EXTMSK ;WITH MASK
JRST SPCLOP ;WHAT NEXT?
PPN: TROE F,F$PPN ;PPN IN YET?
ERROR <Multiple PPN illegal>
PUSHJ P,PPNINX ;GO GET PPN
JRST SPCLOP ;WHAT NEXT?
PROT: TROE F,F$PROT ;PROTECTION IN YET?
ERROR <Multiple protection illegal>
PUSHJ P,PROTIN ;GET PROTECTION
JRST SPCLOP ;WHAT'S NEXT?
DEV: SKIPE T1 ;GET AN ARG?
SKIPE T2 ;AND FAIL TO GET WILDCARD
ERROR <Null or wild device illegal>
TROE F,F$DEV ;DEVICE IN YET?
ERROR <Multiple device illegal>
MOVEM T1,DEVSPC+1 ;PUT IN SPECS
JRST SPCIN1 ;AND CONTINUE
;HERE WHEN A / IS INPUT, INDICATING A SWITCH IS COMING
SWITCH: TRO F,F$SWCH ;FLAG SWITCH IN
PUSH P,RK ;SAVE VITAL AC'S
TLZ RK,(F$STAR!F$QUST) ;NO WILD CARDS
PUSHJ P,WRDINX ;GET SWITCH
MOVEI T4,(CH) ;SAVE LAST CHAR IN FOR ANYONE
SKIPN CH,$SWCHS ;GET SWITCH IOWD
ERROR <Switches not implemented>
PUSHJ P,DOSWCH ;NOW CALL USER IF A MATCH OR GIVE ERROR
POP P,RK ;RESTORE T1
JRST SPCLOP ;GO BACK TO COMMAND LOOP
;WE SEPARATE THIS SO THE USER CAN CALL IT
;CALL WITH ARG IN T1, AOBJN WORD IN CH. LIST OF SIXBIT ACCEPTED
; VALUES MUST BE IMMEDIATELY FOLLOWED BY A DISPATCH TABLE WHICH
; WE PUSHJ TO IF A MATCH IS FOUND. NEVER RETURN IF ERROR.
; A SIXBIT SWITCH VALUE PRECEDED BY A "*" IMPLIES THAT ANY
; NON-UNIQUE ABBREVIATION OF THAT SWITCH WILL BE ACCEPTED.
;DESTROY CH,T1-3 (ACS 1-4), ALL OTHERS PRESERVED
ENTRY DOSWCH
DOSWCH: PUSHJ P,SAVERK ;SAVE RETURN KEYS
PUSH P,T4 ;PRESERVE T4
HLLM CH,-1(P) ;SAVE NEGATIVE LENGTH
SKIPN RK,T1 ;PRESERVE ARGUMENT
ERROR <Null switch illegal>
SETZB T2,T3 ;CLEAR ACS
SOJA T2,DOSWC2 ;BUILT MASK IN T2, SO SET ALL BITS
DOSWC1: LSH RK,-6 ;ROTATE WORD 1 CHARACTER OVER
LSH T2,6 ;AND MASK 1 CHARACTER BACK
DOSWC2: TRNN RK,77 ;HIT LAST CHAR YET?
JRST DOSWC1 ;NO, KEEP ADJUSTING
DOSWC3: CAMN T1,(CH) ;DO WE HAVE AN EXACT MATCH?
DOSW3A: SKIPA T3,CH ;
SKIPA RK,(CH) ;NO, PICK UP LEGAL SWITCH VALUE
JRST DOSWC4 ;AND FINISH UP
LDB T4,[POINT 6,RK,5] ;GET FIRST CHAR OF POSSIBLE MATCH
CAIN T4,'*' ;A STAR, INDICATING UNIQUENESS NOT REQUIRED?
LSH RK,6 ;YES, DON'T WORRY ABOUT IT NOW
AND RK,T2 ;ZAP LEGAL VALUE WITH MASK
CAME RK,T1 ;NOW DOES IT MATCH?
AOBJN CH,DOSWC3 ;NO, LOOP FOR ALL
JUMPGE CH,DOSWC4 ;GO IF LOOPED THROUGH ALL
CAIN T4,'*' ;SKIP IF WE NEED UNIQUE MATCH
JRST DOSW3A ;HAVE OUR MATCH -- GO USE IT
SKIPN T3 ;HAVE A MATCH -- SKIP IF IT ISN'T THE FIRST
SKIPA T3,CH ;COPY ADDRESS OF MATCH
MOVEI T3,1 ;PUT POSITIVE VALUE IN T3 TO FLAG NOT UNIQUE
AOBJN CH,DOSWC3 ;AND CONTINUE
DOSWC4: JUMPE T3,DOSWC6 ;GO IF NO SUCH SWITCH
JUMPG T3,DOSWC5 ;IF POSITIVE ARG, NON-UNIQUE VALUE
HLRE T1,-1(P) ;PICK UP NEG SIZE OF LIST
MOVNS T1 ;MAKE POSITIVE
ADDI T1,(T3) ;ADD OFFSET OF THE MATCH
POP P,T4 ;RESTORE T4
MOVEI CH,(T4) ;GET LAST CHAR IF IT WAS SAVED
MOVE RK,-1(P) ;RESTORE RETURN KEYS
PJRST @(T1) ;AND CALL ROUTINE TO FIX
DOSWC5: SKIPA T2,[[ASCIZ/Switch not unique /]]
DOSWC6: MOVEI T2,[ASCIZ/No such switch /]
JRST BADSWC ;ERROR
;HERE TO INPUT A DECPPN
;PPN IS RETURNED IN FILSPC+.RBPPN, MASK IS RETURNED IN PPNMSK
;IF THERE ARE SFD'S, THEN A POINTER TO THE SFD LIST IS RETURNED
;IN FILSPC+.RBPPN. SFD WILDCARDS ARE RETURNED IN SFDMSK+LEVEL
;OF NESTING
PPNINX: PUSHJ P,SAVERK ;SAVE KEYS
TLO RK,(F$COMA!F$DASH!F$NMBR);EXPECT COMMA OR "-"
PUSHJ P,GETCH ;PEEK AT THE NEXT CHARACTER
TLZ RK,(F$DASH!F$NMBR) ;DASH NO LONGER LEGAL
TLNE F,(F$DASH) ;DID WE JUST EAT A DASH?
JRST [PUSHJ P,GETDEF ;YES, READ HIS DEFAULT PATH
TLO RK,(F$RSBR!F$BRK) ;EXPECT "]"
PUSHJ P,GETCH ;READ NEXT CHAR
JRST PPNDON] ;AND FINISH UP
MOVEM CH,$NXTCH ;WE REALLY DON'T WANT THAT CHAR
IFN CITPPN,< PUSHJ P,DECINX ;DECIMAL PROJECT NO>
IFE CITPPN,< PUSHJ P,OCTINX ;GET PROJECT NO.>
GETPPN T3, ;GET OUT PPN
JFCL ;PLAY IT SAFE
MOVEM T3,PTHSPC+2 ;SAVE DEFAULT VALUE
HRL T1,T2 ;LOAD BOTH RETURNS IN AC1
JUMPN T1,.+3 ;ZERO NUMBER?
TRNE F,F$NUM ;YES, NO NUMBER SHOULD BE IN
ERROR <Illegal project number>
JUMPE T1,.+3 ;USE DEFAULT IF NOTHING RETURNED
HRLM T1,PTHSPC+2 ;ELSE USE RETURNED VALUE
HRLM T2,PPNMSK ; ..
TLNN F,(F$COMA) ;RETURN WITH COMMA?
ERROR <Comma required in directory>
PROGIN: TLO RK,(F$RSBR) ;ALSO EXPECT RIGHT BRACKET
IFN CITPPN,< PUSHJ P,R64INX ;RADIX 64 IS BEAUTIFUL>
IFE CITPPN,< PUSHJ P,OCTINX ;GET PROGRAMMER NO.>
HRL T1,T2 ;GET BOTH ARGS IN T1
JUMPN T1,.+3 ;ZERO NUMBER?
TRNE F,F$NUM ;YES, NO NUMBER SHOULD BE IN
ERROR <Illegal programmer number>
JUMPE T1,.+3 ;JUMP IF NONE
HRRM T1,PTHSPC+2 ;ARG GIVEN, USE IT
HRRM T2,PPNMSK ; ..
TLNN F,(F$COMA) ;COMMA FOR MORE?
JRST PPNDON ;NO, DONE
;CONTINUED
SFDIN: PUSH P,[EXP -6] ;SAVE -6 ON STACK
SFDIN1: PUSHJ P,WRDINX ;GO GET AN SFD
SKIPN T1 ;CHECK FOR NO NAME
JUMPE T2,[ MOVEI T1,[ASCIZ/Null SFD illegal/]
JRST GIVERR]
AOSL T3,(P) ;DECREMENT SFD NEXT COUNT
ERROR (<Too many SFD's in path arguments>)
MOVEM T1,PTHSPC+10(T3) ;STORE SFD
MOVEM T2,SFDMSK+5(T3) ;AND MASK
TLNE F,(F$COMA) ;ANOTHER COMMA?
JRST SFDIN1 ;YES, LOOP FOR MORE
POP P,(P) ;FIX UP STACK
PPNDON: TLNN F,(F$RSBR!F$BRK) ;EXPECT "]" OR EOL
ERROR <Right bracket required in directory>
POPJ P, ;RETURN
;HERE TO READ PROTECTION
PROTIN: PUSHJ P,SAVERK ;SAVE FLAGS
MOVSI RK,(F$RABR) ;EXPECT ">"
PUSHJ P,OCTINX ;GET OCTAL
CAIE T4,3 ;THREE DIGITS IN?
ERROR <Protection must have three digits>
DPB T1,[POINT 9,FILSPC+.RBPRV,8] ;SAVE PROTECTION
POPJ P, ;AND RETURN
;HERE TO READ A WORD
;SIXBIT RETURNED IN T1, MASK IN T2
WRDINX: PUSHJ P,SAVERK ;SAVE FLAGS
TLO RK,(F$ALPH!F$NMBR!F$QUOT) ;WANT ALPHANUMERIC
TRZ F,F$WRD ;FLAG NO WORD IN YET
SETZB T1,T2 ;CLEAR SPACE TO HOLD
MOVE T4,[POINT 6,T1(T3)] ;BYTE POINTER
WRDIN1: PUSHJ P,GETCH ;GET NEXT CHAR
SETZ T3, ;CLEAR INDEX AC
TLNE F,(F$QUOT) ;QUOTE IN?
JRST [TRC F,F$ALOK ;YES, COMPLEMENT QUOTE
PUSHJ P,GETCH ;GET NEXT CHAR
TLNN F,(F$QUOT) ;ANOTHER QUOTE?
JRST .+1 ;NO, JUST CONTINUE
TRC F,F$ALOK ;YES, RETURN ALOK BIT
JRST WRDIN3] ;AND ACCEPT IT
TRNE F,F$ALOK ;ACCEPTING ALL CHARACTERS?
JRST WRDIN3 ;YES, DON'T MAKE CHECKS
TLNN F,(F$ALPH!F$NMBR!F$STAR!F$QUST!F$QUOT) ;ALPHANUMERIC CHAR?
POPJ P, ;NO -- DONE
TLNE F,(F$STAR) ;WILD STAR?
JRST WILDST ;YES, TAKE CARE OF IT
TLNN F,(F$QUST) ;WILD "?"?
JRST WRDIN3 ;NO, FINISH
WRDIN2: MOVEI CH,177+40 ;SET SEVEN BITS FOR WILD
MOVEI T3,<T2-T1> ;INDEX TO T2
WRDIN3: SUBI CH,40 ;MAKE SIXBIT
TRO F,F$WRD ;FLAG WORD IN
TLNE F,(F$BRK) ;BREAK CHAR?
ERROR <Quote not closed>
JUMPL CH,BADCHR ;CONTROL CHAR
TLNE T4,770000 ;IF NOT SIX CHARS YET
IDPB CH,T4 ;THEN STUFF AWAY BYTE
JRST WRDIN1 ;AND LOOP BACK
WILDST: TRO F,F$WRD ;FLAG WORD IN
LSH T4,-36 ;GET # OF BITS LEFT
SETO T3, ;SET UP FULL MASK
LSH T3,-44(T4) ;SHIFT OVER FOR FILLED CHARS
IOR T2,T3 ;AND ADD TO MASK
TLZ RK,(F$ALPH!F$NMBR!F$QUST!F$QUOT!F$STAR) ;DON'T EXPECT THESE
PJRST GETCH ;GET NEXT CHAR AND RETURN
;HERE TO INPUT A NUMBER OF GIVEN RADIX FROM THE TTY
;THE NUMBER IS RETURNED IN T1, THE MASK IN T2, THE NUMBER OF DIGITS IN T4
;THE NUMBER IS CHECKED TO MAKE SURE IT FITS IN A HALF WORD
IFN CITPPN,< ;WANT MULTIPLE RADIXES FOR CIT
R64INX: MOVEI T3,70 ;^D64-^O10
JRST DECIN1 ;SKIP AHEAD
OCTINX: TDZA T3,T3 ;ZERO T3 AND SKIP
DECINX: MOVEI T3,2 ;DECIMAL
DECIN1: SETZB T1,T2 ;KEEP TOTAL HERE
SETZ T4, ;CLEAR DIGIT COUNT
PUSHJ P,SAVERK ;SAVE RETURN KEYS
TRZ F,F$NUM!F$NGNM ;FLAG NO NUMBER IN YET
TLO RK,(F$ALPH!F$NMBR!F$DASH) ;EXPECT NUMBERS
TLZ RK,(F$QUST!F$NULL) ;NO "?" OR NULLS
PUSHJ P,GETCH ;GET FIRST CHARACTER
TLZ RK,(F$STAR!F$DASH) ;NO MORE WILD CARDS OR "-"S
TLNE F,(F$STAR) ;WILD STAR?
JRST WILDNM ;YES, GO HANDLE IT
TLNN F,(F$DASH) ;DASH FOR NEGATIVE NUMBER?
JRST NUMIN2 ;NO, JUST READ THE NUMBER
TRO F,F$NGNM ;YES, FLAG IT
NUMIN1: PUSHJ P,GETCH ;GET CHARACTER
NUMIN2: TLNN F,(F$ALPH!F$NMBR) ;SKIP IF NUMBER
JRST NUMIN3 ;MUST HAVE IT
CAIL CH,"0" ;LESS THAN ZERO?
CAILE CH,"0"+7(T3) ;OR GREATER THAN OUR RADIX?
ERROR (BADCHR) ;YES, REJECT IT
IMULI T1,10(T3) ;INCREMENT COUNT
ADDI T1,-"0"(CH) ;AND ADD LAST COLUMN
TRO F,F$NUM ;FLAG NUMBER IN
AOJA T4,NUMIN1 ;LOOP FOR MORE
NUMIN3: TLNE T1,-1 ;LH ZERO?
ERROR (<Number too large>) ;no
TRZE F,F$NGNM ;NEGATIVE NUMBER?
MOVNS T1 ;YES, GET NEGATIVE VALUE
POPJ P, ;RETURN
WILDNM: TLZ RK,(F$ALPH!F$NMBR) ;EXPECT KEYS ONLY
SETO T2, ;SET UP MASK
TRO F,F$NUM ;FLAG NUMBER IN
PJRST GETCH ;GET NEXT CHAR AND RETURN
> ;END CITPPN CONDITIONAL
IFE CITPPN,< ;FOR NORMAL PEOPLE
OCTINX: SETZB T1,T2 ;CLEAR SPACE FOR NUMBER AND MASK
SETZ T4, ;DIGIT COUNT
PUSHJ P,SAVERK ;SAVE RETURN KEYS
TRZ F,F$NUM ;NO NUMBER IN YET
TLO RK,(F$NMBR) ;WANT NUMBERS
TLZ RK,(F$NULL) ;NO NULLS
PUSHJ P,GETCH ;PICK UP FIRST CHARACTER
TLZ RK,(F$STAR) ;NO MORE WILD STARS
TLNN F,(F$STAR) ;JUST GET A STAR?
JRST OCTIN2 ;NO, DO INPUT
TLZ RK,(F$NMBR) ;EXPECT NO MORE NUMBERS
SOJA T2,GETCH ;ZAP MASK, GET CHAR, RETURN
OCTIN1: PUSHJ P,GETCH ;NEXT CHAR
OCTIN2: TLNN F,(F$NMBR!F$QUST) ;WE EXPECT IT?
POPJ P, ;NO, MUST BE DONE
TLNN F,(F$QUST) ;WE ONLY LIKE QUESTION MARK
CAIG CH,"7" ;AND OCTAL
TROA F,F$NUM ;WHICH IS WHAT WE HAVE
ERROR (BADCHR) ;NO IT ISN'T
LSHC T1,3 ;ROTATE MASK AND NUMBER
TLNE F,(F$QUST) ;GET A QUESTION MARK?
TROA T2,7 ;YES, ZAP MASK BITS
ADDI T1,-"0"(CH) ;NO, INCREMENT COUNT
CAIG T4,5 ;MORE THAN SIX DIGITS?
AOJA T4,OCTIN1 ;NO, LOOP
MOVEI T1,[ASCIZ/Number too large/]
JRST GIVERR ;HE BLEW IT
> ;END IFE CITPPN CONDITIONAL
;HERE TO GET THE NEXT CHAR
;SKIP RETURN GIVEN IF NON-BREAK
;THE LH OF F IS SET UP WITH THE PROPER CLASS BIT
GETCH: TRZE F,F$NWLN ;NEED TO READ IN A NEW LINE?
PUSHJ P,REDLIN ;YES, DO SO
SKIPGE CH,$NXTCH ;NEXT CHARACTER THERE?
ILDB CH,$COMBP ;NO, READ IT
SETOM $NXTCH ;NO MORE NEXT CHAR
JUMPE CH,[HRLI F,(F$BRK) ;A BREAK IF NULL
SETZM $NEWLN ;WILL NEED A NEW LINE
POPJ P,] ;SO RETURN
GETCH1: CAIL CH,"A" ;LESS THAN "A"
CAILE CH,"Z" ;OR GREATER THAN "Z"
JRST GETCH2 ;THEN NOT ALPHABETIC
HRLI F,(F$ALPH) ;SET BIT
JRST GETCHX ;AND FINISH
GETCH2: CAIL CH,"0" ;NOW CHECK FOR NUMBER
CAILE CH,"9" ; ..
JRST GETCH3 ;NOT NUMEVIC
HRLI F,(F$NMBR) ;NOTE NUMBER
JRST GETCHX ;AND SKIP ON
GETCH3: CAIE CH,";" ;CHECK FOR COMMENT CHARS
CAIN CH,"!" ;EITHER OF THESE
TRO F,F$CMNT ;YES, SET PERMENANT FLAG
TRNE F,F$ALOK ;IF ALL CHARACTERS ACCEPTED
TRZ F,F$CMNT ;THEN DON'T FLAG COMMENTS
PUSH P,T1 ;SAVE AC'S
PUSH P,T2 ; ..
MOVSI T1,-CHLEN ;GET LENGTH OF CHAR TABLE
HRRZ T2,CHTAB(T1) ;GET ENTRY IN TABLE
CAME T2,CH ;MATCH OUR CHAR
AOBJN T1,.-2 ;NO, KEEP TRYING
HLL F,CHTAB(T1) ;GET FINAL MATCH OR ZERO IF NONE
POP P,T2 ;RESTORE AC'S
POP P,T1 ; ..
GETCHX: TRNE F,F$CMNT ;ERROR OR COMMENT IN PROGRESS?
JRST GETCH ;YES, LOOP BACK
TRNN F,F$ALOK ;SKIP IF ALL CHARS OK
TDNE F,RK ;SKIP IF CH NOT EXPECTED
POPJ P, ;EXPECTED, RETURN
TLNE F,(F$NULL) ;NULL IN?
TRNN F,F$NLOK ;YES, SKIP IF OK TO IGNORE
ERROR (BADCHR) ;BAD CHARACTER -- FLICK IT IN
JRST GETCH ;GO GET NEXT CHAR
REDLIN: PUSHJ P,SAVERK ;GRAB AN AC
SETOM $NXTCH ;RESET PEEK-AHEAD
MOVEI RK,MAXCHR ;KEEP FOR CHAR COUNT
PUSHJ P,REDLN2 ;SET UP BYTE POINTER
REDLN1: INCHWL CH ;GET A CHAR
CAIL CH,12 ;CHECK FOR VARIOUS BREAKS
CAILE CH,14 ;VERTICAL TABS AND LF
CAIN CH,33 ;TRY ALTMOE
JRST BRKCR ;YES, SEND BRKCR
CAIE CH,3 ;CHECK FOR ^C
CAIN CH,32 ;AND ^Z
EXIT ;LET HIM GO
CAIE CH,22 ;^R
CAIN CH,7 ;^G
JRST BRKCR ;BREAK
CAIE CH,25 ;^U
CAIN CH,177 ;RUBOUT
JRST BRKCR ;SAME
CAIN CH,15 ;CR IS FUNNY
JRST [INCHWL CH ;FOLLOWED BY LF
JRST BRKNCR] ;AND FINISH UP
CAIL CH,"A"+40 ;CONVERT LC
CAILE CH,"Z"+40
SKIPA
MOVEI CH,-40(CH) ;TO UC
IDPB CH,$COMBP ;PUT IN BUFFER
SOJG RK,REDLN1 ;LOOP
MOVEI T1,[ASCIZ/Line too long/]
JRST GIVERR
BRKCR: OUTSTR [ASCIZ/
/]
BRKNCR: SETZ CH, ;BREAK CHAR IS A NULL
IDPB CH,$COMBP ;FINISH WONDER ASCII STRING
REDLN2: MOVE CH,[POINT 7,$COMBF] ;SET UP BP TO COMMAND BUFFER
MOVEM CH,$COMBP ;FOR INPUT
POPJ P, ;AND RETURN
;TABLE OF CHARACTERS AND BITS
CHTAB: F$NULL + " " ;SPACE
F$NULL + 11 ;TAB
F$SLSH + "/" ;SLASH
F$DOT + "." ;DOT
F$RABR + ">" ;RIGHT ANGLE BRACKET
F$LABR + "<" ;LEFT ANGLE BRACKET
F$RSBR + "]" ;RIGHT SQUARE BRACKET
F$LSBR + "[" ;LEFT SQUARE BRACKET
F$COLN + ":" ;COLON
F$STAR + "*" ;STAR
F$QUST + "?" ;QUESTION MARK
F$COMA + "," ;COMMA
F$EQAL + "=" ;EQUAL SIGN
F$EQAL + "_" ;BACK ARROW
F$DASH + "-" ;DASH
F$QUOT + """" ;QUOTE
CHLEN==.-CHTAB
0 ;FINAL ZERO WORD FOR UNKNOWN CHARS
END
.RU CTLB
[ctlb ]