Trailing-Edge
-
PDP-10 Archives
-
BB-FT68B-SM
-
exec/execcs.mac
There are 47 other files named execcs.mac in the archive. Click here to see a list.
;Edit 1014 to EXECCS.MAC by MERRILL on Wed 10-Oct-84
; FORTRAN CANNOT BE RUN FROM MACRO
;; PA1050 does not like being overwritten, so always
;; run FORTRA first.
;Edit 1013 to EXECCS.MAC by SANTIAGO on Tue 21-Aug-84, for SPR #19854
; Have COMPILE check if a switch was terminated by a colon
;; and more text, and blow up if switch does not require data.
;Edit 1003 to EXECCS.MAC by MELOHN on Thu 10-May-84, for SPR #19189
; Install TCO 6.1995 - fix routine CMPER to replace '%'with',%'
;Edit 990 to EXECCS.MAC by TSANG on Mon 19-Dec-83
; Give a meaningful error message if you submit @COMP FOO/L
;Edit 974 to EXECCS.MAC by TSANG on Mon 15-Aug-83, for SPR #19336
; SWITCHES SHOULD BE PASSED TO COMPILER EXACTLY AS USER TYPED.
;Edit 973 to EXECCS.MAC by PRATT on Mon 15-Aug-83, for SPR #17432
; No wildcards in filespecs for compile class commands
;Edit 958 by TSANG on Fri 29-Apr-83, for SPR #19037
; Make /RELOCATABLE switch work properly.
;Edit 957 by TSANG on Fri 1-Apr-83, for SPR #19005
; Create a meaningful error message for generation number on
;; the file name.
;Edit 956 by TSANG on Mon 28-Mar-83
; Remove /CHECK and /NOCHECK switches from EXEC
;Edit 955 by TSANG on Mon 28-Mar-83
; Let /NOWARNING switch apply to all language
;Edit 954 by TSANG on Mon 28-Mar-83
; Make /SWITCH:TEXT work, treat the TEXT field as a new field,
;; instead of an argument of the switch (except in LANGUAGE-SWITCH)
;Edit 947 - Modify EDIT #931 to make /NOWARNING switch work.
;Edit 944 - Make the ABORT switch work.
; UPD ID= 160, FARK:<5-1-WORKING-SOURCES.EXEC>EXECCS.MAC.11, 17-Jan-83 15:42:51 by TSANG
;Edit 941 - Modify Edit #933 to save the problem from compiling an indirect file.
; UPD ID= 152, FARK:<5-1-WORKING-SOURCES.EXEC>EXECCS.MAC.10, 21-Dec-82 14:05:51 by TSANG
;Edit 938 - Make /NOBINARY switch work.
; UPD ID= 147, FARK:<5-1-WORKING-SOURCES.EXEC>EXECCS.MAC.9, 21-Dec-82 11:13:06 by TSANG
;Edit 935 - Make the quotation mark in a quoted string work property.
; UPD ID= 143, FARK:<5-1-WORKING-SOURCES.EXEC>EXECCS.MAC.8, 13-Dec-82 10:32:03 by TSANG
;Edit 933 - Modify EDIT #932.
; UPD ID= 141, FARK:<5-1-WORKING-SOURCES.EXEC>EXECCS.MAC.7, 22-Nov-82 15:49:32 by TSANG
;Edit 932 - Make "%" operator work properly.
; UPD ID= 139, FARK:<5-1-WORKING-SOURCES.EXEC>EXECCS.MAC.6, 22-Nov-82 14:45:01 by TSANG
;Edit 931 - Make /WARNINGS and /NOWARNINGS switches work properly.
; UPD ID= 137, FARK:<5-1-WORKING-SOURCES.EXEC>EXECCS.MAC.4, 17-Nov-82 10:44:12 by TSANG
;Edit 749 - Let the local SW /NOCOMP to override global SW /COMP.
; UPD ID= 135, FARK:<5-1-WORKING-SOURCES.EXEC>EXECCS.MAC.3, 5-Nov-82 13:50:57 by WEETON
;Edit 930 - Make @LOAD/NOSYMBOL work.
; UPD ID= 122, FARK:<5-WORKING-SOURCES.EXEC>EXECCS.MAC.16, 25-Oct-82 11:33:28 by TSANG
;EDIT 924 - ADDITION TO EDIT 922, ISSUE A WARNING MESSAGE
; UPD ID= 119, FARK:<5-WORKING-SOURCES.EXEC>EXECCS.MAC.15, 15-Oct-82 15:56:21 by TSANG
;EDIT 922 - RECOMPILE THE SOURCE FILE IF REL FILE IS OFFLINE
; UPD ID= 112, FARK:<5-WORKING-SOURCES.EXEC>EXECCS.MAC.13, 12-Oct-82 09:02:31 by DONAHUE
;Edit 919 - Force a recompile if source in connected dir but REL is not
; UPD ID= 98, FARK:<5-WORKING-SOURCES.EXEC>EXECCS.MAC.12, 21-Sep-82 14:41:37 by TSANG
;EDIT 909 - Create a correct format for PASCAL file in TEMCOR FILE.
; UPD ID= 84, FARK:<5-WORKING-SOURCES.EXEC>EXECCS.MAC.11, 23-Aug-82 09:00:48 by TSANG
;EDIT 747 - MODIFY EDIT 746, LEAVE THE CBL68 PROCESSOR ALONE, DON'T TOUCH IT.
; UPD ID= 81, FARK:<5-WORKING-SOURCES.EXEC>EXECCS.MAC.10, 19-Aug-82 16:23:24 by TSANG
;EDIT 746 - LET THE GLOBAL LANGUAGE SWITCH OVERRIDE THE DEFAULT ONE AND USE
; COBOL PROCESSOR TO REPLACE CBL68 PROCESSOR.
; UPD ID= 70, FARK:<5-WORKING-SOURCES.EXEC>EXECCS.MAC.9, 14-Jul-82 15:09:58 by TSANG
;EDIT 740 - INSERT A SUBROUTINE TO CHECK THE LINE-CONTINUATION CHARACTER "-"
; AND STRIP IT IF SEEN.
; UPD ID= 68, FARK:<5-WORKING-SOURCES.EXEC>EXECCS.MAC.8, 22-Jun-82 16:51:12 by TSANG
;EDIT 739 - MODIFY THE BLISS SWITCH TO DDT SWITCH IN DEBUG SWITCH TABLE (DBTAB)
; UPD ID= 23, FARK:<4-1-WORKING-SOURCES.EXEC>EXECCS.MAC.2, 8-Apr-82 10:15:18 by GROUT
;Edit 716 - Rewrite GTLANG, make other requisite changes
; UPD ID= 140, SNARK:<5.EXEC>EXECCS.MAC.18, 7-Feb-82 14:00:09 by CHALL
;TCO 5.1719 ADD NATIVE FORTRAN (NFO) TO LANGUAGES MARCO
;TCO 5.1717 BILDIT- FOR NATIVE, PUT SWITCHES AFTER FILESPECS
; UPD ID= 116, SNARK:<5.EXEC>EXECCS.MAC.15, 28-Dec-81 11:12:13 by CHALL
;TCO 5.1644 - UPDATE COPYRIGHT NOTICE
; UPD ID= 103, SNARK:<5.EXEC>EXECCS.MAC.14, 22-Oct-81 14:39:14 by CHALL
;TCO 5.1582 .SNDCS- ALLOW "." TO BE A LEGAL EXTENSION NAME
; UPD ID= 95, SNARK:<5.EXEC>EXECCS.MAC.13, 21-Oct-81 11:27:34 by GROUT
;TCO 5.1577 Fix TPLUS and TCOMM to skip COMIN CRLF check
; UPD ID= 94, SNARK:<5.EXEC>EXECCS.MAC.12, 21-Oct-81 11:23:37 by GROUT
;TCO 5.1572 Fix INFO DEFAULT COMPILE-SWITCHES typeout
; UPD ID= 91, SNARK:<5.EXEC>EXECCS.MAC.11, 21-Oct-81 11:14:22 by GROUT
;TCO 5.1571 Fix /LANGUAGE-SWITCHES to work with SET DEFAULT COMPILE-SWITCHES
; UPD ID= 90, SNARK:<5.EXEC>EXECCS.MAC.10, 21-Oct-81 11:08:08 by GROUT
;TCO 5.1569 Fix SET DEFAULT COMPILE-SWITCHES
; UPD ID= 89, SNARK:<5.EXEC>EXECCS.MAC.9, 21-Oct-81 10:47:05 by GROUT
;TCO 5.1568 Make global language switches override file types for translator
; UPD ID= 88, SNARK:<5.EXEC>EXECCS.MAC.8, 21-Oct-81 10:43:17 by GROUT
;TCO 5.1567 Make /LANGUAGE-SWITCHES work as last thing on line
; UPD ID= 87, SNARK:<5.EXEC>EXECCS.MAC.7, 10-Oct-81 19:46:53 by CHALL
;TCO 5.1560 ADDED CBL68 (.C68) AND CBL74 (.C74) TO LANGUAGES TABLE
; ALSO, ADDED CBL68 (.68C) TO BE PARALLEL TO THE EXISTING CBL74 (.74C)
; UPD ID= 77, SNARK:<5.EXEC>EXECCS.MAC.5, 2-Oct-81 10:34:35 by CHALL
;TCO 5.1539 P1SRC1- CHANGE "%" TO "?" IN "?SOURCE FILE MISSING"
; ALSO, PASS2- CHANGE "%" TO "?" IN "?OBJECT FILE MISSING"
; UPD ID= 74, SNARK:<5.EXEC>EXECCS.MAC.4, 21-Sep-81 09:10:13 by CHALL
;TCO 5.1520 GTASC- 7-CHAR FILE NAMES WERE ALLOWED (TYPO), BUT NOT NO MO
; UPD ID= 24, SNARK:<5.EXEC>EXECCS.MAC.3, 14-Aug-81 18:33:42 by CHALL
;TCO 5.1454 CHANGE NAMES FROM CSCAN TO EXECCS AND XDEF TO EXECDE
; UPD ID= 1798, SNARK:<5.EXEC>EXECCS.MAC.2, 7-Apr-81 17:14:54 by TILLSON
;tco 5.1278 - Use "COBOL" as debugger name, not "74-COBOL"
;<4.EXEC>EXECCS.MAC.1, 26-Mar-80 18:55:00, Edit by DK32
;Programmable Command Language
; UPD ID= 1388, SNARK:<5.EXEC>EXECCS.MAC.13, 30-Dec-80 14:53:00 by DONAHUE
;tco 5.1221 - Make HANSWI check for S%QUO+S%VAL instead of S%DSP
; UPD ID= 1385, SNARK:<5.EXEC>EXECCS.MAC.12, 24-Dec-80 16:11:36 by OSMAN
;More 5.1220 - Allow compiler to have non-TOPS10 entry vector
; UPD ID= 1381, SNARK:<5.EXEC>EXECCS.MAC.11, 24-Dec-80 14:42:07 by OSMAN
;More 5.1220 - NTVCOM was superfluous
; UPD ID= 1380, SNARK:<5.EXEC>EXECCS.MAC.10, 24-Dec-80 14:38:55 by OSMAN
;tco 5.1220 - Talk to native-mode compilers
; UPD ID= 1238, SNARK:<5.EXEC>EXECCS.MAC.9, 6-Nov-80 15:20:36 by OSMAN
;tco 5.1189 - Use $GET0 instead of $GET2
; UPD ID= 1163, SNARK:<5.EXEC>EXECCS.MAC.8, 14-Oct-80 10:45:09 by DONAHUE
;TCO 5.1172 - MAKE TCR PUT A NULL AT END OF COMMAND STRING
; UPD ID= 985, SNARK:<5.EXEC>EXECCS.MAC.7, 3-Sep-80 14:57:49 by OSMAN
;tco 5.1140 - Make /LANGUAGE-SWITCHES: work!
; UPD ID= 869, SNARK:<5.EXEC>EXECCS.MAC.6, 11-Aug-80 11:21:29 by OSMAN
;tco 5.1129 - Make CFIELD global
; UPD ID= 850, SNARK:<5.EXEC>EXECCS.MAC.5, 7-Aug-80 16:48:30 by OSMAN
;More 5.1122 - Make sure CREF isn't run in "stay" mode
; UPD ID= 822, SNARK:<5.EXEC>EXECCS.MAC.4, 4-Aug-80 09:46:54 by OSMAN
;tco 5.1122 - Add /STAY
; UPD ID= 548, SNARK:<5.EXEC>EXECCS.MAC.3, 21-May-80 17:05:00 by MURPHY
;PREVENT FOLLOWING SEARCH LIST FOR REL FILE IN CERTAIN CASES
; UPD ID= 419, SNARK:<4.1.EXEC>EXECCS.MAC.4, 8-Apr-80 13:44:01 by OSMAN
;tco 4.1.1139 - Make "?Can't find process" a better message
; UPD ID= 395, SNARK:<4.1.EXEC>EXECCS.MAC.3, 1-Apr-80 16:40:43 by TOMCZAK
;TCO#4.1.1133 - Have EXEC look for CBL74, not 74-COBOL
;<4.1.EXEC>EXECCS.MAC.2, 26-Nov-79 09:59:06, EDIT BY OSMAN
;tco 4.2577 - Put in PASCAL and SIMULA support
;<4.EXEC>EXECCS.MAC.201, 19-Oct-79 15:29:02, EDIT BY OSMAN
;MORE 4.2436 - STRIP NULLS FROM INDIRECT FILE CONTENTS
;<4.EXEC>EXECCS.MAC.196, 3-Oct-79 19:59:21, EDIT BY OSMAN
;tco 4.2509 - Don't allow cr in LOAD-class command unless filespec seen
;<4.EXEC>EXECCS.MAC.190, 3-Oct-79 15:23:41, EDIT BY OSMAN
;USE PERMANENT FREE SPACE FOR REMEMBERED STRING
;<4.EXEC>EXECCS.MAC.181, 1-Oct-79 09:35:25, EDIT BY OSMAN
;PUT INDIRECT FILES IN-LINE!
;remove special guide-word scanner (not needed)
;MORE 4.2436 - Make CMPRES remember character from previous indirect level
;More 4.2436 - Make CMPRES ignores all spaces except those sandwiched
;between filespecs
;<4.EXEC>EXECCS.MAC.177, 14-Sep-79 15:51:52, EDIT BY OSMAN
;MORE 4.2436 - Make CMPRES delete spaces after quoted string
;<4.EXEC>EXECCS.MAC.176, 14-Sep-79 11:02:23, EDIT BY OSMAN
;MORE 4.2436 - ignore comma comma at RDCOMA
;<4.EXEC>EXECCS.MAC.175, 14-Sep-79 10:12:35, EDIT BY OSMAN
;MORE 4.2436 - Get rid of RDSKP; Make CMPRES flush spaces following comma
;Don't set F%LAHD after gobbling indirect file
;<4.EXEC>EXECCS.MAC.174, 10-Sep-79 16:13:07, EDIT BY OSMAN
;tco 4.2466 - Do better than "?File not found" when indirect file in
;indirect file is not found
;<4.EXEC>EXECCS.MAC.173, 13-Sep-79 15:21:44, EDIT BY OSMAN
;MORE 4.2436 - Store words for PARSE recursion
;<4.EXEC>EXECCS.MAC.171, 13-Sep-79 6:24:13, EDIT BY OSMAN
;MORE 4.2436 - HANDLE NON-7-BIT indirect files correctly
;<4.EXEC>EXECCS.MAC.170, 7-Sep-79 11:19:36, EDIT BY OSMAN
;DON'T CALL JFNSTK AT TAT, COM2, OR IDEN; IT'S ALREADY CALLED AT CFN2
;<4.EXEC>EXECCS.MAC.169, 11-Sep-79 14:56:13, EDIT BY OSMAN
;more 4.2436 - Leave room for null in indirect buffer
;<4.EXEC>EXECCS.MAC.168, 11-Sep-79 10:28:27, EDIT BY OSMAN
;MORE 4.2436 - CALL RETBUF with correct args
;<4.EXEC>EXECCS.MAC.166, 4-Sep-79 15:41:26, EDIT BY OSMAN
;tco 4.2436 - Allow comments in indirect files
;<EKLUND>EXECCS.MAC.5, 28-Aug-79 13:56:39, EDIT BY EKLUND
;TCO 4.2426 - Load LOWTSA.REL first if SAIL program is loaded
;<4.EXEC>EXECCS.MAC.161, 16-Aug-79 09:39:05, EDIT BY OSMAN
;tco 4.2403 - Give better error on SET NO DEFAULT COMPILE
;<4.EXEC>EXECCS.MAC.159, 27-Jul-79 16:33:56, EDIT BY EKLUND
;tco 4.2354 - Prohibit file specific switches after comma in commands
;<4.EXEC>EXECCS.MAC.158, 26-Jul-79 17:08:29, EDIT BY OSMAN
;tco 4.2351 - Prevent ?Invalid CMBFP pointer adnauseum
;<4.EXEC>EXECCS.MAC.156, 18-Jul-79 10:16:54, EDIT BY OSMAN
;tco 4.2334 - Don't recompile if .REL is current and trailing spaces
;<4.EXEC>EXECCS.MAC.151, 17-Jul-79 09:48:18, EDIT BY OSMAN
;tco 4.2331 - Allow comments in COMPIL-class commands.
;<4.EXEC>EXECCS.MAC.150, 21-Jun-79 11:32:23, EDIT BY OSMAN
;tco 4.2303 - Look for .REL in both connected and source directory
;<4.EXEC>EXECCS.MAC.149, 21-Jun-79 11:10:45, EDIT BY OSMAN
;tco 4.2302 - fix LOAD A:FOO1+A:FOO2 when .REL in A:
;DON'T CLEAR PPN AT MAKOBJ IN CASE REL FILE IS IN SOURCE AREA
;<HELLIWELL.EXEC.4>EXECCS.MAC.3, 6-Jun-79 11:50:35, EDIT BY HELLIWELL
;ADD TEMP VARS SRCPTR AND DSKPTR FOR USE IN GTLANG
;<HELLIWELL.EXEC.4>EXECCS.MAC.2, 5-Jun-79 12:28:46, EDIT BY HELLIWELL
;FIX ERRORS IN WHERE TO LOOK FOR .REL FILES AND WHEN
;CLEAR TEMP CORE FILE AREA BEFORE ENTERING FIRST FILE
;<4.EXEC>EXECCS.MAC.147, 2-May-79 10:22:31, EDIT BY OSMAN
;SET UP JFN IN A FOR $GET2
;<4.EXEC>EXECCS.MAC.146, 1-May-79 11:22:05, EDIT BY OSMAN
;GTJFN => CALL GTJFS (SO ^C CAN'T LEAVE JFN AROUND)
;<4.EXEC>EXECCS.MAC.142, 20-Apr-79 15:36:17, EDIT BY OSMAN
;tco 4.2238 - Fix "?SCNCDR COMA REQUIRED IN DIRECTORY 0" (tmpcor blocks too long)
;<4.EXEC>EXECCS.MAC.138, 30-Mar-79 10:57:11, EDIT BY OSMAN
;COPY COMMAND SO THAT WE DON'T CLOBBER ORIGINAL BUFFER (SO CTRL/H DOESN'T GET CONFUSED)
;<4.EXEC>EXECCS.MAC.137, 12-Mar-79 17:53:14, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.EXEC>EXECCS.MAC.132, 4-Jan-79 19:46:40, EDIT BY OSMAN
;tco 4.2149 - make link switches (%) work better
;<4.EXEC>EXECCS.MAC.122, 3-Jan-79 15:41:08, EDIT BY OSMAN
;GET RID OF STRP, STRC
;<4.EXEC>EXECCS.MAC.120, 21-Dec-78 14:09:56, EDIT BY OSMAN
;tco 4.2130 - Don't say "?Not confirmed" on "LOAD @FOO"
;<4.EXEC>EXECCS.MAC.119, 20-Dec-78 11:01:58, EDIT BY OSMAN
;tco 4.2125 - fix "comp foo + zot"
;<4.EXEC>EXECCS.MAC.116, 8-Oct-78 17:06:41, EDIT BY OSMAN
;REMOVE REFS TO CERET BY REMOVING GTASCE
;<4.EXEC>EXECCS.MAC.112, 14-Sep-78 14:11:33, EDIT BY OSMAN
;ONLY SEARCH XDEF, TTITLE DOES REST
;TCO 4.1978 - FIX "COMP /L" AND "COMP A=B" TO MAKE THEM NOT LOOP
;AND THEN TYPE "?TOO MANY JFNS IN COMMAND".
;CHANGE COLON PARSING TO NOT BREAK ON COLON, EVEN IF COLON PART OF SWITCH
;<4.EXEC>EXECCS.MAC.79, 7-Aug-78 14:52:52, EDIT BY OSMAN
;<4.EXEC>EXECCS.MAC.78, 7-Aug-78 11:32:02, EDIT BY OSMAN
;PUT IN /LANGUAGE-SWITCHES:
;<4.EXEC>EXECCS.MAC.77, 7-Aug-78 10:36:59, EDIT BY OSMAN
;FIX G COMMAND (FROM "EDIT" PROGRAM)
;<EKLUND>EXECCS.MAC.14, 27-Jul-78 15:17:56, Edit by EKLUND
; TCO 1959
;MAKE /REL SWITCH WORK (AVOID %OBJECT FILE MISSING MESSAGE)
;<EKLUND>EXECCS.MAC.13, 27-Jul-78 15:16:24, Edit by EKLUND
; TCO 1958
;DO NOT PASS /LOCALS TO LINK UNLESS EXPLICITLY REQUESTED BY USER
;<EKLUND>EXECCS.MAC.12, 27-Jul-78 15:11:59, Edit by EKLUND
; TCO 1957
;MAKE THE /FOR AND /DDT SWITCHES SELECT THE RIGHT DEBUGGER (USED WITH @DEBUG)
;<4.EXEC>EXECCS.MAC.75, 27-Jul-78 16:38:20, EDIT BY OSMAN
;fix swmov
;<4.EXEC>EXECCS.MAC.74, 27-Jul-78 15:01:10, Edit by DBELL
;FIX TCO 1955
;<4.MONITOR>EXECCS.MAC.1, 27-Jul-78 13:35:42, EDIT BY OSMAN
;FIX A BUG
;<4.EXEC>EXECCS.MAC.72, 26-Jul-78 17:31:06, Edit by DBELL
;TCO 1955. CLEAR PRARG AREA SO EXECUTE COMMANDS DON'T MAKE LINK FAIL
;<4.EXEC>EXECCS.MAC.71, 25-Jul-78 10:15:00, EDIT BY OSMAN
;UNSTACK LNGJFN WHEN DONE WITH IT
;<4.EXEC>EXECCS.MAC.70, 24-Jul-78 11:06:59, EDIT BY OSMAN
;<4.EXEC>EXECCS.MAC.69, 21-Jul-78 08:26:11, EDIT BY OSMAN
;CHANGE BMSK TO NOT BREAK ON CR (BUT STILL BREAK ON LF)
;<4.EXEC>EXECCS.MAC.67, 14-Jul-78 13:11:15, EDIT BY OSMAN
;CHANGE LINK STRING FROM "/DEBUG:FORTRAN" TO "/DEBUG:(DDT,FORTRAN)"
;<4.EXEC>EXECCS.MAC.66, 13-Jul-78 15:41:15, EDIT BY OSMAN
;MAKE LHED, CRFHED, SAVPNT LOCAL
;<4.EXEC>EXECCS.MAC.65, 13-Jul-78 15:17:17, EDIT BY OSMAN
;MAKE CWBUF LOCAL
;<4.EXEC>EXECCS.MAC.61, 10-Jul-78 20:47:56, EDIT BY OSMAN
;MAKE TEXTIB BE LOCAL (AND RENAME IT TO CSTXTB)
;<4.EXEC>EXECCS.MAC.58, 27-Jun-78 15:13:27, EDIT BY OSMAN
;MAKE LOCAL VARIABLES BE DECLARED IN TRVAR (INSTEAD OF EXECPR AND EXECGL)
;<4.EXEC>EXECCS.MAC.57, 27-Jun-78 10:55:33, EDIT BY OSMAN
;STACK LNGJFN, SO IT NEEDN'T BE TREATED SPECIALLY IN RLJFNS
;<4.EXEC>EXECCS.MAC.56, 23-Jun-78 18:32:12, EDIT BY OSMAN
;REMOVE UNREFERENCED SYMBOLS: C.ILEG-IND-LPRN-PERC-PLUS-RPRN-SLSH,
;CMP3, D%IGN, P1LCOB, P1ST, PARD1, PPN1, PSWP, RDCMA4, RDFLD1, RDFLD2, S%PTYP,
;SPACE, SWSAV, SWSAV1, TCTAB
;<4.EXEC>EXECCS.MAC.52, 15-Jun-78 14:14:09, EDIT BY OSMAN
;ADD SET NO DEFAULT COMPILE-SWITCHES (FILE TYPE)
;ADD /68-COBOL /74-COBOL
;<4.EXEC>EXECCS.MAC.47, 14-Jun-78 14:45:05, EDIT BY OSMAN
;ADD "INFORMATION (ABOUT) DEFAULTS (FOR) COMPILE-SWITCHES (FILE-TYPE)"
;SET NO DEFAULTS (FOR) COMPILE-SWITCHES (FILE-TYPE)"
;<4.EXEC>EXECCS.MAC.37, 13-Jun-78 14:22:32, EDIT BY OSMAN
;CHANGE COMPILER-SWITCHES TO COMPILE-SWITCHES
;<4.EXEC>EXECCS.MAC.22, 11-Jun-78 21:15:47, EDIT BY OSMAN
;FREE UP USAGE OF P6, SO THAT TRVAR CAN BE USED FOR SRCEXT (AND ANY FUTURE NEEDS!)
;<4.EXEC>EXECCS.MAC.7, 8-Jun-78 16:34:16, EDIT BY OSMAN
;CAUSE DEFAULT SWITCHES TO COME AFTER EACH PROGRAM SPEC
;<3A.EXEC>EXECCS.MAC.2, 8-Jun-78 10:46:50, EDIT BY OSMAN
;ALLOW CRLF AS ALTERNATIVE TO LF AT END OF COMMAND LINE
;<4.EXEC>EXECCS.MAC.4, 3-May-78 11:01:15, Edit by DBELL
;MAKE /MAP AND /SAVE PRECEED /DEBUG IN LINK COMMAND
;<4.EXEC>EXECCS.MAC.3, 2-Mar-78 09:07:06, Edit by PORCHER
;<4.EXEC>EXECCS.MAC.2, 2-Mar-78 08:41:04, Edit by PORCHER
;Make CCL start use SFRKV rather than touching .JBSA
;<4.EXEC>EXECCS.MAC.1, 31-Jan-78 17:03:20, Edit by PORCHER
;Add stuff for execute-only
SUBTTL T.HESS/TAH 1-SEP-75
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH EXECDE
TTITLE EXECCS - COMMAND SCANNER FOR TOPS-20
SALL
ESC==ALTM ;BETTER SYMBOL
QUOTE=="""" ;QUOTING CHARACTER
B.BP==70000,,0 ;CONSTANT TO BACKUP BYTE POINTER
;INTERNAL AC USAGE
;P1 - FLAGS
;P2 - DESC BLOCK POINTER
;P3 - COUNT OF CHARS IN STRING
;P4 - POINTER TO STRING (PARSE)
; LANGUAGE TYPE (LSCAN)
;P5 - FLAGS DURING LSCAN
;P6 - INTENTIONALLY NOT TOUCHED, SINCE TRVAR USES IT
;CHARACTER TYPE DEFINITIONS
C.SPAC==1 ;SPACE
C.COMA==6 ;COMMA
C.EOL==7 ;END-OF-LINE
C.COLN==12 ;COLON (SWITCH DELIM)
;FLAGS IN LH OF P1 (PARSE AND GLOBAL)
F%LAHD==1B0 ;LOOK AHEAD FLAG
F%SLSH==1B1 ;SLASH SEEN
F%FILE==1B2 ;POSSIBLE FILESPEC
F%OBJ==1B3 ;OBJECT SPEC IS NEXT
F%DDT==1B4 ;LOAD DDT
F%TOPN==1B5 ;TEMP FILE OPEN
F%GO==1B6 ;START EXECUTION
F%SDDT==1B7 ;GO TO DDT
F%NLOD==1B8 ;DON'T LOAD
F%NCMA==1B9 ;NEED COMMA FLAG
F%CMOK==1B9 ;(PARSE) COMMA OK FOR NULL SPEC
F%SPEC==1B10 ;FIRST FILESPEC SEEN (SWITCH HACK)
F%SUPP==1B11 ;LOADING SUPPRESSED
F%DSYM==1B12 ;DOING LOCAL SYMBOLS
F%AGN==1B13 ;DO OLD COMMAND AGAIN
;**;[716] Replace 1 line with 4 here (No label) JRG 29-MAR-82
F%NLOB==1B14 ;[716] GTLANG MAY NOT LOOK FOR OBJECT FILE
F%XPXT==1B15 ;[716] GTLANG HAS SEEN AN EXPLICIT EXTENSION TYPED
F%FWKE==1B16 ;[716] GTLANG HAS FOUND A FILE WITH A KNOWN EXTENSION
F%STOJ==1B17 ;[716] GTLANG HAS A STACKED OUTPUT JFN
;FLAGS IN RH OF P1 (LOCAL FOR FILESPEC BLOCKS)
F%LIST==1B18 ;MAKE LISTING
F%CREF==1B19 ;CREF
F%CMPL==1B20 ;FORCE COMPILATION
F%NBIN==1B21 ;NOBINARY FOR THIS FILE
F%OPT==1B22 ;PRODUCE OPTIMIZED OUTPUT
F%DEB==1B23 ;DEBUG CODE FOR THIS FILE
F%LIB==1B24 ;LIBRARY SEARCH OF THIS FILE
;**;[930]Change one line at F%LSYM== +0L RWW 5-Nov-82
F%LSYM==1B25 ;Don't load local symbols
F%ABT==1B26 ;ABORT-ON-ERROR
F%MACH==1B27 ;MACHINE-CODE
F%FLAG==1B28 ;FLAG-NON-STANDARD
;**;[947] Modify one line FEB-8-83 YKT
F%NWAR==1B29 ;[947] NO WARNINGS
F%CHK==1B30 ;CHECK
;F%ERR==1B31 ;ERROR LIMIT
F%LANG==1B31 ;GLOBAL LANGUAGE SWITCH SEEN
;BITS 32-35 ARE LANG TYPE
F.LMSK==17B35 ;MASK FOR LANG TYPE
F.ALL==776000 ;MASK FOR ALL FILE RELEVENT SWS
;OFFSETS IN FILE DESCRIPTOR BLOCK
LNK==0 ;LINK TO NEXT BLOCK
SRC==0 ;POINTER TO SOURCE DESC OR 0
NAM==1 ;BYTE POINTER TO FILESPEC
FLG==2 ;FLAG WORD
;**;[716] Replace 5 lines with 6 here (No label) JRG 29-MAR-82
SVER==3 ;[716] SOURCE VERSION D/T
OVER==4 ;[716] OBJECT VERSION D/T
HDD==5 ;[716] HACKED DEVICE DESIGNATOR (DD OR PROG #,,RH OF DISK DD)
HDDO==6 ;[716] HACKED DEVICE DESIGNATOR FOR OLD OBJECT FILE
HDDNO==7 ;[716] HACKED DEVICE DESIGNATOR FOR NEW OBJECT FILE
SWP==8 ;[716] POINTER TO LANGUAGE SWITCHES
B.SIZE==9 ;SIZE OF BLOCK
L.SIZE==3 ;SIZE OF LINK-20 SWITCH BLOCK
CMPWDS==FRESIZ/3 ;MAX WORDS TO ALLOW IN COMMAND. BE CAREFUL RAISING
;THIS, SINCE A "LOAD" AFTER "LOAD FOO" CAUSES TWO
;PASSES, AND FREE SPACE IS FRAGMENTED DURING THE SECOND
;PASS
CMPMSZ==CMPWDS*5 ;MAXIMUM CHARACTERS IN COMMAND INCLUDING ALL INDIRECT FILES
;FLAGS IN LH OF FILE DESC BLOCK FLAG WORD
D%LINK==1B1 ;LINK-20 SWITCH SPEC
D%EXTN==1B2 ;EXPLICIT EXTENSION TYPED
D%FNF==1B3 ;FILE DOES NOT EXIST
;**;[716] Delete 1 line here (No label) JRG 29-MAR-82
;SWITCH TABLE DEFINITIONS (BITS IN LHS OF VALUE)
S%DSP==1B0 ;DISPATCH ADDRS
S%TOFF==1B1 ;TURN OFF BITS
S%FRH==1B2 ;FLAGS IN RHS OF P1
S%FLH==1B3 ;FLAGS IN LHS OF P1
S%LTYP==1B4 ;LANGUAGE TYPE
S%LINK==1B6 ;LINK-20 SWITCH TEXT
S%VAL==1B7 ;VALUE ALLOWED
S%QUO==1B8 ;SWITCH TAKES QUOTED STRING AFTER IT
;ARGUMENT BLOCK DEFINITIONS FOR SENDING DATA TO COMPATABILITY PACKAGE
TMPCOR==BUF0 ;TMPCOR AREA BEGINS AT BUF0
NFILES==TMPCOR ;WORD 0, HOLDS NUMBER OF FILES BEING SENT
ADDTAB==TMPCOR+1 ;WORD 1, BEGINNING OF TABLE OF FILE S/A'S
ADDTLN==%LT+1 ;ONE FILE FOR EACH SOURCE TRANSLATOR + ONE FOR LINK
TMPBUF==ADDTAB+ADDTLN ;ADDRESSES FOLLOWED BY FILES THEMSELVES
;LANGUAGE PROCESSOR DEFINITIONS
;**;[739] change next line from "LANGUAGE NAME" TO "DEBUG SWITCH NAME"
;**;[739] YKT 22-JUN-82
;ARGS: A - DEBUG SWITCH NAME ;[739] USED IN DBTAB:
; B - EXTENSION
; C - PROCESSOR NAME
; D - TEMP FILE NAME
; E - TEMP FILE NAME FOR NATIVE COMPILER
DEFINE LANGUAGE <
L (BINARY,REL,LINK,LNK)
L (FORTRAN,FOR,FORTRA,FOR,NFO)
L (SAIL,SAI,SAIL,SAI)
L (FAIL,FAI,FAIL,FAI)
L (SNOBOL,SNO,SNOBOL,SNO)
L (PASCAL,PAS,PASCAL,PAS,NPO)
L (SIMULA,SIM,SIMULA,SIM)
;**;[739] change debug switch name in next line YKT 22-JUN-82
L (DDT,BLI,BLIS10,BLI) ;[739] DEBUG SW NAME USED IN DBTAB:
L (ALGOL,ALG,ALGOL,ALG)
L (COBOL,68C,CBL68,COB,NCO)
L (COBOL,74C,CBL74,COB,NCO)
L (COBOL,C68,CBL68,COB,NCO)
L (COBOL,C74,CBL74,COB,NCO)
L (COBOL,CBL,COBOL,COB,NCO)
L (MACRO,MAC,MACRO,MAC)
>
;CSCAN - ENTRY FROM COMMAND DECODER
;PRIMARY COMMAND ALREADY IN CBUF
;READ REMAINDER OF COMMAND
.COMPI::CALL CNSE ;NOISE STUFF
TXO P1,F%NLOD ;SET NO LOAD
JRST CSCAN ;CALL SCANNER
.DEBUG::CALL CNSE ;GUIDE WORD
TXOA P1,F%SDDT ;SET DEBUG
.EXECU::CALL CNSE ;NOISE STUFF
TXOA P1,F%GO ;GO FLAG
.LOAD:: CALL CNSE ;NOISE HACK
JRST CSCAN
CNSE: MOVEI B,[FLDDB. .CMNOI,,<-1,,[ASCIZ /FROM/]>]
CALL CFIELD ;TYPE NOISE BUT DON'T ALLOW "@"!
MOVEI P1,0 ;CLEAR FLAGS
RET
;ENTRY FROM CREF COMMAND
.CREF:: LINEX <Data line for CREF program>
CMERRX <Invalid data line for CREF program>
CALL CRSCAN ;MAKE RESCAN BUFFER
HRROI B,[GETSAVE (<SYS:CREF.>)]
SETZM STAYF ;WAIT FOR CREF TO FINISH
JRST RUNGO ;INVOKE CREF FOR NOW
CMAGN:: MOVX P1,F%AGN ;SAY WE'RE DOING OLD COMMAND AGAIN
JRST CSCAN ;GO ALLOCATE LOCAL VARIABLES
CMAGN1: CALL CSCANR ;RESET PARSER
CALL TIRST ;RESET TEXTI/GTJFN BLOCKS
MOVE P1,CSVCC ;GET COMMAND INFO
JRST CSCAN2 ;PARSE OLD ARGS IF ANY
;ROUTINE TO INIT SCANNER POINTERS, VALUES, ETC...
CSCANR: GJINF ;GET JOB RELATED INFO
MOVEM C,CSJOB ;JOB #
MOVE A,B ;CONNECTED DIRECTORY NUMBER
STPPN ;CONVERT TO PPN
;**;[716] Replace 1 line with 9 at CSCANR:+4L JRG 29-MAR-82
HRLZM B,CHDD ;[716] SAVE RH OF PPN INTO LH OF CHDD (LH ALWAYS 4)
MOVE B,A ;[716] PUT DIRECTORY NUMBER BACK INTO B
HRROI A,FSPEC ;[716] WRITE STRING TO FSPEC
DIRST ;[716]
ERCAL CJERRE ;[716] IN CASE ERROR
HRROI A,FSPEC ;[716] TRANSLATE STRING TO DEVICE DESIGNATOR
STDEV ;[716]
ERCAL CJERRE ;[716] IN CASE ERROR
HRRM B,CHDD ;[716] SAVE RH OF DD INTO RH OF CHDD
SETZM LHED ;INITIALIZE VARIABLES
SETZM CRFHED
SETZM SAVPNT
SETZM LSWPTR ;NO GLOBAL /LANG: YET
SETZM MAPPNT ;NO /MAP YET
MOVEI Q1,LT.FOR ;INITIAL LANGUAGE TYPE
DPB Q1,[POINTR (P1,F.LMSK)]
MOVEI P2,LHED ;BEGINNING OF FILE LIST
MOVEI A,STRSIZ*5
CALL GETBUF ;ALLOCATE FREE SPACE FOR TEXTI DESTINATION BUFFER
HRLI A,440700 ;MAKE A BYTE POINTER
MOVEM A,TXTPR ;REMEMBER POINTER
RET ;RETURN
NATWDS==1000 ;NUMBER OF WORDS FOR NATIVE COMMAND STRING
;**;[716] Change 1 line at CSCAN:+0L JRG 29-MAR-82
;**;[954] Change 1 line at CSCAN:+0L YKT 28-MAR-83
;**;[958] Change 1 line at CSCAN:+0L YKT 03-MAY-83
;**;[974] Change 1 line at CSCAN:+0L YKT 15-AUG-83
CSCAN: TRVAR <NEWPT0,NEWJFN,OLDJFN,NATIVF,SAVQS,CSPTR,CDPTR,CMPPT0,BAKPTR,TXTPR,NFIAR,NFILS,<SWIBUF,SWISIZ>,BMSKA,LSWPTR,LHED,CRFHED,SAVPNT,<FSPEC,FILWDS>,<CWBUF,LCWBUF>,<CSTXTB,10>,SRCSAV,CSJOB,CHDD,SAVBRK,EXTP,COMPBP,LPROC,DEBAID,TMPJFN,INDJFN,INDSIZ,CJEPTR,CMPBUF,ADDSIZ,CMPSIZ,LNGJFN,GJNSF,OUTJFN,LNGTYP,RELDAT,NXPROC,MAPPNT,BSTDAT,SAILF,FSPEXT,QQQFLG,DEFSW,RELOSW,BINYSW,WARNSW,NOCRSW,NODBSW,NOFGSW,NOLISW,NOMASW,NOOPSW> ;[974][716][954][958]
;**;[974] Add 8 lines at CSCAN:+0L YKT 15-AUG-83
SETZM BINYSW ;[974]
SETZM WARNSW ;[974]
SETZM NOCRSW ;[974]
SETZM NODBSW ;[974]
SETZM NOFGSW ;[974]
SETZM NOLISW ;[974]
SETZM NOMASW ;[974]
SETZM NOOPSW ;[974]
SETZM STAYF ;DON'T STAY AT COMMAND LEVEL UNLESS /STAY
MOVE A,CMPTR ;GET POINTER TO FOLLOWING "COMPILE (FROM)"
MOVEM A,.RDIOJ+CSTXTB ;POINT TEXTI BLOCK AT ORIGINAL COMMAND STRING
MOVEM A,COMPBP ;REMEMBER POINTER FOR CREATING DEFAULT STRING LATER
TXNE P1,F%AGN ;DOING OLD COMMAND AGAIN?
JRST CMAGN1 ;YES, GO DO IT
CALL TI ;READ A LINE
CALL CSCANR ;SCAN RESET
MOVEM P1,CSVCC ;SAVE COMMAND INFO FOR EDIT
CSCAN1: MOVEI A,7 ;ALLOCATE ROOM IN TEXTI BLOCK
MOVEM A,CSTXTB
SETZM .RDRTY+CSTXTB ;SAY NO ^R POINTER
SETZM .RDBFP+CSTXTB ;NO SPECIAL BACKUP POINTER
MOVE A,[TMPCOR,,TMPCOR+1] ;GET READY
SETZM TMPCOR ;TO CLEAR THE TEMPORARY FILE AREA
BLT A,TMPCOR+777 ;DO IT
MOVEI A,BMSK ;SET UP STANDARD BREAK MASK
MOVEM A,BMSKA
SETZM LNGJFN ;SAY NO LANGUAGE JFN YET
SETZM SAILF ;ASSUME NOT SAIL
SETZM INDJFN ;NO INDIRECT YET
SETZM SRCSAV ;NO PARTIAL SOURCE LIST
SETZM DEBAID ;NO DEBUGGING AID
SETOM LPROC ;UNKNOWN LANG PROCESSOR
;**;[958] Add two lines at CSCAN1+16 YKT 03-MAY-83
SETZM DEFSW ;[958] SET DEFAULT
SETZM RELOSW ;[958] RELOCATABLE SW
MOVEI A,NATWDS ;NUMBER OF WORDS FOR NATIVE STRING
CALL GETBUF ;GET BUFFER FOR NATIVE COMMAND STRING
HRLI A,440700 ;MAKE BYTE POINTER TO AREA
MOVEM A,NEWPT0 ;REMEMBER POINTER TO AREA FOR NATIVE STRING
CALL CMPRES ;GET RID OF UNEEDED SPACES
CALL PARSE ;CALL PARSER
CALL RLJFNS ;RELEASE JFNS
TXNN P1,F%SPEC ;SEEN FILE SPEC?
CSCAN2: JRST [SKIPN A,CSVC ;NO, USE SAVED COPY
ERROR <No saved arguments>
MOVEM A,.RDIOJ+CSTXTB ;REMEMBER POINTER TO COPY
MOVEM A,COMPBP ;REMEMBER THAT WE'RE USING SAVED ONE
JRST CSCAN1] ;AND REPARSE
MOVE A,COMPBP ;BUFFER THE NEW ONE
CAMN A,CSVC ;IF STRING ALREADY SAVED,
JRST CSCANO ;DON'T DO IT AGAIN
CALL XBUFFS ;IN PERMANENT SPACE
EXCH A,CSVC ;REMEMBER POINTER TO SAVED STRING
CAIE A,0 ;MAKE SURE THERE WAS A PREVIOUS STRING
CALL STREM ;RELEASE SPACE IT TOOK UP
MOVEI A,.CHLFD ;PCL Fix buffer
DPB A,CMPTR ;PCL So .CMINI works again
CSCANO: HLRO A,PRTAB+LT.REL ;GET NAME OF LINK-20
TXNE P1,F%NLOD ;ARE WE GOING TO LOAD?
MOVEI A,0 ;NO - THEN NO FILESPEC
MOVEM A,NXPROC ;SAVE AS NEXT PROCESSOR
;;;; FALL INTO NEXT PHASE
;START SCAN TO LOOK FOR THINGS TO COMPILE
MOVEI P4,%LT ;GET HIGHEST LANG TYPE
P1LUP: MOVE A,NEWPT0 ;GET POINTER TO AREA FOR CREATING NATIVE STRING
MOVEM A,NEWJFN ;INITIALIZE POINTER TO END OF NATIVE STRING
CALL LSCAN ;SCAN LIST
JRST PASS1 ;CO-ROUTINE ADDRS
TXNN P1,F%TOPN ;FILE OPEN?
JRST P1LPA ;NO - SKIP CLOSE STUFF
SETZM NATIVF ;SAY WE'RE DOING OLD-STYLE LINE
MOVE A,OLDJFN ;GET JFN
CALL PUTLNK ;GO PUT LINK TO NEXT PROCESSOR IN TEXT
CALL CLSTMP ;CLOSE TMP FILE FOR OLD-STYLE LINE
P1LPA: MOVE A,NEWJFN ;GET POINTER TO NATIVE STRING
CAMN A,NEWPT0 ;IS THERE ANY NATIVE STRING?
JRST P1LPB ;NO
SETOM NATIVF ;YES, SAY WE'RE DOING NATIVE-STYLE LINE
CALL PUTLNK ;PUT IN LINK INFORMATION FOR NATIVE LINE
CALL OPNTMP ;CREATE TMP FILE FOR NATIVE COMMAND STRING
MOVE B,NEWPT0 ;GET POINTER TO BEGINNING OF NATIVE STRING
CALL TSOUT0 ;WRITE COMMAND STRING INTO TEMP FILE
CALL CLSTMP ;CLOSE TEMP FILE FOR NEW STYLE COMMAND STRING
P1LPB: MOVE A,NEWJFN
HLRO B,PRTAB(P4) ;LINK TO OURSELVES
TXZN P1,F%TOPN
CAME A,NEWPT0
MOVEM B,NXPROC ;SAVE NEXT PROCESSOR ONLY IF THIS COMPILER WILL BE RUN
SOS P4 ;DECREMENT LANG
CAIE P4,LT.REL ;DONE IF LANG TYPE = RELOC
JRST P1LUP ;CONTINUE
JRST P2ST ;START PASS2
PUTLNK: SKIPN B,NXPROC ;WHERE TO GO WHEN DONE
JRST P1LPN ;NONE
SKIPE NATIVF ;NATIVE STYLE LINE?
JRST [ HRROI B,[ASCIZ "/RUN:"]
CALL TSOUT0 ;YES, PUT /RUN:PROG/OFFSET:1
MOVE B,NXPROC
CALL TSOUT0 ;PUT PROGRAM NAME
HRROI B,[ASCIZ "/OFFSET:1"]
CALL TSOUT0
JRST P1LPC1] ;JOIN COMMON CODE
CAIN P4,LT.FOR ;FORTRAN?
JRST P1LFOR ;SPECIAL FORTRAN HACK
CAIE P4,LT.C68 ;68 COBOL,
CAIN P4,LT.C74 ; OR 74 COBOL?
JRST P1LBLI ;YES
CAIE P4,LT.CBL ;COBOL SPECIAL HACK
CAIN P4,LT.BLI ;BLISS?
JRST P1LBLI ;SPECIAL BLISS HACK
;**;[909] Insert two lines YKT 21-SEP-82
CAIN P4,LT.PAS ;[909] SPECIAL PASCAL HACK
JRST P1LFOR ;[909] YES
CALL TSOUT0 ;DUMP FILESPEC
P1LPC: MOVEI B,"!"
CALL TBOUT
P1LPC1: HRROI B,[BYTE (7)15,12]
CALLRET TSOUT0 ;TERMINATE
;**;[716] Add 2 lines at P1LPN:+0L JRG 29-MAR-82
P1LPN: MOVEI B,.CHNUL ;[716] ASSUME LINK TO PROCESSOR IS END OF STRING
IDPB B,A ;[716] GUARANTEE NULL AT END OF STRING
RET
;SPECIAL LANGUAGE HACKS
P1LFOR: HRROI B,[ASCIZ "/RUN:"] ;FORTRAN USES SCAN
CALL TSOUT0 ;PUT IN FILE
MOVE B,NXPROC ;GET NEXT PROCESSOR NAME
CALL TSOUT0 ;DUMP IT
CALL EOLOUT ;TERMINATE
JRST P1LPN ;JOIN COMMON CODE
P1LBLI: MOVE Q1,NXPROC ;POINT TO STRING
HRLI Q1,(<POINT 7,,>)
CALL PUTDF0 ;OUTPUT DEVICE AND FILENAME
NOP ;IGNORE EXTENSION
JRST P1LPC ;CONTINUE
P2ST: SETZM NATIVF ;LINK ISN'T NATIVE
TXNE P1,F%NLOD ;WANT TO LOAD?
JRST P2XIT ;NO - EXIT THIS SECTION
TXNE P1,F%SUPP ;LOSAGE?
ERROR <Loading suppressed>
MOVEI P4,LT.REL ;USE RELOC TYPE
CALL OPNTMP ;OPEN TMP FILE
MOVEM A,TMPJFN ;SAVE JFN
TXZ P1,F%NCMA ;NO COMMA NEEDED YET
SKIPN MAPPNT ;SEE IF WE NEED /MAP
SKIPE SAVPNT ; OR /SAVE SWITCH PROCESSING
CALL MAPSAV ;YES - OUTPUT MAP/SAVE INFO
SKIPE SAILF ;IF SAIL INVOLVED
CALL [ HRROI B,[ASCIZ /SYS:LOWTSA/]
CALL TSOUT0 ;PUT OUT REQUEST FOR LOWTSA
CALLRET EOLOUT]
TXNE P1,F%SDDT ;WANT TO DEBUG?
CALL SETDEB ;YES - SET DEBUGGER
CALL LSCAN ;LOOP THROUGH LIST
JRST PASS2 ;INSERT SPEC IN FILE
HRROI B,[ASCIZ "/EXE"] ;ASSUME EXECUTE
TXNE P1,F%GO ;IS IT?
CALL TSOUT0 ;YES - DUMP SWITCH
HRROI B,[ASCIZ "/GO"] ;NO - JUST LOAD
CALL TSOUT0 ;DUMP SWITCH
CALL EOLOUT ;AND EOL
CALL CLSTMP ;CLOSE TEMPORARY FILE
TXNE P1,F%SUPP ;AOK?
ERROR <Loading suppressed>
P2XIT: CALL FINCRF ;FINISH UP CREF FILE
SKIPE B,NXPROC ;SEE IF SOMEWHERE TO GO
JRST RUNGO ;YES, GO START COMPILER OR LINK
CALL UNMAP ;UNMAP FREE SPACE USED
CALLRET RLJFNS ;RELEASE JFNS & RETURN IF DONE
;PERFORM RUN AND CCL START ON THE PROCESS
RUNGO: STKVAR <BPTR,CCLJFN,ENT0>
MOVEM B,BPTR ;REMEMBER POINTER TO STRING
CALL TRYGTJ ;TRY TO GET JFN
JRST [ MOVE A,BPTR ;FAILED, GET POINTER TO STRING
ERROR <Can't find %1m - %?>]
MOVEM A,CCLJFN ;REMEMBER JFN OF PROGRAM
CALL ERESET ;RESET
MOVE A,CCLJFN ;SAY WHICH PROGRAM TO LOAD
CALL $GET0 ;DO GET ETC...
CALL DPRARG ;SEND TMP FILES
CALL UNMAP ;UNMAP FREE SPACE USED
CALL SETGO ;SET UP FOR PROGRAM RUNNING
MOVX B,<XWD 1,0> ;INCREMENT 1 INTO VECTOR LOCATION 0
SFRKV ; IS CCL START ADDRESS, START PROCESS
ERJMP RUNGO1 ;FAILED-- TRY TO DO OLD STYLE
JRST WAITF ;WAIT FOR PROCESS TO TERMINATE
;**** Old style CCL start ***** Remove this code sometime ****
;(such as when SFRKV allows XWD 1,0 in AC2 regardless of whether program
;is TOPS10-style)
;
;The following code handles both the case where the "entry vector address" as
;returned by GEVEC is the location of the first instruction of the program,
;and the case where the address is actually that containing a JRST to the
;first instruction.
RUNGO1: CALL GETENT ;GET ENTRY VECTOR
MOVE A,C ;NO, GET ADDRESS OF ENTRY VECTOR
MOVEM A,ENT0 ;REMEMER WHERE ENTRY VECTOR IS
CALL LOADF ;READ WHAT MIGHT BE FIRST INSTRUCTION
CALL CJERRE ;IF CAN'T, SAY WHY AND DIE
HLRZ B,A ;GET LEFT HALF OF WHAT MIGHT BE FIRST REAL INSTRUCTION
CAIE B,(JRST) ;IS IT REALLY FIRST INSTRUCTION?
HRRZ A,ENT0 ;NO, FIRST INSTRUCTION IS THE ENTRY VECTOR!
MOVEI B,1(A) ;INCREMENT TO CREATE CCL ENTRY POINT
CALLRET GOTO2 ;GO START COMPILER
;ROUTINE TO DUMP /MAP AND/OR /SAVE INFO AND SWITCHES
MAPSAV: SKIPN B,MAPPNT ;NEED MAP?
JRST MAPSV1 ;NO - MUST BE SAVE
TLNE B,-1 ;CHECK FOR ARG
CALL TSOUT0 ;OUTPUT ARG
HRROI B,[ASCIZ "/MAP"]
CALL TSOUT0 ;DUMP SWITCH NAME
SKIPN SAVPNT ;/SAVE ALSO?
JRST MAPSVX ;NO - JUST EXIT
CALL CMOUT ;YES - NEED COMMA
MAPSV1: MOVE B,SAVPNT ;NO - MUST BE SAVE FILE
TLNE B,-1 ;NO ARG IF LHS := 0
CALL TSOUT0 ;DUMP IF NECESSARY
HRROI B,[ASCIZ "/SAVE"]
CALL TSOUT0 ;DUMP SWITCH NAME
MAPSVX: MOVEI B,"," ;TERMINATE WITH A COMMA
CALLRET TBOUT ;...
;ROUTINE TO SETUP DEBUG AID IF ANY
SETDEB: HRROI B,[ASCIZ "/DEBUG"]
CALL TSOUT0 ;DUMP LINK SWITCH
TXNN P1,F%LANG ;WAS A LANGUAGE SWITCH SEEN?
JRST TRYDDT ;NO, HOW ABOUT /DDT ?
LDB B,[POINTR(P1,F.LMSK)] ;GET DEFAULT LANG COMPILER NAME
CAIE B,0 ;IF NONE, MOVE ON...
MOVEM B,DEBAID ;OTHERWISE, USE IT TO SELECT DEBUGGER
TRYDDT: MOVEI B,LT.MAC ;BUT FIRST,
TXNE P1,F%DDT ;CHECK FOR /DDT IN COMMAND
MOVEM B,DEBAID ;YES, SO USE REAL DDT INSTEAD!
SKIPN B,DEBAID ;ANYTHING ELSE?
CALLRET SPOUT ;NO
HRRO B,DBTAB(B) ;YES - GET AID NAME
CALL TSOUT0 ;DUMP IT
CALLRET SPOUT ;AND SPACE
;LSCAN - ROUTINE TO CRAWL THROUGH LIST OF FILE SPECS
;CALL: CALL LSCAN
; <COROUTINE ADDRS>
; RETURN ON EMPTY LIST
LSCAN: MOVEI P2,LHED ;GET LIST HEAD
LSCAN0: HRRZ P2,LNK(P2) ;LOOK AT NEXT ENTRY
JUMPE P2,RSKP ;SKIP RETURN WHEN DONE
SKIPGE P5,FLG(P2) ;LOAD FLAGS
JRST LSCAN0 ;YES - SKIP IT
HLL P2,SRC(P2) ;LOAD SOURCE POINTER IF ANY
CALL @0(P) ;INVOKE COROUTINE
JRST LSCAN0 ;TRY NEXT
;SRCSCN - ROUTINE TO SCAN ALL SOURCES AND CALL SOURCE COROUTINE
SRCSCN: TLNN P2,-1 ;SINGLE SOURCE?
JRST SRCSC2 ;YES - INVOKE ROUTINE AND RETURN
PUSH P,P2 ;SAVE POINTER
PUSH P,P5 ;AND FLAGS
HLRZ P2,P2 ;GET STARTING POINT
SRCSC1: MOVE P5,FLG(P2) ;LOAD FLAGS
CALL @-2(P) ;CALL COROUTINE
HRRZ P2,LNK(P2) ;LINK TO NEXT
JUMPN P2,SRCSC1 ;PROCEED IF EXISTS
POP P,P5 ;RESTORE FLAGS
POP P,P2 ;AND POINTER
RETSKP ;RETURN, SKIPPING COROUTINE ADDRESS
SRCSC2: CALL @0(P) ;INVOKE COROUTINE
RETSKP ;RETURN, SKIPPING COROUTINE ADDRESS
;PASS1 - DETERMINE WHAT TO COMPILE AND CONSTRUCT COMMAND
PASS1: TXNE P5,D%LINK ;LINK-20 SWITCH?
RET ;YES - IGNORE
MOVNI Q2,1 ;INIT TO -1
CALL SRCSCN ;SCAN SOURCES
JRST P1SRC ;ROUTINE FOR SOURCE ON PASS1
JUMPE Q2,R ;RETURN IF NO SOURCE
;**;[716] Add 6 lines at PASS1:+6L JRG 29-MAR-82
SKIPN A,OVER(P2) ;[716] IS THERE A VALID OBJECT FILE?
JRST [TXO P1,F%SUPP ;[716] LOSAGE NOTED
TYPE <?Invalid object file: > ;[716]
MOVE B,NAM(P2) ;[716] TELL HIM WHAT
CALL DSOUTR ;[716] PRINT SPEC
RET] ;[716] RETURN
TXNN P5,F%CMPL ;FORCED COMPILE?
;**;[716] Change 2 lines at PASS1:+7L JRG 29-MAR-82
CAML Q2,A ;[716] COMPARE SOURCE & REL TIMES
CALLRET BLDCOM ;[716] BUILD COMMAND STRING
RET ;DON'T COMPILE
P1SRC: LDB A,[POINTR (P5,F.LMSK)] ;GET LANG TYPE
CAIE A,(P4) ;MATCH?
JRST P1SRCX ;NO - SKIP OVER
JUMPE Q2,P1SRC1 ;IF Q2 IS ZERO WE HAVE ALREADY LOST
CAMG Q2,SVER(P2) ;SAVE LARGEST TO DATE
MOVE Q2,SVER(P2) ;LOAD D/T OR 0
P1SRC1: TXNN P5,D%FNF ;FILE PRESENT?
RET ;YES - RETURN
TXO P1,F%SUPP ;SET SUPPRESSED
TYPE <?Source file missing: >
MOVE B,NAM(P2)
CALL DSOUTR ;FILE NAME & CRLF
P1SRCX: MOVEI Q2,0 ;SAY WE LOST
RET ;RETURN
;PASS2 - BUILD LINK-20 COMMAND FILE
PASS2: TXNE P5,D%LINK ;LINK SWITCH
JRST PASS2S ;YES - HANDLE SPECIAL
SKIPN OVER(P2) ;HAVE REL SOMEWHERE?
JRST [TXO P1,F%SUPP ;LOSAGE NOTED
PUSH P,A ;SAVE JFN
TYPE <?Object file missing: >
MOVE B,NAM(P2) ;TELL HIM WHAT
CALL DSOUTR ;PRINT SPEC
POP P,A ;RESTORE JFN
RET] ;RETURN
TXZE P1,F%NCMA ;NEED COMMA?
CALL CMOUT ;YES - PUT ONE IN
CALL P2SYMS ;DO SYMBOL CODE
;**;[716] Replace 7 lines with 1 at PASS2:+13L JRG 29-MAR-82
CALL PUTDFO ;[716] OUTPUT DEVICE AND FILENAME
JRST PASS2A ;END-OF-SPEC USE REL EXTENSION
LDB Q2,[POINTR (P5,F.LMSK)] ;GET LANG TYPE
CAIN Q2,LT.REL ;LANG TYPE = REL?
TXNN P5,D%EXTN ;EXPLICIT EXTENSION TYPED?
JRST PASS2A ;NO - USE DEFAULT
CALL PROUT ;YES - DUMP PERIOD
CALL PUTDF0 ;REMAINDER OF TYPED EXTENSION
NOP ;IGNORE END-OF-SPEC
JRST PASS2B ;DONE WITH SPEC
PASS2A: HRROI B,[ASCIZ ".REL"] ;DEFAULT EXTENSION
CALL TSOUT0 ;DUMP INTO FILE
PASS2B: TXO P1,F%NCMA ;SAY WE NEED A COMMA
;**;[716] Replace 4 lines with 2 at PASS2B:+1L JRG 29-MAR-82
MOVE B,HDDO(P2) ;[716] MOVE IN HDDO
CALL PUTPPN ;[716] DUMP PPN IF NECESSARY
TXNN P5,F%LIB ;WANT LIB FOR THIS?
JRST PASOUT ;DONE
HRROI B,[ASCIZ "/SEARCH"]
CALL TSOUT0 ;YES - DUMP SWITCH
JRST PASOUT ;DONE, SAVE JFN AND RETURN
;PASS2S CALLED TO DUMP LINK SWITCH
PASS2S: MOVEI B,"/" ;OUTPUT SLASH
MOVE Q1,NAM(P2) ;GET STRING POINTER
ILDB Q1,Q1 ;PEEK AT FIRST CHAR
CAIE Q1,"/" ;IS IT A SLASH?
CALL TBOUT ;NO - DUMP ONE
MOVE B,NAM(P2) ;GET STRING
CALL TSOUT0 ;DUMP IT
TXO P1,F%NCMA ;NO COMMA YET
PASOUT: MOVEM A,TMPJFN ;SAVE UPDATED JFN
RET
;ROUTINE TO OUTPUT /LOCAL OR /NOLOCAL ETC...
;**;[930]Replace 10 lines with 8 at P2SYMS: +2L RWW 5-Nov-82
P2SYMS: TXNE P5,F%LSYM ;[930]test if /NOSYMBOL given as local switch
JRST P2SYM1 ;[930]yes, force /NOLOCAL switch
TXNN P1,F%LSYM ;[930]local /NOSYMBOL not given, test if global
RET ;[930]no, return with no switches set
TXNN P5,F%LSYM ;[930]was global /NOSYMBOL turned off with
;[930] local /SYMBOL switch?
RET ;[930]yes, return with no special switches set
P2SYM1: HRROI B,[ASCIZ "/NOLOCAL "] ;here when /NOSYMBOL switch given
CALLRET TSOUT0 ;[930]dump switch to link.
;BLDCOM - ROUTINE TO BUILD A COMMAND STRING
;CHECK FOR FILE OPEN FOR THIS LANGUAGE
;**;[716] Change 2 lines at BLDCOM:+0L JRG 29-MAR-82
BLDCOM: SKIPE A,HDDNO(P2) ;[716] GET HDDNO WORD FROM BLOCK
MOVEM A,HDDO(P2) ;[716] IF NON-ZERO, IT SHOULD REPLACE HDDO
SETOM OVER(P2) ;MARK REL EXISTANCE
SKIPN SIXTAB(P4) ;DOES OLD-STYLE COMPILER EXIST FOR THIS LANGUAGE?
JRST BLDCMN ;NO, SKIP OLD-STYLE
SETZM NATIVF ;SAY WE'RE DOING OLD-STYLE LINE
MOVE A,OLDJFN ;OLDJFN => TMPJFN IN CASE OPNTMP ISN'T CALLED
MOVEM A,TMPJFN
TXNE P1,F%TOPN ;TEMP FILE OPEN?
JRST BLDCM1 ;YES - GO ON
CALL OPNTMP ;OPEN TEMP FILE
MOVEM A,TMPJFN ;SAVE JFN
TXO P1,F%TOPN ;FLAG FILE OPEN
BLDCM1: CALL BILDIT ;DO OLD-STYLE COMMAND LINE
MOVEM A,OLDJFN ;REMEMBER LATEST OLD POINTER
BLDCMN: SKIPN NSXTAB(P4) ;IS THERE A NATIVE VERSION FOR THIS COMPILER?
RET ;NO - DONE
SETOM NATIVF ;MARK THAT WE'RE DOING NEW STYLE
MOVE A,NEWJFN ;SET UP WHICH BYTE POINTER TO USE
MOVEM A,TMPJFN
CALL BILDNC ;BUILD NEW-STYLE COMMAND STRING
MOVEM A,NEWJFN ;REMEMBER POINTER TO NATIVE-STYLE STRING
RET
;SUBROUTINE TO BUILD THE COMMAND LINE FOR A NATIVE COMPILER
BILDNC: MOVE A,TMPJFN ;GET JFN TO OUTPUT TO
TXZ P1,F%NCMA ;SAY NO COMMA HAS BEEN SEEN YET
CALL SRCSCN ;LOOP THROUGH SOURCES
JRST BLDSRN ;(ADDRESS OF COROUTINE FOR SOURCE FILES)
TXNN P5,F%NBIN ;WANT AN OBJECT FILE?
;**;[938] Modify 1 line at BILDNC+5 YKT 21-DEC-82
JRST [CALL BILOBN ;[938] YES - OUTPUT IT (AS A SWITCH)
JRST .+3] ;[938]
HRROI B,[ASCIZ "/NOBINARY"] ;[938] NO,
CALL TSOUT0 ;[938]
HRROI B,[ASCIZ "/ABORT"] ;SWITCH FOR ABORT
TXNE P5,F%ABT ;WANT IT?
CALL TSOUT0 ;YES - DUMP IT
HRROI B,[ASCIZ "/MACH"] ;SWITCH FOR MACHINE-CODE
;**;[974] Change 1 line and Add 4 lines YKT 15-AUG-83
TXNN P5,F%MACH ;[974] WANT IT?
JRST [SKIPN NOMASW ;[974] NO, IS NOMACH SW EXPLICITLY TYPED?
JRST .+2 ;[974] NO, DON'T WRITE
HRROI B,[ASCIZ "/NOMACH"] ;[974] YES,
JRST .+1] ;[974]
CALL TSOUT0 ;YES - DUMP IT
HRROI B,[ASCIZ "/FLAG"] ;SWITCH FOR FLAG-NON-STANDARD
;**;[974] Change 1 line and Add 4 lines YKT 15-AUG-83
TXNN P5,F%FLAG ;[974]WANT IT?
JRST [SKIPN NOFGSW ;[974] NO, IS NOFLAG SW EXPLICITLY TYPED?
JRST .+2 ;[974] NO, DON'T WRITE
HRROI B,[ASCIZ "/NOFLAG"] ;[974] YES,
JRST .+1] ;[974]
CALL TSOUT0 ;YES - DUMP IT
;**;[947] Modify next 9 lines YKT FEB-08-83
;**;[931] Replace next 3 lines by 7 lines YKT NOV-22-82
HRROI B,[ASCIZ "/NOWARN"] ;[947] SWITCH FOR NO WARNINGS
;**;[974] Change 1 line and Add 4 lines YKT 15-AUG-83
TXNN P5,F%NWAR ;[974][947] WANT IT?
JRST [SKIPN WARNSW ;[974] NO, IS WARN SW EXPLICITLY TYPED?
JRST .+2 ;[974] NO, DON'T WRITE
HRROI B,[ASCIZ "/WARN"] ;[974] YES,
JRST .+1] ;[974]
;**;[955] Delete next two lines YKT MAR-28-83
; CAIE P4,LT.FOR ;[955][947][931] IS FORTRAN TYPE?
; JRST NEXTT ;[955][947][931] NO,
; TXNE P5,F%WARN ;[947][931] WANT IT?
; JRST [HRROI B,[ASCIZ "/WARNINGS"] ;[947][931] YES,
; JRST .+2] ;[947][931] WRITE IT
; HRROI B,[ASCIZ "/NOWARNINGS"] ;[947][931] NO,
CALL TSOUT0 ;YES - DUMP IT
;**;[955] Modify next line YKT MAR-28-83
;**;[974] Delete next 3 lines YKT 15-AUG-83
; HRROI B,[ASCIZ "/CHECK"] ;[974][955][947][931] SWITCH FOR CHECK
; TXNE P5,F%CHK ;[974]WANT IT?
; CALL TSOUT0 ;[974]YES - DUMP IT
TXNN P5,F%LIST ;WANT LISTING?
;**;[974] Add 1 line YKT 15-AUG-83
JRST [CALL NOCRLI ;[974] NO, SKIP OVER LIST STUFF
JRST BLDNC1] ;
TXNN P5,F%CREF ;YES - WANT CREF, TOO?
JRST [HRROI B,[ASCIZ "/LIST:LPT:"] ;YES - OUTPUT SWITCH
;**;[974] Add 2 lines YKT 15-AUG-83
CAIN P4,LT.PAS ;[974]
HRROI B,[ASCIZ "/LIST:"] ;[974]
CALL TSOUT0
;**;[716] Replace 3 lines with 1 at BILDNC:+25L JRG 29-MAR-82
CALL PUTDF1 ;[716] DUMP NAME
NOP ;IGNORE EXTENSION
JRST BLDNC1] ;CONTINUE
HRROI B,[ASCIZ "/CREF"]
CALL TSOUT0 ;ELSE JUST PUT IN CREF SWITCH WITH NO FILENAME
BLDNC1: SKIPE B,LSWPTR ;GOT GLOBAL LANGUAGE SWITCHES?
CALL TSOUT0 ;YES - DUMP THEM
SKIPE B,SWP(P2) ;GOT LANGUAGE SWITCHES?
CALL TSOUT0 ;YES - DUMP THEM
CALL EOLOUT ;END THE SPECS
MOVEM A,TMPJFN ;SAVE UPDATED JFN
RET ;RETURN
;**;[974] Add 7 lines YKT 15-AUG-83
NOCRLI: HRROI B,[ASCIZ "/NOLIST"] ;[974]
SKIPE NOLISW ;[974] NOLIST SW EXPLICIT TYPED?
CALL TSOUT0 ;[974] YES,
HRROI B,[ASCIZ "/NOCREF"] ;[974]
SKIPE NOCRSW ;[974] NOCREF SW EXPLICIT TYPED?
CALL TSOUT0 ;[974] YES,
RET ;[974] NO,
;COROUTINE CALLED BY SRCSCN TO OUTPUT SOURCE SPECS IN NATIVE FORMAT
BLDSRN: MOVEI B,"+" ;FOR NATIVE MODE, PLUS BETWEEN SOURCE SPECS
TXZE P1,F%NCMA ;NEED SEPARATOR?
CALL TBOUT ;YES, PUT IT IN
;**;[716] Replace 5 lines with 1 at BLDSRN:+3L JRG 29-MAR-82
CALL PUTDF ;[716] OUTPUT DEVICE AND FILE NAME
JRST BLDN1 ;SPEC OVER, NO PERIOD
CALL PROUT ;PUT IN PERIOD
CALL PUTDF0 ;CONTINUE SPEC
NOP ;SHOULD BE OVER BY NOW
BLDN1: TXO P1,F%NCMA ;MAKE SURE SEPARATOR PUT IN IF MORE SPECS
RET ;DONE WITH THIS SPEC
;SUBROUTINE TO BUILD THE COMMAND LINE FOR AN OLD-STYLE COMPILER
BILDIT: MOVE A,TMPJFN ;GET JFN TO OUTPUT TO
TXNE P5,F%NBIN ;WANT OBJECT?
CALL CKCOB ;NO - OUTPUT A HYPHEN IF COBOL
TXNN P5,F%NBIN ;WANT OBJECT?
CALL BILOBO ;YES - OUTPUT OBJECT SPECS
MOVEI B,"," ;SEPARATE WITH A COMMA
CALL TBOUT
TXNN P5,F%LIST ;WANT LISTING?
JRST [CALL CKCOB ;NO - CHECK COBOL
JRST BLDIT1] ;SKIP OVER LIST STUFF
TXNN P5,F%CREF ;YES - WAS A CREF REQUESTED TOO?
JRST [HRROI B,[ASCIZ "LPT:"]
CALL TSOUT0 ;NO - DUMP DEVICE (FOR LIST FILE)
MOVE Q1,NAM(P2);GET POINTER TO FILESPEC
;**;[716] Replace 2 lines with 1 at BILDIT:+14L JRG 29-MAR-82
CALL PUTDF1 ;[716] DUMP NAME
NOP ;IGNORE EXTENSION
JRST BLDIT1] ;CONTINUE
;**;[716] Replace 12 lines with 5 at BILDIT:+18L JRG 29-MAR-82
MOVE B,CHDD ;[716] OUTPUT CREF FILE TO CONNECTED DIRECTORY
CALL PUTDEV ;[716]
MOVE Q1,NAM(P2) ;[716] GET POINTER TO FILENAME AGAIN
CALL PUTDF0 ;[716] OUTPUT FILENAME
NOP ;[716] IGNORE
MOVEI D,"C" ;OUTPUT SW
CALL SWOUT ;...
CAIE P4,LT.C68 ;68 COBOL,
CAIN P4,LT.C74 ; OR 74 COBOL?
JRST BLDIT1 ;YES, SO DON'T CREF
CAIE P4,LT.CBL ;IF COBOL
CAIN P4,LT.BLI ; OR BLISS
JRST BLDIT1 ; THEN DON'T CREF
CALL ENTCRF ;ENTER NAME IN CREF FILE
BLDIT1: MOVEI B,"=" ;DELIMIT
CALL TBOUT
TXZ P1,F%NCMA ;SAY NO COMMA SEEN YET
CALL SRCSCN ;LOOP THROUGH SOURCES
JRST BLDSRC ;(ADDRESS OF COROUTINE FOR SOURCE FILES)
SKIPE B,LSWPTR ;GOT GLOBAL LANGUAGE SWITCHES?
CALL TSOUT0 ;YES - DUMP THEM
SKIPE B,SWP(P2) ;GOT LANGUAGE SWITCHES?
CALL TSOUT0 ;YES - DUMP THEM
CALL EOLOUT ;END OF SPECS
MOVEM A,TMPJFN ;SAVE UPDATED JFN
RET ;RETURN
;COROUTINE CALLED BY SRCSCN TO OUTPUT SOURCE SPECS IN OLD FORMAT
BLDSRC: TXZE P1,F%NCMA ;NEED COMMA?
CALL CMOUT ;YES - DUMP ONE
CALL PUTDF ;OUTPUT DEVICE & FILE
JRST BSRC1 ;END OF SPEC
CALL PROUT ;DUMP PERIOD
CALL PUTDF0 ;CONTINE SPEC
NOP ;IGNORE
BSRC1: TXO P1,F%NCMA ;SET NEED-COMMA FLAG
;**;[716] Change 1 line at BSRC1:+1L JRG 29-MAR-82
MOVE B,HDD(P2) ;[716] GET HACKED DEVICE DESIGNATOR
CALLRET PUTPPN ;DUMP ONE AND RETURN
;**;[716] Delete 1 line at BSRC1:+3L JRG 29-MAR-82
;SUBROUTINE TO OUTPUT THE OBJECT FILE
;BILOBO: ENTRY FOR OLD-STYLE
;BILOBN: ENTRY FOR NATIVE MODE
BILOBN: HRROI B,[ASCIZ "/OBJECT:"]
CALL TSOUT0 ;NATIVE MODE: OUTPUT OBJECT FILE AS A SWITCH
;**;[716] Replace 26 lines with 1 at BILOBN:+2L JRG 29-MAR-82
BILOBO: CALL PUTDFO ;[716] OUTPUT DEVICE AND FILENAME
JRST BLDOB1 ;END OF SPEC
LDB Q2,[POINTR (P5,F.LMSK)] ;GET LANGUAGE TYPE
CAIN Q2,LT.REL ;IS IT "RELOC"?
TXNN P5,D%EXTN ;YES - EXPLICIT EXTENSION?
JRST BLDOB1 ;NO - PROCEED
CALL PROUT ;DUMP PERIOD
CALL PUTDF0 ;Q1 STILL HAS POINTER
NOP ;IGNORE END-OF-SPEC RETURN
;**;[716] Replace 7 lines at BLDOB1:+0L JRG 29-MAR-82
BLDOB1: MOVE B,HDDO(P2) ;[716]
SKIPE NATIVF ;[716] NATIVE COMPILER?
JRST BLDOB2 ;[716] YES - SKIP PPN, BUT DO SWITCHES
CALL PUTPPN ;[716] NO - DUMP PPN
CAIE P4,LT.FOR ;[716] FORTRAN?
RET ;[716] NO - DONE
;**;[974] Change 2 lines and Add 4 lines YKT 15-AUG-83
BLDOB2: HRROI B,[ASCIZ "/OPTIM"] ;[974][716] SWITCH FOR OPTIMIZE
TXNN P5,F%OPT ;[974] WANT IT
JRST [SKIPN NOOPSW ;[974] NO, IS NOOPT SW EXPLICITLY TYPED?
JRST .+2 ;[974] NO, DON'T WRITE
HRROI B,[ASCIZ "/NOOPTIM"] ;[974] YES,
JRST .+1] ;[974]
CALL TSOUT0 ;YES - DUMP IT
HRROI B,[ASCIZ "/DEBUG"] ;SWITCH FOR DEBUG
;**;[974] Change 1 line and Add 4 lines YKT 15-AUG-83
TXNN P5,F%DEB ;[974] WANT DEBUG CODE?
JRST [SKIPN NODBSW ;[974] NO, IS NODEBUG SW EXPLICITLY TYPED?
JRST .+2 ;[974] NO, DON'T WRITE
HRROI B,[ASCIZ "/NODEBUG"] ;[974] YES,
JRST .+1] ;[974]
CALLRET TSOUT0 ;YES - DUMP IT AND RETURN
RET ;NO - JUST RETURN
;ROUTINE TO CHECK FOR COBOL AND OUTPUT A "-" TO THE COMMAND FILE
CKCOB: CAIE P4,LT.C68 ;COBOL 68,
CAIN P4,LT.C74 ; OR COBOL 74?
JRST CKCOB1 ;YES
CAIE P4,LT.CBL ;IS IT COBOL?
RET ;NO - RETURN
CKCOB1: MOVEI B,"-"
CALLRET TBOUT ;YES - DUMP MINUS
;ROUTINE TO PUT PPN IN OUTPUT STREAM
;**;[716] Replace 18 lines with 8 at PUTPPN:+0L JRG 29-MAR-82
PUTPPN: TLNN B,600000 ;[716] IS THIS A NON-DIRECTORY DEVICE?
TLNN B,777777 ;[716] OR IS THIS THE CONNECTED DIRECTORY?
RET ;[716] YES TO ONE, LEAVE
PUSH P,B ;[716] SAVE ARG
HRROI B,[ASCIZ "[4,"] ;[716] MOVE IN PROJECT NUMBER (ALWAYS 4)
CALL TSOUT0 ;[716] DUMP IT
POP P,B ;[716] GET PPN BACK
HLRZS B ;[716] PUT PROGRAMMER NUMBER IN RHS
LDF C,1B0+10 ;...
NOUT ;MAJIK
CALL CJERR
MOVEI B,"]" ;CLOSE BRACKET
CALLRET TBOUT ;DUMP AND RETURN
;ROUTINE TO ADD NEW FILESPEC TO THINGS THAT NEED CREFING
ENTCRF: PUSH P,A ;SAVE POSIBLE JFN
;**;[716] Replace 3 lines with 5 at ENTCRF:+1L JRG 29-MAR-82
MOVE A,CSBUFP ;[716] CURRENT POINTER
MOVE B,CHDD ;[716] OUTPUT DEVICE FOR CONNECTED STRUCTURE
CALL PUTDEV ;[716] OUTPUT CURRENT STRUCTURE
MOVE C,A ;[716] MOVE UPDATED POINTER TO C
MOVE Q1,NAM(P2) ;[716] POINTER TO NAME
CALL CPYDF ;COPY FILE NAME
NOP ;IGNORE THIS RETURN
MOVEI B,0 ;TERMINATE STRING
IDPB B,C ;...
CALL CHKCRF ;CHECK AND ENTER IF UNIQUE
POP P,A ;RESTORE ACCUM
RET ;RETURN
;CHECK FOR ALREADY EXISTING FILESPEC
CHKCRF: MOVEI Q1,CRFHED ;POINTER TO HEAD OF LIST
CKCRF1: SKIPN Q2,0(Q1) ;CHECK FOR END OF LIST
JRST CKCRF2 ;END - ENTER NEW STRING
MOVE A,CSBUFP ;POINTER TO STRING TO BE CONSIDERED
MOVE B,1(Q2) ;POINTER TO OLD STRING
STCMP ;COMPARE STRINGS
JUMPE A,R ;MATCH IF ZERO CODE (RETURN)
MOVE Q1,Q2 ;ADVANCE POINTER
JRST CKCRF1 ;TRY NEXT
CKCRF2: MOVEI A,2 ;ALLOCATE CELL
CALL BALLOC ;...
HRRM A,0(Q1) ;LINK TO OLD
MOVE A,CSBUFP ;POINTER TO NEW STRING
CALL BUFFS ;ISOLATE THE STRING
HRRZ B,0(Q1) ;GET ADDRESS OF NEW BLOCK
MOVEM A,1(B) ;STORE POINTER TO STRING IN SECOND WORD OF BLOCK
RET ;RETURN
;ROUTINE TO MERGE EXISTING CREF FILE WITH CORE INFO
FINCRF: SKIPN CRFHED ;ANYTHING NEW?
RET ;NO - THEN DONE
CALL TJNUM ;GO MAKE A FILENAME
MOVEI A,"CR"
DPB A,[POINT 14,FSPEC,34]
MOVE A,[ASCII "E.TMP"]
MOVEM A,1+FSPEC ;COMPLETE NAME
SETZM 2+FSPEC ;MAKE ASCIZ
LDF A,GJ%SHT!GJ%PHY!GJ%OLD
HRROI B,FSPEC ;ARGS FOR GTJFN
CALL GTJFS ;SEE IF FILE EXISTS
JRST DONCRF ;NO - JUST DUMP CORE
LDF B,7B5+1B19 ;BITS FOR READ
OPENF ;OPEN FILE
CALL CJERR ;LOSAGE
PUSH P,A ;SAVE JFN ON STACK
PUSH P,EOFDSP ;SAVE EOF TRAP
MOVEI A,CRFEOF ;NEW ADDRS FOR TRAP
MOVEM A,EOFDSP ;...
;;;; FALL INTO FNCRFN
;HERE TO SCAN FILE FOR SPEC
FNCRFN: MOVE A,-1(P) ;FETCH JFN
FNCRF1: BIN ;READ A CHAR
CAIE B,"=" ;SEARCH FOR BEGINNING OF SPEC
JRST FNCRF1 ;LOOP TILL FOUND
MOVE C,CSBUFP ; " POINTER
FNCRF2: BIN ;GOBBLE CHAR
CAIN B,LF ;LOOK FOR EOL
JRST FNCRF3 ;FOUND - CHECK FOR MERGE
IDPB B,C ;COPY TO STRING SPACE
JRST FNCRF2
FNCRF3: MOVEI B,0 ;REPLACE CR WITH NULL
DPB B,C ;...
CALL CHKCRF ;CALL COMMON CODE
JRST FNCRFN ;LOOK FOR MORE
;HERE ON EOF INTERUPT FROM READING CREF FILE
CRFEOF: POP P,EOFDSP ;RESTORE THIS
MOVE A,0(P) ;GET JFN
TLO A,(1B0) ;RETAIN IT
CLOSF ;CLOSE FILE
CALL CJERR ;NEVER HAPPEN
LDF B,7B5+1B20 ;OPEN FOR WRITE
TLZ A,(1B0) ;CLEAR FLAG
OPENF ;...
CALL CJERR ;SOMETHING WENT WRONG
JRST DNCRF1 ;JOIN WRITE
;ROUTINE TO WRITE OUT NEW CREF FILE
DONCRF: CALL TOPNF ;OPEN TMP FILE IN FSPEC
PUSH P,A ;STACK JFN
DNCRF1: MOVE Q1,CRFHED ;GET LIST HEAD
MOVE A,0(P) ;GET JFN
DNCRF2: MOVEI B,"=" ;EQUAL SIGN
CALL TBOUT ;DUMP IT
MOVE B,1(Q1) ;POINTER TO FILESPEC
CALL TSOUT0 ;DUMP IT NEXT
CALL EOLOUT ; AND CRLF
SKIPE Q1,0(Q1) ;SEE IF MORE
JRST DNCRF2 ;YES - LOOP BACK
POP P,A ;NO - CLOSE OUT FILE
CLOSF ;...
CALL CJERR ;WHOOPS
RET ;ALL DONE - RETURN
;PUTDF - ROUTINE TO OUTPUT FILESPEC AS FOLLOWS:
;OUTPUT DEVICE IF ANY , DUMP FILENAME
; TERMINATE ON FIRST PERIOD OR ; OR NULL.
;NON-SKIP IF FILESPEC TERMINATED (; OR NULL).
;SKIP IF PERIOD FIRST.
;PUTDF0 - IF Q1 ALREADY SET UP
;**;[716] Replace 1 line with 22 at PUTDF:+0L JRG 29-MAR-82
PUTDFO: SKIPA B,HDDO(P2) ;[716] GET HDD FROM HDDO
PUTDF: MOVE B,HDD(P2) ;[716] GET HDD FROM HDD
SKIPE NATIVF ;[716] IN COMPATIBILITY MODE?
TLNE B,600000 ;[716] OR NON-DIRECTORY DEVICE?
JRST [CALL PUTDEV ;[716] YES TO ONE, JUST OUTPUT DEVICE
JRST PUTDF1] ;[716] AND GO OUTPUT FILENAME
TLNN B,-1 ;[716] GOT THE CONNECTED DIRECTORY?
JRST PUTDF1 ;[716] YES - DON'T OUTPUT DEVICE AND DIRECTORY AT ALL
PUSH P,A ;[716] SAVE JFN
PUSH P,B ;[716] AND HDD
HRLI B,600000 ;[716] CHANGE TO DEVICE DESIGNATOR
MOVE A,CSBUFP ;[716] PUT IN CSBUF
DEVST ;[716] GET STRUCTURE STRING
ERCAL CJERRE ;[716] IN CASE ERROR
POP P,B ;[716] RESTORE PPN
HLRZS B ;[716] PUT PROGRAMMER NUM IN RH
HRLI B,4 ;[716] PUT PROJECT 4 IN LH
MOVE C,CSBUFP ;[716] PUT POINTER TO STRUCTURE IN C
POP P,A ;[716] GET BACK JFN
PPNST ;[716] TRANSLATE TO STRING
ERCAL CJERRE ;[716] IN CASE ERROR
PUTDF1: MOVE Q1,NAM(P2) ;[716] USE FILENAME POINTER
PUTDF0: PUSH P,[TBOUT] ;ROUTINE TO USE
PUTDFC: ILDB B,Q1 ;GET CHAR
SKIPE B ;LOOK FOR NULL
CAIN B,";" ; OR SEMICOLON
JRST PTDFR ;GIVE RETURN (END-OF-SPEC)
CAIN B,"." ;PERIOD?
JRST PTDFR1 ;YES - RETURN NOW
CALL @0(P) ;NO - DUMP CHAR
JRST PUTDFC ;CONTINUE
PTDFR1: AOS -1(P) ;SET FOR SKIP RETURN
PTDFR: POP P,0(P) ;PRUNE PDL
RET ;AND RETURN
;**;[716] Change comment for CPYDF: JRG 29-MAR-82
;[716] ROUTINE LIKE PUTDF0 ONLY COPIES TO CORE
CPYDF: PUSH P,[CPYDF1] ;ROUTINE TO USE
JRST PUTDFC ;JOIN COMMON CODE
CPYDF1: IDPB B,C ;POINTER IN C
RET
;**;[716] Delete routine SKPDEV JRG 29-MAR-82
;**;[716] Add routine PUTDEV JRG 29-MAR-82
;ROUTINE TO OUTPUT DEVICE FROM HDD TO DEVICE DESIGNATOR IN A
PUTDEV: TLC B,600000 ;CHANGE PROJECT NUMBER LH TO 600000+.DVDSK
TLCE B,600000
HRLI B,600000 ;NOTE: .DVDSK = 0
DEVST ;COPY THE DEVICE NAME
ERCAL JERRE ;HORRIBLE ERROR
MOVEI B,":" ;OUTPUT A COLON
CALLRET TBOUT ;AND RETURN
;OPEN TMP CORE FILE
OPNTMP: AOS A,NFILES ;INCREASE NUMBER OF TMP FILES BY ONE
CAIN A,1 ;FIRST ONE?
JRST OPNT2 ;YES
MOVE B,ADDTAB-2(A) ;NO, IT STARTS RIGHT AFTER LAST ONE
ADD B,TMPCOR(B) ;GET ADDRESS OF NEXT FILE
AOJ B, ;LENGTH DOESN'T INCLUDE HEADER
OPNT1: HRRZM B,ADDTAB-1(A) ;REMEMBER STARTING ADDRESS OF TMP FILE
HLLZ C,SIXTAB(P4) ;GET NAME OF TMP FILE, MAC, FOR, LNK ETC.
SKIPE NATIVF ;DOING NATIVE-STYLE?
HLLZ C,NSXTAB(P4) ;YES, GET CORRECT NAME FOR NATIVE COMPILER
MOVEM C,TMPCOR(B) ;STORE NAME IN LEFT HALF OF FIRST WORD
MOVEI A,TMPCOR+1(B) ;MAKE BYTE POINTER TO SECOND WORD OF
HRLI A,440700 ;FILE
RET ;GIVE CALLER THE BYTE POINTER ("JFN")
OPNT2: SETZM ADDTAB ;CLEAR BUFFER
MOVE B,[ADDTAB,,ADDTAB+1]
BLT B,BUF1-1
MOVEI B,TMPBUF-TMPCOR ;ASSUME FIRST ONE
JRST OPNT1
;CLOSE TEMP FILE
CLSTMP: MOVE B,NFILES
MOVE C,ADDTAB-1(B) ;GET BEGINNING OF FILE ADDRESS
MOVEI D,0 ;END WITH A NULL
CLSTM1: IDPB D,A ;FILL REST OF WORD WITH NULLS
TLNE A,(76B5) ;AT END OF WORD?
JRST CLSTM1 ;NO, LOOP BACK TIL DONE
SUBI A,TMPCOR(C) ;CALCULATE LENGTH OF FILE
HRRM A,TMPCOR(C) ;REMEMBER LENGTH
RET
;ROUTINE TO ATTEMPT TO OPEN FILE IN FSPEC
TOPNF: LDF A,GJ%SHT!GJ%FOU!GJ%PHY!GJ%TMP
HRROI B,FSPEC ;POINT TO FILESPEC
CALL GTJFS ;GET A JFN
CALL CJERR ;TEMP FILE LOSAGE
LDF B,7B5+1B20 ;BYTE SIZE + WRITE
OPENF ;OPEN FILE
CALL CJERR ;TEMP FILE LOSAGE
RET ;RETURN
TJNUM: MOVEI Q1,3 ;NEED TO MAKE TMP FILE
MOVE A,CSJOB ;GET JOB #
TJNM1: IDIVI A,^D10 ;DIVIDE INTO DIGITS
ADDI B,"0" ;CONVERT TO ASCII
LSHC B,-7 ;SHIFT OVER
SOJG Q1,TJNM1 ;LOOP
MOVEM C,FSPEC ;PUT IN BLOCK
RET ;RETURN
SUBTTL PARSE
;The CMPRES routine tidies up command strings for the COMPILE-class
;commands. Lots of these petty chores are normally handled by the monitor
;via the COMND jsys. However, since the PARSE routine doesn't use COMND,
;this CMPRES routine is needed.
;CMPRES does the following:
;
; o Carriage returns are ignored. Linefeeds are changed to
; commas. This is so that multiple-line indirect files work.
;
; o All multiple spaces are compressed to at most one space
;
; o Any spaces following end of line are
; deleted. Neglecting to remove spaces at end of line causes
; "COMP FOO.MAC " to force a compilation.
;
; o Spaces preceding percent signs are deleted.
; If spaces aren't removed in front of percent, the command
; LOAD FOO %"text" fails to call the compiler!
; o Comments enclosed in exclams (!) are removed
;
; o Comments starting with semicolon (;) last through the next
; linefeed or end of command
;
; o All spaces other than those sandwiched between filespecs
; are removed.
;Accepts: AC1/ Pointer to command string
C%PLUS==1B0 ;LAST NON-SPACE WAS NOT A FILESPEC CONSTITUENT
CMPRES: MOVEI A,CMPWDS ;INITIALLY ALLOCATE ENTIRE BUFFER FOR COMMAND
CALL GETBUF
MOVEM A,CMPBUF ;REMEMBER ADDRESS OF BLOCK
ADDI A,CMPWDS-1 ;GET LAST ADDRESS IN BLOCK
SETZM (A) ;GUARANTEE NULL AT END OF STRING
HRLI A,100700 ;GET STARTING POINTER IF STRING WERE 0 BYTES
MOVEM A,CMPPT0 ;REMEMBER POINTER TO NULL COMMAND
MOVE A,.RDIOJ+CSTXTB ;GET POINTER TO COMMAND STRING
CALL BCOUNT ;SEE HOW MANY CHARACTERS ARE IN IT
MOVEI C,1(B) ;LEAVE ROOM FOR NULL
CAILE C,CMPMSZ ;MAKE SURE THERE'S ROOM FOR COMMAND STRING
ERROR <COMPIL-class command string is too long>
MOVEM C,CMPSIZ ;REMEMBER INITIAL SIZE OF STRING
MOVN A,B ;GET NEGATIVE NUMBER OF CHARACTERS
MOVE C,A ;REMEMBER NEGATIVE COUNT FOR SOUT JSYS
ADJBP A,CMPPT0 ;GET ACTUAL STARTING BYTE POINTER FOR COMMAND
MOVEM A,CMPPT0 ;REMEMBER STARTING POINTER
MOVEM A,CSPTR ;INITIALIZE SOURCE POINTER
MOVEM A,CDPTR ;INITIALIZE DESTINATION POINTER
MOVE B,.RDIOJ+CSTXTB ;GET POINTER TO COMMAND STRING
SOUT ;CREATE INITIAL COMMAND (BEFORE EXPANDING INDIRECT FILES!)
MOVX Z,C%PLUS ;FORCE LEADING SPACES TO BE FILTERED OUT
CALL REMNUL ;REMOVE NULLS FROM COMMAND
CMP2: CALL GCMC ;GET CHARACTER, STRIP COMMENT IF SEEN
CAIE A,.CHTAB ;TABS ARE THE SAME AS SPACES
CAIN A," " ;A SPACE?
JRST CMP1 ;YES, GO HACK IT
CMP4: IDPB A,CDPTR ;NOT A SPACE, STORE IT IN NEW STRING
JUMPE A,CMPDON ;DONE IF NULL
TXZ Z,C%PLUS ;FIRST ASSUME FILEPSEC CHARACTER
CALL SKPFCH ;IS CHARACTER A FILESPEC CHARACTER?
TXO Z,C%PLUS ;NO, REMEMBER
JRST CMP2 ;GO BACK FOR REST OF CHARACTERS
CMPDON: MOVE A,CMPPT0 ;GET RESULTANT STARTING POINTER
MOVEM A,.RDIOJ+CSTXTB ;PLACE IN TEXTI BLOCK
HRRZ A,A ;KEEP FIRST ADDRESS USED
SUB A,CMPBUF ;CALCULATE NUMBER OF WORDS UNUSED
MOVE B,CMPBUF ;TELL RETBUF WHERE THE BLOCK IS
CALLRET RETBUF ;RETURN THE UNUSED WORDS AND EXIT
CMP1: CALL GCMC ;GET CHARACTER AFTER SPACE
CAIE A,.CHTAB ;TABS ARE THE SAME AS SPACES
CAIN A," " ;MULTIPLE SPACES?
JRST CMP1 ;YES, SEARCH FOR FIRST NON-SPACE
TXNE Z,C%PLUS ;WAS CHARACTER BEFORE SPACES A NON-FILE CHARACTER?
JRST CMP4 ;YES, SO LEAVE OUT THE SPACES
JUMPE A,CMP4 ;THROW AWAY TRAILING SPACES
CALL SKPFCH ;SKIP IF CHARACTER IS A FILE CHARACTER
JRST CMP7 ;NOT A FILE CHARACTER, SO THROW AWAY SPACES
MOVEI A," " ;SPACE SANDWICHED BETWEEN FILESPECS, LEAVE IT IN
IDPB A,CDPTR
CMP7: LDB A,CSPTR ;GET THE FILE CHARACTER BACK
JRST CMP4
;SKPFCH SKIPS IF CHARACTER IS A FILE CONSTITUENT FOR COMPIL-CLASS COMMANDS.
;
;ACCEPTS: A/ CHARACTER
;
;RETURNS: +1: CHARACTER IS NOT PART OF A FILESPEC
; +2: CHARACTER IS PART OF A FILESPEC
SKPFCH: IDIVI A,4*8 ;GET INDEX AND OFFSET
MOVE B,BITS(B) ;GET BIT POSITION
TDNE B,NFLBTS(A) ;SKIP IF BIT NOT ON
RET ;BIT ON, CHARACTER IS NOT PART OF FILESPEC
RETSKP ;CHARACTER IS PART OF FILESPEC, SKIP.
;TABLE OF CHARACTERS NOT INCLUDED IN COMPIL-CLASS FILESPECS. THERE ARE
;FOUR WORDS, EACH OF WHICH CONTAINING 32 LEFT-JUSTIFIED BITS, YIELDING A TOTAL
;OF 128 BITS, ONE FOR EACH POSSIBLE CHARACTER. THE BIT IS ON IF THE CHARACTER
;IS NOT PART OF A FILESPEC
NFLBTS: BRMSK. FILB0.,FILB1.,FILB2.,FILB3.,,<%> ;PERCENT IS PART OF A LINK SWITCH
;GET CHARACTER, STRIP COMMENT OR CARRIAGE RETURN IF SEEN
GCMC: ILDB A,CSPTR ;LOOK AT CHARACTER FROM OLD STRING
;**;[740] INSERT 20 LINES YKT 14-JUL-82
CAIN A,"-" ;[740] CHECK THE LINE-CONTINUATION "-"
JRST [MOVE D,A ;[740] YES, MAY BE, SO SAVE THE CHARACTER
ILDB A,CSPTR ;[740] LOAD NEXT BYTE
CAIE A,.CHCRT ;[740] IS CR ?
JRST ADJBP1 ;[740] NO, IT IS NOT A LINE-CONTINUATION "-"
ILDB A,CSPTR ;[740] YES, LOAD THE NEXT BYTE
CAIE A,.CHLFD ;[740] IS LF ?
JRST ADJBP2 ;[740] NO, IT IS NOT A LINE-CONTINUATION "-"
JRST GCMC] ;[740] YES, STRIP THE LINE-CONTINUATION
JRST CMIND ;[740] NO, IT IS NOT A LINE-CONTINUATION
ADJBP1: MOVEM D,A ;[740] RESTORE THE BYTE "-"
MOVNI C,1 ;[740]
IBP C,CSPTR ;[740] ADJUST THE SOURCE POINTER BACKWARD BY 1
MOVEM C,CSPTR ;[740]
JRST CMIND ;[740]
ADJBP2: MOVEM D,A ;[740] RESTORE THE BYTE "-"
MOVNI C,2 ;[740]
IBP C,CSPTR ;[740] ADJUST THE SOURCE POINTER BACKWARD BY 2
MOVEM C,CSPTR ;[740]
JRST CMIND ;[740]
;**;[740] ADD A LABEL TO THE NEXT LINE YKT 14-JUL-82
CMIND: CAIN A,"@" ;[740] INDIRECT FILE?
JRST GCMIND ;YES, GO STUFF IT INTO THE STRING
CAIN A,.CHCRT ;CARRIAGE RETURN
JRST GCMC ;YES, IGNORE IT
CAIN A,"""" ;QUOTED STRING?
JRST GCMQT ;YES, FIND THE END OF IT
CAIE A,"," ;COMMA IS SAME AS LINEFEED!
CAIN A,.CHLFD ;END OF LINE?
JRST GCMLF ;YES
CAIN A,";" ;IS REST OF LINE A COMMENT?
JRST CMP6 ;YES, GO FIND END OF LINE
;**;[941] Modify 1 line & add 3 lines YKT JAN-17-83
; CAIE A,"!" ;INTERNAL COMMENT IN LINE?
CAIN A,"!" ;[941] INTERNAL COMMENT IN LINE?
JRST CMP5 ;[941] YES,
CAIN A,"%" ;[941] LINK SWITCH?
JRST CMPER ;[941] YES,
RET ;NO
CMP5: ILDB A,CSPTR ;YES, FIND END OF IT
JUMPE A,R ;IF COMMAND ENDS BEFORE COMMENT, CATCH IT.
CAIN A,.CHLFD ;END OF LINE SEEN?
JRST GCMLF ;YES, ENDS COMMENT AND ACTS AS END OF LINE
CAIE A,"!" ;END OF COMMENT YET?
JRST CMP5 ;NO, KEEP LOOKING
JRST GCMC ;COMMENT OVER, READ NEXT CHARACTER
CMP6: ILDB A,CSPTR ;REST OF LINE IS COMMENT, FIND END OF LINE
JUMPE A,R ;NULL MEANS END OF LINE
CAIN A,.CHLFD ;END OF LINE SEEN?
JRST GCMLF ;YES, ENDS COMMENT AND ACTS AS END OF LINE
JRST CMP6 ;KEEP LOOKING FOR END OF LINE
;GET HERE WHEN ATSIGN (@) SEEN IN COMMAND STRING. SHOVE EVERYTHING TO
;THE LEFT OF IT MORE TO THE LEFT, SO THE INDIRECT FILE'S CONTENTS MAY BE STUFFED
;IN INSTEAD OF THE ATSIGN AND THE FILESPEC
GCMIND: HRROI A,[ASCIZ "CMD"] ;DEFAULT EXTENSION
MOVEM A,CJFNBK+.GJEXT ;GOOD PLACE
MOVE A,[377777,,377777]
MOVEM A,CJFNBK+.GJSRC ;NO EXTRA INPUT
LDF A,GJ%OLD ;PREPARE FOR GTJFN
MOVEM A,CJFNBK ;STORE
MOVEI A,CJFNBK ;POINT TO BLOCK
MOVE B,CSPTR ;POINTER TO STRING
CALL GTJFS ;GET A JFN
CALL [ MOVE B,CSPTR ;FAILED, TRY TO GET PARSE-ONLY JFN
MOVE Q1,A ;REMEMBER ERROR CODE
MOVX A,GJ%OFG ;SAY WE WANT NAME ONLY
MOVEM A,.GJGEN+CJFNBK
MOVEI A,CJFNBK
CALL GTJFS ;ATTEMPT PARSE-ONLY
CALL [ MOVE A,Q1 ;FAILED, GET ORIGINAL ERROR
ERROR <Can't access indirect file - %1?>]
MOVE B,Q1 ;GOT A JFN, GET THE ERROR CODE
ERROR <Can't access indirect file %1S - %2?>]
MOVNI C,1
ADJBP C,B ;KEEP CHARACTER AFTER FILESPEC
MOVEM C,CJEPTR ;REMEMBER POINTER TO END OF FILESPEC
LDF B,7B5+OF%RD ;BITS FOR OPENF
MOVEM A,INDJFN ;REMEMBER INDIRECT JFN
OPENF ;OPEN FILE
CALL CJERR ;WHOOPS
MOVE B,[2,,.FBBYV] ;WE WANT BYTE SIZE AND NUMBER OF BYTES
MOVEI C,C ;READ INFO INTO C AND D
GTFDB
ERCAL [ERROR <Can't determine size of indirect file %1s>]
LOAD C,FB%BSZ,C ;ISOLATE THE BYTE SIZE
MOVE A,[440000,,1] ;GET BYTE POINTER TO 0TH BYTE IF BYTE SIZE WAS 0
DPB C,[300600,,A] ;NOW A HAS BYTE POINTER TO 0TH BYTE
ADJBP D,A ;GET POINTER TO LAST BYTE IN D
HRRZ A,D ;REMEMBER NUMBER OF WORDS
LDB C,[360600,,D] ;GET NUMBER OF UNUSED BITS IN LAST WORD
SOJ C, ;BIT 35 IS UNUSED FOR ASCII
IDIVI C,7 ;SEE HOW MANY ASCII BYTES ARE UNUSED IN LAST WORD
IMULI A,5 ;GET MAXIMUM NUMBER OF ASCII CHARACTERS
SUB A,C ;GET RID OF UNUSED CHARACTERS
MOVEM A,INDSIZ ;REMEMBER TOTAL NUMBER OF ASCII CHARACTERS
MOVNI A,1
ADJBP A,CSPTR ;BACKUP ONE FROM CURRENT TO FLUSH THE ATSIGN
MOVEM A,CSPTR ;STORE SO THAT FIRST CHARACTER OF INDIRECT FILE GETS SEEN
MOVE B,CJEPTR ;GET POINTER TO END OF FILESPEC
CALL SUBBP ;GET NEGATIVE CHARACTERS FILESPEC AND ATSIGN TAKES
ADD A,INDSIZ ;ADD TO SPACE NEEDED BY INDIRECT FILE TO GET DISTANCE STUFF HAS TO BE SHUFFLED
MOVEM A,ADDSIZ ;REMEMBER ADDITIONAL SIZE OF COMMAND
MOVE B,CMPPT0 ;GET POINTER TO BEGINNING OF STRING
MOVE A,CSPTR ;GET POINTER TO BEFORE ATSIGN
CALL SUBBP ;CALCULATE LENGTH OF STRING TO MOVE
MOVN C,A ;TELL SOUT TO MOVE EXACTLY THAT NUMBER OF CHARACTERS
MOVE A,ADDSIZ ;GET ADDITIONAL SIZE (MIGHT BE NEGATIVE!)
ADDB A,CMPSIZ ;GET TOTAL NEW SIZE OF COMMAND STRING
SKIPGE ADDSIZ ;IS COMMAND STRING SHRINKING?
JRST GSHRNK ;YES, CONTENTS IS SHORTER THAN FILEPSEC!
CAILE A,CMPMSZ ;STILL LESS THAN MAXIMUM ALLOWED?
ERROR <Indirect file too large or too many indirect files>
MOVN A,ADDSIZ ;GET NEGATIVE AMOUNT WE HAVE TO MOVE THE COMMAND
ADJBP A,CMPPT0 ;BACKUP POINTER TO GET NEW BEGINNING
MOVE B,CMPPT0 ;MOVE FROM OLD BEGINNING
MOVEM A,CMPPT0 ;REMEMBER NEW BEGINNING
CAIE C,0 ;DON'T GIVE SOUT 0, SINCE IT DOESN'T MEAN 0 BYTES
SOUT ;SHOVE FIRST PORTION TO THE LEFT
MOVE B,A ;B NOW HAS PLACE WHERE INDIRECT FILE GOES
MOVE A,INDJFN ;SAY WHAT CHANNEL INDIRECT FILE IS ON
MOVN C,INDSIZ ;PREPARE TO READ EXACT NUMBER OF CHARACTERS
CALL GEOFQ ;DO SIN AND CHECK FOR EOF
JUMPN C,[MOVE A,CJEPTR ;SIN STOPPED SHORT. GET POINTER TO COMMAND BEYOND THE INDIRECT SPEC
MOVEI C,0 ;STOP ON NULL
SIN ;SLIDE STUFF LEFT TO FILL GAP AFTER INDIRECT FILE CONTENTS
JRST .+1]
MOVN A,ADDSIZ ;GET NEGATIVE AMOUNT WE MOVED STRING
ADJBP A,CDPTR ;FIX DESTINATION POINTER TO ACCOUNT FOR MOVED STRING
MOVEM A,CDPTR ;REMEMBER FIXED POINTER
MOVN A,ADDSIZ ;FIX SOURCE POINTER
ADJBP A,CSPTR
MOVEM A,CSPTR ;STORE FIXED SOURCE POINTER
GCOMMN: CALL RJFN ;CLOSE INDIRECT FILE SO THAT HAVING MANY LEVELS DOESN'T RUN OUT OF JFNS
CALL REMNUL ;REMOVE ANY NULLS THAT WERE IN INDIRECT FILE
JRST GCMC ;CONTINUE PARSING WITH CONTENTS OF INDIRECT FILE
GCMQT: IDPB A,CDPTR ;SAVE QUOTED STRING
GCQ1: ILDB A,CSPTR ;QUOTED STRING, FIND ITS END
CAIE A,"""" ;FIND THE END YET?
JRST GCMQT ;NO, KEEP LOOKING
RET
;REMNUL USES CSPTR AS POINTER TO "REST" OF UNCOMPRESSED STRING AND REMOVES
;ANY NULLS EXCEPT THE ONE TERMINATING THE STRING. THE REASON WE DON'T MERELY
;STRIP NULLS AS WE SCAN THE STRING, IS THAT WHEN ATSIGN IS SEEN, GTJFN IS
;SCANNING, SO WE MUST MAKE SURE WE STRIP AT LEAST THOSE NULLS THAT MAY FALL
;WITHIN A FILESPEC.
REMNUL: MOVE A,CSPTR ;START SCANNING HERE
MOVE B,CSPTR ;STORE NON-NULLS WITH B POINTER
REMN1: ILDB C,A ;PICK UP NEXT CHARACTER FROM COMMAND STRING
IDPB C,B ;STORE IT, NULL OR NOT.
JUMPN C,REMN1 ;JUST CONTINUE IF NON-NULL
MOVE C,CMPSIZ ;NULL FOUND, CALCULATE POINTER TO END OF STRING
ADJBP C,CMPPT0
CAMN B,C ;IS THIS NULL AT END OF STRING?
RET ;YES, WE'RE DONE
MOVNI C,1 ;STRING DIDN'T END, BACK UP DESTINATION POINTER
ADJBP C,B
MOVE B,C ;CAUSE INTERNAL NULL TO BE OVERWRITTEN
SOS CMPSIZ ;REMEMBER REDUCED SIZE TOO
JRST REMN1 ;LOOP FOR CHARACTERS AFTER INTERNAL NULL
;HERE DURING INDIRECT PROCESSING IF INDIRECT FILE CONTENTS IS SHORTER THAN
;ITS NAME. HANDLE THIS BY COPYING THE INDIRECT FILE CONTENTS OVER THE FILESPEC
;AND THEN SLIDING THE REMAINDER OF THE COMMAND STRING TO THE LEFT
GSHRNK: MOVE A,INDJFN ;GET HANDLE OF INDIRECT FILE
MOVE B,CSPTR ;COPY OVER THE ATSIGN AND FILESPEC
MOVN C,INDSIZ ;INPUT EXACT NUMBER OF CHARACTERS
CALL GEOFQ ;DO SIN AND CHECK FOR EOF
MOVE A,CJEPTR ;NOW INPUT CHARACTERS STARTING AFTER FILESPEC
MOVEI C,0 ;READ UNTIL NULL FOUND
SIN ;SLIDE STUFF LEFT THAT WAS AFTER INDIRECT SPEC
JRST GCOMMN ;JOIN COMMON CODE
;GEOFQ DOES SIN AND VERIFIES THAT THE FAILING SIN JSYS READING THE INDIRECT FILE WAS DUE
;TO EOF. THIS IS EXPECTED IF THE INDIRECT FILE HAS LINE NUMBERS.
;
;RETURNS +1 EOF WAS THE CAUSE OF THE ERROR. ALL AC'S PRESERVED.
; NEVER IF SOME STRANGE ERROR OCCURRED
GEOFQ: SIN ;READ ENTIRE FILE
ERJMP .+2 ;FAILED, GO INVESTIAGE
RET ;SUCCEEDED, RETURN
ADDM C,CMPSIZ ;FIX COMMAND SIZE. C WILL BE NEGATIVE IF LINE NUMBERS IN INDIRECT FILE
SAVEAC <A,B,C,D> ;SAVE WHAT THE SIN JSYS RETURNED
CALL DGETER ;GET THE ERROR CODE
CAIE A,IOX4 ;END OF FILE REACHED?
CALL CJERRE ;NO, SO BOMB OUT
RET ;YES, SO RETURN GOOD
;COME HERE IF COMMA OR LF. WE MUST FILTER OUT MULTIPLE COMMAS, SINCE CRLF AT THE
;END OF INDIRECT FILES GENERATES ONE COMMA, AND THEN THE COMMA IN THE COMMAND
;FOLLOWING THE INDIRECT SPEC WOULD CAUSE A MULTIPLE ONE.
GCMLF: MOVE B,CDPTR
CAMN B,CMPPT0 ;IS LINEFEED AT BEGINNING OF COMMAND?
JRST GCMC ;YES, SO IGNORE IT
LDB A,CDPTR ;LINEFEED IS USUALLY COMMA, BUT SEE IF COMMA ALREADY
CAIN A,"," ;DO WE ALREADY HAVE A COMMA?
JRST GCMC ;YES, IGNORE THIS LINEFEED
MOVEI A,"," ;TREAT END OF LINE AS COMMA
DPB A,CSPTR ;STORE IN SOURCE STRING IN FOR LDB INSTRUCTION
RET ;ACCOUNT FOR COMMA
;**;[941] Add 6 lines YKT JAN-17-83
;COME HERE IF "%" SIGN SEEN, WE MUST WRITE A COMMA PRECEEDING THE "%" SIGN. IF
;THE PRECEEDING FILE IS AN INDIRECT FILE, JUST FORGET ABOUT THE COMMA. BECAUSE
;AT THE END OF AN INDIRECT FILE, THE COMMA WILL BE CREATED.
CMPER: LDB Q1,CDPTR ;[941] LOAD LAST WRITTEN CHARACTER
CAIN Q1,"," ;[941] IS A COMMA?
RET ;[941] YES, DON'T WORRY
;**;[1003] Replaced 3 L with 15 L at CMPER+3 BCM MAY-07-84
SETO B, ;[1003] GET -1
ADJBP B,CMPPT0 ;[1003] ADJUST POINTER TO STRING BACK ONE CHAR
MOVEM B,CMPPT0 ;[1003] SAVE THIS AS ORIGINAL BYTE POINTER
MOVE A,CDPTR ;[1003] GET POINTER TO DESTINATION BYTE
CALL SUBBP ;[1003] GET NUMBER OF BYTES TO MOVE
SOJ A, ;[1003] ADJUST BY ONE
MOVN C,A ;[1003] TELL SOUT EXACT NUMBER OF BYTES TO MOVE
MOVE A,CMPPT0 ;[1003] WHERE TO MOVE STRING TO
MOVE B,CMPPT0 ;[1003] GET NEW START OF STRING
IBP B ;[1003] MAKE OLD START OF STRING
SKIPGE C ;[1003] DON'T DO SOUT IF ZERO!
SOUT% ;[1003] MOVE THE STRING BACKWARDS
MOVEI B,"," ;[1003] GET A COMMA
IDPB B,A ;[1003] STORE IT BEFORE "%"
MOVEI A,"%" ;[1003] GET BACK '%'
RET ;[1003] DONE. CONTINUE PROCESSING
;MAIN PARSER
PARSE: CALL RDFLD ;HERE TO READ A FIELD
PARSE2: JRST XTAB(A) ;TRANSFER ON BREAK TYPE
;TRANSFER TABLE FOR CHARACTER TYPE DISPATCH
XTAB: ERROR <Illegal character in command> ;0 - ILLEGAL
JRST RDSPAC ;1 - SPACE SEEN
JRST RDPLUS ;2 - PLUS SEEN
JRST RDSLSH ;3 - SLASH SEEN
ERROR <Illegal character in command> ;4 - ILLEGAL
ERROR <Illegal character in command> ;5 - ILLEGAL
JRST RDCOMA ;6 - COMMA SEEN
RET ;NULL IS END OF COMMAND
ERROR <Illegal character in command> ;10 - ILLEGAL
JRST RDPERC ;11 - PERCENT SEEN
JRST RDCOLN ;12 - COLON SEEN
JRST RDQS ;13 - QUOTED STRING STARTING
ERROR <Illegal character in command> ;14 - ILLEGAL
ERROR <Illegal character in command> ;15 - ILLEGAL
ERROR <Illegal character in command> ;16 - ILLEGAL
;HERE TO HANDLE QUOTED STRING
RDQS: MOVE A,P4 ;GET POINTER TO SWITCH
CALL SWMOV ;SAVE SWITCH STRING IN FSPEC
CALL RDQOT1 ;READ QUOTED STRING (OPEN QUOTE ALREADY SEEN)
MOVEM A,SAVQS ;REMEMBER POINTER TO QUOTED STRING
HRROI A,FSPEC ;POINT TO THE SAVED SWITCH
CALL DOSWI0 ;HANDLE THE PARTICULAR SWITCH
TXZ P1,F%SLSH ;SAY WE ARE DONE PROCESSING THE SWITCH
TXO P1,F%CMOK ;SAY NULL SPEC IS OK
JRST PARSE ;GO READ THE NEXT ITEM IN THE COMMAND
;HERE TO PROCESS COLON (MAY BE SWITCH DELIM OR DEVICE)
RDCOLN: CAIG P3,1 ;ANYTHING?
ERROR <Null spec before colon>
CALL CAPND ;APPEND COLON TO BUFFER
;**;[954] Add one line at RDCOLN+2 YKT 28-MAR-83
CAIE A,0 ;[954] SPECIAL CHARACTER?
JRST XTAB(A) ;YES, DISPATCH
;**;[954] Add one line at RDCOLN+3 YKT 28-MAR-83
JRST [TXO P1,F%LAHD
JRST RDSPAC] ;[954] NO, MAY BE A FILESPEC
CAPND: MOVEI Q1,":" ;REPLACE DELIMITER
CAPND1: DPB Q1,3+CSTXTB ;IN BUFFER
PUSH P,P3 ;SAVE COUNT
;**;[954] Modify one line at CAPND1+2 YKT 28-MAR-83
CALL RDFLDN ;[954] SPECIAL READ
ADDM P3,0(P) ;UPDATE COUNT
POP P,P3 ;PRUNE PDL
RET ;RETURN
;HERE TO PROCESS LINK SWITCH SPEC
RDPERC: CAILE P3,1 ;BETTER STAND ALONE
JRST RDSLH1 ;ELSE MAY BE LOCAL SW
MOVEI A,L.SIZE ;SIZE FOR L20 SWITCH
CALL BALLOC ;ALLOCATE BLOCK
HRRM A,LNK(P2) ;LINK TO NEW BLOCK
MOVE P2,A ;UPDATE AC P2
CALL RDQUOT ;READ QUOTED STRING
MOVEM A,NAM(P2) ;STORE STRING POINTER
LDF Q2,D%LINK ;SAY LINK SWITCH
IORM Q2,FLG(P2) ;...
TXO P1,F%CMOK ;SAY NULL SPEC OK
JRST PARSE ;CONTINUE
;HERE TO PROCESS COMMA (MUST HAVE COMPLETE FILESPEC NOW)
RDCOMA: TXZE P1,F%SLSH ;SWITCH FIELD?
JRST RDCMA3 ;YES - PROCESS
CAILE P3,1 ;DO WE HAVE AN ATOM?
JRST [CALL FILBLK ;YES - GEN BLOCK
TXZ P1,F%FILE ;DONE WITH THIS SPEC
JRST RDCMA1] ;PROCEDE
TXNN P1,F%CMOK ;NULL ATOM - IS IT OK?
JRST PARSE ;NO, MUST BE END OF INDIRECT FILE
;**;[716] Add 1 line at RDCMA1:+0L JRG 29-MAR-82
RDCMA1: SETZM GJNSF ;[716] CLEAR GJ%NS FLAG (ONLY HERE MUST ATOM BE DONE)
TXZ P1,F%CMOK ;CLEAR FLAG FOR NULL SPEC
SKIPN Q1,SRCSAV ;DID WE HAVE SEPARATE SOURCES
;**;[716] Replace 1 line with 6 at RDCMA1:+2L JRG 29-MAR-82
JRST [MOVE A,FLG(P2) ;[716] NO, CHECK TO SEE IF LINK SWITCH
TXNN A,D%LINK ;[716] IF LINK SWITCH, DON'T STORE
SKIPGE A,RELDAT ;[716] IF NOT LINK SWITCH, STORE IF GE 0
JRST RDCMA2 ;[716] DON'T STORE, GO SET UP LANG TYPE
MOVEM A,OVER(P2) ;[716] STORE
JRST RDCMA2] ;[716] GO SET UP LANG TYPE
MOVE B,BAKPTR ;GET PREVIOUS BLOCK POINTER
TXNE P1,F%OBJ ;HAVE OBJECT?
SETZM LNK(B) ;YES - CLEAR OLD SRC LINK
TXZN P1,F%OBJ ;CHECK FOR OBJ GIVEN
CALL MAKOBJ ;MAKE OBJECT BLOCK
HRLM Q1,SRC(P2) ;POINTER TO SOURCE LIST
HLRZ Q1,SRCSAV ;POINTER TO LAST OBJ BLOCK
HRRM P2,LNK(Q1) ;POINT TO NEW ONE
MOVEI Q2,LT.REL ;MARK AS RELOC
DPB Q2,[POINTR (<FLG(P2)>,F.LMSK)]
SETZM SRCSAV ;CLEAR POINTER
RDCMA2: SKIPGE B,LPROC ;HAVE A PROCESSOR?
LDB B,[POINTR (P1,F.LMSK)] ;USE DEFAULT
SETOM LPROC ;CLEAR THIS NOW
MOVE Q1,B ;COPY TYPE
CAIE Q1,LT.REL ;NO DEBUG AID FOR REL FILES
CAIN Q1,LT.MAC ; OR MACRO
MOVEI Q1,0 ;YES - NO AID FOR YOU
CAIN B,LT.SAI ;IF SAIL
SETOM SAILF ;SAY WE HAVE SEEN SAIL
CAMLE Q1,DEBAID ;CHECK BEST SEEN SO FAR
MOVEM Q1,DEBAID ;SAVE BETTER
PUSH P,P2 ;SAVE THIS POINTER
HLL P2,SRC(P2) ;POINTER TO SOURCE LIST
MOVE P5,FLG(P2) ;GET FLAGS
MOVEI Q2,0 ;INIT REG
CALL SRCSCN ;LOOP THROUGH SOURCES
;**;[941] Remove Edit 932 & 933 YKT JAN-17-82
;**;[933] Add 2 lines YKT DEC-13-82
; JRST [MOVE P2,BAKPTR ;[933] GET PREVIOUS BLOCK POINTER
; HRRZ P2,LNK(P2) ;[933] LOOK AT NEXT BLOCK
JRST [DPB B,[POINTR (<FLG(P2)>,F.LMSK)] ;STORE TYPE
ANDI P5,F.ALL ;MASK FLAGS WE WANT
IOR Q2,P5 ;ACCUMULATE RESULT
;**;[933] Remove EDIT #932 YKT DEC-13-82
;**;[932] Add 3 lines YKT NOV-22-82
; MOVEI P2,LHED ;[932] GET LIST HEAD
; HRRZ P2,LNK(P2) ;[932] LOOK AT NEXT BLOCK
; DPB B,[POINTR (<FLG(P2)>,F.LMSK)] ;[932] STORE TYPE
RET] ; AND EXIT
POP P,P2 ;RESTORE ORIG POINTER
IORM Q2,FLG(P2) ;SET AGGREGATE FLAGS
JRST PARSE ;CONTINUE SCAN
;HERE TO PROCESS SWITCH
RDCMA3: TXZE P1,F%FILE ;FILE SPEC SEEN?
JRST [CALL DOSWIT ;PROCESS SWITCH
JRST RDCMA1] ;CHECK FOR 2ND PART
CALL DOSWIT ;DO SWITCH
TXNE P1,F%SPEC ;ANYTHING YET?
SKIPGE LPROC ;YES - LANG SWITCH?
JRST PARSE ;NO - CONTINUE
JRST RDCMA2 ;YES - HANDLE SOURCE UPDATE
;ROUTINE TO MAKE OBJ BLOCK FROM LAST SRC BLOCK (P2)
MAKOBJ: MOVEI A,B.SIZE ;GET SOME SPACE
CALL BALLOC ;...
EXCH A,P2 ;P2 POINTS TO NEW BLK
MOVEI Q2,NAM(P2) ;SET UP BLT POINTER
HRLI Q2,NAM(A) ;...
;**;[716] Replace 1 line with 3 at MAKOBJ:+5L JRG 29-MAR-82
BLT Q2,B.SIZE-1(P2) ;[716] MOVE VALUES
SKIPL A,RELDAT ;[716] DO WE WANT TO STORE?
MOVEM A,OVER(P2) ;[716] YES, DO SO
LDF A,D%EXTN ;CLEAR EXPLICIT EXTENSION
ANDCAM A,FLG(P2) ; FLAG IN IMPLICIT NAME
RET ;RETURN
;HERE TO PROCESS SLASH
RDSLSH: CAILE P3,1 ;ANYTHING BEFORE SLASH?
JRST RDSLH1 ;HANDLE FILESPEC
TXOE P1,F%SLSH ;SET SLASH SEEN
ERROR <Illegal slash>
JRST PARSE ;CONTINUE SCAN
;HERE TO HANDLE SPEC BEFORE SLASH IS PROCESSED
RDSLH1: TXO P1,F%LAHD ;WANT TO SEE IT AGAIN
TXZE P1,F%SLSH ;PREVIOUS SWITCH?
JRST RDSPC2 ;YES - PROCESS
CALL FILBLK ;STORE FILE SPEC
TXNE P1,F%OBJ ;IN OBJECT SPEC?
JRST [TXZ P1,F%FILE ;YES - SAY DONE WITH SPEC
JRST RDCMA1] ; AND STORE
HRL P2,B ;SAVE BACK POINTER
JRST PARSE ;AND CONTINUE SCAN
;HERE TO PROCESS SPACE (DELIMITS OBJECT MODULE)
RDSPAC: TXZ P1,F%CMOK ;CLR THIS HERE
TXZN P1,F%FILE ;ANY SPEC SEEN YET?
JRST RDSPC1 ;NO - CHECK SWITCH
TXZE P1,F%SLSH ;SW SEEN?
JRST [SKIPN SRCSAV ;SAVED SOURCE POINTER YET?
MOVEM P2,SRCSAV ;NO - SAVE ONE
TXO P1,F%OBJ ;AND MOVE TO OBJECT FIELD
JRST RDSPC2] ;PROCESS SWITCH
RDSPC0: CAIG P3,1 ;DO WE HAVE A SPEC?
CALL SCREWUP ;NEVER COME HERE
CALL RDFILB ;SAVE FILE
TXO P1,F%OBJ ; AND SET FLAG FOR OBJECT
JRST PARSE ;PROCEDE
RDSPC1: TXZN P1,F%SLSH ;SWITCH?
JRST RDSPC0 ;NO - FILE ALONE
RDSPC2: CALL DOSWIT ;PROCESS SWITCH
JRST PARSE ;PROCEED
;HERE TO PROCESS PLUS SIGN (MULTIPLE SOURCES)
RDPLUS: CAILE P3,1 ;BETTER HAVE SPEC
TXNE P1,F%OBJ ;AND BE IN SOURCE FIELD
ERROR <Illegal plus sign>
CALL RDFILB ;STASH SPEC AND CHECK SRCSAV
JRST PARSE ;GET NEXT SPEC
RDFILB: CALL FILBK1 ;STASH SPEC ETC.
HRL P2,B ;BACK POINTER TO BE SAVED
SKIPN SRCSAV ;FIRST TIME?
MOVEM P2,SRCSAV ;YES - SAVE POINTER TO THIS BLK
RET ;RETURN
SUBTTL PARSE SUBROUTINES
;ROUTINE TO ALLOCATE AND FILL A FILE DESCR BLOCK
;RETURNS POINTER TO PREVIOUS BLOCK IN B, NEW BLOCK IN P2.
;**;[716] Change 2 lines at FILBLK:+0L JRG 29-MAR-82
FILBLK: TXZA P1,F%NLOB ;[716] SAY OK TO LOOK FOR OBJECT
FILBK1: TXO P1,F%NLOB ;[716] SAY NOT TO LOOK FOR OBJCECT
MOVE B,[POINT 7,FSPEC] ;COPY STRING TO FSPEC
;**;[947] Delete next line YKT FEB-08-83
;**;[931] Add one line at FILBK1+1 YKT NOV-22-82
; TXO P1,F%WARN ;[947][931] DEFAULT
FILBK2: ILDB A,P4 ;...
IDPB A,B
JUMPN A,FILBK2
MOVEI A,B.SIZE ;SIZE OF BLOCK
CALL BALLOC ;ALLOCATE IT
HRRM A,LNK(P2) ;STORE POINTER TO NEW BLOCK
PUSH P,P2 ;SAVE OLD POINTER
MOVE P2,A ;SET UP NEW POINTER
HRRM P1,FLG(P2) ;SET DEFAULTS
SETZM NAM(P2) ;NONE YET
TXO P1,F%FILE!F%SPEC ;SAY FILE SEEN
CALL GTLANG ;FILL IN LANG TYPE INFO
JRST [LDF A,D%FNF ;SET FILE NOT FOUND
IORM A,FLG(P2) ;IN FLAGS OF SPEC
JRST NODEF] ;KEEP GOING
MOVE A,EXTP ;GET POINTER TO EXTENSION
TXNN P1,F%OBJ ;ON OBJECT OR FILE NOT FOUND?
CALL PARDEF ;NO, GOBBLE THE DEFAULT SWITCHES
NODEF: POP P,B ;RETURN BACK POINTER
MOVEM B,BAKPTR ;STORE IN BAKPTR TOO
RET ;...
;ROUTINE TO ALLOCATE SOME SPACE IN STRING SPACE
;CALL: MOVEI A,<SIZE-IN-WORDS>
; CALL BALLOC
; <RETURN> C(A) := ADDRS OF BLOCK, BLOCK ZEROED
BALLOC: STKVAR <BSZ>
MOVEM A,BSZ ;REMEMBER HOW MUCH IS WANTED
CALL GETBUF ;GET THE MEMORY
SETZM (A) ;CLEAR OUT THE BLOCK
SOSGE B,BSZ ;GET ONE LESS THAN SIZE
RET ;NO MORE TO CLEAR, BLOCK IS ONE ONE WORD
ADD B,A ;GET LAS WORD TO CLEAR
HRRI C,1(A) ;MAKE BLT POINTER FOR 0ING BLOCK
HRL C,A
BLT C,(B) ;0 THE BLOCK
RET
;GTLANG - ROUTINE TO DETERMINE LANGUAGE TYPE AND CHECK FOR
;EXISTING OBJECT FILE.
GTLANG: CALL GTLNGX ;CALL SUBROUTINE
JRST GTLNGA ;NO SUCH FILE RETURN
AOS 0(P) ;SKIP RETURN
GTLNGB: HRRZ A,LNGJFN ;GET JFN USED
JUMPE A,R ;NONE - RETURN
CALL RJFN ;RELEASE LNGJFN
SETZM LNGJFN ;SAY RELEASED
RET ;GIVE DESIRED RETURN
;**;[958] Add two lines at GTLNGA+0L YKT 03-MAY-83
GTLNGA: TXNN P1,F%OBJ ;[958] IS IN OBJECT FILE?
CALL CJERR ;[958] NO, IT IS SOURCE FILE
HRROI A,FSPEC ;POINT TO SPEC
CALL BUFFS ;ISOLATE IT
MOVEM A,NAM(P2) ;REMEMBER POINTER
JRST GTLNGB ;JOIN COMMON CODE
;**;[716] Replace routines GTLNGX through GTLNG1 JRG 29-MAR-82
GTLNGX: DMOVE A,[POINT 7,[ASCII "*"]
GJ%OLD+GJ%IFG+GJ%FLG] ;LOAD DEFAULTS FOR NON-OBJECT FIELD
TXNE P1,F%OBJ ;IN OBJECT FIELD?
DMOVE A,[POINT 7,[ASCII "REL"]
GJ%FOU+GJ%FLG] ;YES, THEN USE THESE DEFAULTS INSTEAD
MOVEM A,CJFNBK+.GJEXT ;SAVE DEFAULTS
MOVEM B,CJFNBK
MOVE A,[377777,,377777] ;DON'T USE ANY OTHER INPUT
MOVEM A,CJFNBK+.GJSRC
MOVEI A,CJFNBK ;BLOCK ADDRS
HRROI B,FSPEC ;POINT TO STRING
CALL GTJFS ;LOOK UP FILE
JRST [CAIN A,GJFX24 ;FILE NOT FOUND RETURN
RET ;RETURN ERROR
CAIL A,GJFX16 ;VARIOUS OTHER FNF RETURNS
CAILE A,GJFX21 ;...
CALL CJERR ;SYNTAX ERROR
RET] ;ERROR RETURN
HRRZM A,LNGJFN ;SAVE JFN
LDB B,B ;CHECK TERMINATOR
JUMPN B,[HRROI A,FSPEC
ERROR <Illegal character in filespec: %1m>]
TXNE A,GJ%EXT ;WAS AN EXPLICIT EXTENSION TYPED?
TXZA P1,F%XPXT ;NO, CLEAR F%XPXT
TXO P1,F%XPXT ;YES, SET F%XPXT
TXNN P1,F%OBJ ;ARE WE IN OBJECT FIELD?
JRST GTLNX0 ;NO, GO HANDLE
MOVX A,GJ%OLD+GJ%FLG ;IN OBJECT FIELD, TRY TO DO INPUT GTJFN
SKIPE GJNSF ;DO WE WANT TO SET GJ%NS?
TXO A,GJ%NS ;YES, SET IT
MOVEM A,CJFNBK ;STORE FLAGS
MOVEI A,CJFNBK ;BLOCK ADDRS
HRROI B,FSPEC ;POINT TO STRING
CALL GTJFS ;LOOK UP .REL FILE
JRST GTLNX0 ;FAILS, NO STACKED OUTPUT JFN
TXO P1,F%STOJ ;THERE IS STACKED OUTPUT JFN
HRRZS A ;TAKE THE FLAGS OFF THE JFN FOR DVCHR
EXCH A,LNGJFN ;INPUT JFN BECOMES LNGJFN
MOVEM A,OUTJFN ;OUTPUT JFN IS SAVED AS OUTJFN
CALL GTHDD ;GET THE HDD
MOVEM C,HDDNO(P2) ;STORE IT IN HDDNO
JRST GTLNX1 ;PROCEED
GTLNX0: TXZ P1,F%STOJ ;NO STACKED OUTPUT JFN
SETZM HDDO(P2) ;INDICATE NOT DIFFERENT DIRECTORY FOR OBJECT
GTLNX1: LDF A,GJ%OFG!GJ%XTN ;LOAD FLAGS
MOVEM A,CJFNBK ;STORE FLAGS
LDF A,G1%SLN ;SUPRESS LOGICAL NAME EXPANSION
MOVEM A,CJFNBK+.GJF2
SETZM CJFNBK+.GJEXT ;NO MORE DEFAULT EXTENSION
MOVEI A,CJFNBK ;POINT TO BLOCK
HRROI B,FSPEC ;POINT TO STRING
CALL GTJFS ;LOOK UP FILE
CALL JERRE ;SHOULD NEVER FAIL
MOVE B,A ;WRITE DEVICE AND DIRECTORY FIELDS
HRROI A,FSPEC ;INTO FSPEC
MOVX C,1B2+1B5+JS%PAF
JFNS
MOVEM A,NAM(P2) ;SAVE BYTE POINTER TO BEGINNING OF FILE NAME
MOVE B,LNGJFN ;WRITE FILENAME FIELD
MOVX C,1B8 ;FROM OTHER JFN INTO FSPEC
JFNS
MOVEM A,FSPEXT ;SAVE EXTENSION POINTER HERE
CALL RJFN ;RELEASE PARSE-ONLY JFN
MOVE A,LNGJFN ;JFN
DVCHR ;GET DEVICE CHARACTERISTICS
TXNN B,DV%IN ;IS DEVICE OUTPUT ONLY
TXNE P1,F%NLOD ;AND ARE WE LOADING?
TRNA ;NO, SKIP
RET ;YES, LEAVE
TXNE B,DV%DIR ;DIRECTORY DEVICE?
TDZA C,C ;YES, CLEAR
HRLOI C,377777 ;NO, FUNNY LARGE DATE
TXNE P1,F%OBJ ;ARE WE IN OBJECT FIELD?
TXNE P1,F%STOJ ;IF SO, DO WE HAVE STACKED OUTPUT JFN
TRNA ;NOT IN OBJECT FIELD OR THIS IS INPUT JFN, SKIP
SETO C, ;FORCE COMPILE (NO INPUT FILE TO CHECK)
MOVEM C,BSTDAT ;SAVE IN BSTDAT
TXNN B,DV%DIR ;IS IT A DIRECTORY DEVICE?
SKIPA C,A ;NO, SAVE REAL DEVICE DESIGNATOR
SETZ C, ;YES, SAVE ZERO (FILL IN LATER WITH GTHDDF)
MOVEM C,HDD(P2)
JUMPE C,GTLNX2 ;DON'T SAVE IN HDDNO IF NOT FORCED COMP
TXNE P1,F%OBJ ;ARE WE IN OBJECT FIELD?
MOVEM C,HDDNO(P2) ;YES, SAVE FORCED COMP IN HDDNO
GTLNX2: MOVEI A,LT.REL ;DEFAULT SOURCE LANGUAGE TYPE SEEN IS REL
MOVEM A,LNGTYP
TXZ P1,F%FWKE ;CLEAR "FILE WITH KNOWN EXTENSION" BIT
LDF A,GJ%OLD ;FILES WE'RE LOOKING FOR ARE OLD
MOVEM A,CJFNBK ;SAVE FLAGS IN GTJFN BLOCK
SKIPN BSTDAT ;IS NON-DIRECTORY DEVICE OR FORCED COMP OBJECT
TXNE P1,F%XPXT ;OR WAS AN EXPLICIT EXTENSION TYPED?
TRNA ;YES TO ONE, SKIP
JRST GTLNG2 ;NO, START LOOKING AT STANDARD EXTENSIONS
TXNE P1,F%OBJ ;IN OBJECT SPEC?
SKIPN BSTDAT ;NON-TWO-WAY SPEC (NON-DIR OR INPUT FAILED)?
TRNA ;NO TO ONE, SKIP
JRST [MOVX B,LT.REL ;YES TO BOTH, EXTENSION MIGHT NOT BE THERE,
JRST GTLNX3] ;SO IT'S ARBITRARILY TYPE .REL
MOVE A,LNGJFN ;GET BACK LNGJFN
CALL DJFNSE ;PUT EXTENSION IN CWBUF
MOVE B,CWBUF ;PUT EXTENSION INTO B
CALL LOOKE ;LOOK UP EXTENSION IN LTAB
SETZ B, ;FAILED, MAKE LANGUAGE TYPE ZERO
GTLNX3: MOVEM B,LNGTYP ;STORE LNGTYP
MOVE A,LNGJFN ;GET BACK LNGJFN AGAIN
;**;[919] Add 1 line at GTLNX:+3L PED 11-OCT-82
MOVEM A,TMPJFN ;[919] PUT IT WHERE GTLN1S WILL FIND IT
SKIPE BSTDAT ;IS NON-DIRECTORY DEVICE OR FORCED COMP OBJECT?
JRST GTLNG4 ;YES, SKIP CHECKING FOR BETTER THINGS
MOVE Q1,B ;GET IN LANGUAGE TYPE FOR GTLN1S
CALL GTLN1S ;MAKE SHORT CALL TO LOOK AT THIS FILE
MOVE B,LNGTYP ;SEE IF WE JUST LOOKED AT .REL FILE
CAIN B,LT.REL ;DID WE?
JRST GTLNG4 ;YES, SKIP CHECKING IT AGAIN
GTLNG2: MOVE Q1,[1-LTABL,,1] ;GET LANGUAGE TABLE INDEX (SKIP NULL EXTENSION)
SETOM RELDAT ;SET REL FILE DATE-TIME TO -1 (FORCE COMPILE)
;**;[749] Modify one line at GTLNG2+2 YKT 16-NOV-82
TXNN P1,F%NLOB ;[749] CAN WE USE AN OBJECT FILE?
GTLNG3: CALL GTLNG1 ;CHECK THIS FILE TYPE
;WE CAN'T USE AN OBJECT FILE, SKIP .REL ENTRY
;NOTE THAT .REL MUST ALWAYS BE
;THE FIRST ENTRY IN THE LANGUAGE TABLE
TXNN P1,F%XPXT ;STOP HERE IF EXPLICIT EXTENSION WAS TYPED
AOBJN Q1,GTLNG3 ;SEE IF ANY OTHERS
TXZN P1,F%FWKE ;DID WE SEE A FILE WITH A KNOWN EXT?
RET ;NO, FAIL
GTLNG4: LDF A,D%EXTN ;EXPLICIT EXTENSION GIVEN
IORM A,FLG(P2)
;**;[958] Add 4 lines at GTLNG4+1L YKT 03-MAY-83
SKIPE RELOSW ;[958] IS RELOCATABLE SW SEEN?
JRST [TXNN P1,F%XPXT ;[958] YES, IS EXPLICIT FILE TYPE EXISTING?
ANDCAM A,FLG(P2) ;[958] NO,
JRST .+1] ;[958] YES,
MOVE A,LNGJFN ;RESTORE LANGUAGE JFN
CALL DJFNSE ;GET EXTENSION
CALL COPEXT ;COPY EXTENSION
SKIPE B,LNGTYP ;DO WE HAVE LANGUAGE TYPE FROM BEFORE?
CALL SETLTP ;YES, SET IT
PUSH P,B ;SAVE LANG TYPE TEMPORARILY
MOVE A,LNGJFN ;GET BACK LNGJFN
SKIPN C,HDD(P2) ;IS IT A NON-DIRECTORY DEVICE?
CALL GTHDDF ;NO, GET HDD FOR FILE
MOVEM C,HDD(P2) ;STORE IT
;**;[919] Replace 2 lines with 7 at GTLNG4:+12.L PED 11-OCT-82
TLNE C,-1 ;[919] CONNECTED DIRECTORY
IFSKP.
SETOM GJNSF ;[919] YES, FOLLOWING OBJECT SPEC USES GJ%NS
MOVE B,HDDO(P2) ;[919] CHECK OBJECT HDD
TLNE B,-1 ;[919] CONNECTED DIR TOO?
SETOM RELDAT ;[919] NO, CAN'T USE IT
ENDIF.
POP P,B ;RESTORE LANG TYPE
CAIN B,LT.REL ;IS IT A .REL FILE?
MOVEM C,HDDO(P2) ;YES, STORE HDD IN HDDO ALSO
MOVE A,BSTDAT ;GET BEST D/T FOUND EARLIER
CAIN B,LT.REL ;IS IT A .REL FILE?
MOVE A,RELDAT ;YES, GET D/T FROM HERE INSTEAD
CALL STODT ;STORE D/T ACCORDING TO TYPE
CAIE B,LT.REL ;IS OBJECT TYPE ALREADY
TXNE P1,F%NLOB ;OR CAN'T WE LOOK FOR OBJECT?
CALLRET STEXNA ;YES, UPDATE FSPEC, STORE NAME, LEAVE
TXNE P1,F%STOJ ;IS THERE A STACKED OUTPUT JFN?
JRST [MOVE A,OUTJFN ;YES, GET IT BACK
JRST GTLNG5] ;AND SKIP OVER GETTING A NEW JFN
SETZM CJFNBK+2 ;CLEAR DEFAULTS
MOVE Q1,[CJFNBK+2,,CJFNBK+3]
BLT Q1,XTNCNT-1 ;...
HRROI A,[ASCIZ /REL/] ;STORE DEFAULT FOR FILE EXTENSION
MOVEM A,CJFNBK+.GJEXT
LDF A,GJ%FOU ;FIND OUT WHERE .REL FILE WILL GO
MOVEM A,CJFNBK ;...
MOVEI A,CJFNBK ;GET GTJFN BLOCK ADDRESS
MOVE B,NAM(P2) ;ENTER .REL FILE ON CONNECTED DIR
CALL GTJFS ;(OR ON DSK:)
CALLRET STEXNA ;FAILED, UPDATE FSPEC AND STORE NAME, AND LEAVE
GTLNG5: SETOM OVER(P2) ;SAY WE HAVE CREATED A NEW .REL FILE
TXO P1,F%STOJ ;WE HAVE A STACKED OUTPUT JFN
MOVEM A,OUTJFN ;SAVE FOR AFTER DVCHR
CALL GTHDD ;GET HDD FOR THE FILE
MOVEM C,HDDNO(P2) ;SAVE FOR LATER
CALLRET STEXNA ;UPDATE FSPEC, STORE FILE NAME, AND LEAVE
GTLNG1: HRROI B,LTAB(Q1) ;GET A LANGUAGE TYPE FOR DEFAULT
MOVEI A,CJFNBK ;GET ADDRESS OF GTJFN BLOCK
MOVEM B,.GJEXT(A) ;SAVE DEFAULT LANG EXT
TRNN Q1,777776 ;IS THIS TYPE .REL?
TXNN P1,F%XPXT ;AND WAS THERE AN EXPLICIT EXTENSION TYPED?
SKIPA B,[POINT 7,FSPEC] ;NOT BOTH - USE DIRECTORY SPECIFIED
MOVE B,NAM(P2) ;YES, IMPLICIT OBJECT ONLY LOOKED FOR ON DSK:
CALL GTJFS ;SEE IF THIS LANGUAGE TYPE IS THERE
RET ;THIS TYPE IS NOT THERE, RETURN
;**;[922] Add 7 lines at GTLNG1+11 YKT 15-OCT-82
MOVE B,[1,,.FBCTL] ;[922]
MOVEI C,C ;[922]
GTFDB ;[922]
TXNN C,FB%OFF ;[922] IS THE REL FILE OFFLINE?
JRST .+4 ;[922] NO, DON'T WORRY
SETOM RELDAT ;[922] YES, FORCE TO RECOMPILE
;**;[924] Add 1 line at GTLNG1+17 YKT 22-0CT-82
ETYPE <%% %1S - is offline file %_> ;[924] WARNING MESSAGE
RET ;[922] ASSUME NO REL FILE EXISTING
MOVEM A,TMPJFN ;FOUND A JFN, SAVE IT FOR NOW
GTLN1S: CALL GTDT ;GET THE D & T OF LAST WRITE TO FILE
CAMG A,BSTDAT ;IS IT LATER THAN PREVIOUSLY FOUND TYPE
CALLRET RJFN ;NO, THROW IT AWAY AND RETURN
HRRZ B,Q1 ;GET LANGUAGE TYPE INTO B
CAIE B,LT.REL ;IS THIS A .REL FILE?
JRST [MOVEM A,BSTDAT ;NOT .REL FILE, PUT IN BSTDAT
JRST GTLN1F] ;REJOIN TO CHECK FLAGS
MOVEM A,RELDAT ;YES, SAVE D&T FOR MAKOBJ
TXNE P1,F%OBJ ;IS THIS OBJECT SPEC?
JRST GTLN1F ;YES, DON'T FIND HDD AGAIN
;**;[919] Remove 2 lines at GTLN1S:+9.L PED 11-OCT-82
MOVE A,TMPJFN ;LONG CALL, FROM TMPJFN
CALL GTHDDF ;GET HDD OF .REL FILE
MOVEM C,HDDO(P2) ;SAVE IT FOR LATER
GTLN1F: TXON P1,F%FWKE ;SAY WE'VE SEEN A FILE WITH KNOWN EXT
TXNN P1,F%XPXT ;FIRST TIME, IS THIS SHORT CALL AT GTLN1S?
TRNA ;NOT FIRST TIME OR ISN'T LNGJFN, SKIP
RET ;THIS IS A SHORT CALL, DON'T SWAP TO SELF
HRRZ B,Q1 ;GET LANGUAGE TYPE INTO B
CAIN B,LT.REL ;IS THIS A .REL FILE?
TXNN P1,F%XPXT ;IF SO, IS THIS THE FIRST FILE WE'RE DOING?
TRNA ;NOT .REL FILE OR IT'S THE FIRST FILE, SKIP
CALLRET RJFN ;DON'T SWAP WITH VALID SOURCE JFN, LEAVE NOW
MOVE A,TMPJFN ;GET BACK THE JFN OF THIS FILE
MOVE B,LNGJFN ;GET JFN OF CURRENT BEST FILE
SWJFN ;SWAP THE TWO JFN'S
HRRZ B,Q1 ;GET LANGUAGE TYPE INTO B
CAIN B,LT.REL ;IS THIS A .REL FILE?
CALLRET RJFN ;YES, LEAVE NOW
TXNE P1,F%LANG ;IS THERE A GLOBAL LANGUAGE SWITCH?
LDB B,[POINTR (P1,F.LMSK)] ;YES, SUBSTITUTE THAT LANGUAGE TYPE
MOVEM B,LNGTYP ;SAVE THE LANGUAGE TYPE WE FOUND
CALLRET RJFN ;THROW AWAY JFN WE DON'T WANT, AND RETURN
SETLTP: SKIPGE LPROC ;HAVE PROCESSOR SET YET?
JRST [MOVEM B,LPROC ;NO -SET IT
RET] ; AND RETURN
TXNE P1,F%OBJ ;OK IF OBJECT FIELD
CAIE B,LT.REL ;OK IF RELOC
CAMN B,LPROC ;OR SAME AS BEFORE
RET ;...
ERROR <Language processor conflict>
;ROUTINE TO COPY EXTENSION FROM CWBUF . THE COPY IS
;USED AS THE FILE-TYPE USED FOR LOOKING UP DEFAULTS IF IT ISN'T IN THE
;OBJECT FIELD.
;POINTER TO THE COPY IS STORED IN EXTP
COPEXT: HRROI A,CWBUF ;POINT TO EXTENSION
CALL BUFFS ;MAKE A COPY
MOVEM A,EXTP ;REMEMBER POINTER TO COPY
RET
;**;[716] Delete routines GTLNGS and GTASC JRG 29-MAR-82
;**;[716] Insert routine CHK10 JRG 29-MAR-82
;CHK10 - CHECK FILE NAME TO BE OUTPUT FOR TOPS10 COMPAT.
;TAKES JFN IN B
CHK10: MOVE A,CSBUFP ;BEGINNING OF STRING SPACE
MOVE D,A ;POINTER TO FILESPEC'S END SO FAR
LDF C,1B2+1B35 ;GET DEVICE
JFNS
CALL GTASIZ ;GET STRING SIZE
CAILE C,7 ;MAX LEGAL (INCLUDES ":")
JRST [ HRROI A,FSPEC
ERROR <Device name exceeds 6 characters: %1M>]
HRRZ B,LNGJFN ;JFN
LDF C,1B8+1B35 ;FILE NAME
JFNS
CALL GTASIZ ;GET SIZE
CAILE C,6 ;MAX LEGAL
JRST [ HRROI A,FSPEC
ERROR <File name exceeds 6 characters: %1M>]
HRRZ B,LNGJFN ;JFN
LDF C,1B11+1B35 ;GET EXTENSION
JFNS
CALL GTASIZ
CAILE C,4 ;MAX LEGAL (INCLUDES ".")
JRST [ HRROI A,FSPEC
ERROR <File type exceeds 3 characters: %1M>]
RET
GTASIZ: MOVEI C,0 ;INIT COUNT
GTASZ1: CAMN A,D ;COMPARE
RET ;MATCH RETURN
ILDB B,D ;PROCEED - GET CHAR
CAIE B,"-" ;CHECK LEGAL
CAIN B,"_"
JRST ILCHR ;INFORM LOSER
CAIN B,"$"
JRST ILCHR
AOJA C,GTASZ1 ;LOOP TILL MATCH
ILCHR: HRROI A,FSPEC ;GET FILESPEC THAT'S WRONG
ERROR <Illegal character %2\ in file: %1m">
;DOSWIT - DECODE SWITCH AND TAKE ACTION
DOSWIT: MOVE A,P4 ;STR POINTER TO A
CALL SWMOV ;MOVE STR TO FSPEC
MOVE B,A ;REMEMBER POINTER TO LAST CHARACTER
HRROI A,FSPEC ;POINTER TO SW NAME
; CALLRET DOSWI0 ;DO THE SWITCH
;ROUTINE TO PARSE A SWITCH. GIVE IT POINTER TO SWITCH IN A.
;GIVE IT POINTER TO END OF SWITCH IN B.
DOSWI0: STKVAR <SUFFIX>
MOVE B,A ;PUT POINTER IN B
TLC B,-1
TLCN B,-1
HRLI B,440700 ;MAKE REAL BYTE POINTER
SETZM SUFFIX ;NO SUFFIX YET
DOSWI1: ILDB D,B ;SCAN SWITCH STRING
JUMPE D,DOSWI2 ;IF NULL CHARACTER, NO SUFFIX TO WORRY ABOUT
CAIE D,":" ;FIND A COLON?
JRST DOSWI1 ;NO, KEEP LOOKING
MOVEM B,SUFFIX ;REMEMBER POINTER TO SUFFIX
MOVEI C,0 ;MAKE STRING END IN NULL
DPB C,B
DOSWI2: MOVE B,A ;GET POINTER TO SWITCH AGAIN
MOVEI A,SWTAB ;THE SWITCH TABLE
TBLUK ;LOOK UP THE SWITCH
TXNE B,TL%NOM ;NO MATCH AT ALL?
JRST NOMAT ;CORRECT
TXNE B,TL%AMB ;AMBIGUOUS?
JRST AMBIG ;YUP
MOVE C,(A) ;PUT VALUE INTO C
;**;[974] Add 17 lines YKT 15-AUG-83
HLR D,C ;[974]
CAIN D,[ASCIZ "BINARY"] ;[974]
SETOM BINYSW ;[974]
CAIN D,[ASCIZ "WARNINGS"] ;[974]
SETOM WARNSW ;[974]
CAIN D,[ASCIZ "NOCREF"] ;[974]
SETOM NOCRSW ;[974]
CAIN D,[ASCIZ "NODEBUG"] ;[974]
SETOM NODBSW ;[974]
CAIN D,[ASCIZ "NOFLAG-NON-STANDARD"] ;[974]
SETOM NOFGSW ;[974]
CAIN D,[ASCIZ "NOLIST"] ;[974]
SETOM NOLISW ;[974]
CAIN D,[ASCIZ "NOMACHINE-CODE"] ;[974]
SETOM NOMASW ;[974]
CAIN D,[ASCIZ "NOOPTIMIZE"] ;[974]
SETOM NOOPSW ;[974]
HRRZ B,(C) ;GET RHS OF TABLE
HLL C,(C) ;GET FLAGS FROM LHS
MOVE A,SUFFIX ;GIVE SUPPORT ROUTINES POINTER TO SWITCH ARG
TXNE C,S%DSP ;CHECK FOR ROUTINE ADDRS
JRST 0(B) ;EXIT THROUGH ROUTINE
TXNE C,S%VAL!S%LINK ;VALUE ALLOWED OR L20 SWITCH?
JRST SWVAL ;YES - FURTHER WORK REQ'D
CAIN P5,":" ;CHECK FOR COLON
JRST [ HRROI A,FSPEC
ERROR <Value illegal for switch: %1m>]
TXNE C,S%LTYP ;LANGUAGE TYPE DESIGNATOR?
JRST SWLTYP ;YES - CHECK PERM/TEMP
MOVE D,[IORM B,FLG(P2)] ;INTSTR TO SET FLAGS
TXNE C,S%TOFF ;CLEAR FLAGS?
TLC D,(<IORM>-<ANDCAM>) ;YES - CHANGE INSTR
TXNE C,S%FLH ;FLAGS IN LH?
MOVSS B ;YES - SWAP HALVES
TXNN C,S%FLH ;PERM FLAGS?
TXNN P1,F%SPEC ;OR FILE SPEC SEEN YET
JRST [TLZ D,17 ;CLEAR INDEX REG
HRRI D,P1 ;SET FLAG ADDRS
JRST DOSWIX] ;DO FLAGS & RETURN
TXNE C,S%FRH ;TEMP FLAGS?
DOSWIX: XCT D ;YES - SET/CLR IN DESC BLOCK
RET ;RETURN
;HERE TO HANDLE ADDITIONAL VALUES AND LINK-20 SWITCHES
SWVAL: RET ;RETURN FOR NOW
;/STAY CAUSES EXEC TO STAY AT COMMAND LEVEL DURING COMPILATION/LOADING.
DOSTAY: SETOM STAYF ;REMEMBER TO STAY
RET
;HANDLE /LANGUAGE-SWITCHES:
DOLSW: TXNE P1,F%SPEC ;GLOBAL?
JRST DOL1 ;NO, ON PARTICULAR PROGRAM
SKIPE LSWPTR ;YES, ALREADY GIVEN?
ERROR <Only one global /LANGUAGE-SWITCHES: allowed>
MOVE A,SAVQS ;GET POINTER TO SAVED QUOTED STRING
MOVEM A,LSWPTR ;REMEMBER POINTER TO STRING
RET
DOL1: SKIPE SWP(P2) ;SWITCH GIVEN FOR THIS FILE YET?
ERROR <Only one /LANGUAGE-SWITCHES: switch allowed per source module>
MOVE A,SAVQS ;GET POINTER TO SAVED QUOTED STRING
MOVEM A,SWP(P2) ;REMEMBER POINTER TO STRING
RET
;HERE TO HANDLE LANGUAGE TYPE SWITCHES
SWLTYP: CAIN B,LT.SAI ;IF SAIL
SETOM SAILF ;SAY WE HAVE SEEN SAIL
;**;[958] Add 7 lines at SWLTYP+1L YKT 03-MAY-83
CAIN B,LT.REL ;[958] IS RELOCATABLE SW?
JRST [SETOM RELOSW ;[958] YES, SO SET THE SW SEEN
TXNE P1,F%XPXT ;[958] IS FILE TYPE SEEN?
JRST .+1 ;[958] YES,
LDF Q3,D%EXTN ;[958] NO, LET THE .REL FILE BEEN USED
ANDCAM Q3,FLG(P2);[958] MAKE SURE AN EXPLICIT EXTEN ISN'T USED
JRST .+1] ;[958]
;**;[716] Replace 8 lines with 21 at SWLTYP:+2L JRG 29-MAR-82
TXNN P1,F%SPEC ;[716] SPEC SEEN YET?
JRST SWLTP2 ;[716] NO, GO HANDLE GLOBAL SWITCH
MOVE C,LPROC ;[716] MOVE IN LANGUAGE TYPE WE ARE REPLACING
CAIN C,LT.REL ;[716] IS IT .REL?
RET ;[716] YES, DON'T CHANGE, LEAVE
;**;[746] Add 2 lines at SWLTYP:+7L YKT 19-AUG-82
;**;[958] Modify next 4 lines YKT 03-MAY-83
SKIPN DEFSW ;[958] SET DEFAULT SW SEEN?
JRST .+3 ;[958] NO,
SETZM DEFSW ;[958] YES, SET FLAG ON
TRNN P1,F%LANG ;[958] IS GLOBAL LANGUAGE SWITCH SEEN?
MOVEM B,LPROC ;[716] NO, SET PROCESSOR TYPE
CAIE B,LT.REL ;[716] IS THIS /REL WE'RE SETTING?
RET ;[716] NO, WE ARE DONE
JUMPE C,SWLTP1 ;[716] IF WAS NULL TYPE, MOVE SOURCE TO OBJECT
SKIPN HDDO(P2) ;[716] IF WAS NON-NULL, IS OBJECT FILE SET UP?
JRST SWLTP1 ;[716] NO, MOVE SOURCE TO OBJECT
;**;[958] Delete next two lines YKT 03-MAY-83
; LDF B,D%EXTN ;[958][716] YES, LET THE OBJECT FILE BE USED:
; ANDCAM B,FLG(P2) ;[958][716] CORRECT EXTENSION IS .REL, MAKE SURE AN
RET ;[716] EXPLICIT EXTENSION ISN'T USED
SWLTP1: MOVE B,SVER(P2) ;[716] MOVE SOURCE TIME/DATE
MOVEM B,OVER(P2) ;[716] TO OBJECT TIME/DATE
MOVE B,HDD(P2) ;[716] ALSO SET UP HDD
MOVEM B,HDDO(P2) ;[716] FOR OBJECT FILE
RET ;[716] LEAVE
SWLTP2: DPB B,[POINTR (P1,F.LMSK)] ;[716] SET PERM TYPE
TRON P1,F%LANG ;SET GLOBAL LANG SWITCH SEEN
RET ;RETURN
;ERROR RETURNS
AMBIG: HRROI A,FSPEC
;**;[716] Replace 1 line at AMBIG:+1L JRG 29-MAR-82
ERROR <Switch name ambiguous: %1M> ;[716]
NOMAT: HRROI A,FSPEC
ERROR <No such switch: %1M>
;ROUTINE TO PARSE THE DEFAULT SWITCHES FOR A FILE TYPE
;PASS IT POINTER TO THE FILE TYPE IN A.
PARDEF: STKVAR <QUOF,PAREND,SWIPTR,<ABSAV,2>>
CALL GETDL ;GET DEFAULT SWITCHES FOR FILE TYPE
;**;[958] Add two lines at PARDEF+1L YKT 03-MAY-83
SKIPE A ;[958] IS DEFAULT SW EXISTING?
SETOM DEFSW ;[958] YES, SET THE FLAG ON
MOVEM A,SWIPTR ;INITIALIZE POINTER TO SWITCH LIST
PARD0: MOVE A,[440700,,SWIBUF] ;POINTER TO SWITCH BUFFER
MOVE B,SWIPTR ;POINTER TO NEXT SWITCH
MOVEI C,SWISIZ*5 ;MAXIMUM CHARACTERS TO READ
ILDB D,B ;READ THE SLASH
JUMPE D,R ;IF NULL, LAST ONE WAS LAST SWITCH
SETZM QUOF ;NOT IN QUOTED STRING YET
PARD3: ILDB D,B ;READ CHARACTER OF SWITCH
JUMPE D,PARD4 ;IF NULL, SWITCH OVER
SKIPE QUOF ;IN QUOTED STRING?
JRST PARD5 ;YES, SO "/" DOESN'T START NEXT SWITCH
CAIN D,"/" ;OR IF SLASH OF NEXT SWITCH, SWITCH OVER
JRST PARD4 ;YES, SWITCH OVER
PARD5: IDPB D,A ;SWITCH NOT OVER, ACCUMULATE NAME
CAIE D,QUOTE ;A QUOTE?
JRST PARD6 ;NO, GO DECREMENT COUNT
;**;[935] Insert 9 lines at PARD5+2 YKT 21-DEC-82
SKIPN QUOF ;[935] OPEN QUOTE?
JRST PARD2 ;[935] YES,
MOVE Q3,B ;[935] NO, SAVE PTR
SOSG C ;[935] DECREASE THE COUNT
JRST .+6 ;[935] NO MORE SPACES FOR SW
ILDB D,B ;[935] READ CHARACTER OF SW
CAIE D,0 ;[935] END OF STRING?
JRST PARD5 ;[935] NO, KEEP ON
MOVEM Q3,B ;[935] YES, RESTORE PREVIOUS PTR
SKIPE QUOF ;START OR END OF A QUOTED STRING?
JRST [DMOVEM A,ABSAV ;END, SAVE A AND B
MOVEM C,PAREND ;AND C TOO
MOVEI B,0 ;PUT ZERO BYTE AT END OF STRING
DPB B,A
MOVE A,QUOF ;GET QUOTED STRING POINTER
CALL BUFFS ;BUFFER THE QUOTED STRING
MOVEM A,SAVQS ;AND SAVE THE POINTER
SETZM QUOF ;NOT IN QUOTED STRING ANY MORE
DMOVE A,ABSAV ;RESTORE A AND B
MOVE C,PAREND ;AND C
MOVEI D,QUOTE ;AND D
DPB D,A ;RESTORE QUOTE AT END OF STRING
JRST PARD6] ;GO DECREMENT COUNT
;**;[935] Modify 1 line at PARD2 YKT 21-DEC-82
PARD2: MOVEM A,QUOF ;[935] BEGINNING OF QUOTED STRING, SAVE PTR
PARD6: SOJG C,PARD3 ;READ REST OF NAME
ERROR <Default switch too long>
PARD4: MOVEM A,PAREND ;REMEMBER POINTER TO END OF SWITCH
MOVEI C,0 ;PUT NULL AFTER NAME
IDPB C,A
MOVNI A,1
ADJBP A,B ;BACK SOURCE POINTER BACK TO BEGINNING OF NEXT SWITCH
MOVEM A,SWIPTR ;REMEMBER POINTER FOR NEXT SWITCH
HRROI A,SWIBUF ;POINT AT THE DEFAULT SWITCH
MOVE B,PAREND ;PASS POINTER TO END OF SWITCH
CALL DOSWI0 ;PARSE THE SWITCH
JRST PARD0 ;LOOP FOR REST OF SWITCHES
;ROUTINES TO PROCESS /MAP AND /SAVE SWITCHES
SWMAP: PUSH P,[MAPPNT] ;SAVE ADDRS ON STACK
SKIPE @0(P) ;ALREADY SEE THIS SWITCH?
ERROR <MAP or SAVE switch seen twice>
CAIE P5,":" ;MORE COMING?
JRST [MOVEI P4,-1 ;NO - SET FLAG
JRST SWSAV2] ;AND EXIT
CALL RDFLD ;YES - READ NEXT FIELD
CAIN P5,":" ;CHECK FOR DEVICE
CALL CAPND ;AND APPEND TO COLON
SWSAV2: EXCH P4,0(P) ;REVERSE ARGS
POP P,@P4 ;AND SAVE VALUE
RET ;RETURN
;**;[716] Delete routine GTPPN JRG 29-MAR-82
;**;[716] Add routines GTHDD and GTHDDF JRG 29-MAR-82
;GTHDD - ROUTINE TO GET HDD FOR JFN IN A AND OUTJFN
GTHDD: PUSH P,A
DVCHR
TXNE B,DV%TYP ;IS IT DISK?
JRST [MOVE C,A ;YES, SKIP GETTING HDD
POP P,(P) ;ADJUST STACK
RET] ;AND RETURN
CALLRE GTHDD1 ;GET HDD TO STORE FILE IN, AND RETURN
;GTHDDF - ROUTINE TO GET HDD FOR FILE
GTHDDF: PUSH P,A ;SAVE JFN FOR LATER
DVCHR% ;GET BACK DEVICE DESIGNATOR
ERCAL CJERRE ;HORRIBLE ERROR
TXNE B,DV%TYP ;IS IT A DISK?
ERROR <Non-disk directory devices are not supported>
GTHDD1: EXCH A,(P) ;SWITCH JFN AND DEVICE DESIGNATOR
STPPN% ;GET BACK PPN FOR DEVICE
ERCAL CJERRE ;HORRIBLE ERROR
POP P,C ;CONSTRUCT HDD IN AC C
HRL C,B
CAMN C,CHDD ;IS FILE IN CONNECTED DIRECTORY?
TLZ C,777777 ;IF SO, CLEAR LH OF HDD (NO PPN NECESSARY)
RET ;RETURN
;DJFNSE - OBTAIN EXTENSION OF FILE SPECIFIED BY JFN IN A
;RETURNS ASCIZ IN CWBUF
DJFNSE: LDF C,1B11 ;EXTENSION ONLY ENTRY
SETZM CWBUF ;CLEAR DESTINATION
HRRZ B,A ;JFN TO B
HRROI A,CWBUF ;POINTER TO DEST
JFNS ;GET EXTENSION
RET ;RETURN
;DOJFNS - OBTAIN DESIRED TEXT FOR JFN IN A
;FORMAT DESIRED IN C
;RETURNS ASCIZ IN CSBUF
DOJFNS: HRRZ B,A ;JFN TO B
MOVE A,CSBUFP ;POINTER TO DEST
JFNS ;GET IT
RET ;RETURN
;**;[716] Replace 5 lines with 4 at DOJFNS:+5L JRG 29-MAR-82
;[716] ROUTINE TO LOOK UP EXTENSION FOUND IN B AND RETURN
;[716] LANG TYPE IN B
LOOKE: MOVSI C,-LTABL ;[716] LTAB LENGTH
CAME B,LTAB(C) ;MATCH?
AOBJN C,.-1 ;NO - TRY NEXT
JUMPGE C,R ;FAIL RETURN
HRRZ B,C ;TABLE INDEX IS TYPE
TXNE P1,F%LANG ;IS THERE A GLOBAL LANGUAGE SWITCH?
CAIN B,LT.REL ;IF SO, IS FILE REL?
JUMPN B,RSKP ;NO, SKIP, ELSE IF NOT GLOBAL, IS NULL?
LDB B,[POINTR (P1,F.LMSK)] ;GLOBAL AND NOT REL OR NULL, REPLACE
RETSKP ;RETURN
;**;[716] Add routine STEXNA JRG 29-MAR-82
;ROUTINE TO WRITE EXTENSION OF LNGJFN AT FSPEXT, ISOLATE THE FILENAME AND
;EXTENSION, AND STORE POINTER IN NAM OF FDB
STEXNA: MOVE A,FSPEXT ;PLACE TO WRITE FILE EXTENSION
LDB B,A ;BUT CHECK TO SEE IF THERE'S A FILENAME FIRST
CAIN B,":"
JRST [ MOVEI A,1 ;NO THERE ISN'T
CALL GETBUF ;GET A WORD
SETZM (A) ;ZERO IT
HRLI A,440700 ;POINT TO IT
JRST STEXN1] ;AND SAVE THE POINTER
MOVEI B,"." ;(BUT PUT IN DOT FIRST)
IDPB B,A
MOVE B,LNGJFN
LDF C,1B11
JFNS
MOVE A,NAM(P2) ;ONLY COPY OVER THE PORTION WE WANT
CALL BUFFS
STEXN1: MOVEM A,NAM(P2) ;SAVE NEW FILENAME BYTE POINTER
MOVE B,LNGJFN ;CHECK JFN TO BE OUTPUT
CALL CHK10 ;FOR TOPS-10 LEGALITY
TXZN P1,F%STOJ ;IS THERE AN EXTRA JFN TO RELEASE?
RETSKP ;NO, LEAVE, GIVING GOOD RETURN
MOVE B,OUTJFN ;CHECK THIS JFN TOO
CALL CHK10 ;FOR TOPS-10 LEGALITY
CALL RJFN ;RELEASE EXTRA JFN
RETSKP ;LEAVE, GIVING GOOD RETURN
;ROUTINE TO SEND TMP FILE TO COMPATABILITY PACKAGE
DPRARG: MOVE A,NFILES ;POINT TO WORD CONTAINING LAST FILE ADDRESS
MOVE C,ADDTAB-1(A) ;GET STARTING ADDRESS OF LAST FILE
ADD C,TMPCOR(C) ;GET FINAL ADDRESS
HRRZI C,1(C) ;KEEP ONLY THE LENGTH
MOVEI B,NFILES ;SPECIFY S/A OF ARG BLOCK
MOVE A,FORK ;SEND BLOCK TO CURRENT FORK
HRLI A,.PRAST ;FUNCTION IS "ARG BLOCK BEING SPECIFIED"
PRARG ;SEND THE BLOCK
ERJMP .+2 ;FAILED, SEE WHY
RET
;THE PRARG FAILED, PROBABLY BECAUSE WE TRIED TO SEND TOO MUCH.
;WRITE FILES TO DISK.
MOVE Q1,NFILES ;GET NUMBER OF FILES
TMP1: SOJL Q1,TMP2 ;JUMP TO TMP2 IF NO MORE TMP FILES
MOVEI P1,0 ;NO HIGH ORDER BITS
MOVE P2,CSJOB ;BINARY JOB NUMBER
MOVEI P3,0 ;UNUSED WORD
MOVE P4,[400000,,3] ;WE WANT FILLING, THREE DIGITS
MOVE P5,CSBUFP ;POINTER TO AREA INTO WHICH TO WRITE NUMBER
EXTEND P1,[CVTBDO "0"
"0"] ;THREE DIGITS TO ASCII(FILL WITH "0" AT BEGINNING)
ERCAL CJERRE ;FAILED, SAY WHY
MOVE D,ADDTAB(Q1) ;GET ADDRESS OF FILE
MOVEI P2,TMPCOR(D) ;GET SIXBIT NAME OF FILE(ADDRESS THEREOF)
HRLI P2,440600 ;MAKE BYTE POINTER
MOVEI P1,3 ;WE WANT TO CONVERT 3 CHARACTERS
MOVEI P4,3
EXTEND P1,[MOVSO "A"-'A'];SIXBIT TO ASCII CONVERSION
ERCAL CJERRE
MOVE A,P5 ;RETAIN UPDATED BYTE POINTER
HRROI B,[ASCIZ /.TMP;T/];REST OF FILESPEC
MOVEI C,0
SOUT
MOVX A,GJ%FOU+GJ%SHT ;OUTPUT USE, SHORT FORM
MOVE B,CSBUFP ;POINT TO FILESPEC
CALL GTJFS ;GET HANDLE
CALL CJERRE ;FAILED
MOVE B,[70000,,OF%WR] ;OPEN FOR WRITING
OPENF
ERCAL CJERRE ;FAILED
MOVE D,ADDTAB(Q1) ;GET ADDRESS OF FILE
HRROI B,TMPCOR+1(D) ;GET POINTER TO DATA
MOVEI C,0 ;END ON NULL
SOUT ;WRITE THE DATA TO FILE
CLOSF ;CLOSE FILE
ERCAL CJERRE ;COULDN'T
JRST TMP1 ;DO NEXT FILE
TMP2: RET ;ALL DONE
;GTDT - GET DATE/TIME OF FILE JFN IN A
;RETURNS VERSION D/T IN A
GTDT: PUSH P,[0] ;PLACE TO READ D/T
PUSH P,B ;SAVE ACS
PUSH P,C
MOVEI C,-2(P) ;POINT TO SPECIAL CELL
MOVE B,[1,,.FBWRT] ;GET TIME LAST WRITTEN
GTFDB
POP P,C ;RESTORE STUFF
POP P,B
POP P,A ;SHOULD HAVE D/T
RET ;RETURN
;ROUTINE TO STORE DATE/TIME IN SPEC BLOCK ACCORDING TO
;LANGUAGE TYPE (I.E. REL OR NOT)
STODT: CAIN B,LT.REL ;RELOC TYPE?
;**;[716] Replace 15 lines with 9 at STODT:+1L JRG 29-MAR-82
MOVEM A,OVER(P2) ;[716] YES - STORE IN OBJECT
MOVEM A,SVER(P2) ;[716] STORE IN SOURCE REGARDLESS,
RET ;[716] DUE TO /BINARY, AND RETURN
;[716] OUTPUT SUBROUTINE DSOUTR
DSOUTR: MOVE A,COJFN ;[716] OUTPUT JFN
MOVEI C,0 ;[716]
SOUT ;[716] PRINT STRING
ETYPE <%_> ;[716] AND CRLF
RET ;RETURN
;PUNCTUATION ROUTINES
PROUT: SKIPA B,["."] ;PERIOD
CMOUT: MOVEI B,"," ;COMMA
CALLRET TBOUT ;DUMP IT
SWOUT: MOVEI B,"/" ;SLASHIFY IT
CALL TBOUT ;...
MOVE B,D ;SW VALUE
CALLRET TBOUT ;DUMP IT
EOLOUT: MOVEI B,15
CALL TBOUT
SKIPA B,[12] ;END-OF-LINEF
SPOUT: MOVEI B," " ;SPACE
CALLRET TBOUT ;DUMP AND RETURN
SUBTTL RDSKP AND RDFLD
;RDFLD - READS NEXT FIELD USING TEXTI
;RETURNS: P5 := BREAK CHAR
; A := BREAK TYPE
; P3 := CHAR COUNT
; P4 := POINTER TO STRING
RDFLD: MOVE Q1,.RDIOJ+CSTXTB ;CURRENT POINTER
TXZE P1,F%LAHD ;CHECK IF NEED BACKUP
ADD Q1,[B.BP] ;YES - ADD CONST
MOVEM Q1,.RDIOJ+CSTXTB ;NOW HAVE CORRECT POSITION
MOVE P4,TXTPR ;POINTER TO STRING SPACE
MOVEM P4,3+CSTXTB ;OUTPUT STRING HERE
RDFLD0: MOVEI P3,STRSIZ ;ENOUGH LENGTH FOR ANY REASNABLE FIELD
MOVEM P3,4+CSTXTB ; IN STRING SPACE
MOVE A,BMSKA ;GET SPECIAL BREAK MASK ADDRESS
MOVEM A,7+CSTXTB
LDF Q1,RD%RIE ;RETURN ON EMPTY STRING
MOVEM Q1,1+CSTXTB ;...
MOVEI A,CSTXTB ;POINT AT ARGS
TEXTI ;SNARF FIELD
CALL EOFJER ;CHECK FOR END OF FILE
MOVE Q1,1+CSTXTB ;GET FLAGS
TXNN Q1,RD%BTM ;BREAK ON TERM?
ERROR <Command string space exhausted>
LDB P5,3+CSTXTB ;GET BREAK CHAR
CALL GTYP ;GET CHAR TYPE
MOVEI Q1,0 ;NULL OUT DELIM
DPB Q1,3+CSTXTB ;...
SUB P3,4+CSTXTB ;SIZE = ORIG - NEW COUNT
RET ;AND RETURN
;FOLLOW THE ":" IN A SWITCH
;**;[954] Add new routine YKT 28-MAR-83
RDFLDN: MOVE Q1,.RDIOJ+CSTXTB ;[954] CURRENT POINTER
TXZE P1,F%LAHD ;[954] CHECK IF NEED BACKUP
ADD Q1,[B.BP] ;[954] YES - ADD CONST
MOVEM Q1,.RDIOJ+CSTXTB ;[954] NOW HAVE CORRECT POSITION
MOVEI P3,STRSIZ ;[954] ENOUGH LENGTH FOR ANY REASNABLE FIELD
MOVEM P3,4+CSTXTB ;[954] IN STRING SPACE
TXNN P1,F%SLSH ;[954] SLASH SEEN (SWITCH)?
JRST RDFLDX ;[954] NO
MOVE A,QQQFLG ;[954] YES, IT'S A SWITCH
TXNE A,S%QUO+S%VAL ;[954] IS A /LANGUAGE-SWITCH:?
JRST RDFLDX ;[954] YES,
MOVEI A,BMSKSW ;[954] NO, IT'S A REGULAR SW, SET NEW BRK MSK
CAIA ;[954]
RDFLDX: MOVE A,BMSKA ;[954] GET SPECIAL BREAK MASK ADDRESS
MOVEM A,7+CSTXTB ;[954]
LDF Q1,RD%RIE ;[954] RETURN ON EMPTY STRING
MOVEM Q1,1+CSTXTB ;[954] ...
MOVEI A,CSTXTB ;[954] POINT AT ARGS
TEXTI ;[954] SNARF FIELD
CALL EOFJER ;[954] CHECK FOR END OF FILE
MOVE Q1,1+CSTXTB ;[954] GET FLAGS
TXNN Q1,RD%BTM ;[954] BREAK ON TERM?
ERROR <Command string space exhausted>
LDB P5,3+CSTXTB ;[954] GET BREAK CHAR
CALL GTYP ;[954] GET CHAR TYPE
MOVEI Q1,0 ;[954] NULL OUT DELIM
DPB Q1,3+CSTXTB ;[954] ...
SUB P3,4+CSTXTB ;[954] SIZE = ORIG - NEW COUNT
RET ;[954] AND RETURN
;ROUTINE TO READ A QUOTED STRING. RETURNS POINTER TO IT IN A.
RDQUOT: CALL LDCHR ;GET A CHAR
CAIE P5,QUOTE ;GRNTEE QUOTED
ERROR <String must be quoted>
RDQOT1: MOVE P4,CSBUFP ;PICK UP STRING POINTER
RDPRC1: CALL LDCHR ;GET CHAR
CAIN A,C.EOL ;CHECK END
ERROR <Unterminated quoted string>
CAIN P5,QUOTE ;END OF SWITCH?
;**;[935] Modify 1 line at RDPRC1+4 YKT 21-DEC-82
JRST [MOVE A,.RDIOJ+CSTXTB ;[935] SAVE THE POINTER
ILDB P5,.RDIOJ+CSTXTB ;[935] LOAD & INCR PTR
CAIN P5,QUOTE ;[935] QUOTE MARK?
JRST RDPRC1+5 ;[935] YES,
MOVEM A,.RDIOJ+CSTXTB ;[935] NO,
JRST RDPRC2] ;[935] YES - SET UP BLOCK
IDPB P5,P4 ;STUFF CHAR
JRST RDPRC1
RDPRC2: MOVEI P5,0 ;TERMINATE WITH NULL
IDPB P5,P4 ;...
MOVE A,CSBUFP
CALLRET BUFFS ;BUFFER THE STRING AND RETURN POINTER TO CALLER
;LDCHR - ROUTINE TO GET NEXT CHARACTER
;RETURNS: P5: = CHARACTER
; A := CHAR TYPE
LDCHR: TXZN P1,F%LAHD ;CHECK FLAG
IBP .RDIOJ+CSTXTB ;INCR BYTE POINTER
LDB P5,.RDIOJ+CSTXTB ;GET CHAR
; CALLRET GTYP ;GET TYPE INFO AND EXIT
;GTYP - GET CHAR TYPE IN A
GTYP: MOVE Q1,P5 ;COPY IT
IDIVI Q1,^D9 ;LOOK IT UP IN TABLE
LDB A,PTAB(Q2) ;...
RET ;RETURN
;THE FOLLOWING ROUTINE GETS A POINTER TO THE STRING OF DEFAULT
;SWITCHES FOR A PARTICULAR EXTENSION. THE ROUTINE RETURNS WITH 0
;OR A POINTER IN A.
;PASS THE ROUTINE IN A A POINTER TO THE DESIRED EXTENSION
GETDL: MOVE C,A ;POINTER IN C
BIN ;READ FIRST CHARACTER
CAIN B,0 ;NULL EXTENSION?
SKIPA B,[440700,,[ASCIZ /./]] ;YES, SO LOOK UP DOT
MOVE B,C ;RETRIEVE POINTER
MOVEI A,DEXTBL ;ADDRESS OF DEFAULT TABLE
TBLUK ;LOOK FOR THE EXTENSION
TXNN B,TL%EXM ;EXACT MATCH?
JRST GETDL0 ;NO
HRR A,(A) ;YES, GET POINTER TO STRING
HRLI A,440700 ;MAKE BYTE POINTER
RET ;GIVE IT TO CALLER
GETDL0: MOVEI A,0 ;NO DEFAULTS SET, RETURN 0
RET
;INFO DEFAULT COMPILE-SWITCHES
.IDCS:: STKVAR <NWHICH,NS>
HLRZ A,DEXTBL ;GET NUMBER OF FILE TYPES
MOVEM A,NS ;REMEMBER HOW MANY TO DO
SETZM NWHICH ;INITIALIZE WHICH ONE WE'RE ON
IDC0: AOS C,NWHICH ;STEP TO NEXT FILE TYPE
CAMLE C,NS ;DONE THEM ALL YET?
RET ;YES
HLRO A,DEXTBL(C) ;GET POINTER TO FILE TYPE
HRRO B,DEXTBL(C) ;GET POINTER TO LIST OF SWITCHES
ETYPE < SET DEFAULT COMPILE-SWITCHES %1M %2M%%_>
JRST IDC0 ;LOOP FOR REST
;SET NO DEFAULT COMPILE-SWITCHES (FILE TYPE)
.SNDCS::STKVAR <<WHAT,2>,TBDLSA>
NOISE (FILE TYPE)
MOVEI B,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /*/]>,<"*" for all>,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /./]>,,,[
FLDDB. .CMKEY,,DEXTBL,<File type,>,,[
FLDDB. .CMFLD,CM%SDH]]]] ;.CMFLD MERELY FOR NONX ENTRIES
CALL FLDSKP ;GET SOME INPUT
CMERRX
LDB C,[331100,,(C)] ;SEE WHICH WAS TYPED
DMOVEM B,WHAT ;REMEMBER COMND DATA
CONFIRM ;CONFIRM THE COMMAND
DMOVE B,WHAT ;GET WHAT WAS TYPED
CAIN C,.CMFLD ;NONEXISTENT ENTRY?
JRST SNDERR ;YES - GIVE ERROR
CAIN C,.CMTOK ;STAR OR DOT?
JRST SNDALL ;YES, DELETE ALL DEFAULTS OR "."
MOVE A,(B) ;SAVE TABLE ENTRY FOR LATER
SNDCS1: MOVEM A,TBDLSA
MOVEI A,DEXTBL ;POINT AT TABLE
TBDEL ;REMOVE REQUESTED ENTRY
HLRO A,TBDLSA ;DEALLOCATE STRINGS IN EACH HALF
CALL STREM
HRRO A,TBDLSA
CALLRET STREM ;AND RETURN
;HERE IF A TOKEN WAS TYPED. IF "*" DELETE ALL DEFAULTS. IF "." DELETE "."
SNDALL: LDB A,[350700,,ATMBUF] ;GET THE TOKEN THAT WAS TYPED
CAIE A,"*" ;STAR?
JRST SNDALD ;NO - MUST BE A DOT
HLLZ D,DEXTBL ;YES - FIGURE OUT HOW MANY DEXTBL ENTRIES
HRRZS DEXTBL ;CLEAR ALL ENTRIES
JUMPE D,R ;IF NO ENTRIES, DONE
MOVNS D ;CONSTRUCT AOBJN POINTER
HRRI D,DEXTBL+1
SNDAL1: HLRO A,(D) ;DEALLOCATE STRINGS IN EACH HALF
CALL STREM
HRRO A,(D)
CALL STREM
AOBJN D,SNDAL1 ;GO BACK IF MORE
RET
SNDALD: HRROI B,ATMBUF ;FIND THE "." ENTRY
MOVEI A,DEXTBL ; IN THE DEFAULT EXTENSION TABLE
TBLUK
TXNN B,TL%EXM ;FOUND IT?
JRST SNDERR ;NO - ERROR
MOVE B,A ;YES - SET UP ADDRESS TO DELETE
MOVE A,(A) ;GET ADDRESS OF EXTENSION ENTRY
JRST SNDCS1 ;GO FINISH OFF
SNDERR: HRROI A,ATMBUF ;POINTER TO NONEXISTENT FILE TYPE
LDB B,[350700,,ATMBUF] ;SEE IF ANYTHING TYPED
CAIN B,.CHNUL ;ANYTHING TYPED?
ERROR <File type or "*" expected>
ETYPE <%%No defaults were set for file type %1m%%_>
RET
;SET DEFAULT COMPILE-SWITCHES (FILE TYPE) TYP (SWITCHES) /SW/SW/SW...
.SDCS:: STKVAR <STE,SAVOP,SAVSCT,SAVFGS,EXTPTR,ENTPTR,ANYYET,<LST,DCSSIZ>,SWPT,LSTPT,LSTRM>
NOISE (FILE TYPE)
DOTX <File type (without the dot), or just dot (.) for null type>
CAIA ;NOT DOT, MUST BE REAL FILE TYPE
JRST SDC0 ;USER TYPED DOT
WORDX <File type (without the dot)>
CMERRX <File type or dot (.) required>
SDC0: CALL BUFFF ;ISOLATE THE EXTENSION
MOVEM A,EXTPTR ;REMEMBER IT
MOVEI A,DCSSIZ*5 ;INITIALIZE AMOUNT OF ROOM LEFT
MOVEM A,LSTRM
HRROI A,LST ;INITIALIZE POINTER TO LIST OF SWITCHES
MOVEM A,LSTPT ;REMEMBER POINTER
SETZM ANYYET ;NOTE THAT NO SWITCHES INPUT YET
SDC1: MOVEI B,[FLDDB. .CMCFM,,,,,[FLDDB. .CMSWI,,SWTAB]]
SKIPN ANYYET ;GOT ANY SWITCHES YET?
MOVE B,(B) ;NO, SO NO CR ALLOWED
CALL FLDSKP ;READ FIELD, SKIP IF SUCCESSFUL
CMERRX <Invalid switch>
LDB C,[331100,,(C)] ;SEE WHAT WAS TYPED
SETOM ANYYET ;MARK THAT WE'VE GOT AT LEAST ONE SWITCH
CAIN C,.CMCFM ;END OF LINE?
JRST SDC3 ;YES, GO STORE SWITCHES
MOVEM B,STE ;REMEMBER TABLE ENTRY
MOVE B,(B) ;GET TABLE ENTRY
HLRO B,B ;MAKE POINTER TO SWITCH STRING
MOVEM B,SWPT ;REMEMBER POINTER TO SWITCH
SETZB C,D ;STOP ON NULL (D USED FOR SECOND SOUT)
HRROI B,[ASCIZ ./.] ;PUT SLASH IN FOR SWITCH
MOVE A,LSTPT ;GET POINTER TO LIST
SOUT ;WRITE THE SLASH
SOS C,LSTRM ;GET ROOM LEFT, ACCOUNT FOR SLASH
MOVE B,SWPT ;GET POINTER TO SWITCH
CALL SOUTN ;SOUT BUT DON'T KEEP NULL
MOVEM A,SAVOP ;SAVE OUTPUT POINTER
MOVEM C,SAVSCT ;SAVE SWITCH CHARACTER COUNT
MOVE A,STE ;GET SWITCH TABLE ENTRY
CALL HANSWI ;DO SPECIAL PARSING
JRST [ MOVE A,SAVOP
MOVE C,SAVSCT ;NO, RESTORE SOUT STUFF
JRST SDC4]
MOVEM A,SAVFGS ;SAVE SPECIAL FLAGS
MOVE A,SAVOP ;GET BACK DATA TO CONTINUE SOUT
MOVE C,SAVSCT
MOVX D,S%QUO
TDNE D,SAVFGS ;IS SWITCH QUOTED?
CALL SDCQ ;YES - OUTPUT A QUOTE
MOVEI D,0 ;END ON NULL
HRROI B,ATMBUF ;GET SPECIAL DATA
CALL SOUTN ;SOUT BUT DON'T KEEP NULL
MOVX D,S%QUO
TDNE D,SAVFGS ;QUOTED?
CALL SDCQ ;YES - OUTPUT A QUOTE
SDC4: CAIG C,1 ;MAKE SURE ROOM FOR AT LEAST ONE MORE CHAR (NEXT "/" !)
ERROR <Too many switches in command>
MOVEM C,LSTRM ;REMEMBER HOW MUCH ROOM IS LEFT NOW
MOVEM A,LSTPT ;REMEMBER UPDATED POINTER
JRST SDC1 ;KEEP READING
SDC3: MOVEI A,DEXTBL ;GET ADDRESS OF TABLE
MOVE B,EXTPTR ;GET POINTER TO EXTENSION
TBLUK ;FIND EXTENSION IN TABLE
TXNE B,TL%EXM ;ALREADY IN TABLE?
JRST SDC2 ;YES
MOVE A,EXTPTR ;NO, SET IT UP IN PERMANENT FREE SPACE
CALL XBUFFS
HRRZM A,EXTPTR ;REMEMBER WHERE WE PUT IT
HRLZ B,A ;GET TABLE ENTRY TO BE ADDED
MOVEI A,DEXTBL ;ADDRESS OF TABLE
TBADD ;ADD NEW ENTRY
ERJMP [HRRO A,EXTPTR ;REMOVE EXTENSION STRING
CALL STREM ;FROM PERMANENT FREE SPACE
ERROR <No room for another file type>]
SDC2: HRRZM A,ENTPTR ;SAVE ENTRY POINTER FOR LATER
HRRO A,(A) ;MAKE BYTE POINTER TO DEFAULT STRING SO FAR
TRNN A,777777 ;IS THERE ANY STRING TO APPEND TO?
JRST [HRROI A,LST ;NO, PUT IN PERMANENT FREE SPACE
CALL XBUFFS
HRRM A,@ENTPTR ;PUT STRING POINTER INTO TABLE ENTRY
RET]
CALL BCOUNT ;YES, FIND HOW BIG IT IS
ADDI B,DCSSIZ*5+1 ;COMPUTE SIZE OF JOINED STRINGS
SUB B,LSTRM ;(PLUS 1 FOR NULL)
IDIVI B,5
CAIE C,0
AOJ B,
MOVE A,B
CALL GTBUFX ;GET THE MEMORY
HRROS A ;FIX UP OUTPUT ADDRESS AS BYTE POINTER
MOVE C,ENTPTR
HRRO B,(C) ;COPY FROM PRESENT DEFAULT STRING FIRST
HRRZM B,SAVOP ;SAVE TO DELETE LATER
HRRM A,(C) ;UPDATE STRING POINTED TO
SETZ C,
SOUT
MOVEI C,377777 ;COPY A NULL TOO
HRROI B,LST ;GET POINTER TO DEFAULT LIST GIVEN IN COMMAND
MOVEI D,0 ;STOP COPYING ON NULL
SOUT ;ADD IT TO REST
HRRO A,SAVOP ;RETURN OLD STRING TO PERMANENT FREE SPACE
CALLRET STREM
SDCQ: SETZ D, ;SUBROUTINE TO OUTPUT A QUOTE
HRROI B,[ASCIZ /"/]
; CALLRET SOUTN ;SOUT BUT DON'T KEEP NULL; FALL INTO SOUTN
;ROUTINE USED ABOVE TO DO SOUT ASSUMING POSITIVE COUNT IN C. BACKS
;UP COUNT AND DESTINATION POINTER SO AS NOT TO KEEP NULL CHARACTER IN
;STRING
SOUTN: SOUT ;WRITE THE DATA
BKJFN ;BACK UP THE POINTER
CALL JERR ;SHOULDN'T FAIL
AOJA C,R ;UNCOUNT THE FINAL NULL AND RETURN
SUBTTL TI - TEXT INPUT ROUTINE
;TEXTI/GTJFN BLOCK INIT ROUTINE
TIRST: LDF Q1,GJ%XTN!GJ%OLD ;EXTENDED GTJFN
MOVEM Q1,CJFNBK
SETZM CJFNBK+2 ;CLEAR DEFAULTS
MOVE Q1,[CJFNBK+2,,CJFNBK+3]
BLT Q1,XTNCNT-1 ;...
LDF Q1,G1%RBF!G1%RND!G1%NLN+3 ;RETURN ON NULL NAME
MOVEM Q1,XTNCNT
RET ;RETURN
;ROUTINE FOR DOING COMND JSYS FOR COMPILE-CLASS COMMANDS. PREVENTS
;"@" FROM HAVING STANDARD EFFECT, AS COMPILE-CLASS COMMANDS WANT TO
;PROCESS "@" THEMSELVES.
CFIELD::MOVX A,CM%XIF ;WE WANT TO DO INDIRECT FILESPEC OURSELF
IORM A,CMFLG
CALLRET FIELD ;READ INPUT AND RETURN
;MAIN ROUTINE
;INPUT ROUTINE, MERELY INPUTS ENTIRE LINE, DOING RECOGNITION ON
;FILESPECS AND SWITCHES
TI: SETZM NFIAR ;NO FILES IN A ROW YET
SETZM NFILS ;NO FILES AT ALL
MOVEI B,[
FLDDB. .CMCFM,, ,,,[ ;CR IS LEGAL
FLDDB. .CMSWI,,SWTAB,,,[ ;SWITCH
FLDDB. .CMFIL,CM%SDH,,<File name>,,[ ;FILESPEC
FLDDB. .CMTOK,,<440700,,[ASCIZ /@/]>,,,[ ;INDIRECT FILE
FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]]]] ;PERCENT SIGN
CALL COMIN ;INPUT THE FIELD
CAIA ;FAILED
JRST @D ;DISPATCH ON FIELD FLAVOR
CALL SKCROK ;DIFFERENT ERROR DEPENDING ON WHETHER CR ALLOWED
CMERRX <Switch, filespec, "@", or "%" required>
CMERRX <Carriage return, switch, filespec, "@", or "%" required>
;CR GOT TYPED
TCR: MOVE A,CMPTR ;GET POINTER TO END OF STRING
SETZM B
IDPB B,A ;PUT NULL AT END OF STRING
RET ;RETURN TO CALLER
;AT SIGN TYPED
TAT: DEXTX <CMD> ;DEFAULT COMMAND FILE EXTENSION IS "CMD"
MOVX A,GJ%OLD ;COMMAND FILE MUST EXIST
MOVEM A,CJFNBK+.GJGEN
MOVEI B,[FLDDB. .CMFIL,,,<Name of indirect file>,,]
CALL CFIELD ;READ INDIRECT FILESPEC
TXNE A,CM%NOP
CMERRX <Invalid indirect file specification>
AOS NFILS ;WE MUST ASSUME THERE IS A FILESPEC IN THE INDIRECT FILE
JRST TALL ;AFTER INDIRECT FILE, ANYTHING CAN BE INPUT
;FILE SPEC SEEN. MAY BE FOLLOWED BY ANYTHING.
TFILE: AOS NFILS ;REMEMBER HOW MANY FILES
AOS A,NFIAR ;COUNT HOW MANY FILESPECS IN A ROW
CAIGE A,2 ;DON'T ALLOW MORE THAN TWO FILESPECS IN A ROW (WITHOUT THIS CHECK, "COMP /L" CAUSES "?TOO MANY JFNS IN COMMAND")
JRST TALL
MOVEI B,[
FLDDB. .CMCFM,, ,,,[ ;CR IS LEGAL
FLDDB. .CMSWI,,SWTAB,,,[ ;SWITCH
FLDDB. .CMCMA,,,,,[ ;COMMA
FLDDB. .CMTOK,,<440700,,[ASCIZ /@/]>,,,[ ;INDIRECT FILE
FLDDB. .CMTOK,,<440700,,[ASCIZ /+/]>,,,[ ;PLUS SIGN
FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]]]]] ;PERCENT SIGN
CALL COMIN ;TRY TO PARSE A FIELD
CMERRX ;FAILED, USE SYSTEM'S REASON
JRST @D ;SUCCEEDED, DISPATCH ON FLAVOR
;PLUS SIGN SEEN
TPLUS: MOVEI B,[FLDDB. .CMFIL,CM%SDH,,<Source file specification>,,] ;FILESPEC
CALL COMIN1 ;INPUT FILESPEC
CMERRX <Invalid source file specification>
JRST TALL ;ANYTHING CAN BE TYPED AFTER A SOURCE
;GET HERE WHEN ANYTHING MAY BE TYPED
TALL: MOVEI B,[
FLDDB. .CMCFM,, ,,,[ ;CR IS LEGAL
FLDDB. .CMSWI,,SWTAB,,,[ ;SWITCH
FLDDB. .CMFIL,CM%SDH,,<File name>,,[ ;FILESPEC
FLDDB. .CMCMA,,,,,[ ;COMMA
FLDDB. .CMTOK,,<440700,,[ASCIZ /@/]>,,,[ ;INDIRECT FILE
FLDDB. .CMTOK,,<440700,,[ASCIZ /+/]>,,,[ ;PLUS SIGN
FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]]]]]] ;PERCENT SIGN
CALL COMIN ;INPUT THE FIELD
CAIA ;FAILED
JRST @D ;DISPATCH ON FIELD FLAVOR
CALL SKCROK ;SEE IF CARRIAGE RETURN ALLOWED
CMERRX <Switch, filespec, comma, "@", "+", or "%" required>
CMERRX <Carriage return, switch, filespec, comma, "@", "+", or "%" required>
;SKCROK SKIPS IF CARRIAGE RETURN VALID NOW. CLOBBERS NOTHING.
SKCROK: SKIPN CSVC ;IF DEFAULT STRING, THEN CR IS O.K.
SKIPE NFILS ;IF NO DEFAULT STRING BUT FILE SEEN, THEN CR O.K.
RETSKP ;SKIP, CR O.K.
RET ;DON'T SKIP, CR NOT O.K.
;ROUTINE TO DO INPUT FOR COMPILE-CLASS COMMAND. TAKES NON-SKIP
;RETURN IF FIELD DOESN'T MATCH SOMETHING IN THE REQUESTED CHAIN (FED
;BY AC2 ON THE CALL). SKIP RETURNS WITH ADDRESS OF SUPPORT ROUTINE
;IN D IF SUCCESSFUL PARSE.
COMIN: CALL SKCROK ;SEE IF CARRIAGE RETURN LEGAL
MOVE B,(B) ;NO, SO CR INVALID ON EMPTY LINE
COMIN1: PUSH P,B ;SAVE FUNCTION CHAIN
DEXTX ;NO DEFAULT EXTENSION ON FILESPEC
MOVX A,GJ%XTN ;WE HAVE AN EXTENDED FLAG, SO WE NEED THIS BIT
MOVEM A,CJFNBK+.GJGEN
MOVX A,G1%NLN ;EXTENDED FLAG SAYS ONLY ALLOW TOPS-10 STYLE NAMES (SHORT NAMES AND NO GENERATION FIELDS AND ATTRIBUTES ALLOWED)
MOVEM A,CJFNBK+.GJF2 ;STORE EXTENDED FLAGS
POP P,B ;RESTORE FUNCTION CHAIN
CALL CFIELD ;DO COMND JSYS
;**;[990] Replace two lines by 24 LINES at COMIN1+10L YKT DEC-19-83
; TXNE A,CM%NOP ;MAKE SURE A LEGAL POSSIBILITY WAS TYPED
; JRST COM1 ;GO TRY PARSE ONLY
TXNN A,CM%NOP ;[990]
IFSKP. ;[990]
CAIE B,NPXAMB ;[990]
IFSKP. ;[990]
CMERRX ;[990]
ENDIF. ;[990]
CAIE B,NPXNOM ;[990]
IFSKP. ;[990]
CMERRX ;[990]
ENDIF. ;[990]
CAIE B,NPXNUL ;[990]
IFSKP. ;[990]
CMERRX ;[990]
ENDIF. ;[990]
CAIE B,NPXNC ;[990]
IFSKP. ;[990]
CMERRX ;[990]
ENDIF. ;[990]
JRST COM1 ;[990]
ENDIF. ;[990]
CALL IDEN ;FIND OUT WHAT GOT TYPED
RETSKP ;SKIP ON SUCCESS
;REGULAR GTJFN FAILED, SO TRY OLD-FILE ONLY. NOTE THAT IT ISN'T
;GOOD TO TRY OLD-FILE-ONLY FIRST, BECAUSE SIMPLE COMMON CASE OF
;"COMPILE FOO" WOULD FAIL, AS FILE ISN'T CALLED "FOO", BUT "FOO.FOR"
;OR SOMETHING LIKE THAT. HOWEVER, THE ORIGINAL GTJFN WE DID WITH
;NO BITS ON WILL FAIL ON "COMP X:FOO" WHERE X: IS DEFINED WITH
;"DEFINE X: (AS) <A>,<B>", AND DIRECTORY <A> IS NOT WRITABLE BY THE
;USER. OLD-FILE-ONLY WILL CAUSE THE LOGICAL NAME TO BE STEPPED
;WHEN LOOKING FOR "FOO" IF NOT FOUND IN <A>.
;ACTUALLY, OLD-FILE-ONLY WILL ALSO FAIL FOR "COMP X:FOO"! HOWEVER,
;IF FOO.MAC IS UNIQUE IN X:, "COMP X:FOO$" WILL RECOGNIZE IT WITH
;OLD-FILE-ONLY. BUT IF NO RECOGNITION IS ATTEMPTED, "COMP X:FOO" WILL
;FAIL, SINCE THERE'S NO OLD FILE CALLED "FOO" IN X:. HENCE, IF OLD-FILE-ONLY
;FAILS, WE HAVE TO TRY PARSE-ONLY GTJFN!! NOTE THAT PARSE-ONLY
;MUST BE TRIED LAST TO ALLOW RECOGNITION TO WORK.
COM1: MOVE A,NFIAR ;SEE HOW MANY FILES IN A ROW SO FAR
CAIL A,2 ;TWO?
RET ;YES, DON'T ALLOW ANY MORE
MOVX A,GJ%OLD ;TRY OLD-FILE-ONLY
IORM A,CJFNBK+.GJGEN
MOVEI B,[FLDDB. .CMFIL]
CALL CFIELD
TXNN A,CM%NOP ;SKIP IF FAILED
JRST COM2 ;SUCCEEDED
MOVE A,CJFNBK+.GJGEN ;GET FLAGS
TXZ A,GJ%OLD ;TURN OFF OLD-FILE-ONLY
TXO A,GJ%Ofg ;TRY PARSE-ONLY
IORM A,CJFNBK+.GJGEN
MOVEI B,[FLDDB. .CMFIL]
CALL CFIELD
;**;[957] Replace next two lines by 6 new lines YKT APR-01-83
TXNN A,CM%NOP ;[957] FAIL?
JRST COM2 ;[957] NO,
CAIE B,600060 ;[957] YES, BECAUSE GENER #, ATTRIBUTES OR INVALID CHARACTER?
RET ;[957] NO, LET NORMAL TO HANDLE ERROR
MOVE D,[440700,,ATMBUF] ;[957] YES, PRINT SOME SPECIAL MESSAGE
ERROR <No generation field or attributes allowed, or invalid character in file name - %4M> ;[957]
COM2: MOVE A,CSBUFP ;GET POINTER TO TEMPORARY STORAGE
MOVSI C,(1B8) ;ALWAYS OUTPUT THE FILE NAME ONLY
JFNS ;GET THE FILE NAME THAT WAS ENTERED
ILDB A,CSBUFP ;TAKE A LOOK AT THE FIRST CHARACTER
JUMPE A,R ;ERROR IF FILE NAME IS NULL
;**;[973] Add 2 lines after COM2+4 JMP 15-Aug-83
TXNE B,GJ%NAM!GJ%EXT ;[973] CHECK GTJFN FLAGS FOR WILDCARDS
ERROR <No wildcards allowed in file specification> ;[973]
MOVEI D,TFILE ;SAY THAT FILESPEC TYPED
RETSKP
;ROUTINE TO CALL AFTER COMND TO FIGURE OUT WHAT GOT TYPED. RETURNS ADDRESS
;IN D OF ROUTINE TO JUMP TO TO HANDLE THAT FIELD.
IDEN: MOVE A,B ;IF FILE TYPED, JFN NOW IN A!
LDB D,[331100,,.CMFNP(C)] ;FIND OUT WHAT WAS TYPED
CAIE D,.CMFIL ;FILESPEC?
SETZM NFIAR ;NO, SO TALLY ZERO FILESPECS IN A ROW
EXCH C,D ;FUNCTION CODE IN C, POINTER IN D
CAIN C,.CMTOK ;TOKEN?
JRST IDTOK ;YES, GO INVESTIGATE FURTHER
CAIN C,.CMCMA ;COMMA?
MOVEI D,TCOMM ;YES
CAIN C,.CMCFM ;CARRIAGE RETURN?
MOVEI D,TCR ;YES
CAIN C,.CMFIL ;FILESPEC?
MOVEI D,TFILE ;YES
CAIN C,.CMSWI ;SWITCH?
MOVEI D,TSWI ;YES
RET
IDTOK: MOVE A,.CMDAT(D) ;TOKEN TYPED, GET POINTER TO WHICH KIND
BIN ;GET THE TOKEN
CAIN B,"%" ;LINK SWITCH DELIMITER?
MOVEI D,TPER ;YES
CAIN B,"@" ;INDIRECT FILE DELIMITER?
MOVEI D,TAT ;YES
CAIN B,"+" ;PLUS SIGN?
MOVEI D,TPLUS ;YES
RET
;% TYPED. READ THE LINK SWITCH
TPER: QUOTEX <LINK switch, in quotes>
CMERRX <Invalid LINK switch>
JRST TALL ;AFTER LINK SWITCH, ANYTHING MAY BE TYPED
;SWITCH TYPED. ANYTHING MAY FOLLOW
TSWI: MOVE A,B ;PUT TABLE ADDRESS IN A
CALL HANSWI ;HANDLE DETAILS ABOUT PARSING THE SWITCH
JRST TALL ;WE DON'T CARE IF SPECIAL VALUE WAS REQUIRED
JRST TALL
;ROUTINE TO DO SWITCH-SPECIFIC PARSING
;GIVE IT TABLE ADDRESS IN A. IT SKIPS WITH ARG PARSED, IFF A SPECIAL
;ARG IS REQUIRED
;RETURNS VALID SETTING OF S%QUO IN A.
HANSWI: STKVAR <QQQ>
HRRZ A,(A) ;GET ADDRESS OF SWITCH DATA
MOVEI B,1(A) ;GET ADDRESS CONTAINING SPECIAL DISPATCH ADDRESS
MOVE A,(A) ;GET SWITCH DATA
;**;[954] Add one line at HANSWI+3 YKT 28-MAR-83
MOVEM A,QQQFLG ;[954] SAVE IT
MOVEM A,QQQ ;REMEMBER FLAGS
TXNE A,S%QUO+S%VAL ;QUOTED STRING OR VALUE TO FOLLOW?
IFSKP. ; NO, BUT CHECK IF ONE WAS TYPED ANYWAY
MOVE D,SBLOCK+.CMFLG ;SET UP COMND% FLAGS
TXNE D,CM%SWT ;WAS ILLEGAL COLON TYPED IN SWITCH?
ERROR <Invalid use of colon in switch> ; YES, COMPLAIN ABOUT IT.
RET ;NO PROBLEM FOUND
ENDIF.
CALL @(B) ;GO GET VALUE TYPED IN TO SWITCH
MOVE A,QQQ ;RETURN FLAGS IN A
RETSKP ;SKIP TO SAY SOMETHING MORE WAS READ
;READ VALUE FOR /LANGUAGE-SWITCHES
RDLSW: QUOTEX <Switch(es) for compiler, in quotes>
CMERRX <Invalid value for /LANGUAGE-SWITCHES:>
RET
;COMMA TYPED. DON'T ALLOW END OF LINE AFTER COMMA, OR ANOTHER COMMA,
;OR A PLUS SIGN.
TCOMM: MOVEI B,[
FLDDB. .CMFIL,CM%SDH,,<File name>,,[ ;FILESPEC
FLDDB. .CMTOK,,<440700,,[ASCIZ /@/]>,,,[ ;INDIRECT FILE
FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]] ;PERCENT SIGN
CALL COMIN1 ;INPUT FIELD
CMERRX <Filespec, "@", or "%" required after comma>
JRST @D ;DISPATCH
;SWMOV - ROUTINE TO PLACE SWITCH NAME IN BUFFER IN PROPER
;FORMAT FOR FSYM
;CALL: MOVE A,<POINTER-TO-STRING>
; CALL SWMOV
; RETURN HERE (STRING IN FSPEC), POINTER TO LAST CHAR IN A
SWMOV: MOVE B,A ;SOURCE POINTER IN B
HRROI A,FSPEC ;COPY TO FSPEC
MOVEI C,0 ;STOP ON NULL
SOUT
RET
;LANGUAGE EXTENSION TABLE
DEFINE L(LANG,EXT,PROC,TNAME) <
LT.'EXT==<%LT==%LT+1>
ASCII "EXT"
>
%LT==0 ;INITIAL VALUE
;**;[716] Replace 2 lines with 5 at SWMOV:+14L JRG 29-MAR-82
;[716] Note that LT.REL, which must be the first entry, for GTLNG1, must be 1,
;[716] because language type 0 is reserved for the null extension
LTAB: 0 ;[716] NULL EXTENSION (ILLEGAL AS ACTUAL LANGUAGE TYPE)
LANGUAGE ;[716] EXPAND MACRO
LTABL==.-LTAB ;LENGTH OF TABLE
LT.68C==LT.C68
LT.74C==LT.C74
;TABLE OF SIXBIT TMP FILE NAMES
SIXTAB: 0 ;TYPE 0 UNUSED
DEFINE L(A,B,C,D)
<IFNB <D>, SIXBIT /D/ ;;SIXBIT IF OLD-STYLE LINE EXISTS
IFB <D>, 0 ;;0 IF NO OLD-STYLE LINE EXISTS
>
LANGUAGE
;TABLE OF SIXBIT TMP FILE NAMES FOR NATIVE-COMPILERS
NSXTAB: 0
DEFINE L(A,B,C,D,E)
<IFB <E>, 0 ;;0 IF NO NATIVE COMPILER FOR THIS LANGUAGE
IFNB <E>, SIXBIT /E/ ;;SIXBIT FOR NATIVE COMPILER TEMP FILE NAME
>
LANGUAGE
;LANGUAGE TMP FILE NAME TABLE
DEFINE L(LANG,EXT,PROC,TNAME) <
[GETSAVE (<SYS:'PROC'.>)],,[ASCIZ \TNAME'.TMP\]
>
PRTAB: ;PROCESS NAME TABLE(LH)
0 ;TEMP NAME (RH)
LANGUAGE ;EXPAND
;DEBUG AID TABLE
DEFINE L(LANG,EXT,PROC,TNAME) <
0,,[ASCIZ \:'LANG\]
>
DBTAB: 0 ;LOSAGE ENTRY
LANGUAGE ;EXPAND
;**;[747] Take edit 746 out at NAMES+1L YKT 20-AUG-82
;**;[746] Modify one line at NAMES+1L YKT 19-AUG-82
DEFINE NAMES <
NM (68-COBOL,S%LTYP,LT.C68) ;[747] STILL USE THE ORIGINAL ONE
NM (74-COBOL,S%LTYP,LT.C74)
;**;[944] Modify two lines at NAMES+3L YKT 20-JAN-83
NM (ABORT,S%FRH,F%ABT) ;[944]
NM (ALGOL,S%LTYP,LT.ALG) ;[944]
NM (BINARY,S%TOFF!S%FRH,F%NBIN)
;**;[956] Delete /CHECK,/NOCHECK switches YKT 28-MAR-83
; NM (CHECK,S%FRH,F%CHK) ;[956]
NM (COBOL,S%LTYP,LT.CBL)
NM (COMPILE,S%FRH,F%CMPL)
NM (CREF,S%FRH,F%CREF!F%LIST)
NM (CROSS-REFERENCE,S%FRH,F%CREF!F%LIST)
NM (DDT,S%FLH,F%DDT)
NM (DEBUG,S%FRH,F%DEB)
; NM (ERROR-LIMIT,S%FRH,F%ERR)
NM (FAIL,S%LTYP,LT.FAI)
NM (FLAG-NON-STANDARD,S%FRH,F%FLAG)
NM (FORTRAN,S%LTYP,LT.FOR)
NM (LANGUAGE-SWITCHES:,S%QUO!S%DSP,DOLSW,RDLSW)
NM (LIBRARY,S%FRH,F%LIB)
NM (LIST,S%FRH,F%LIST)
NM (MACHINE-CODE,S%FRH,F%MACH)
NM (MACRO,S%LTYP,LT.MAC)
NM (MAP,S%DSP,SWMAP,[RET])
NM (NOBINARY,S%FRH,F%NBIN)
; NM (NOCHECK,S%TOFF!S%FRH,F%CHK) ;[956]
NM (NOCOMPILE,S%TOFF!S%FRH,F%CMPL)
NM (NOCREF,S%TOFF!S%FRH,F%CREF!F%LIST)
NM (NOCROSS-REFERENCE,S%TOFF!S%FRH,F%CREF!F%LIST)
NM (NODEBUG,S%TOFF!S%FRH,F%DEB)
; NM (NOERROR-LIMIT,S%TOFF!S%FRH,F%ERR)
NM (NOFLAG-NON-STANDARD,S%TOFF!S%FRH,F%FLAG)
NM (NOLIBRARY,S%TOFF!S%FRH,F%LIB)
NM (NOLIST,S%TOFF!S%FRH,F%CREF!F%LIST)
NM (NOMACHINE-CODE,S%TOFF!S%FRH,F%MACH)
NM (NOOPTIMIZE,S%TOFF!S%FRH,F%OPT)
NM (NOSEARCH,S%TOFF!S%FRH,F%LIB)
;**;[930]Change 1 line at DBTAB: +41L RWW 5-Nov-82
NM (NOSYMBOLS,S%FRH,F%LSYM)
;**;[947] Modify next line YKT 8-FEB-83
NM (NOWARNINGS,S%FRH,F%NWAR) ;[947]
NM (OPTIMIZE,S%FRH,F%OPT)
NM (PASCAL,S%LTYP,LT.PAS)
NM (RELOCATABLE,S%LTYP,LT.REL)
NM (SAIL,S%LTYP,LT.SAI)
NM (SEARCH,S%FRH,F%LIB)
NM (SIMULA,S%LTYP,LT.SIM)
NM (SNOBOL,S%LTYP,LT.SNO)
NM (STAY,S%DSP,DOSTAY,[RET])
;**;[930]Change 1 line at DBTAB: +51L RWW 5-Nov-82
NM (SYMBOLS,S%TOFF!S%FRH,F%LSYM)
;**;[947] Modify next line YKT 8-FEB-83
NM (WARNINGS,S%TOFF!S%FRH,F%NWAR) ;[947]
>
DEFINE NM (NAME,FLAGS<0>,VALUE<0>,VAL2) <
%V==VALUE ;TEMP EQUATE
IF2 ,<IFN <%V&^O777777B17>,<%V==<Z (%V)>>>
IFB <VAL2>,<[ASCIZ "NAME"],,[<Z (FLAGS)>,,%V]>
IFNB <VAL2>,<[ASCIZ "NAME"],,[ <Z (FLAGS)>,,%V
VAL2]>
>
SWTAB: SWLEN,,SWLEN
NAMES
SWLEN==.-SWTAB-1
BRINI. ;START WITH ALL 0'S
BRKCH. " " ;BREAK ON THESE CHARACTERS
BRKCH. "/"
BRKCH. ":"
BRKCH. "+"
BRKCH. "%"
BRKCH. ","
BRKCH. (QUOTE) ;QUOTE MARK
BRKCH. (0) ;NULL (END OF COMMAND)
BMSK: EXP W0.,W1.,W2.,W3.
;**;[954] Add new break mask YKT 28-MAR-83
BRINI. ;[954] START WITH ALL 0'S
BRKCH. (40,77) ;[954] BREAK ON ALMOST EVERY THING
BRKCH. (100,137) ;[954]
BRKCH. (140,176) ;[954]
BMSKSW: EXP W0.,W1.,W2.,W3. ;[954]
;CTAB - CHARACTER TYPE TABLE
;EACH 4-BIT ENTRY CONTAINS THE CHARACTER TYPE FOR CHARACTER N
CTAB: BYTE (4) 7,0,0,0,0,0,0,0,0 ; NULL THRU ^H(NULL MARKS END OF COMMAND)
BYTE (4) 0,0,0,0,0,0,0,0,0 ; ^I THRU ^Q
BYTE (4) 0,0,0,0,0,0,0,0,0 ; ^R THRU ^Z
BYTE (4) 0,0,0,0,0,1,0,13,0 ; ESC,PS,CS,RS,^_,SP,!,",#
BYTE (4) 0,11,0,0,0,0,0,2,6 ; $,%,&,',(,),*,+,,
BYTE (4) 0,0,3,0,0,0,0,0,0 ; -,.,/,0,1,2,3,4,5
BYTE (4) 0,0,0,0,12,0,0,0,0 ; 6,7,8,9,:,;,<,=,>
BYTE (4) 0,0,0,0,0,0,0,0,0 ; ?,@,A,B,C,D,E,F,G
BYTE (4) 0,0,0,0,0,0,0,0,0 ; H,I,J,K,L,M,N,O,P
BYTE (4) 0,0,0,0,0,0,0,0,0 ; Q,R,S,T,U,V,W,X,Y
BYTE (4) 0,0,0,0,0,0,0,0,0 ; Z,[,\,],^,_,@,a,b
BYTE (4) 0,0,0,0,0,0,0,0,0 ; c,d,e,f,g,h,i,j,k
BYTE (4) 0,0,0,0,0,0,0,0,0 ; l,m,n,o,p,q,r,s,t
BYTE (4) 0,0,0,0,0,0,0,0,0 ; u,v,w,x,y,z,[,\,]
BYTE (4) 0,0 ; 176,177
;PTAB - BYTE POINTER TABLE FOR CTAB
PTAB: POINT 4,CTAB(Q1),3
POINT 4,CTAB(Q1),7
POINT 4,CTAB(Q1),11
POINT 4,CTAB(Q1),15
POINT 4,CTAB(Q1),19
POINT 4,CTAB(Q1),23
POINT 4,CTAB(Q1),27
POINT 4,CTAB(Q1),31
POINT 4,CTAB(Q1),35
;TRANSLATE (DIRECTORY) COMMAND
;ALLOWS EITHER PPN OR DIRECTORY NAME TO BE INPUT AND TRANSLATES TO THE
;OTHER
.TRANS::NOISE (DIRECTORY)
DIRX <Directory name or project-programmer-number>
JRST PPNQ ;USER DIDN'T TYPE DIRECTORY NAME.
CONFIRM ;GET CONFIRMATION OF COMMAND
MOVE C,B ;REMEMBER DIRECTORY NUMBER IN C
MOVE A,CSBUFP
DIRST ;GET DIRECTORY STRING
ERCAL CJERRE
MOVE A,CSBUFP
STDEV ;GET DEVICE ASSOCIATED WITH DIRECTORY
ERCAL CJERRE
MOVE A,CSBUFP
PUSH P,A ;REMEMBER POINTER TO DEVICE NAME
DEVST ;GET NAME OF DEVICE
ERCAL CJERRE
MOVE A,C ;PUT DIRECTORY NUMBER IN A
STPPN ;GET IT'S PPN
HLRZ C,B ;LEFT HALF IN C
HRRZ B,B ;LEAVE RIGHT HALF IN B
POP P,D ;GET POINTER TO DEVICE NAME
ETYPE <%1r (IS) %4m:[%3o,%2o]
>
RET
;USER TYPED NON-DIRECTORY. MAYBE IT'S A PPN.
PPNQ: CALL CONST ;GET DEVICE DESIGNATOR FOR CONNECTED STRUCTURE
MOVEM A,FBLOCK+.CMDEF ;FILL IN DEFAULT INFO
MOVE D,A ;REMEMBER POINTER IN CASE USER DOESN'T TYPE STRUCTURE NAME
DEVX <Structure name or/and "[" to start PPN>
SKIPA A,D ;NO DEVICE TYPED, USE CONNECTED STRUCTURE
CALL BUFFF ;ISOLATE THE DEVICE NAME
PUSH P,A ;REMEMBER POINTER TO DEVICE NAME
MOVEI A,"["
CHARX <"[" to start PPN>
JRST BADPPN ;BAD SYNTAX FOR PPN
OCTX <Octal programmer number>
JRST BADPPN
PUSH P,B ;SAVE PROJECT NUMBER
COMMAX <Comma to separate programmer number from project number>
JRST BADPPN
OCTX <Octal project number>
JRST BADPPN
PUSH P,B ;PROGRAMMER NUMBER
MOVEI A,"]"
CHARX <"]" to end PPN>
JRST BADPPN
CONFIRM
POP P,B ;GET PROGRAMMER NUMBER
POP P,D ;AND PROJECT NUMBER
HRL B,D ;PUT THEM TOGETHER
MOVE C,(P) ;GET POINTER TO STRUCTURE NAME
MOVE A,CSBUFP ;GET SOME SPACE FOR WRITING DIRECTORY NAME INTO
PPNST ;GET THE DIRECTORY NAME
ERCAL CJERRE ;ASSUME FAILURE WILL HAVE REASONABLE MESSAGE
HRRZ B,B ;KEEP ONLY THE PROGRAMMER NUMBER IN B
MOVE A,CSBUFP ;GET POINTER TO STRUCTURE NAME
POP P,C ;GET POINTER TO STRUCTURE NAME
ETYPE <%3m:[%4o,%2o] (IS) %1m
>
RET
;THE FOLLOWING VERBOSE ERROR MESSAGE WAS PUT IN BECAUSE AT TIME
;OF THIS COMMAND, DOCUMENTATION DEPARTMENT DIDN'T HAVE TIME TO UPDATE
;ALL THE DOCUMENTATION TO DESCRIBE IT, AS MANY PLACES HAD TO BE EDITED.
BADPPN: ERROR <To translate between PPN's and directories, type one of:
TRANSLATE str:<directory>
TRANSLATE str:[n,m]
>
END