github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-03 18:06:05 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/link/lnkscn.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

886 lines
29 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE LNKSCN - INTERFACE TO SCAN FOR LINK
SUBTTL D.M.NIXON/DMN/JLd/JNG/PAH/DZN/PY/JBS/HD/RJF 5-Feb-88
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1986,1988.
; ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH LNKPAR,LNKLOW,MACTEN,UUOSYM,SCNMAC
IFN TOPS20,<SEARCH MONSYM,MACSYM> ;[2071]
SALL
ENTRY LNKSCN
EXTERN LNKLOD,LNKCOR,LNKLOG,.TYOCH
CUSTVR==0 ;CUSTOMER VERSION
DECVER==6 ;DEC VERSION
DECMVR==0 ;DEC MINOR VERSION
DECEVR==2417 ;DEC EDIT VERSION
VERSION
SEGMENT
SUBTTL COMMUNICATION WITH SCAN
EXTERN .ISCAN,.TSCAN,.OSCAN
EXTERN .POPJ1,.SWDEC,.SWOCT,.SWSIX,F.NAM,.OCTNW
;COMMUNICATION WITH .TYOCH
EXTERN .TCHAR,.TCRLF,.TDECW,.TOCTW,.TSIXN,.TSTRG,.TIAUC
;ACCUMULATORS
C==P4 ;CHARACTER INPUT
SUBTTL REVISION HISTORY
;START OF VERSION 1A
;37 ADD GARBAGE COLLECTOR AT CLANS
;47 INTEGRATE WITH SCAN %4
;52 ADD ASCIZ TEXT BLOCK
;60 ADD /VERSION SWITCH, MOVE .INSUB TO LNKSCN.MAC
;71 ADD PEF MESSAGE
;START OF VERSION 1B
;121 (12145) .VERSW DOESN'T PRESERVE P4, /VER:1(20) FAILS
;START OF VERSION 2
;141 TURN ON ASCII TEXT BLOCK
;145 ADD /USERLIB & /NOUSERLIB SWITCHES
;147 TURN ON MIXFOR FEATURE
;150 REMOVE EDIT #71 (PEF MESSAGE)
;151 (12491) CALL .OSCAN CORRECTLY
;165 INTEGRATE WITH SCAN %5(356), REMOVE .VERSW
;START OF VERSION 2B
;253 Fix ASCII blocks:
; if in CCL mode, tell SCAN to read our input
; if multi-line, keep byte pointer so don't lose characters
; if error, SCAN comes back for more, even if none
;264 Allow editing of bad file specs. when indirect
;411 If SCAN retruns again after the end of an ASCII block,
; hand it "/K<eol>" so it will return from .TSCAN
;426 Suppress the prompt characters while processing ASCII text.
;427 Save all of SCAN's ACs in TXTIN.
;430 Prevent hanging in TI state while reading ASCII text.
;433 Properly support the /RUN switch.
;436 Defeat ^O when prompting.
;START OF VERSION 2C
;534 Fix problems with .OSCAN, ASCII text, and add /CRLF.
;554 Fix problems with switch scanning for cases like /SAVE.
;557 Clean up listing for release.
;START OF VERSION 3A
;560 Release on both TOPS-10 and TOPS-20 as LINK version 3A(560)
;START OF VERSION 4
;600 Remove call to DEFVALUES macro
;731 SEARCH MACTEN,UUOSYM
;740 Remove .SWVER code.
;765 Release on both TOPS-10 and TOPS-20 as LINK version 4(765)
;START OF VERSION 4A
;1122 Remove edit 740.
;1167 Don't allow symbol names to start with digits.
;1174 Label and clean up all error messages.
;1217 Clean up the listings for release.
;1220 Release on both TOPS-10 and TOPS-20 as version 4A(1220).
;START OF VERSION 4B
;1221 Allow .R LINK (commands) and @LINK commands
;1252 Remove edit 1221 on TOPS-20.
;1301 Use the message bits from SCAN.
;Start of Version 5.1
;2026 Update copyright notice.
;2071 Search MONSYM and MACSYM
;Start of Version 6
;2220 Handle long symbol typein.
;2306 Handle long ascii PDV name, version format PDV version.
;2312 Allow Radix-50 special characters in PDV names, insure null byte.
;2323 Allow case-sensitive symbol typein in quotes.
;2334 Fix default for symbols, octal version typein.
;2403 New coporate copywrite statement.
;2417 Update copywrite statement to 1988.
SUBTTL INITIALIZE SCANNER
LNKSCN: JFCL .+1 ;NORMAL ENTRY
SKIPE F.EDIT ;ARE WE CORRECTING SPEC?
JRST [MOVEI T1,FORCIN ;FORCE INPUT FROM TTY:
PUSHJ P,.TYPRE## ; INCASE INDIRECT/CCL
JRST MAINLP] ;GO GET LINE
SKIPE F.ASCI ;HOW ABOUT ASCII TEXT?
JRST [MOVEI T1,USRIN ;YES, READ IT INSTEAD
PUSHJ P,.TYPRE## ;EVEN IF IND/CCL
JRST MAINLP] ;GO GET COMMAND
MOVEI T1,0 ;NO, SET INPUT TO START
PUSHJ P,.TYPRE ; OR CONTINUE NORMAL SOURCE
SKIPE N.ZER## ;CALLED TO PROCESS /RUN?
JRST [PUSHJ P,.RUNCM## ;YES, DO THE RUN
HRRZ T1,.JBSA## ;RESTART IF FAILED
JRST (T1)]
E$$SNL::.ERR. (MS,,V%L,L%I,S%I,SNL,<Scanning new command line>) ;[1174]
SETZ T1, ;SCAN CAN USE TTCALLS
PUSHJ P,.TYOCH## ;SINCE PROBLEM WITH EXECUTE ONLY HACK
MOVE T1,.ISBLK ;DATA BLOCK FOR .ISCAN
SKIPL OSCANF ;ONLY INITIALIZE ONCE
PUSHJ P,.ISCAN ;INITIALIZE COMMAND SCANNER
SKIPE T1,TTYSUB ;NOW WE CAN SET LINE BUFFERING ROUTINE
PUSHJ P,.TYOCH## ;UNLESS STILL ZERO
SUBTTL MAIN LOOP FOR COMMAND SCANNING
MAINLP: MOVE T1,.JBREL ;SET .JBFF OUTSIDE CORE RANGE
MOVEM T1,.JBFF ;INCASE /HELP
MOVE T1,.TSBLK ;DATA BLOCK FOR .TSCAN
PUSHJ P,.TSCAN ;GET THE COMMAND
HLRZ T1,.FLVRB## ;[1301] GET THE /MESSAGE MASK
ANDCAM T1,VERLVL ;[1301] RESET SPECIFIED BITS
HRRZ T1,.FLVRB## ;[1301] GET THE BITS SET BY /MESSAGE
IOR T1,VERLVL ;[1301] GET THE OLD BITS TOO
SKIPN T1 ;[1301] ANY BITS SET
MOVX T1,M%P!M%F ;[1301] NO, USE THE DEFAULT
TXNE T1,M%C ;[1301] USER WANT CONTINUATION?
TXO T1,M%F ;[1301] YES, MAKE SURE HE GETS FIRST TOO
MOVEM T1,VERLVL ;[1301] STORE THE RESULT
IFN FTOPTION,<
SKIPE OSCANF ;-1 IF ALREADY DONE FOR THIS LOAD
JRST MAINL1 ;NOT FIRST TIME
PUSH P,F.NXZR ;SAVE PTR TO END OF SCAN CHAIN
PUSH P,F.INZR ;AND TO BEGINNING
SETZM F.NXZR ;ZAP SO WON'T UPSET CLANS
SETZM F.INZR ;..
SETZM SWFLAG ;NO SWITCHES YET SEEN
MOVE T1,.OSBLK ;DATA BLOCK FOR OPTION FILE
PUSHJ P,.OSCAN ;READ USER OPTION PROFILE
MOVEI T2,F.INZR ;START OF NEW LIST
MOVE T1,T2 ;NOT YET END OF LIST
HRRZ T2,(T1) ;LIST TERMINATED?
JUMPN T2,.-2 ;NO
POP P,T2 ;GET PREVIOUS LIST
HRRM T2,(T1) ;LINK INTO NEW LIST
POP P,F.NXZR ;MAKE SURE END OF CHAIN IS OK
SETZM SWFLAG ;CLEAR SWITCH SEEN FLAG
>;END OF IFN FTOPTION
SETOM OSCANF ;ONLY ONCE
MAINL1: HRRZS F.NXZR ;MAKE SURE LH ISN'T -1 FROM USRSWT
SKIPN F.INZR ;ANYTHING TO LOAD?
JRST MAINLP ;NO, TRY AGAIN
MOVE T1,F.INZR ;POINT TO CURRENT DATA BLOCK
ADDI T1,F.ZER ;POINT TO START OF SCAN INFO
MOVEM T1,F.WLZR ;FOR WILD
MOVE T1,LOGSUB ;RESET LOG DEVICE
PUSHJ P,.TYOCH ;SINCE SCAN WIPES IT OUT
SKIPL GOTO ;SEEN /G YET?
JRST MAINRT ;NO, LOAD WHAT WE HAVE
SETZM GOTO ;DON'T CONFUSE LNKLOD
PUSHJ P,.KLIND## ;IF CCL MODE DELETE TEMP FILE
MAINRT: IFN FTOVERLAY,<
SKIPE OVERLW ;LOADING IN OVERLAY MODE
JRST LNKOV1## ;YES
>
JRST LNKLOD## ;AND LOAD THIS
.ISBLK: 5,,.+1
IFE TOPS20,< ;[1252]
IOWD 1,[SIXBIT /LINK/] ;[1221] ALLOW MONITOR COMMANDS
>
IFN TOPS20,< ;[1252]
0 ;[1252] RESCAN DOES NOT WORK WITH TOPS-20
> ;[1252]
OFFSET,,'LNK'
USRIN,,0
0
UPRMPT,,0
.TSBLK: 9,,.+1
IOWD LNKSWL,LNKSWN
LNKSWD,,LNKSWM
0,,LNKSWP
-1
CLANS,,0
AIN,,AOUT
0
0,,FS.MOT!FS.MIO
0,,USRSWT
IFN FTOPTION,<
.OSBLK: 4,,.TSBLK+1
>;END OF IFN FTOPTION
;SUBROUTINE TO CLEAR ANSWER AREA
CLRRET: PUSHJ P,DY.RET## ;RESTORE SPACE
CLANS: ;CLEAR START OF PARAMS
SKIPN T1,F.INZR ;NEED TO GARBAGE COLLECT?
JRST CLANZ ;NO
SKIPE T3,1(T1) ;YES, ANY SWITCHES FOR THIS SPEC?
JRST CLANSW ;YES, RETURN THEM FIRST
HRRZ T2,0(T1) ;GET NEXT POINTER
MOVEM T2,F.INZR ;STORE BACK FOR NEXT TIME ROUND
MOVEI T2,F.LEN ;LENGTH WE ALLOCATED
JRST CLRRET ;RETURN SPACE
CLANSW: EXCH T1,T3 ;PUT ADDRESS OF SWITCH IN T1
TLNN T1,-1 ;LEFT HALF SWITCH?
JRST CLANRS ;NO, TRY RIGHT
HLRZ T1,T1 ;FOR INDEXING
MOVE T2,0(T1) ;LENGTH,,NEXT POINTER
HRLM T2,1(T3) ;STORE BACK IN (F.INZR)+1
HLRZ T2,T2 ;LENGTH
JRST CLRRET ;RETURN SPACE
CLANRS: MOVE T2,0(T1) ;LENGTH,,NEXT POINTER
HRRZM T2,1(T3) ;STORE BACK IN (F.INZR)+1
HLRZ T2,T2 ;LENGTH
JRST CLRRET ;RETURN SPACE
CLANZ: SETZM F.NXZR ;FOR SCAN
SETZM SWFLAG ;CLEAR SWITCH SEEN INDICATOR
CPOPJ: POPJ P, ;RETURN
;HERE FROM SCAN TO PRINT PROMPT CHARACTERS.
;NEED TO SUPPRESS THEM IF PROCESSING ASCII TEXT.
UPRMPT: SKIPE F.ASCI ;PROCESSING ASCII TEXT?
POPJ P, ;YES, JUST RETURN
SKPINL ;DEFEAT ^O SO PROMPT WILL APPEAR
JFCL ;IGNORE POSSIBLE SKIP
SKIPGE T1 ;CONTINUATION LINE?
MOVEI T1,"#" ;YES, CHANGE PROMPT CHARACTER
OUTCHR T1 ;DELIVER IT
POPJ P, ;RETURN TO SCAN
;SUBROUTINES TO ALLOCATE FILE AREAS
;EXITS WITH T1 = ADDRESS
;T2 = LENGTH
;SUBROUTINE TO ALLOCATE OUTPUT FILE AREA
AOUT: ;FALL INTO AIN TO GET SPACE
;SUBROUTINE TO ALLOCATE INPUT FILE AREA
AIN: MOVEI T2,F.LEN ;SET LENGTH
SKIPGE F.NXZR ;SET NEGATIVE IF SWITCHES SEEN
JRST AIN4 ;BLOCK IS ALREADY SETUP
SETZM SWFLAG ;CLEAR GARBAGE IN SWFLAG
SKIPE T1,LOGSUB ;IF WE HAVE A REAL LOG FILE
PUSHJ P,.TYOCH## ;RESET LOG OUTPUT ROUTINE
PUSHJ P,DY.GET## ;GET SOME FREE SPACE
SKIPN LOGSUB ;DID WE RESET TTY OUTPUT
JRST AIN0 ;NO
MOVE T2,T1 ;SAVE T1
MOVE T1,TTYSUB ;GET TTY ROUTINE BACK
PUSHJ P,.TYOCH## ;RESET TTY
MOVE T1,T2 ;RESTORE CORE POINTER
AIN0: SKIPE F.INZR ;FIRST ONE?
JRST AIN1 ;NO
MOVEM T1,F.INZR ;SET FIRST ADDRESS POINTER
JRST AIN2 ;FIXUP SIZE AND ADDRESS FOR SCAN
AIN1: HRRM T1,@F.NXZR ;STORE POINTER TO THIS
AIN2: MOVEM T1,F.NXZR ;ADVANCE TO IT
SETZM (T1) ;CLEAR FORWARD POINTER
SETZM 1(T1) ;AND SWITCH POINTER
AIN3: ADDI T1,F.ZER ;PASS OVER HEADER WORDS
SUBI T2,F.ZER ;SINCE SCAN DOESN'T KNOW ABOUT THEM
POPJ P, ;RETURN
AIN4: HRRZS T1,F.NXZR ;GET CURRENT BLOCK
HRRZS (T1) ;CLEAR DUMMY FILE BLOCK FLAG
SETZM SWFLAG ;CLEAR SWITCH SEEN FLAG
JRST AIN3 ;AND RETURN
SUBTTL HERE TO HANDLE SWITCHES
;HERE FOR GLOBAL SWITCHES (LHS)
;ENTER FROM SCAN WITH VALUE IN P3 AND TOKEN IN T2
;AND DELIMITER CHARACTER IN C=P4
;SPECIAL ACTION IS REQUIRED IF DELIMITER IS ":"
;SINCE SCAN HAS NOT YET RETURNED THE FILE SPEC BLOCK THE FIRST SWITCH
;MUST ALLOCATE A DUMMY BLOCK.
;IT DOES THIS BY CALLING AIN AND MARKS THE BLOCK BY
;-1 IN LEFT OF F.NXZR AND -1 IN LEFT OF @F.NXZR
;THE SWITCHES ARE IN CHAINED BLOCK
;ALL GLOBAL SWITCHES, THOSE BEFORE THE FILE NAME ARE CHAINED TO THE
;LEFT HALF OF (@F.NXZR)+1, AND ALL LOCAL SWITCHES TO THE RIGHT HALF.
;THE SWITCHES ARE IN BLOCKS WHOSE STRUCTURE IS
;WORD COUNT ,, LINK TO NEXT SWITCH
;TOKEN VALUE
;VALUE
;REST DEPENDS UPON TOKEN #
;WHEN THE FILE SPEC IS RETURNED THE LEFT HALVES OF F.NXZR AND @F.NXZR
;ARE CLEARED.
USRSWT: LDB T3,[POINT 6,T2,11] ;GET BYTE SIZE
SUBI T3,^D65 ;CONVERT TO - ARG LEN IF MULTI
MOVN T3,T3 ;MAKE POSITIVE ARG LENGTH
CAIG T3,LN.SWV ;LOOK TOO LONG?
JRST USRSW0 ;NO, IS OK AS IS
MOVEI T3,1 ;YES, IS REALLY 1 WORD OR LESS
SKIPE SCNSYM ;[2220] SCANNING A SYMBOL?
JRST [PUSH P,T3 ;[2220] YES, GET AN AC
PUSHJ P,USRSYM ;[2220] FIX IN CASE LONG SYMBOL
POP P,T3 ;[2220] RESTORE THE AC
JRST USRSW0] ;[2220] CONTINUE
MOVEM N,.NMUL## ;SINGLE WORDS NOT ALWAYS STORED
USRSW0: PUSH P,T3 ;SAVE 1ST SWITCH ARG MAX LEN
HRRZ T2,T2 ;CLEAR BYTE POINTER FROM LEFT
PUSH P,T2 ;AND TOKEN
CAIN T2,%GO% ;IS THIS /G?
SETOM GOTO ;YES, MARK SO WE CAN DELETE TMP FILE
IFN FTOVERLAY,<
CAIN T2,%OV% ;/OVERLAY?
HRROS OVERLW ;YES, MARK SEEN IT
>
HLRZ T2,SWTTAB(T2) ;PICKUP SIZE OF SWITCH BLOCK
SKIPE T1,LOGSUB ;IF A LOG FILE,
PUSHJ P,.TYOCH## ;SET IT TO RECEIVE MESSAGES
PUSHJ P,DY.GET## ;GET THE SWITCH BLOCK
SKIPN LOGSUB ;DID WE RESET TTY OUTPUT?
JRST .+5 ;NO
PUSH P,T1 ;SAVE SWITCH BLOCK ADDR OVER TYOCH
MOVE T1,TTYSUB ;GET TTY ROUTINE BACK
PUSHJ P,.TYOCH## ;TELL SCAN
POP P,T1 ;NOW NEED SWITCH BLOCK ADDR
;FALL THROUGH TO NEXT PAGE
;HERE TO STORE THE FIRST ARG IN OUR SWITCH BLOCK & CHECK FOR A 2ND ARG
HRLZM T2,0(T1) ;STORE SIZE, CLEAR LINK TO NEXT
POP P,1(T1) ;STORE TOKEN # IN BLOCK
MOVX T3,SWT.S1 ;[2220] GET THE SYMBOL FLAG
SKIPE SCNSYM ;[2220] SCANNING A SYMBOL?
IORM T3,1(T1) ;[2220] YES, STORE IT IN SCAN BLOCK
SETZM SCNSYM ;[2220] CLEAR THE SYMBOL FLAG
POP P,T3 ;RESTORE # WORDS IN SWITCH ARG
CAILE T3,-2(T2) ;WILL IT FIT IN OUR BLOCK?
PUSHJ P,E$$IST ;[1174] NO, ERROR IN SWITCH MACRO
SUBI T2,2(T3) ;YES, T2 GETS WORDS LEFT OVER
MOVSI T4,.NMUL## ;NOW TO BLT ARG TO SWITCH BLOCK
HRRI T4,2(T1) ;WILL WORK FINE IF AT LEAST 1 WORD
ADDI T3,2(T1) ;LAST DEST+1
BLT T4,-1(T3) ;COPY ARG
SKIPE T2 ;ANY ROOM FOR 2ND ARG TO SWITCH?
CAIE C,":" ;YES, IS THERE ONE?
JRST USRSW1 ;NO, GET ERROR FROM SCAN IF ":"
MOVE T4,1(T1) ;YES, GET TOKEN BACK
HRRZ T4,SWTTAB(T4) ;GET ADDR OF SCANNER FOR 2ND ARG
JUMPE T4,USRSW1 ;NONE, GET ERROR FROM SCAN
SPUSH <T3,T2,T1> ;SAVE GOOD INFO OVER PROCESSOR
SETZM .NMUL## ;CLEAR ANSWER AREA
MOVE T2,[.NMUL##,,.NMUL##+1] ;[2306] TO AVOID CONFUSION
BLT T2,.NMUE## ;[2306] IF NO VALUE SUPPLIED NEXT TIME
PUSHJ P,0(T4) ;CALL SECOND PROCESSOR, T1 IS ADDR OF BLOCK
SPOP <T1,T2,T3> ;RESTORE ALL GOOD VALUES
SKIPE SCNSYM ;[2220] SCANNING A SYMBOL?
JRST [PUSH P,T3 ;[2220] YES, GET AN AC
MOVX T3,SWT.S2 ;[2220] A SYMBOL FLAG
IORM T3,1(T1) ;[2220] STORE IT IN SCAN BLOCK
PUSHJ P,USRSYM ;[2220] FIX IN CASE LONG SYMBOL
POP P,T3 ;[2220] RESTORE THE AC
SETZM SCNSYM ;[2220] CLEAR THE SYMBOL FLAG
JRST USRSW3] ;[2220] CONTINUE
CAIN T2,1 ;SINGLE WORD ARG?
MOVEM N,.NMUL## ;YES, N NOT ALWAYS STORED
USRSW3: HRLI T3,.NMUL## ;RH T3 ALREADY OK FOR BLT
ADDI T2,0(T3) ;LAST DEST. IS REMAINDER OF BLOCK
BLT T3,-1(T2) ;SO FILL IN REST OF SWITCH BLOCK
USRSW1: SETZM .NMUL## ;AVOID CONFUSION ON NEXT CALL
MOVE T2,[.NMUL##,,.NMUL##+1] ;BY ZEROING THINGS NOW
BLT T2,.NMUE## ; ..
SKIPGE F.NXZR ;IF FIRST SWITCH FOR THIS FILE
JRST USRSW2 ;NO, FILE AREAS ALREADY SET UP
PUSH P,T1 ;SAVE SWITCH BLOCK ADDR
PUSHJ P,AIN ;ALLOCATE A BLOCK
HRROS -F.ZER(T1) ;MARK BLOCK AS A DUMMY ONLY
HRROS F.NXZR ;MARK DUMMY BLOCK SET UP
POP P,T1 ;RESTORE SWITCH BLOCK ADDR
USRSW2: SKIPE F.NAM ;GLOBAL IF FILE NAME NOT YET SEEN
JRST USRLSW ;NO, ITS LOCAL
;FALL THROUGH TO NEXT PAGE
;HERE TO CHAIN GLOBAL SWITCH INTO SCAN BLOCK (OFF OF SWFLAG)
SKIPL T2,SWFLAG ;SEE IF FIRST SWITCH
JRST USRGS2 ;YES IT IS
HRROM T1,SWFLAG ;STORE NEW POINTER
HRRM T1,(T2) ;AND LINK IN
USRRET: POPJ P,
USRGS2: HRROM T1,SWFLAG ;STORE POINTER AND FLAG GLOBAL
MOVE T2,F.NXZR ;GET POINTER TO BLOCK
HRLM T1,1(T2) ;LINK SWITCH CHAIN TO FILE CHAIN
POPJ P,
;HERE FOR LOCAL SWITCHES (RHS)
USRLSW: SKIPG T2,SWFLAG ;SEE IF FIRST SWITCH
JRST USRLS2 ;YES IT IS
HRRZM T1,SWFLAG ;STORE NEW POINTER
HRRM T1,(T2) ;AND LINK IN
POPJ P,
USRLS2: HRRZM T1,SWFLAG ;STORE POINTER AND FLAG LOCAL
MOVE T2,F.NXZR ;GET POINTER TO BLOCK
HRRM T1,1(T2) ;LINK SWITCH CHAIN TO FILE CHAIN
POPJ P,
;[2220] Here if a symbol. Check for long symbol, and if so build
;[2220] a pointer to it and put it in the DY area.
USRSYM: PUSH P,T2 ;[2220] Save an AC
SETZ T2, ;[2220] Clear a counter
USRSM1: SKIPE .NMUL##(T2) ;[2220] This word null?
AOJA T2,USRSM1 ;[2220] No, try another
CAIG T2,1 ;[2220] Short (or no) symbol?
JRST USRSM2 ;[2220] Yes, don't change it
PUSH P,T1 ;[2220] Long symbol, save another AC
PUSHJ P,DY.GET## ;[2220] Get some memory for it
HRL T1,T2 ;[2220] Build length,,pointer
PUSH P,T1 ;[2220] Save it
ADDI T2,-1(T1) ;[2220] Last address to store
HRLI T1,.NMUL## ;[2220] From,,to
BLT T1,(T2) ;[2220] Copy it
POP P,.NMUL## ;[2220] Put the pointer in as the result
POP P,T1 ;[2220] Restore an Ac
USRSM2: POP P,T2 ;[2220] Restore another AC
POPJ P, ;[2220] Return
E$$IST::.ERR. (MS,,V%L,L%F,S%F,IST,<Inconsistency in switch table>) ;[1174]
SUBTTL GENERATE SWITCH TABLES
;GENERATE SWITCH TABLES
DEFINE SWMAC (A,B,C,D,E,F,G,H,I)<
IFB <C>,<
A H'B,TK.,D,E
>
IFNB <C>,<
A H'B,<POINT 65-C,TK.,35>,D,E
>
IF1,<
IFIDN <B><GO>,<
IFNDEF %GO%,<
%GO%==TK.
>>
IFIDN <B><OVERLAY>,<
IFNDEF %OV%,<
%OV%==TK.
>>
TK.==TK.+1
>
IF2,<
IFG .-LNKSWP,<TK.==TK.+1>
>>
TK.==0 ;INITIAL CONDITION
DOSCAN (LNKSW)
DEFINE KEYMAC (A,B)<
KEYS A'K,<B>>
KEYWORDS
SUBTTL GENERATE SIZE TABLE FOR SWITCH STORAGE
DEFINE SWMAC (A,B,C,D,E,F,G,H,I)<
IF1,<
F,,0
>
IF2,<
IFNB <I>,<IFNDEF I,<EXTERN I>>
F,,I
>>
SWTTAB: SWTCHS
SUBTTL CHARACTER INPUT ROUTINES
IFE .ASBLK,<USRIN==0> ;USE INCHWL ROUTINE IN SCAN
IFN .ASBLK,<
USRIN: SKIPE F.ASCI ;READING ASCIZ TEXT FROM CORE?
JRST TXTIN ;YES
INCHWL C ;NO
POPJ P,
TXTIN: AOSE F.ASCI ;IS SCAN RETURNING TOO MUCH?
SOSA F.ASCI ;NO, CONTINUE
JRST TXTKOM ;YES, GO GIVE IT A KOMMAND
SOSGE F.ASCC ;BUFFER STILL CONTAINS DATA?
JRST NXTTXT ;NO, GET NEXT BUFFER
ILDB C,F.ASCI ;READ A CHAR
JUMPN C,CPOPJ ;RETURN IF NOT NULL
SKIPA C,F.ASCC ;NO OF CHAR LEFT
NXTTXT: TDZA C,C ;ENTER HERE WHEN BUFFER EMPTY
IDIVI C,5 ;NO OF WORDS LEFT
SUBI C,^D127 ;NO. TO BACKUP
ADDB C,F.ASCI ;TO START OF BLOCK
PUSHJ P,.PSH4T## ;SCAN USES ALL THE T ACS
HRRZ T1,C ;GIVE BLOCK BACK
MOVEI T2,^D128
MOVE C,(C) ;STORE POINTER TO NEXT BLOCK OR 0
MOVEM C,F.ASCI ;NEW POINTER
PUSHJ P,DY.RET## ;RETURN SPACE
PUSHJ P,.POP4T## ;RESTORE ALL T ACS
JUMPE C,TXTFIN ;FINISHED IF NOTHING TO LINK TO
MOVE C,[POINT 7,1] ;ASCII BYTE POINTER
ADDM C,F.ASCI ;FOR READIN
MOVEI C,^D127*5 ;MAX BYTE COUNT FOR THIS BUFFER
MOVEM C,F.ASCC ;FOR SOSGE LOOP
JRST TXTIN ;GET NEXT CHAR
TXTFIN: SETOB C,F.ASCI ;RETURN EOL CHAR
POPJ P,
E$$ITB::.ERR. (MS,.EC,V%L,L%F,S%F,ITB,<Invalid text in ASCII block from file >) ;[1174]
.ETC. (FSP,,,,,DC)
;STILL IN IFN .ASBLK
;HERE IF SCAN IS RETURNING TOO MUCH. HAND IT THE NEXT CHAR
;OF "/K<CRLF>". IF THAT DOESN'T STOP IT, BOMB WITH ?LNKITB.
TXTKOM: SETOM F.ASCI ;RESET ASCII TEXT IN PROGRESS
SKIPN F.ASCK ;FIRST TIME THROUGH?
JRST [MOVE C,[POINT 7,KOMTXT] ;YES, SET UP BP
MOVEM C,F.ASCK ;FOR USE BELOW
JRST .+1] ;RETURN TO MAIN FLOW
ILDB C,F.ASCK ;NEXT BYTE OF KOMMAND
JUMPE C,E$$ITB ;[1174] IF SCAN STILL WANTS MORE, GIVE UP
POPJ P, ;ELSE RETURN IT THE CHARACTER
;THE NO-OP KOMMAND ITSELF
KOMTXT: ASCIZ ./K
.
>;END IFN .ASBLK
;ROUTINE CALLED TO DO CHARACTER INPUT DURING EDITING OF A FILE
;SPECIFICATION SO THAT NORMAL COMMAND INPUT CAN BE SUSPENDED
;AND RESUMED AFTER THE EDIT. CALLED BY SCAN DURING PUSHJ
;TO .TSCAN TO GET NEXT LINE. ENABLED BY CALL TO .TYPRE
FORCIN: INCHWL C ;GET NEXT CHARACTER
POPJ P, ;RETURN IT TO SCAN
SUBTTL .INSUB - SPECIAL INPUT SUBROUTINES NOT YET IN SCAN
ENTRY .SYMSW,.SWSYM,.SYOSW,.SWSYO,.SXDSW,.SWSXD
ENTRY .DPKSW,.SWDPK
N==P3
C==P4
;.SYMSW -- INPUT A SIXBIT SYMBOL FROM COMMAND STRING
;.SYMSC -- DITTO (CHARACTER ALREADY IN C)
;[2220] Call: PUSHJ P,.SYMSC/.SYMSW
;[2220] RETURN WITH WORDS IN .NMUL
;[2220] Uses T1 Updates C (separator)
;[2220] Sets SCNSYM to indicate that it was a symbol.
;[2220] Uses SCNSYM internally to indicated a quoted string.
;[2220] Allows quoted strings. Quotes are needed for all characters
;[2220] except 0-9, A-Z, $, ., and %.
;[2220] A special requirement of this routine is that if a quoted
;[2220] string is seen it is necessary that one extra character be
;[2323] read. This is because .TIALT returns a space for the second
;[2220] quote.
;[2220] This routine is similar to .SIXQW/.SIXQC in SCAN, except
;[2220] that it allows extra characters and always returns the next
;[2323] character in C, and that it converts lower case characters
;[2323] in quotes to shifted SIXBIT.
.SYMSW::PUSHJ P,.TIALT## ;[2323] Prime the pump
.SYMSC::MOVEI T1,.TSYMB## ;[2334] Use SIXBIT for error printing
MOVEM T1,.LASWD## ;[2220] Remember it
CAIE C,"""" ;[2220] Is this a quote?
SETOM SCNSYM ;[2220] No, remember not quoted string
PUSH P,.NMUL## ;[2334] Save the default
SETZM .NMUL## ;[2334] No characters yet
PUSH P,P1 ;[2323] Get an accumulator
SETZ P1, ;[2323] Remember in upper case mode
PUSHJ P,.TICQT## ;[2220] Check for quoting
MOVE T1,[POINT 6,.NMUL##] ;[2220] Initialize Byte pointer
;[2220] Here for each character
SYMM1: SKIPLE .QUOTE## ;[2220] See if in quoted string
JRST SYMMS ;[2323] Yes, check for case sensitivity
PUSHJ P,.TICAN## ;[2220] See if alphanumeric
CAIN C,"." ;[2220] No, is it a dot?
JRST SYMM2 ;[2220] Yes, it's good
CAIE C,"$" ;[2220] Is it a dollar sign?
CAIN C,"%" ;[2220] Or a percent sign?
JRST SYMM2 ;[2220] Yes, it's good
;[2220] Here when it's not a character to store. Check for special
;[2220] Quoted string problem.
POP P,P1 ;[2323] Restore the flag AC
SKIPE SCNSYM ;[2220] Quoted string?
JRST SYMMD ;[2334] No, already flagged, done
CAIN C," " ;[2220] Returned a space? (could be eol)
PUSHJ P,.TIALT## ;[2323] Yes, get the next character
SETOM SCNSYM ;[2220] Note that a symbol was scanned
SYMMD: POP P,T1 ;[2334] Recover the default
SKIPE .NMUL## ;[2334] Get anything?
POPJ P, ;[2334] Yes, Done
MOVEM T1,.NMUL## ;[2334] No, put back default
SETZM SCNSYM ;[2334] Default is not symbolic
POPJ P, ;[2334] Done
SYMMS: CAIN C," " ;[2323] Spaces in symbols are no good
JRST E.ILSC## ;[2323] Give error if bad character
CAIE C,"/" ;[2323] User cannot type shift characters
CAIN C,"\" ;[2323] Either of them
JRST E.ILSC## ;[2323] Give error if bad character
CAIL C,"A" ;[2323] Is it an upper case alphabetic?
CAILE C,"Z" ;[2323] Between A and Z?
JRST SYMS1 ;[2323] No
JUMPE P1,SYMM2 ;[2323] Yes, done if in upper case mode
MOVEI P1,'/' ;[2323] Get the upper case flag
CAME T1,[POINT 6,.NMUE##,35] ;[2323] See if overflow
IDPB P1,T1 ;[2323] OK, Store
SETZ P1,
JRST SYMM2 ;[2323] Go store the character
SYMS1: CAIL C,"a" ;[2323] Is it a lower case alphabetic?
CAILE C,"z" ;[2323] Between a and z?
JRST SYMM2 ;[2323] Not alphabetic at all, just store
JUMPN P1,SYMM2 ;[2323] Yes, done if in lower case mode
MOVEI P1,'\' ;[2323] Get the lower case flag
CAME T1,[POINT 6,.NMUE##,35] ;[2323] See if overflow
IDPB P1,T1 ;[2323] OK, Store
;[2220] Here with a character to store. Check ranges and store if possible.
SYMM2: PUSHJ P,.TIMUC## ;[2323] Make it upper case
CAIL C,40 ;[2220] See if in range for sixbit
CAILE C,137 ;[2220]
JRST E.ILSC## ;[2220] Not in range, give error
SUBI C," "-' ' ;[2220] Convert to sixbit
CAME T1,[POINT 6,.NMUE##,35] ;[2220] See if overflow
IDPB C,T1 ;[2220] OK, Store
ADDI C," "-' ' ;[2220] Convert back to ascii
PUSHJ P,.TIALT## ;[2220] Get next character
JRST SYMM1 ;[2220] Process it
;[2220] HERE WHEN SWITCH VALUE IS A SIXBIT SYMBOL
.SWSYM::PUSHJ P,.SYMSW ;GET THE WORD
JRST .SWDPB## ;AND STORE IT
;.SYOSW -- INPUT A SIXBIT SYMBOL OR OCTAL WORD FROM COMMAND STRING
;.SYOSC -- DITTO (CHARACTER ALREADY IN C)
;TERMINATES AT FIRST NON-SYMBOL CHARACTER (AFTER FIRST #)
;ASSUMES OCTAL IF FIRST CHAR IS #, OR FIRST 6 CHAR ARE 0-7
;[2220] ASSUMES SYMBOLIC IF ANY OF FIRST CHARACTER ALPHABETIC OR SPECIAL
;CALL: PUSHJ P,.SYOSC/.SYOSW
; RETURN WITH WORD IN N
;USES T1 UPDATES C (SEPARATOR)
.SYOSW::PUSHJ P,.TIALT## ;[2323] Prime the pump
.SYOSC::CAIL C,"0" ;[2220] Digits?
CAILE C,"9" ;[1167] ?
CAIN C,"-" ;[2220] No, minus?
JRST .OCTNC## ;[1167] Octal number
CAIN C,"#" ;[2220] Explicit octal?
JRST .OCTNW## ;[2220] Yes, a number
JRST .SYMSC ;[2220] No, it's a symbol
;[2220] HERE WHEN SWITCH VALUE IS A ONE WORD OR OCTAL WORD
.SWSYO::PUSHJ P,.SYOSW ;GET THE WORD
JRST .SWDPB## ;AND STORE IT
;.SXDSW -- INPUT A SIXBIT SYMBOL OR DECIMAL WORD FROM COMMAND STRING
;.SXDSC -- DITTO (CHARACTER ALREADY IN C)
;TERMINATES AT FIRST NON-SYMBOL CHARACTER (AFTER FIRST #)
;ASSUMES OCTAL IF FIRST CHAR IS #, DECIMAL IF FIRST 6 CHAR ARE 0-9
;[2220] ASSUMES SYMBOLIC IF FIRST CHARACTER ALPHABETIC OR SPECIAL
;CALL: PUSHJ P,.SXDSC/.SXDSW
; RETURN WITH WORD IN N
;USES T1 UPDATES C (SEPARATOR)
.SXDSW::PUSHJ P,.TIALT## ;[2323] Prime the pump
.SXDSC::CAIL C,"0" ;[2220] Digits?
CAILE C,"9" ;[1167] ?
CAIN C,"-" ;[2220] No, minus?
JRST .DECNC## ;[2220] Decimal number
CAIN C,"#" ;[2220] Explicit octal?
JRST .OCTNW## ;[2220] Yes, a number
JRST .SYMSC ;[2220] No, it's a symbol
;HERE WHEN SWITCH VALUE IS A SIXBIT SYMBOL OR DECIMAL WORD
.SWSXD::PUSHJ P,.SXDSW ;GET THE WORD
JRST .SWDPB## ;AND STORE IT
;.DPKSW -- INPUT A DECIMAL PAGE OR CORE SIZE FROM COMMAND STRING
;.DPKSC -- DITTO (CHARACTER ALREADY IN C)
;FORM IS /CORE:NK OR /CORE:LK+HK
;IF IT STARTS WITH #, THEN OCTAL TYPEIN
;TERMINATES AT FIRST NON-DECIMAL CHARACTER
;IF SUFFIX IS P USES PAGE SIZE, IF K USE CORE SIZE
;THROWS AWAY ANY CHARACTERS BEFORE THE LAST 10 OR SO
;CALL: PUSHJ P,.DPKSC/.DPKSW
; RETURNS WITH DOUBLE WORD IN .NMUL, .NMUL+1
;USES T1 UPDATES C (SEPARATOR)
.DPKSW::PUSHJ P,.TIAUC## ;PRIME THE PUMP
.DPKSC::SETZB N,.NMUL## ;CLEAR STORAGE AREA
SETZM .NMUL##+1
DPKIN0: CAIN C,"#" ;SEE IF OCTAL FLAGGED
PJRST .OCTNW## ;YES--GO READ OCTAL FIELD
CAIN C,"-" ;IN CASE NEGATIVE
JRST .DPKSW ;JUST IGNORE SIGN, BUT TEST FOR OCTAL AGAIN
DPKIN1: CAIL C,"0" ;SEE IF DECIMAL
CAILE C,"9" ; ..
PJRST DPKMUL ;NO--AT END, SO HANDLE SUFFIX
IMULI N,^D10 ;YES--MULTIPLY NUMBER
ADDI N,-"0"(C) ;INCORPORATE DIGIT
PUSHJ P,.TIAUC## ;GET NEXT CHARACTER
JRST DPKIN1 ;LOOP BACK FOR MORE
;DPKMUL -- HANDLE P OR K SUFFIX MULTIPLIER
; P FOR #1000, K FOR #2000
;CALL: MOVE N,NUMBER
; PUSHJ P,DPKMUL
; RETURN WITH NUMBER MULTIPLIED BY SUFFIX
;USES T1 (MULTIPLIER--RETURNED) UPDATES C (SEPARATOR)
DPKMUL: MOVEI T1,0 ;INITIALIZE SUFFIX MULTIPLIER
CAIN C,"K" ;K = 2 000
MOVEI T1,^D10
CAIN C,"P" ;P = 1 000
MOVEI T1,^D9
LSH N,(T1) ;APPLY TO NUMBER
JUMPN T1,.TIAUC## ;IF SUFFIX--GET ONE MORE CHARACTER
POPJ P,
;HERE WHEN SWITCH VALUE IS A CORE OR PAGE SIZE
.SWDPK::PUSHJ P,.DPKSW ;GET THE NUMBER
MOVEM N,.NMUL## ;STORE LOW
CAIE C,"+" ;SEE IF ANY MORE
JRST .SWDPB## ;NO, STORE WHAT WE HAVE
PUSHJ P,.TIAUC## ;GET NEXT CHARACTER
PUSHJ P,DPKIN0 ;AND SEE WHAT IT IS
MOVEM N,.NMUL##+1 ;STORE HIGH
JRST .SWDPB## ;AND RETURN
ENTRY .SWVER ;[1122]
;HERE WHEN SWITCH VALUE IS A VERSION NUMBER
.SWVER::PUSHJ P,.VERSW## ;[1122] GET THE WORD
JRST .SWDPB## ;[1122] AND STORE IT
;[2306] Here for second argument for /PVDATA switch. This is special,
;[2306] because the type of argument will depend on the previous
;[2306] keyword. In particular, the NAME keyword should accept the
;[2306] length of and a pointer to an ASCIZ string. The VERSION
;[2306] keyword should accept a symbol, an octal number if # seen,
;[2306] or a version number. The other keywords, START, MEMORY,
;[2306] PROGRAM, CBLOCK and EXPORT should accept a symbol or an
;[2306] octal value.
.SWPDV::PUSHJ P,.PDVSW ;[2306] Get the word
JRST .SWDPB## ;[2306] And store it
.PDVSW: HRRZ T1,2(T1) ;[2306] Get the first argument
CAIN T1,$PDVNAME ;[2306] /PVDATA:NAME?
PJRST .ASCSW ;[2306] Yes, go get ASCIZ name
CAIE T1,$PDVVERSION ;[2306] /PVDATA:VERSION?
PJRST .SYOSW ;[2306] No, get symbol or octal number
; PJRST .SYVSW ;[2306] Yes, get symbol or version
;[2306] Here to get a symbol, a version number, or an octal value
.SYVSW: PUSHJ P,.TIALT## ;[2306] Prime the pump
CAIN C,"#" ;[2306] Explicit octal?
PJRST .OCTNW## ;[2334] Yes
CAIE C,"(" ;[2306] Open parenthesis
CAIN C,"-" ;[2306] Or dash?
PJRST .VERSC## ;[2306] Yes, version number
CAIL C,"0" ;[2306] See if in range
CAILE C,"7" ;[2306] As an octal number
PJRST .SYMSC ;[2306] No, it's a symbol
PJRST .VERSC ;[2306] Yes, it's a version number
;[2306] Here for ASCIZ possibly quoted string. Places result in DY area,
;[2306] returns length,,pointer. Uses SCNSYM as a flag, -1 means parsing
;[2306] a quoted symbol. Always leaves SCNSYM zero. Also uses T1-T3.
.ASCSW: PUSHJ P,.TIALT## ;[2306]
CAIN C,"""" ;[2306] Is this a quote?
SETOM SCNSYM ;[2306] Yes, remember quoted string
PUSHJ P,.TICQT## ;[2312] Check for quoting
HRROI T1,.TSTRG## ;[2312] Set ASCII string format
MOVEM T1,.LASWD ;[2312] For error printing
MOVE T1,[POINT 7,.NMUL##] ;[2312] Initialize byte pointer
ASCS1: SKIPLE .QUOTE## ;[2312] See if in quoted string
JRST ASCS2 ;[2312] Yes, just go store
PUSHJ P,.TICAN## ;[2312] See if alphanumeric
CAIN C,"." ;[2312] No, is it a dot?
JRST ASCS2 ;[2312] Yes, it's good
CAIE C,"$" ;[2312] Is it a dollar sign?
CAIN C,"%" ;[2312] Or a percent sign?
JRST ASCS2 ;[2312] Yes, it's good
;[2312] Have ASCII string, copy it into a block.
SETZ T2, ;[2312] Get trailing null
CAME T1,[POINT 7,.NMUE##,34] ;[2312] See if overflow
IDPB T2,T1 ;[2312] No, store null (must be ASCIZ string)
HRRZ T2,T1 ;[2306] Get the last word written
SUBI T2,.NMUL##-1 ;[2306] Get the size
CAMN T1,[POINT 7,.NMUE##,34] ;[2306] Absolutely full?
ADDI T2,1 ;[2306] Yes, will need one more word
PUSHJ P,DY.GET## ;[2306] Get space for the string
MOVE N,T1 ;[2306] Save the length
HRL N,T2 ;[2306] And the size
ADDI T2,-1(T1) ;[2306] Final destination
HRLI T1,.NMUL## ;[2306] Source,,destination
BLT T1,(T2) ;[2306] Copy the string
SKIPN SCNSYM ;[2312] Doing a quoted string?
POPJ P, ;[2306] No, it's OK
CAIN C," " ;[2306] And returned a space (Could be EOL)?
PUSHJ P,.TIALT## ;[2306] Yes, read one more character
SETZM SCNSYM ;[2306] Zero flag
POPJ P, ;[2306] Done
ASCS2: CAME T1,[POINT 7,.NMUE##,34] ;[2312] See if overflow
IDPB C,T1 ;[2312] No, store
PUSHJ P,.TIALT## ;[2312] Get next character
JRST ASCS1 ;[2312] Loop back to process it
SUBTTL THE END
SCNLIT: END LNKSCN
Reference in New Issue View Git Blame Copy Permalink