Trailing-Edge
-
PDP-10 Archives
-
BB-H580E-SB_1985
-
cpylib.mac
There are 20 other files named cpylib.mac in the archive. Click here to see a list.
; UPD ID= 3502 on 4/27/81 at 5:23 PM by WRIGHT
TITLE CPYLIB - COBOL COPY Library Utility Program
SUBTTL D. WRIGHT
SEARCH COPYRT
SALL
;This program replaces the old LIBARY program. It is used to create,
;update and read pieces of COBOL source code stored in a single file
;as a COPY library. The COBOL-68 and COBOL-74 compilers can read
;COPY libraries in this format, as well as the old LIBARY program.
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981,1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;Version information
CPYMAJ==12 ;MAJOR VERSION
CPYMIN==3 ;MINOR VERSION
CPYWHO==0 ;WHO LAST EDITED (0=DEC)
CPYEDT==7 ;CURRENT EDIT LEVEL
.LBVER==BYTE(3)CPYWHO(9)CPYMAJ(6)CPYMIN(18)CPYEDT
SEARCH MMANGU,IOTMPU ;Use memory manager, IOTMP routine
;TOPS20 symbol defined here.
IFN TOPS20, SEARCH MONSYM,MACSYM
IFE TOPS20, SEARCH UUOSYM,MACTEN
.COPYRIGHT ;Put standard copyright statement in REL file
SALL ;SUPPRESS MACRO EXPANSIONS
IFE TOPS20,<
LOC 137 ;.JBVER (MACRO BUG DOESN'T LET ME SAY ".JBVER" HERE)
EXP .LBVER ;VERSION NUMBER
TWOSEG 400K ;TWO SEGMENT PROGRAM, RELOCATE TO 400K
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
>
IFN TOPS20,<
ENTVEC: JRST ST ;NORMAL ENTRY
JRST ST ;REENTER ENTRY
EXP .LBVER ;VERSION NUMBER
ENTLEN==.-ENTVEC ;ENTRY VECTOR LENGTH
>;END IFN TOPS20
SUBTTL EDIT HISTORY
;AUTOPATCH HISTORY FILE FOR VERSION 12B
;
;.BEGINR
;.COMPONENT CPYLIB
;.VERSION 12B
;.AUTOPATCH 5
;
;.EDIT 1 Premature EOF encountered if first module has /S.
; RLF,18-AUG-82,SPR:20-18117
; A:SRC CPYLIB
;
;.EDIT 2 Insert does not allow digits in mod-name
; SMI,20-OCT-82,SPR:10-33154
; A:SRC CPYLIB
;
;.EDIT 3 Fix byte pointers into fine table to use
;; all 23 bit of module address
; JEH,28-OCT-82,SPR:20-18379
; A:SRC CPYLIB
;
;.ENDA
;.AUTOPATCH 6
;.NOEDIT
;.ENDA
;
;.AUTOPATCH 7
;
;.EDIT 4 CPYLIB doesn't read in last entry from fine table if
;; it is a multiple of 64.
; RLF,27-MAY-83,SPR:20-19243
; A:SRC CPYLIB
;
;.EDIT 5 Shut off /S bit in rough table entries and
;; store 7th and 8th char of module name
; JEH,14-JUN-83,SPR:20-19259
; A:SRC CPYLIB
;
;.EDIT 6 Use TX instead of TL in edit 5 to set F%%SEQ.
; JEH,29-SEP-83,SPR:20-19259
; A:SRC CPYLIB
;
;; This edit did no get into tape 7 correctly.
;; it is included again in tape 10
;;
;
;.ENDA
;
;.AUTOPATCH 8
;.ENDA
;.AUTOPATCH 9
;.ENDA
;.AUTOPATCH 10
;
;; This edit did not get into tape 7 correctly. Try again here.
;.EDIT 7 Use default path in all FILOP blocks unless other
;; path stated, backup files are not being handled
;; correctly
; JEH,09-DEC-83,SPR:10-34260
; A:SRC CPYLIB,IOTMP
;
;.ENDA
;.AUTOPATCH 11
;.ENDV
;.ENDR
;
SUBTTL FORMAT OF LIBRARY FILES
COMMENT \
On both TOPS10 and TOPS20, library files have the following format:
!---------------------------!
! "Rough" table !
! always 128 words long !
!---------------------------!
! "Fine" table !
! one two-word entry for !
! each module in the library!
!---------------------------!
! The text in library !
! format (first module !
! immediately follows the !
! "fine" table !
!---------------------------!
Format of "Rough" table:
Consists of two-word entries, one for each 128-word
block needed to store the "Fine" table. At the end of the
entries, the rough table contains all "-1"'s.
Format of "Fine" table:
Consists of two-word entries, one for each module
stored in the library file. At the end of the two-word entries,
there is one "-1" word to mark the end of the directory.
Each two-word entry has the following format:
----------------------------------------------
! First 6 sixbit characters of name !
----------------------------------------------
! XX !S! AD !
----------------------------------------------
Bits: 0 12 13 35
Fields are:
XX = last 2 sixbit characters of name
S = sequenced flag (0= not /S format, 1= /S format)
AD = file word address of start of the module
\
SUBTTL DEFINITIONS
;ACCUMULATORS
T1=1
T2=2
T3=3
T4=4
T5=5
P1=6
P2=7
P3=10
CH=11 ;USED BY TOPS10 COMMAND SCANNER
F=12 ;FLAGS
WD=13 ;WORD
P=17 ;PUSHDOWN STACK POINTER
;FLAGS
F.BEG==1B1 ;FILE IS AT THE BEGINNING (NO SEARCHING DONE YET)
F.LOP==1B2 ;INPUT LIBRARY FILE IS OPEN FOR READING
F.EXC==1B3 ;SEARCH FLAG - MODULE NAME MUST EXIST IN INPUT FILE
F.TMN==1B4 ;TRUNCATED MODULE NAME TO 8 CHARACTERS
F.TMO==1B5 ;TEMP FILE IS OPEN
F.CFL==1B6 ;READING FROM COMMAND FILE (TOPS10 ONLY)
F.DOT==1B7 ;SAW A "." IN FILESPEC (TOPS10 ONLY)
F.PPN==1B8 ;SAW A PPN IN FILESPEC (TOPS10 ONLY)
F.MIN==1B9 ;"-" SEEN IN NUMBER (TOPS10 ONLY)
F.EOF==1B10 ;EOF ON INPUT LIBRARY FILE
F.EOP==1B11 ;EOP ON INPUT LIBRARY FILE
F.OFT==1B12 ;OFFLINE FILE IS TTY:
F.OFN==1B13 ;OFFLINE FILE IS NUL:
F.OFE==1B14 ;EOF DETECTED ON INPUT OFF-LINE FILE
; E.G. CAN'T "GET ANOTHER BUFFER"
F.BS7==1B15 ;7-BIT BYTES IN INPUT OFFLINE FILE
F.OFO==1B16 ;OFFLINE FILE IS OPEN
F.DTY==1B17 ;Output directory entry to TTY: (not DIRECTORY file)
F.BAK==1B18 ;Write BAK file when done update
F.LFT==1B19 ;Listing file is TTY:
;LIBRARY MODES
.LMTOP==0 ;TOP-LEVEL MODE
.LMCRE==1 ;CREATE MODE
.LMUPD==2 ;UPDATE MODE
.LMREA==3 ;READ MODE
;FILE NUMBERS FOR IOTMP
.FLIOF==0 ;INPUT OFFLINE FILE
.FLOOF==1 ;OUTPUT OFFLINE FILE
.FLTMP==2 ;TEMP DATA FILE
.FLDIR==3 ;TEMP DIRECTORY FILE
.FLLIS==4 ;LISTING FILE
.FLCMD==5 ;COMMAND FILE
.FLILF==6 ;Input library file
.FLOLF==7 ;Output library file
.MAXFN==.FLCMD ;Max file number used
;RANDOM PARAMETERS
OPDEF PJRST [JRST]
.PDSIZ==^D40 ;PUSHDOWN LIST SIZE
TXTLEN==^D100 ;SIZE OF A COMMAND LINE (MAX)
.LINPP==^D60 ;Lines per page in list file
F%%SEQ==1B12 ;/SEQ FLAG IN 2ND WORD OF DIRECTORY ENTRY
;TOPS10 FILESPEC BLOCK DEFINITIONS
IFE TOPS20,<
MXSFD==5 ;MAXIMUM SFD DEPTH ALLOWED
;Each TOPS10 filespec is stored in a block with the following format:
.FSDEV==0 ;DEVICE NAME (SIXBIT)
.FSNAM==1 ;FILE NAME
.FSEXT==2 ;EXTENSION
.FSPRO==3 ;PROTECTION AND DATE
.FSPPN==4 ;PPN
.FSSD1==5 ;1ST SFD
.FSLEN==.FSSD1+MXSFD ;TOTAL LENGTH OF BLOCK
;WORDS IN FILOP. BLOCK:
.FPSFB==0 ;Start of FILOP. block
.FPLKP==.FPSFB+.FOPPN+1 ;Start of 4-word LOOKUP/ENTER block
.FPRNM==.FPLKP+4 ;Start of 4-word RENAME block
.FPRPB==.FPRNM+4 ;ADDRESS OF returned PATH block
.FPIBH==.FPRPB+.PTMAX+1 ;Addr of 3-word input buffer hdr.
.FPOBH==.FPIBH+3 ;Addr of 3-word output buffer hdr.
.FPIPB==.FPOBH+3 ;Address of input path block
.FPLEN==.FPIPB+.PTMAX+1 ;Total length of block
>;END IFE TOPS20
SUBTTL COMMANDS
;TOP LEVEL COMMANDS
DEFINE COMMANDS,<
AA CREATE,CMDCRE ;CREATE
IFN TOPS20,<
AA D,DIRABR,CM%ABR+CM%INV ;D - abbrev for DIRECTORY
>
IFE TOPS20,<
AA D,CMDDIR
>
AA DDT,CMDDDT,CM%INV ;DDT
DIRABR: AA DIRECTORY,CMDDIR ;DIRECTORY
AA EXIT,CMDEXI ;EXIT
AA HELP,CMDHLP ;HELP
AA LIST,CMDLIS ;LIST
AA READ,CMDREA ;READ
AA TAKE,CMDTAK ;TAKE
AA UPDATE,CMDUPD ;UPDATE
>;END DEFINE COMMANDS
DEFINE UCOMMS,< ;UPDATE-MODE COMMANDS
AA DELETE,.UDELE ;DELETE
AA END,.UEND ;END
AA EXIT,.UEXIT ;EXIT
AA HELP,.UHELP ;HELP
AA INSERT,.UINS ;INSERT
AA REPLACE,.UREP ;REPLACE
AA TAKE,CMDTAK ;TAKE
AA WHERE,CMDWHE ;WHERE (ARE WE?)
>;END DEFINE UCOMMS
DEFINE RCOMMS,< ;READ-MODE COMMANDS
AA END,.REND ;END
AA EXIT,.REXIT ;EXIT
AA EXTRACT,.REXTR ;EXTRACT
AA HELP,.RHELP ;HELP
AA TAKE,CMDTAK ;TAKE
>;END DEFINE RCOMMS
DEFINE CCOMMS,< ;CREATE-MODE COMMANDS
AA END,.CEND ;END
AA EXIT,.CEXIT ;EXIT
AA HELP,.CHELP ;HELP
AA INSERT,.CINS ;INSERT
AA TAKE,CMDTAK ;TAKE
>;END DEFINE CCOMMS
SUBTTL MACROS
DEFINE $TEXT (STRING),<
XLIST
ASCIZ |STRING|
LIST
>
IFN TOPS20,<
DEFINE TYPE (ADDRESS),<
HRROI T1,ADDRESS
PSOUT%
>
DEFINE TYPT1,<
PBOUT%
>
DEFINE $QUIT,<
HALTF%
JRST .-1
>
DEFINE AA(NAME,DATA,FLAGS),< ;MACRO FOR COMMAND TABLES
XWD [IFNB <FLAGS>,<EXP CM%FW!<FLAGS>>
ASCIZ/NAME/],DATA
>
>;END TOPS20 MACRO DEFS.
IFE TOPS20,<
DEFINE TYPE (ADDRESS),<
OUTSTR ADDRESS
>
DEFINE TYPT1,<
OUTCHR T1
>
DEFINE $QUIT,<
EXIT
>
DEFINE AA(NAME,DATA,FLAGS),<
XWD [ASCIZ/NAME/],DATA
>
DEFINE SAVACS,<
MOVEM 0,RACS
MOVE 0,[1,,RACS+1]
BLT 0,RACS+17
>
DEFINE RSTACS,<
MOVE 0,[RACS+1,,1]
BLT 0,17
MOVE 0,RACS
>
>;END TOPS10 MACRO DEFS.
SUBTTL TOP-LEVEL HELP MESSAGE
;TOP-LEVEL HELP MESSAGE
HLPMST: $TEXT <CPYLIB is the COBOL COPY-file maintenance tool.
Type "R CPYLIB <carriage-return>" to run CPYLIB.
Once CPYLIB is ready to accept a command, it will type the prompt
"CPYLIB" followed by a right angle bracket. You may then type
one of the following commands:
UPDATE library-file <space> output-file
;Read from the specified library file, and write
;a file with the specified output name. If output-file
;is not supplied, the same filename is used.
;You will be in CPYLIB UPDATE mode (see below).
READ library-file
;Read from the specified library file. Do not write
; output anywhere. You will be in CPYLIB Read
; mode (see below).
CREATE library-file
;Create a new library file with the specified name.
; You will be put in CPYLIB CREATE mode (see below).
DIRECTORY library-file <space> output-file
;Do a directory of the library file, and write the
; output to the specified output-file. If output-file
; is not given, the output will go to the terminal.
LIST library-file <space> output-file
;Write a listing of the library file to the specified
; output file. If output-file is not given, the
; output will go to DSK:CPYLIB.LST.
TAKE cmdfile
;Take commands from the specified file.
CPYLIB modes (UPDATE, CREATE, READ)
-----------------------------------
You select one of the three CPYLIB modes by using one of
the top-level commands "UPDATE", "CREATE", or "READ". CPYLIB
gives you a different prompt for each of the modes. You may
type "HELP" once you are in the modes for further information.
Here is a summary of the commands allowed in each mode:
CPYLIB UPDATE MODE:
The prompt will be "CPYLIB Update" followed by two right angle-brackets.
You are then able to specify any or all of the following commands:
REPLACE, INSERT, DELETE, END, EXIT, HELP, TAKE
CPYLIB Read mode:
The prompt will be "CPYLIB Read" followed by two right angle-brackets.
You are then able to specify any or all of the following commands:
EXTRACT, END, EXIT, HELP, TAKE
CPYLIB CREATE mode:
The prompt will be "CPYLIB Create" followed by two right angle brackets.
You are then able to specify any or all of the following commands:
INSERT, END, EXIT, HELP, TAKE
>;END OF HELP TEXT
SUBTTL MORE HELP MESSAGES
;HELP FOR CREATE MODE
HLPMSC: $TEXT <
In CREATE mode, you are creating a new COBOL library from scratch.
Insert modules in alphabetical order using the "INSERT" command.
For example, "INSERT MODNAM FILE.EXT" will insert the module "MODNAM"
from the file FILE.EXT.
Other commands in INSERT mode are:
TAKE filespec ;Read commands from the specified file
END ;Write out the library file and go back to
; the top level of CPYLIB
EXIT ;Write out the library file and exit.
HELP ;Type this text
>
;HELP FOR UPDATE MODE
HLPMSU: $TEXT <
In UPDATE mode, you are reading from one library file,
changing it by module REPLACEment, DELETion, and INSERTion,
and writing the updated library file back out.
UPDATE mode is analagous to using a text editor which can only go
forwards in the file, looking at one module at a time. Since
the modules in a library are in alphabetical order, you must reference
module names in update-mode commands in alphabetical order.
Commands in update mode are:
INSERT module file.ext ;Insert the specified file into the library
;and call it "module"
REPLACE module file.ext ;Replace the contents of "module" with the contents
; of the specified file.
DELETE module ;Delete "module" from the library.
TAKE file.ext ;Take commands from the specified file
END ;Write out the updated library file and
; go back to CPYLIB's top command level.
EXIT ;Write out the updated library file and
; exit.
WHERE ;Show where in the directory we are. This
; command will type a few modules before and
; after the current position. The current position
; is important because you cannot reference modules
; whose names are alphabetically before it.
HELP ;Type this text
>
;HELP FOR READ MODE
HLPMSR: $TEXT <
In READ mode, you are reading from a particular COBOL library file
but not changing it in any way. The only thing you can do in READ mode
is "EXTRACT" a module (copy it to a file). Modules can be EXTRACTed
from the library in any order.
Commands are:
EXTRACT module file.ext ;Copy the module from the library into the
;specified file
TAKE file.ext ;Take commands from the specified file
END ;Return to CPYLIB's top command level
EXIT ;EXIT to monitor command level
HELP ;Type this text
>
;USEFUL ASCII STRINGS
;PROMPT
APROMP: ASCIZ/CPYLIB>/
CRLF: ASCIZ/
/
CPROMP: ASCIZ/CPYLIB Create>>/
RPROMP: ASCIZ/CPYLIB Read>>/
UPROMP: ASCIZ/CPYLIB Update>>/
SUBTTL START
;START UP THE PROGRAM
$COPYRIGHT ;Put standard copyright statement in EXE file
ST: JFCL ;Guard against CCL entry
IFE TOPS20,<
RESET ;RESET I/O
>
IFN TOPS20,<
RESET% ;RESET I/O
MOVE T1,[CMDLIT,,CMDBLK] ;COPY COMMAND BLOCK
BLT T1,CMDBLK+.CMBLN-1 ;TO GET A FRESH ONE
>
MOVE P,[IOWD .PDSIZ,PDL] ;GET A PUSH-DOWN STACK
MOVEM P,SAVEP ;RESTORE FROM HERE IF NECESSARY
TDZ F,F ;CLEAR ALL FLAGS
MOVEI T1,.LMTOP ;AT TOP-LEVEL MODE
MOVEM T1,LMODE ;SAVE MODE
IFE TOPS20,<
PUSHJ P,SETPTH ;SETUP DEFAULT PATH BLOCK
PUSHJ P,SETFOB ;Setup FILOP. blocks
>
;Init memory manager
SETZ T1, ;No special flags
PUSHJ P,INITM## ;Init mem manager
JUMPE T1,ST1 ;Jump if ok
$QUIT ;?Can't manage memory, quit
;Init IOTMP
ST1: SETZ T1, ;No special flags
MOVE T2,[XWD 4,.MAXFN] ;Default buffer size,,MAX IFN
HRRZI T3,'CPY' ;3-letter program abbreviation
PUSHJ P,$ITINI## ;Init...
JUMPE T1,ST2 ;OK
$QUIT ;?Can't init IOTMP, quit
ST2: PUSHJ P,SETPMP ;SETUP PAGE MAP
MOVEI T1,PAGMAP ;Point to it
PUSHJ P,MMGPMP## ;Tell memory manager
JRST NEWCMD ;Go get a new command
IFE TOPS20,<
XLIST ;BEGIN TOPS20 PART
>
SUBTTL TOPS20 COMMAND SCANNER
IFN TOPS20,<
NEWCMD: MOVEI T1,CMDBLK ;POINT TO COMMAND BLOCK
MOVEI T2,[FLDDB. (.CMINI)] ;INITIALIZE FUNCTION
PUSHJ P,COMMND ;GO DO IT
NEWPAR: MOVE P,SAVEP ;RESTORE THE STACK
SKIPN T1,LFJFN ;JFN FOR LIBRARY FILE?
JRST NEWP0A ;NO
TXZE F,F.LOP ;OPEN for reading?
JRST [MOVEI T1,.FLILF ;Get file number to close
MOVX T2,0 ;No special flags
PUSHJ P,$ITCLS## ;Go close file
JUMPN T1,[HALTF%
JRST .-1]
JRST NEWPR0]
RLJFN% ;TRY TO RELEASE IT
ERJMP .+1 ;OH WELL, WE TRIED
NEWPR0: SETZM LFJFN ;Clear JFN
NEWP0A: SKIPN T1,PRSJFN ;ANY RANDOM PARSED JFN?
JRST NEWPR1 ;NO
SETZM PRSJFN ;CLEAR PARSED JFN
RLJFN% ;TRY TO RELEASE IT
ERJMP .+1 ;OH WELL, WE TRIED
NEWPR1: TXZE F,F.TMO ;TEMP FILE OPENED FOR OUTPUT?
PUSHJ P,KILTMP ;YES, ABORT IT
MOVEI T1,CMDBLK ;POINT TO THE COMMAND BLOCK
MOVEI T2,[FLDDB. (.CMKEY,,CMDTAB)] ;POINT TO COMMAND TABLE
PUSHJ P,COMMND ;READ THE COMMAND
NEWP1B: MOVE T2,(T2) ;GET ADDRESS OF ROUTINE
PUSHJ P,(T2) ;CALL IT
MOVEI T1,.LMTOP ;AT TOP-LEVEL MODE
MOVEM T1,LMODE ;SAVE MODE
JRST NEWCMD ;AND GET A NEW COMMAND
;TOPS20 COMMAND SCANNER (CONT'D)
;COMMAND TABLE
CMDTAB: CMDLEN,,CMDLEN ;HEADER
COMMANDS
CMDLEN==.-CMDTAB-1 ;NUMBER OF COMMANDS
SUBTTL EXIT AND HELP COMMANDS
;EXIT COMMAND
CMDEXI: PUSHJ P,CONFRM ;CONFIRM
HALTF% ;EXIT
POPJ P, ;RETURN IF HE TYPES "CONTINUE"
;HELP COMMAND
CMDHLP: PUSHJ P,CONFRM ;CONFIRM
TYPE HLPMST ;TYPE PRE-PROGRAMMED MESSAGE
POPJ P, ;DONE, RETURN
SUBTTL DIRECTORY COMMAND
CMDDIR: MOVEI T2,[ASCIZ/of/]
PUSHJ P,NOISE
PUSHJ P,JFNFIX ;GET JFN BLOCK READY
HRROI T2,[ASCIZ/LIBARY/] ;DEFAULT NAME
MOVEM T2,JFNBLK+.GJNAM ;SAVE NAME
HRROI T2,[ASCIZ/LIB/] ;DEFAULT EXTENSION
MOVEM T2,JFNBLK+.GJEXT
MOVX T2,GJ%OLD ;GET FLAGS
MOVEM T2,JFNBLK ;SAVE THEM
MOVEI T2,[FLDDB. (.CMFIL,CM%SDH,,<library filespec>)] ;PARSE FILESPEC
PUSHJ P,COMMND
HRRZM T2,LFJFN ;SAVE JFN
MOVEI T2,[ASCIZ/output to/]
PUSHJ P,NOISE
PUSHJ P,JFNFIX
MOVX T2,GJ%FOU
MOVEM T2,JFNBLK
HRROI T2,[ASCIZ/DCY/] ;DEFAULT EXT.
MOVEM T2,JFNBLK+.GJEXT
MOVEI T2,FLDIR ;GET READY TO PARSE
PUSHJ P,COMMND
HRRZ T3,T3 ;GET WHICH PARSE BLOCK USED
CAIN T3,FLDIRC ;CRLF?
JRST CMDDR1 ;YES, USE DEFAULT
HRRZM T2,PRSJFN ;SAVE PARSED JFN INCASE ERROR
PUSHJ P,CONFRM ;CONFIRM
MOVE T1,PRSJFN ;COPY PARSED JFN
MOVEM T1,DIRJFN ;TO HERE
SETZM PRSJFN ;CLEAR THIS
JRST GODIR ;GO DO THE DIRECTORY
;HE TYPED "DIRECTORY <CRLF>"
CMDDR1: HRROI T2,[ASCIZ/TTY:/]
MOVX T1,GJ%FOU!GJ%SHT
GTJFN% ;GET JFN FOR TTY
ERJMP LOSE ;CAN'T, COMPLAIN
MOVEM T1,DIRJFN ;SAVE DIRECTORY JFN HERE
JRST GODIR ;GO DO IT
FLDIR:
FLDIRC: FLDDB. (.CMCFM,CM%SDH,,<CRLF to output directory to TTY:>,,FLDIR1)
FLDIR1: FLDDB. (.CMFIL) ;FILESPEC
SUBTTL LIST COMMAND
CMDLIS: MOVEI T2,[ASCIZ/contents of/]
PUSHJ P,NOISE
PUSHJ P,JFNFIX ;CLEAR OUT JFN BLOCK
HRROI T2,[ASCIZ/LIBARY/] ;DEFAULT NAME
MOVEM T2,JFNBLK+.GJNAM ;SAVE NAME
HRROI T2,[ASCIZ/LIB/] ;DEFAULT EXTENSION
MOVEM T2,JFNBLK+.GJEXT
MOVX T2,GJ%OLD ;GET FLAGS
MOVEM T2,JFNBLK ;SAVE THEM
MOVEI T2,[FLDDB. (.CMFIL,CM%SDH,,<library filespec>)] ;PARSE FILESPEC
PUSHJ P,COMMND
HRRZM T2,LFJFN ;SAVE JFN
MOVEI T2,[ASCIZ/into/]
PUSHJ P,NOISE
PUSHJ P,JFNFIX ;CLEAR OUT JFN BLOCK
HRROI T2,[ASCIZ/CPYLIB/] ;DEFAULT NAME
MOVEM T2,JFNBLK+.GJNAM
HRROI T2,[ASCIZ/LST/]
MOVEM T2,JFNBLK+.GJEXT
MOVX T2,GJ%FOU ;GET FLAGS
MOVEM T2,JFNBLK ;SAVE THEM
MOVEI T2,[FLDDB. (.CMFIL)] ;PARSE FILESPEC
PUSHJ P,COMMND ;PARSE IT
HRRZM T2,PRSJFN ;SAVE JFN OF LIST FILE
PUSHJ P,CONFRM ;CONFIRM
MOVE T1,PRSJFN ;COPY JFN
MOVEM T1,LISJFN ;TO HERE
SETZM PRSJFN ;CLEAR ERROR JFN
;Set F.LFT if listing file is TTY:
TXZ F,F.LFT ;Assume LST file is not TTY:
DVCHR% ;Get device characteristics
ERJMP GOLIST ;If can't, assume not TTY:
LDB T2,[POINTR T2,DV%TYP] ;Get device type
CAIE T2,.DVTTY ;TTY:?
CAIN T2,.DVPTY ; or PTY:?
TXO F,F.LFT ;Yes, set flag
JRST GOLIST ;GO DO THE "LIST"
SUBTTL UPDATE COMMAND
;GO INTO UPDATE MODE
CMDUPD: MOVEI T2,[ASCIZ/library file/]
PUSHJ P,NOISE
PUSHJ P,JFNFIX
HRROI T2,[ASCIZ/LIBARY/] ;DEFAULT NAME
MOVEM T2,JFNBLK+.GJNAM ;SAVE NAME
HRROI T2,[ASCIZ/LIB/] ;DEFAULT EXTENSION
MOVEM T2,JFNBLK+.GJEXT
MOVX T2,GJ%OLD ;GET FLAGS
MOVEM T2,JFNBLK ;SAVE THEM
MOVEI T2,[FLDDB. (.CMFIL)] ;PARSE FILESPEC
PUSHJ P,COMMND
HRRZM T2,LFJFN ;SAVE JFN
MOVEI T2,[ASCIZ/output to/]
PUSHJ P,NOISE
PUSHJ P,JFNFIX
MOVX T2,GJ%FOU ;OUTPUT FILE
MOVEM T2,JFNBLK
PUSHJ P,DEFOFL ;DEFAULT OUTPUT FILE SAME NAME, EXT, ETC.
; AS THE INPUT FILE
MOVEI T2,[FLDDB. (.CMFIL)] ;READ FILE
PUSHJ P,COMMND
HRRZM T2,PRSJFN
PUSHJ P,CONFRM ;CONFIRM
MOVE T2,PRSJFN
MOVEM T2,OUTJFN ;STORE OUTPUT JFN
SETZM PRSJFN
JRST UPMOD ;GO INTO UPDATE MODE
;ROUTINE TO DEFAULT OUTPUT FILE NAME, EXT, ETC. AS
; SAME NAME AS INPUT FILE FIELDS
;PRESERVES T1
; PUSHJ P,DEFOFL
; <RETURN HERE ALWAYS>
DEFOFL: PUSH P,T1 ;SAVE T1
HRROI T1,DEFDEV ;DEFAULT DEVICE
HRRZ T2,LFJFN ;USE THIS JFN
MOVX T3,1B2 ;DEVICE FIELD
JFNS%
ERJMP LOSE ;ERROR
HRROI T1,DEFDIR ;DEFAULT DIRECTORY
MOVX T3,1B5
JFNS%
ERJMP LOSE ;ERROR
HRROI T1,DEFNAM ;DEFAULT FILENAME
MOVX T3,1B8
JFNS%
ERJMP LOSE
HRROI T1,DEFEXT ;DEFAULT FILE EXTENSION
MOVX T3,1B11
JFNS%
ERJMP LOSE
POP P,T1 ;RESTORE T1
HRROI T2,DEFDEV
MOVEM T2,JFNBLK+.GJDEV
HRROI T2,DEFDIR
MOVEM T2,JFNBLK+.GJDIR
HRROI T2,DEFNAM
MOVEM T2,JFNBLK+.GJNAM
HRROI T2,DEFEXT
MOVEM T2,JFNBLK+.GJEXT
POPJ P, ;RETURN
SUBTTL READ COMMAND
;GO INTO READ MODE
CMDREA: MOVEI T2,[ASCIZ/library file/]
PUSHJ P,NOISE
PUSHJ P,JFNFIX
HRROI T2,[ASCIZ/LIBARY/] ;DEFAULT NAME
MOVEM T2,JFNBLK+.GJNAM ;SAVE NAME
HRROI T2,[ASCIZ/LIB/] ;DEFAULT EXTENSION
MOVEM T2,JFNBLK+.GJEXT
MOVX T2,GJ%OLD ;GET FLAGS
MOVEM T2,JFNBLK ;SAVE THEM
MOVEI T2,[FLDDB. (.CMFIL)] ;PARSE FILESPEC
PUSHJ P,COMMND
HRRZM T2,LFJFN ;SAVE JFN
PUSHJ P,CONFRM ;CONFIRM
JRST REAMOD ;GO INTO READ MODE
SUBTTL CREATE COMMAND
;GO INTO CREATE MODE
CMDCRE: MOVEI T2,[ASCIZ/library file/]
PUSHJ P,NOISE
PUSHJ P,JFNFIX
HRROI T2,[ASCIZ/LIBARY/] ;DEFAULT NAME
MOVEM T2,JFNBLK+.GJNAM ;SAVE NAME
HRROI T2,[ASCIZ/LIB/] ;DEFAULT EXTENSION
MOVEM T2,JFNBLK+.GJEXT
MOVX T2,GJ%FOU ;GET FLAGS
MOVEM T2,JFNBLK ;SAVE THEM
MOVEI T2,[FLDDB. (.CMFIL)] ;PARSE FILESPEC
PUSHJ P,COMMND
HRRZM T2,PRSJFN ;SAVE JFN
PUSHJ P,CONFRM ;CONFIRM
MOVE T2,PRSJFN ;THIS IS THE OUTPUT JFN
MOVEM T2,OUTJFN
SETZM PRSJFN ;CLEAR ERROR JFN
JRST CREMOD ;GO INTO CREATE MODE
SUBTTL TAKE COMMAND
CMDTAK: SKIPN TAKJFN ;ALREADY DOING A TAKE?
JRST CMTAK1 ;NO, OK
TYPE [ASCIZ/?CPYINT Illegal to nest "TAKE" commands
/]
JRST ERESET ;ERROR-RESET
CMTAK1: MOVEI T2,[ASCIZ/commands from file/]
PUSHJ P,NOISE
PUSHJ P,TAKDFS ;SETUP "TAKE" FILE DEFAULTS
MOVEI T2,[FLDDB. (.CMFIL)] ;GET READY
PUSHJ P,COMMND ;READ IT
HRRZM T2,PRSJFN ;SAVE PARSED JFN
PUSHJ P,CONFRM ;CONFIRM THE LINE
;HERE TO TAKE COMMANDS FROM A FILE WITH JFN IN "PRSJFN"
TAKCMC: MOVE T1,PRSJFN ;Get JFN
MOVE T2,[7B5+OF%RD]
OPENF%
ERJMP LOSE ;Can't open file, complain
MOVE T1,PRSJFN ;STORE JFN AWAY
MOVEM T1,TAKJFN
SETZM PRSJFN ;CLEAR ERROR JFN
HRLM T1,CMDBLK+1 ;PREPARE TO GET COMMANDS FROM THIS FILE
HRLM T1,CM2BLK+1
MOVEI T1,.NULIO ;OUTPUT TO NULL
HRRM T1,CMDBLK+1
HRRM T1,CM2BLK+1
POPJ P, ;RETURN TO GET NEW COMMAND FROM FILE.
;SETUP TAKE FILE DEFAULTS
TAKDFS: PUSHJ P,JFNFIX ;FIXUP JFN BLOCK
MOVX T2,GJ%OLD ;GET FLAGS
MOVEM T2,JFNBLK ;AND SET THEM
HRROI T2,[ASCIZ/CPYLIB/] ;DEFAULT NAME
MOVEM T2,JFNBLK+.GJNAM
HRROI T2,[ASCIZ/CMD/] ;DEFAULT EXT.
MOVEM T2,JFNBLK+.GJEXT
POPJ P, ;DONE, RETURN
SUBTTL WHERE COMMAND
;Can be given in update mode
CMDWHE: MOVEI T2,[ASCIZ/are we in directory?/]
PUSHJ P,NOISE
PUSHJ P,CONFRM
PJRST GOWHER ;GO type where we are, then return
SUBTTL UPDATE MODE
UPMOD: PUSHJ P,READIR ;READ DIRECTORY OF INPUT FILE
; ERRORS DO NOT RETURN
PUSHJ P,FIXOUD ;FIXUP OUTPUT DIRECTORY
PUSHJ P,OPNTMP ;OPEN FILE FOR OUTPUT
; ERRORS DO NOT RETURN
MOVEI T1,.LMUPD ;ENTER UPDATE MODE
MOVEM T1,LMODE ; . .
UPMOD0: MOVE T1,[POINT 7,UPROMP] ;GET UPDATE MODE PROMPT
PUSHJ P,PR2SET ;SETUP FOR 2ND PARSE
SKIPE T1,OFFJFN ;OFFLINE FILE JFN?
PUSHJ P,CLZOFF ;YES, CLEAR OFFLINE I/O
;READ KEYWORD FOR UPDATE COMMANDS
UPMOD1: MOVEI T1,CM2BLK ;POINT TO 2ND COMMAND BLOCK
MOVEI T2,[FLDDB. (.CMKEY,,CMUTAB)] ;POINT TO UPDATE CMD TABLE
PUSHJ P,COMMND ;READ THE COMMAND
UPMOD2: MOVE T2,(T2) ;GET ADDRESS OF ROUTINE
PUSHJ P,(T2) ;CALL IT
JRST UPMOD0 ;AND GET A NEW COMMAND
;"END" OR "EXIT" DOES A SKIP RETURN HERE
POPJ P, ;RETURN TO TOP LEVEL
;ROUTINE TO CLOSE OFFLINE FILE FROM ABORT
;CALL: T1/ OFFJFN
; PUSHJ P,CLZOFF
; <RETURN HERE ALWAYS, OFFJFN SET TO 0>
CLZOFF: SETZM OFFJFN ;CLEAR JFN
TXZE F,F.OFO ;WAS IT OPEN?
JRST CLZOFO ;YES, UNMAP PAGE AND ABORT I/O
RLJFN% ;NO, JUST RELEASE JFN
ERJMP .+1
POPJ P, ;RETURN
;CLOSE FILE THAT WAS OPEN
CLZOFO: MOVE T1,OFOIFN ;Get IFN (Saved when F.OFO was set)
MOVX T2,IT%NRF ;Throw away file.
PUSHJ P,$ITCLS## ;Close file
;Don't bother to check the status here.. if it didn't work,
; We'll just clear the JFN anyway.
SETZM OFFJFN ;CLEAR JFN
POPJ P, ;RETURN
SUBTTL READ MODE
REAMOD: PUSHJ P,READIR ;READ IN DIRECTORY OF INPUT FILE
; (ERRORS DO NOT RETURN)
MOVEI T1,.LMREA ;ENTER READ MODE
MOVEM T1,LMODE
RDMOD0: MOVE T1,[POINT 7,RPROMP] ;GET READ MODE PROMPT
PUSHJ P,PR2SET ;SETUP FOR 2ND PARSE
SKIPE T1,OFFJFN ;OFFLINE FILE JFN?
PUSHJ P,CLZOFF ;YES, CLEAR OFFLINE I/O
;READ KEYWORD FOR READ COMMANDS
RDMOD1: MOVEI T1,CM2BLK ;POINT TO 2ND COMMAND BLOCK
MOVEI T2,[FLDDB. (.CMKEY,,CMRTAB)] ;POINT TO READ CMD TABLE
PUSHJ P,COMMND ;READ THE COMMAND
RDMOD2: MOVE T2,(T2) ;GET ADDRESS OF ROUTINE
PUSHJ P,(T2) ;CALL IT
JRST RDMOD0 ;AND GET A NEW COMMAND
;"END" OR "EXIT" DOES A SKIP RETURN HERE
POPJ P, ;RETURN TO TOP LEVEL
SUBTTL CREATE MODE
CREMOD: PUSHJ P,FIXOUD ;FIXUP OUTPUT DIRECTORY
PUSHJ P,OPNTMP ;OPEN FILE FOR OUTPUT
; ERRORS DO NOT RETURN
MOVEI T1,.LMCRE ;ENTER CREATE MODE
MOVEM T1,LMODE
CRMOD0: MOVE T1,[POINT 7,CPROMP] ;GET CREATE MODE PROMPT
PUSHJ P,PR2SET ;SETUP FOR 2ND PARSE
SKIPE T1,OFFJFN ;OFFLINE FILE JFN?
PUSHJ P,CLZOFF ;YES, CLEAR OFFLINE I/O
;READ KEYWORD FOR CREATE COMMANDS
CRMOD1: MOVEI T1,CM2BLK ;POINT TO 2ND COMMAND BLOCK
MOVEI T2,[FLDDB. (.CMKEY,,CMCTAB)] ;POINT TO CREATE CMD TABLE
PUSHJ P,COMMND ;READ THE COMMAND
CRMOD2: MOVE T2,(T2) ;GET ADDRESS OF ROUTINE
PUSHJ P,(T2) ;CALL IT
JRST CRMOD0 ;AND GET A NEW COMMAND
;"END" OR "EXIT" DOES A SKIP RETURN HERE
POPJ P, ;RETURN TO TOP LEVEL
;KEYWORD TABLES FOR EACH MODE
;UPDATE COMMANDS
CMUTAB: CMULEN,,CMULEN ;HEADER
UCOMMS
CMULEN==.-CMUTAB-1 ;NUMBER OF UPDATE COMMANDS
;READ COMMANDS
CMRTAB: CMRLEN,,CMRLEN ;HEADER
RCOMMS
CMRLEN==.-CMRTAB-1 ;NUMBER OF READ COMMANDS
;CREATE COMMANDS
CMCTAB: CMCLEN,,CMCLEN ;HEADER
CCOMMS
CMCLEN==.-CMCTAB-1 ;NUMBER OF CREATE COMMANDS
SUBTTL VARIOUS "EXIT" COMMANDS
;ALL RETURN .+1 IF ERROR, .+2 IF SUCCESSFUL
;EXIT UPDATE
.UEXIT: PUSHJ P,.UEND ;END UPDATE
POPJ P, ;ERROR - GIVE ERROR RETURN
HALTF% ;EXIT
JRST CPOPJ1 ;CONTINUE--GIVE SKIP RETURN
;EXIT CREATE
.CEXIT: PUSHJ P,.CEND ;END CREATE
POPJ P, ;ERROR - GIVE ERROR RETURN
HALTF% ;EXIT.
JRST CPOPJ1 ;CONTINUE--GIVE SKIP RETURN
;EXIT READ
.REXIT: PUSHJ P,.REND ;END READ
POPJ P, ;ERROR - GIVE ERROR RETURN
HALTF% ;EXIT.
JRST CPOPJ1 ;CONTINUE--GIVE SKIP RETURN
SUBTTL VARIOUS "END" COMMANDS
;ALL RETURN .+1 IF ERROR (MESSAGE TYPED),
; ELSE .+2 (SUCCESS).
;END UPDATE
.UEND: MOVEI T2,[ASCIZ/UPDATE/]
PUSHJ P,NOISE
PUSHJ P,CONFRM ;CONFIRM COMMAND
PUSHJ P,GUEND ;GO END UPDATE
POPJ P, ;ERROR, single return
JRST CPOPJ1 ;Good return
;END CREATE
.CEND: MOVEI T2,[ASCIZ/CREATE/]
PUSHJ P,NOISE
PUSHJ P,CONFRM ;CONFIRM COMMAND
PUSHJ P,GCEND ;Go end create
POPJ P, ;Error, single return
JRST CPOPJ1 ;SKIP RETURN
;END READ
.REND: MOVEI T2,[ASCIZ/READ/]
PUSHJ P,NOISE
PUSHJ P,CONFRM ;CONFIRM COMMAND
PUSHJ P,GREND ;Go end read
POPJ P, ;Error, single return
JRST CPOPJ1 ;GOOD RETURN
SUBTTL VARIOUS "HELP" COMMANDS
;HELP IN CREATE MODE
.CHELP: PUSHJ P,CONFRM
TYPE HLPMSC ;TYPE MESSAGE
TYPE HLPMC2 ;Type additional text for the -20
POPJ P,
HLPMC2: $TEXT <
If you want to abort the CREATE operation, type
Control-C then "RESET" to the EXEC.
>
;HELP IN READ MODE
.RHELP: PUSHJ P,CONFRM
TYPE HLPMSR ;TYPE MESSAGE
POPJ P, ;RETURN
;HELP IN UPDATE MODE
.UHELP: PUSHJ P,CONFRM
TYPE HLPMSU ;TYPE MESSAGE
TYPE HLPMU2 ;Additional help for TOPS20
POPJ P, ;RETURN
HLPMU2: $TEXT <
If you want to abort the UPDATE operation, type
Control-C then "RESET" to the EXEC.
>
SUBTTL INSERT COMMAND PARSING
.CINS:
.UINS:
MOVEI T2,[ASCIZ/module/]
PUSHJ P,NOISE
PUSHJ P,PRSMOD ;PARSE MODULE NAME
MOVEI T2,[ASCIZ/from/]
PUSHJ P,NOISE
PUSHJ P,JFNFIX ;READY TO PARSE INPUT FILE
MOVX T2,GJ%OLD
MOVEM T2,JFNBLK
MOVEI T2,[FLDDB. (.CMFIL)]
PUSHJ P,COMMND
HRRZM T2,OFFJFN ;SAVE PARSED JFN
PUSHJ P,PRSSWC ;PARSE SWITCHES, OR <CONFIRM>
PUSHJ P,CHKOFT ;CHECK TO SEE IF OFFLINE FILE IS TTY:
POPJ P, ;?Unsupported device
MOVE T1,LMODE ;WHICH MODE ARE WE IN?
CAIN T1,.LMCRE ;CREATE
JRST GOINSC ;INSERT-CREATE MODE
JRST GOINSU ;INSERT-UPDATE MODE
SUBTTL EXTRACT COMMAND PARSING
.REXTR: MOVEI T2,[ASCIZ/module/]
PUSHJ P,NOISE
PUSHJ P,PRSMOD ;PARSE MODULE NAME
MOVEI T2,[ASCIZ/writing to/]
PUSHJ P,NOISE
PUSHJ P,JFNFIX
MOVX T2,GJ%FOU ;NEW FILE
MOVEM T2,JFNBLK
MOVEI T2,[FLDDB. (.CMFIL)]
PUSHJ P,COMMND ;PARSE FILENAME
HRRZM T2,OFFJFN ;SAVE OFFLINE FILE JFN
PUSHJ P,CONFRM ;CONFIRM
PUSHJ P,CHKOFT ;CHECK IF OFFLINE FILE IS TTY:
POPJ P, ;?Unsupported device
JRST GOEXTR ;GO EXTRACT IN READ MODE
SUBTTL REPLACE AND DELETE PARSING
.UREP: MOVEI T2,[ASCIZ/module/]
PUSHJ P,NOISE
PUSHJ P,PRSMOD ;PARSE MODULE NAME
MOVEI T2,[ASCIZ/with contents of/]
PUSHJ P,NOISE
PUSHJ P,JFNFIX
MOVX T2,GJ%OLD
MOVEM T2,JFNBLK
MOVEI T2,[FLDDB. (.CMFIL)]
PUSHJ P,COMMND ;PARSE FILENAME
HRRZM T2,OFFJFN ;SAVE PARSED JFN
PUSHJ P,PRSSWC ;PARSE SWITCHES, OR CONFIRM
PUSHJ P,CHKOFT ;CHECK OFFLINE FILE FOR TTY:
POPJ P, ;?unsupported device
JRST GOREPU
.UDELE: MOVEI T2,[ASCIZ/module/]
PUSHJ P,NOISE
PUSHJ P,PRSMOD ;PARSE MODULE NAME
PUSHJ P,CONFRM ;CONFIRM
JRST GODELU ;DELETE IN UPDATE MODE
;PARSE FILESPEC SWITCHES FOR READING OFFLINE FILE, OR CONFIRM
;IF PARSE ERRORS, GOES TO "LOSE"
PRSSWC: SETZM SEQ ;CLEAR SWITCH SETTINGS
PRSSW1: MOVEI T2,FLFSWC ;CRLF OR FILE SWITCHES
PUSHJ P,COMMND ;GO PARSE 'EM
HRRZ T3,T3 ;WHICH PARSE BLOCK USED?
CAIN T3,FLFSWC ;CRLF?
POPJ P, ;YES, RETURN
HRRZ T2,(T2) ;GET ROUTINE
PUSHJ P,(T2) ;CALL IT
JRST PRSSW1 ;LOOP FOR MORE
FLFSWC: FLDDB. (.CMCFM,,,,,FLFSWI)
FLFSWI: FLDDB. (.CMSWI,,CMDSW1)
CMDSW1: XWD NMFSWT,NMFSWT ;HEADER
AA SEQUENCED,.SWSEQ
NMFSWT==.-CMDSW1-1 ;NUMBER OF FILE SWITCHES
;DO THIS IF "/SEQUENCED" SPECIFIED
.SWSEQ: SETOM SEQ ;SET "SEQUENCED" FLAG
POPJ P, ;RETURN
;CHECK OFFLINE FILE FOR TTY:
;CALL: OFFJFN/ JFN OF FILE
; PUSHJ P,CHKOFT
; <RETURN HERE if unsupported device, message typed>
; <RETURN HERE IF OK, FLAG F.OFT, F.OFN SET OR NOT>
CHKOFT: TXZ F,F.OFT!F.OFN ;Clear flags
HRRZ T1,OFFJFN
DVCHR%
ERJMP CHKOF1 ;FAILED???
LDB T1,[POINTR T2,DV%TYP] ;GET DEVICE TYPE
CAIN T1,.DVTTY ;A TTY?
TXO F,F.OFT ;YES
CAIN T1,.DVNUL ;NUL:?
TXO F,F.OFN ;Yes
CAIN T1,.DVDSK ;DSK:?
JRST CPOPJ1 ;Yes, skip return
TXNE F,F.OFT!F.OFN ;Did we set a flag for another supported device?
JRST CPOPJ1 ;Yes, skip return
TYPE [ASCIZ/?CPYUSD Unsupported device
/]
POPJ P, ;RETURN
CHKOF1: TYPE [ASCIZ/?CPYXXX DVCHR% failed at CHKOFT
/]
HALTF%
JRST .-1
SUBTTL TOPS20 PARSING SUBROUTINES
;PARSE MODULE NAME
PRSMOD: SETZM INMODN ;CLEAR NAME
SETZM INMODN+1 ; . .
TXZ F,F.TMN ;DIDN'T TRUNCATE MODULE NAME YET..
PUSH P,T1 ;SAVE T1
MOVEI T2,[FLDDB. (.CMFLD,CM%SDH,,<One- to eight-char module name>)]
PUSHJ P,COMMND ;PARSE THE FIELD
MOVE T2,[POINT 6,INMODN] ;PUT MODULE NAME HERE
MOVE T1,[POINT 7,ATMBUF] ;GET FROM ATOM BUFFER
MOVEI T4,^D8 ;MAX # CHARACTERS
MOD.0: ILDB T3,T1 ;GET A CHARACTER
JUMPE T3,MOD.1 ;GOT MODULE NAME
CAIL T3,"A"+40 ;CHECK FOR LOWERCASE
CAILE T3,"Z"+40
CAIA
SUBI T3,40 ;MAKE UPPERCASE
CAIN T3,"-" ;Did he say "-"?
MOVEI T3,":" ;Yes, make ":"
SUBI T3,40 ;MAKE SIXBIT
CAIL T3,0 ;LEGAL SIXBIT?
CAILE T3,77
JRST MOD.3 ;NO, COMPLAIN
SOJL T4,MOD.0 ;Jump if no room
IDPB T3,T2 ;STORE CHARACTER
JRST MOD.0
MOD.1: POP P,T1 ;RESTORE T1
JUMPGE T4,CPOPJ ;JUMP IF MODULE NAME IS OK
TXO F,F.TMN ;TRUNCATED MODULE NAME
POPJ P, ;RETURN
;HERE IF BAD CHARACTER IN MODULE NAME
MOD.3: ADDI T3,40 ;GET CHAR THAT FAILED
TYPE [ASCIZ/?Not a legal sixbit character: /]
HRRZ T1,T3
PBOUT%
TYPE CRLF
JRST ERESET ;ERROR RESET
;ROUTINE TO PRINT WARNING IF THE INPUT MODULE NAME WAS TRUNCATED
WRNTRC: TXNN F,F.TMN ;SKIP IF MODULE NAME WAS TRUNCATED
POPJ P, ;NO, JUST RETURN
TYPE [ASCIZ/%Input module name truncated to eight characters
/]
POPJ P, ;RETURN
;CLEAR JFN BLOCK
JFNFIX: SETZM JFNBLK ;RESET THE JFN BLOCK
MOVE T2,[JFNBLK,,JFNBLK+1]
BLT T2,JFNBE ;CLEAR OUT OLD DEFAULTS
POPJ P, ;RETURN
;PARSE NOISE WORDS
;CALL: MOVEI T2,[ASCIZ/STRING/]
; PUSHJ P,NOISE
; <RETURN HERE IF PARSE OK>, ELSE JRSTS TO LOSE
NOISE: HRROM T2,NOIBLK+.CMDAT ;SAVE AS DATA
MOVEI T2,NOIBLK ;POINT TO BLOCK
JRST COMMND ;AND GO TO COMMAND JSYS
CONFRM: MOVEI T2,[FLDDB. (.CMCFM)] ;GET CONFIRM FUNCTION
COMMND: COMND% ;PARSE THE FUNCTION
ERJMP COMMN1 ;ERROR, GO COMPLAIN
TXNE T1,CM%NOP ;DID IT PARSE?
JRST LOSE ;NO, COMPLAIN
POPJ P, ;YES, RETURN SUCCESSFULLY
;COMND FAILED
COMMN1: SKIPN TAKJFN ;ANY TAKE FILE?
JRST LOSE ;NO
MOVEI T1,.FHSLF ;GET ERROR
GETER%
CAME T2,[.FHSLF,,IOX4]
CAMN T2,[.FHSLF,,COMNX9] ;END OF FILE REACHED?
JRST STPTAK ;YES, STOP THE "TAKE"
JRST LOSE ;GO COMPLAIN
;HERE ON COMMAND ERRORS OR JSYS ERRORS
LOSE: TYPE [ASCIZ/
?CPYCME /] ;TYPE PRELIMINARY TEXT
PUSHJ P,LSTFER ;TYPE LAST ERROR IN THIS FORK
LOSFIN: TYPE CRLF ;TYPE FINAL STRING
ERESET: SKIPE TAKJFN ;READING FROM A "TAKE" FILE?
JRST EREST1 ;YES, ABORT IT
MOVEI T1,.PRIIN ;GET READY
CFIBF% ;CLEAR INPUT BUFFER
;HERE TO RESET AFTER ERROR, LOOKING AT TTY: NOW
ERSTT0: MOVE T1,LMODE ;GET LIBRARY COMMAND MODE
CAIN T1,.LMTOP ;AT TOP LEVEL?
JRST ERSETT ;YES
MOVEI T1,CM2BLK ;POINT TO 2ND COMMAND BLOCK
MOVEI T2,[FLDDB. (.CMINI)] ;RE-INIT
COMND%
JRST NEWPR2 ;JUMP TO DO NEW PARSE
ERSETT: MOVE P,SAVEP ;RESET STACK
JRST NEWCMD ;AND GO GET ANOTHER COMMAND
;HERE IF ERROR IN "TAKE" FILE.. ABORT IT.
EREST1: TYPE <[ASCIZ/[CPYCFA Command file aborted]
/]>
;HERE TO STOP THE "TAKE" FILE. CLOSE IT OUT, AND GET MORE
; COMMANDS FROM TTY.
STPTAK: MOVE T1,TAKJFN
CLOSF% ;CLOSE FILE, RELEASE JFN
ERJMP .+1
MOVE T1,[.PRIIN,,.PRIOU] ;READ, WRITE FROM TTY AGAIN
MOVEM T1,CMDBLK+1
MOVEM T1,CM2BLK+1
SETZM TAKJFN ;NO TAKE FILE ANYMORE
JRST ERSTT0 ;RESET AFTER ERROR
;TYPE LAST ERROR IN THIS FORK
LSTFER: MOVEI T1,.PRIOU ;OUTPUT TO TERMINAL
HRLOI T2,.FHSLF ;LAST ERROR IN THIS FORK
SETZ T3, ;ALL OF THE TEXT
ERSTR%
JFCL
JFCL
POPJ P, ;RETURN
SUBTTL DDT COMMAND
CMDDDT: PUSHJ P,CONFRM ;Confirm
JRST GODDT ;Go do it
;HERE WHEN "DDT <CRLF>" TYPED
GODDT: TDZA P1,P1 ;HAVEN'T BEEN HERE BEFORE
GODDT0: SETO P1, ;BEEN HERE BEFORE
MOVE T1,[.FHSLF,,770] ;IS PAGE ACCESSIBLE?
RPACS%
AND T2,[EXP PA%RD!PA%EX!PA%PEX] ;
CAME T2,[EXP PA%RD!PA%EX!PA%PEX] ;
JRST GETDD ;NO, BUT TRY TO READ DDT IN
MOVE T1,770000 ; DOES IT CONTAIN DDT?
CAME T1,[JRST 770002] ; PROBABLY, IF EQUAL.
JRST NODDT ;GIVE ERROR
TYPE <[ASCIZ/[CPYRFD Return from DDT by typing "POPJ 17,$X"]
/]>
PUSH P,.JBSA## ;SAVE START ADDR.
MOVEI T1,BADDG ; Catch him trying to type $G
HRRM T1,.JBSA ;... A common error.
PUSHJ P,770000 ;CALL DDT
POP P,.JBSA ;Restore .JBSA
POPJ P, ;Return to command scanner
NODDT: TYPE [ASCIZ/?CPYDNA DDT not accessible
/]
JRST ERESET ;Return to command scanner
;He typed $G to DDT. Common error.
BADDG: TYPE <[ASCIZ/?CPYCNR Cannot restart program now.
[Assuming you meant to type "POPJ 17,$X" - returning to CPYLIB]
/]>
POPJ P, ;RETURN TO CPYLIB.
;HERE IF PAGE IS NOT EVEN ACCESSIBLE. TRY TO READ DDT IN (BUT
; BE CAREFUL TO NOT ALLOW IT TO WIPE OUT EXISTING DATA!)
GETDD: JUMPN P1,NODDT ;IF BEEN HERE BEFORE, GIVE UP
MOVX T1,GJ%OLD!GJ%SHT ;GET DDT
HRROI T2,[ASCIZ/SYS:UDDT.EXE/]
GTJFN%
ERJMP NODDT ;NOT THERE--SAY "NOT ACCESSIBLE"
PUSH P,T1 ;SAVE THE JFN
MOVEI T1,.FHSLF ;SAVE ENTRY VECTOR INFO
GEVEC% ; (GET% SMASHES IT)
PUSH P,T2 ;SAVE THE INFO
HRR T1,-1(P) ;RH(T1)= JFN
HRLI T1,.FHSLF ;READ INTO SAME FORK
TXO T1,GT%NOV ;DON'T OVERLAY EXISTING PAGES!!
GET% ;READ IN DDT
ERJMP GETFAI ;FAILED
POP P,T2 ;ENTRY VECTOR INFO
MOVEI T1,.FHSLF
SEVEC% ;RESTORE ENTRY VECTOR
POP P,(P) ;FORGET JFN, DON'T CARE ANYMORE
DMOVE T1,116 ;GET SYMBOL TABLE INFO
MOVEM T1,@770001 ;STORE IN DDT
MOVEM T2,@770002 ;. .
JRST GODDT0 ;GO TRY AGAIN
GETFAI: POP P,(P) ;FORGET ENTRY VECTOR INFO
TYPE [ASCIZ/?CPYJSE Can't read in DDT:
GET% JSYS failed: /]
PUSHJ P,LSTFER ;TYPE LAST ERROR IN THIS FORK
POP P,T1 ;RECOVER JFN
RLJFN%
ERJMP .+2 ;CAN'T RELEASE JFN
JRST LOSFIN ;Type CRLF, reset after error
TYPE [ASCIZ/?CPYJSE Can't release JFN for SYS:UDDT.EXE: /]
PUSHJ P,LSTFER ;TYPE WHY!
JRST LOSFIN ;Type CRLF, reset after error
SUBTTL 2ND PARSE ROUTINES
;SETUP FOR 2ND COMMAND PARSE
;CALL: T1/ POINTER TO CONTROL-R BUFFER
; PUSHJ P,PR2SET
; <RETURN HERE>
PR2SET: MOVE T2,[CM2LIT,,CM2BLK] ;SETUP 2ND COMMAND BLOCK
BLT T2,CM2BLK+CM2LEN-1
MOVE T2,CMDBLK+1 ;GET CURRENT INPUT,,OUTPUT JFNS
MOVEM T2,CM2BLK+1 ;COPY TO 2ND COMMAND BLOCK
SKIPN T1 ;ANY BP GIVEN?
HRROI T1,[0] ;NO, GET A NULL ONE
MOVEM T1,CM2BLK+.CMRTY ;SETUP CONTROL-R BUFFER
POP P,T3 ;GET PUSHDOWN PTR THE WAY IT SHOULD BE
MOVEM P,CM2P ;REMEMBER IT
PUSH P,T3 ;RESTORE P
HRRZM T3,PR2STA ;SAVE ADDR AFTER THIS PUSHJ
MOVEI T1,CM2BLK ;POINT TO 2ND BLOCK
MOVEI T2,[FLDDB. (.CMINI)] ;INITIALIZE 2ND BLOCK
COMND% ;DO IT
POPJ P, ;RETURN
;HERE IF A REPARSE IS NEEDED FOR CM2 FUNCTIONS
NEWPR2: MOVE P,CM2P ;RESTORE PDL
SKIPN T1,PRSJFN ;WAS THERE A PARSED JFN?
JRST NEWP2A ;NO
RLJFN% ;YES, RELEASE IT
ERJMP .+1 ;OH, WELL..
SETZM PRSJFN ;CLEAR ERROR JFN
NEWP2A: JRST @PR2STA ;START AGAIN AT THE RIGHT ADDRESS
SUBTTL TOPS20 MEMORY MANAGEMENT
;SETPMP - SETUP PAGE MAP
SETPMP: MOVE P2,[POINT 1,PAGMAP]
SETZ T4, ;START WITH PAGE 0
;SET ASIDE SOME PAGES FOR CPYLIB ITSELF
MOVEI T3,LASTLC ;GET LAST USED LOC
LSH T3,-^D9 ;GET ITS PAGE NUMBER
SETO T1, ;MARK THEM ALL AS NOT FREE
SETPM0: IDPB T1,P2
SOSL T3 ;STOP WHEN ALL THOSE PAGES MARKED
AOJA T4,SETPM0
ADDI T4,1 ;NOW START LOOKING AT NEXT PAGE
SETPM1: HRLI T1,.FHSLF
HRR T1,T4
RPACS%
TXNN T2,PA%PEX ;DOES THIS PAGE EXIST?
TDZA T1,T1 ;NO, MARK AS FREE
SETO T1, ;YES, MARK AS NOT FREE
IDPB T1,P2
ADDI T4,1 ;GO ON TO NEXT PAGE
CAIG T4,765 ;SAVE SOME SPACE FOR DDT
JRST SETPM1
SETO T1, ;MARK REST OF PAGES AS NOT FREE
SETPM2: IDPB T1,P2
ADDI T4,1
CAIG T4,777
JRST SETPM2
POPJ P,
XLIST ;FOR TOPS20, TURN LISTING OFF NOW
>;END IFN TOPS20
IFE TOPS20,<
LIST ;TURN LISTING BACK ON
>
SUBTTL TOPS10 COMMAND SCANNER
IFE TOPS20,<
;HERE TO PARSE A NEW COMMAND
NEWCMD: MOVEI T1,.LMTOP ;AT TOP-LEVEL MODE
MOVEM T1,LMODE ;SAVE MODE
TXNN F,F.CFL ;SKIP IF READING FROM COMMAND FILE
OUTSTR APROMP ;TYPE CPYLIB PROMPT
SETZM ERRTXT ;CLEAR ANY ERROR TEXT
TXZE F,F.LOP ;ILF OPEN for reading?
JRST [MOVEI T1,.FLILF ;Get file number to close
MOVX T2,0 ;No special flags
PUSHJ P,$ITCLS## ;Go close file
JUMPN T1,[EXIT 1,
JRST .-1]
JRST .+1]
;CALL ROUTINE TO READ NEXT INPUT LINE.
; IT WILL RETURN TO "NEWCMD" IF ERRORS, OTHERWISE RETURN .+1
PUSHJ P,GETLIN ;GET INPUT LINE INTO TXTBUF
PUSHJ P,GETUCH ;GET FIRST UPPERCASE CHAR
PUSHJ P,NONSP ;GET FIRST NON-SPACE IF THIS IS NOT
CAIN CH,12 ;JRST A CR ON LINE?
JRST NEWCMD ;YES, GO TYPE PROMPT AGAIN
CAIN CH,"@" ;WANTS INDIRECT COMMAND FILE?
JRST INDIR ;YES--SAME AS "TAKE FILE-SPEC"
MOVSI T1,-NMCMDS ;GET -# OF COMMANDS,,ADDR OF TABLE
HRRI T1,CMDTBL
PUSHJ P,KEYWRD ;PARSE THE KEYWORD
JRST ERESET ; Unknown keyword
;KEYWORD MATCHED -- GO DO IT
PUSHJ P,(T2) ;GO DO COMMAND
JRST NEWCMD ;RETURN
;INDIRECT COMMAND FILE
INDIR: PUSHJ P,CMDTAK ;SAME AS "TAKE FILE-SPEC"
JRST NEWCMD ;RETURN
SUBTTL TOPS10 COMMANDS
CMDTBL: COMMANDS
NMCMDS==.-CMDTBL ;# OF COMMANDS
SUBTTL KEYWORD DISPATCHES FOR TOPS10
;CREATE command
CMDCRE: PUSHJ P,FSPFIX ;Fixup filespec block
MOVE T1,['LIBARY'] ;Default name
MOVEM T1,DEFFSP+.FSNAM
MOVSI T1,'LIB' ;Default ext.
MOVEM T1,DEFFSP+.FSEXT
PUSHJ P,PRSFIL ;Parse the filespec
PUSHJ P,CONFRM ;Confirm
MOVE T1,[PRSFSP,,OUTFSP]
BLT T1,OUTFSP+.FSLEN-1
MOVEI P1,OUTFSP
MOVEI P2,OUTFLP
PUSHJ P,SETFLP ;Setup FILOP. block
TXZ F,F.BAK ;Don't write BAK file
JRST CREMOD ;Go into CREATE mode
;UPDATE command
CMDUPD: PUSHJ P,FSPFIX ;Fixup filespec block
MOVE T1,['LIBARY'] ;Default name
MOVEM T1,DEFFSP+.FSNAM
MOVSI T1,'LIB' ;Default ext.
MOVEM T1,DEFFSP+.FSEXT
PUSHJ P,PRSFIL ;Parse the filespec
MOVE T1,[PRSFSP,,INPFSP] ;Copy filespec
BLT T1,INPFSP+.FSLEN-1
MOVEI P1,INPFSP
MOVEI P2,INPFLP
PUSHJ P,SETFLP ;Setup FILOP. block
PUSH P,TXTBBP ;Save text ptr
PUSHJ P,NONSP ;See if any output spec
POP P,TXTBBP
CAIN CH,12
JRST USMENM ;Update and write to same name
PUSHJ P,FSPFIX ;Fixup filespec block
MOVE T1,['LIBARY'] ;Default name
MOVEM T1,DEFFSP+.FSNAM
MOVSI T1,'LIB' ;Default ext.
MOVEM T1,DEFFSP+.FSEXT
PUSHJ P,PRSFIL ;Parse the filespec
PUSHJ P,CONFRM ;Make sure that's it
MOVE T1,[PRSFSP,,OUTFSP]
BLT T1,OUTFSP+.FSLEN-1
MOVEI P1,OUTFSP
MOVEI P2,OUTFLP
PUSHJ P,SETFLP ;Setup FILOP. block
TXZ F,F.BAK ;Don't write .BAK file when done
JRST UPMOD ;Go to UPDATE mode
USMENM: TXO F,F.BAK ;Write .BAK file when done
MOVE T1,[PRSFSP,,OUTFSP]
BLT T1,OUTFSP+.FSLEN-1
MOVEI P1,OUTFSP
MOVEI P2,OUTFLP
PUSHJ P,SETFLP ;Setup FILOP. block
JRST UPMOD ;Go into update mode
;READ COMMAND
CMDREA: PUSHJ P,FSPFIX ;Fixup filespec block
MOVE T1,['LIBARY'] ;Default name
MOVEM T1,DEFFSP+.FSNAM
MOVSI T1,'LIB' ;Default ext.
MOVEM T1,DEFFSP+.FSEXT
PUSHJ P,PRSFIL ;Parse the filespec
PUSHJ P,CONFRM ;Better be EOL
MOVE T1,[PRSFSP,,INPFSP] ;Copy filespec
BLT T1,INPFSP+.FSLEN-1
MOVEI P1,INPFSP
MOVEI P2,INPFLP
PUSHJ P,SETFLP ;Setup FILOP. block
JRST REAMOD ;Go into READ mode
;DDT
CMDDDT: PUSHJ P,CONFRM ;Confirm
GODDT: SKIPE .JBDDT## ;Is DDT loaded?
JRST GODDT1 ;Yes
;Try to MERGE VMDDT
SAVACS ;MERGE. wipes out all acs
MOVEI T2,VMDDT
MERGE. T2,
JRST GODDT0 ;Failed
RSTACS
MOVEI T2,700000 ;Assume DDT is here
SETDDT T2,
GODDT1: OUTSTR [ASCIZ /[CPYRFD Return from DDT by typing "POPJ 17,$X"]
/]
PUSH P,.JBSA## ;SAVE START ADDR.
MOVEI T1,BADDG ; Catch him trying to type $G
HRRM T1,.JBSA ;... A common error.
HRRZ T2,.JBDDT ;Get DDT entry point
PUSHJ P,(T2) ;Call it
POP P,.JBSA ;Restore .JBSA
POPJ P, ;Return to CPYLIB
;He typed $G to DDT. Common error.
BADDG: TYPE <[ASCIZ/?CPYCNR Cannot restart program now.
[Assuming you meant to type "POPJ 17,$X" - returning to CPYLIB]
/]>
POPJ P, ;RETURN TO CPYLIB.
GODDT0: RSTACS
TYPE [ASCIZ/?CPYDNA DDT is not accessible
/]
JRST ERESET ;Reset after error
;MERGE. block for SYS:VMDDT.EXE
VMDDT: SIXBIT /SYS/
SIXBIT /VMDDT/
SIXBIT /EXE/
EXP 0,0,0
;DIRECTORY
CMDDIR: PUSHJ P,FSPFIX ;Fixup filespec block
MOVE T1,['LIBARY'] ;Default name
MOVEM T1,DEFFSP+.FSNAM
MOVSI T1,'LIB' ;Default ext.
MOVEM T1,DEFFSP+.FSEXT
PUSHJ P,PRSFIL ;Parse the filespec
MOVE T1,[PRSFSP,,INPFSP] ;Copy filespec
BLT T1,INPFSP+.FSLEN-1
MOVEI P1,INPFSP
MOVEI P2,INPFLP
PUSHJ P,SETFLP ;Setup FILOP. block
PUSH P,TXTBBP ;Save pointer to text
PUSHJ P,NONSP ;Get first non-space
POP P,TXTBBP ;Restore current pos.
CAIN CH,12 ;EOL?
JRST DIRTTY ;Yes, directory to TTY:
;Parse filespec to write directory to.
PUSHJ P,FSPFIX ;Fixup filespec block
MOVE T1,['CPYLIB'] ;Default name
MOVEM T1,DEFFSP+.FSNAM
MOVSI T1,'DCY' ;Default ext.
MOVEM T1,DEFFSP+.FSEXT
PUSHJ P,PRSFIL ;Parse the filespec
MOVE T1,[PRSFSP,,DIRFSP] ;Copy filespec
BLT T1,DIRFSP+.FSLEN-1
MOVEI P1,DIRFSP
MOVEI P2,DIRFLP
PUSHJ P,SETFLP ;Setup FILOP. block
PUSHJ P,CONFRM ;Must have <CR> now
JRST GODIR ;Go do directory
;Write directory to TTY:
DIRTTY: PUSHJ P,FSPFIX ;Get ready to fake a parsed filespec
MOVE T1,[SIXBIT /TTY/]
MOVEM T1,DEFFSP+.FSDEV ;Default device name
MOVE T1,[SIXBIT /DCYFIL/]
MOVEM T1,DEFFSP+.FSNAM
MOVEI P1,DEFFSP
MOVEI P2,DIRFLP
PUSHJ P,SETFLP ;Setup FILOP. block for TTY:
JRST GODIR ;Go do DIRECTORY
;HELP COMMAND
CMDHLP: PUSHJ P,CONFRM ;CONFIRM
TYPE HLPMST ;Type top-level help message
POPJ P, ;RETURN
;LIST
CMDLIS: PUSHJ P,FSPFIX ;Get ready to parse filespec
MOVE T1,['LIBARY'] ;Default name
MOVEM T1,DEFFSP+.FSNAM
MOVSI T1,'LIB' ;Default ext.
MOVEM T1,DEFFSP+.FSEXT
PUSHJ P,PRSFIL ;Parse the filespec
MOVE T1,[PRSFSP,,INPFSP]
BLT T1,INPFSP+.FSLEN-1
MOVEI P1,INPFSP
MOVEI P2,INPFLP
PUSHJ P,SETFLP ;Setup FILOP. block for input file
;Parse filespec for output listing file
PUSHJ P,FSPFIX ;Get ready to parse filespec
MOVE T1,['CPYLIB'] ;Default name
MOVEM T1,DEFFSP+.FSNAM
MOVSI T1,'LST' ;Default ext.
MOVEM T1,DEFFSP+.FSEXT
PUSHJ P,PRSFIL ;Parse the filespec
PUSHJ P,CONFRM ;Better be CRLF now
MOVE T1,[PRSFSP,,LSTFSP] ;Copy parsed filespec
BLT T1,LSTFSP+.FSLEN-1 ;To listing filespec
MOVEI P1,LSTFSP
MOVEI P2,LSTFLP
PUSHJ P,SETFLP ;Setup FILOP. block for listing file
;Set F.LFT if listing file is TTY:
TXZ F,F.LFT ;Assume not TTY:
MOVE T1,LSTFLP+.FODEV ;Get device name in T1
DEVCHR T1, ;Get characteristics
TXNE T1,DV.TTY ;TTY?
TXO F,F.LFT ;Yes, set flag
JRST GOLIST ;Go do the listing
;EXIT
CMDEXI: PUSHJ P,CONFRM ;Confirm command
EXIT 1, ;Exit, able to return
POPJ P, ;Continue, return
;TAKE (COMMANDS FROM) file-spec
CMDTAK: TXNE F,F.CFL ;ALREADY READING A COMMAND FILE
JRST ILLNST ;YES, "ILLEGAL TO NEST INDIRECT COMMAND FILES"
PUSHJ P,FSPFIX ;FIXUP FILESPEC BLOCK
MOVE T1,['CPYLIB'] ;DEFAULT NAME
MOVEM T1,DEFFSP+.FSNAM
MOVSI T1,'CMD' ;DEFAULT EXT.
MOVEM T1,DEFFSP+.FSEXT
PUSHJ P,PRSFIL ;PARSE THE FILESPEC
PUSHJ P,CONFRM ;CONFIRM
MOVE T1,[PRSFSP,,CMDFSP] ;COPY PARSED FILESPEC TO COMMAND FILESPEC
BLT T1,CMDFSP+.FSLEN-1
MOVEI P1,CMDFSP ;POINT TO COMMAND FILESPEC
MOVEI P2,CMDFLP ;AND COMMAND FILOP. BLOCK
PUSHJ P,SETFLP ;SETUP INITIAL FILOP. BLOCK
;OPEN THE FILE FOR READING
MOVEI T1,.ITCMF ;Prepare to open file for reading
PUSHJ P,$ITOPI## ;. .
JUMPN T1,CPOPJ ;?Error, return
TXO F,F.CFL ;Set "Reading from command file" bit.
POPJ P, ;Return
;ILLEGAL TO NEST INDIRECT COMMAND FILES
ILLNST: TYPE [ASCIZ/?CPYINI Illegal to nest indirect command files/]
JRST LOSFIN
SUBTTL CREATE MODE
CREMOD: PUSHJ P,FIXOUD ;FIXUP OUTPUT DIRECTORY
PUSHJ P,OPNTMP ;OPEN FILE FOR OUTPUT
; ERRORS DO NOT RETURN
MOVEI T1,.LMCRE ;ENTER CREATE MODE
MOVEM T1,LMODE
MOVEI T1,CREGO ;Address to return to on parsing
MOVEM T1,PR2STA ;Save it incase parse errors
MOVEM P,CM2P ;REMEMBER PDL NOW
CREGO: TXNN F,F.CFL ;Skip if reading from command file
OUTSTR CPROMP ;Type CPYLIB CREATE prompt
SETZM ERRTXT ;Clear any error text
MOVE T1,[-NCCMMS,,CCMDTB] ;-# commands, addr of table
PUSHJ P,PGOGO ;Parse go
JRST CREGO ;GO back to get another command
POPJ P, ;END or EXIT comes here
CCMDTB: CCOMMS ;Create-mode commands
NCCMMS==.-CCMDTB ;Number of commands
SUBTTL READ MODE
REAMOD: PUSHJ P,READIR ;READ IN DIRECTORY OF INPUT FILE
; (ERRORS DO NOT RETURN)
MOVEI T1,.LMREA ;ENTER READ MODE
MOVEM T1,LMODE
MOVEI T1,REAGO ;Place to restart if errors
MOVEM T1,PR2STA ;Save it
MOVEM P,CM2P ;REMEMBER PDL NOW
REAGO: TXNN F,F.CFL ;Skip if reading from command file
OUTSTR RPROMP ;Type CPYLIB READ prompt
SETZM ERRTXT ;Clear any error text
MOVE T1,[-NRCMMS,,RCMDTB] ;-# commands, addr of table
PUSHJ P,PGOGO ;Parse go
JRST REAGO ;GO back to get another command
POPJ P, ;END or EXIT comes here
RCMDTB: RCOMMS ;Read-mode commands
NRCMMS==.-RCMDTB ;# of commands
SUBTTL UPDATE MODE
UPMOD:: PUSHJ P,READIR ;READ DIRECTORY OF INPUT FILE
; ERRORS DO NOT RETURN
PUSHJ P,FIXOUD ;FIXUP OUTPUT DIRECTORY
PUSHJ P,OPNTMP ;OPEN FILE FOR OUTPUT
; ERRORS DO NOT RETURN
MOVEI T1,.LMUPD ;ENTER UPDATE MODE
MOVEM T1,LMODE ; . .
MOVEI T1,UPDGO ;Place to restart incase errors
MOVEM T1,PR2STA ; . .
MOVEM P,CM2P ;REMEMBER PDL NOW
UPDGO: TXNN F,F.CFL ;Skip if reading from command file
OUTSTR UPROMP ;Type CPYLIB UPDATE prompt
SETZM ERRTXT ;Clear any error text
MOVE T1,[-NUCMMS,,UCMDTB] ;-# commands, addr of table
PUSHJ P,PGOGO ;Parse go
JRST UPDGO ;GO back to get another command
POPJ P, ;END or EXIT comes here
UCMDTB: UCOMMS ;Update-mode commands
NUCMMS==.-UCMDTB ;Number of commands
SUBTTL 2ND PARSER ROUTINE
;Call:
; LMODE/ command parser level
; T1/ -n,,addr of command table
; PUSHJ P,PGOGO
; <here if command routine does not skip>
; <here if command routine is called and skips>
PGOGO: MOVEM T1,PR2CMT ;Save -n,,addr
PUSHJ P,GETLIN ;Read line in from TTY:
PUSHJ P,GETUCH ;Get first uppercase char
PUSHJ P,NONSP ;Get first non-space if this is not
CAIN CH,12 ;Just a CR on line?
POPJ P, ;Yes, return to type prompt again
CAIN CH,"@" ;Wants indirect command file?
JRST INDIR2 ;Yes, same as "TAKE" command
MOVE T1,PR2CMT ;Get input to KEYWRD
PUSHJ P,KEYWRD ;Parse the keyword
POPJ P, ;Unknown keyword, return
;Keyword matched -- go do it
PUSHJ P,(T2)
POPJ P, ;Single return
JRST CPOPJ1 ;Double return, echo that
;Indirect command file
INDIR2: PUSHJ P,CMDTAK ;Same as "TAKE file-spec"
POPJ P, ;Return
SUBTTL VARIOUS "HELP" COMMANDS
;HELP IN CREATE MODE
.CHELP: PUSHJ P,CONFRM
TYPE HLPMSC ;TYPE MESSAGE
POPJ P,
;HELP IN READ MODE
.RHELP: PUSHJ P,CONFRM
TYPE HLPMSR ;TYPE MESSAGE
POPJ P, ;RETURN
;HELP IN UPDATE MODE
.UHELP: PUSHJ P,CONFRM
TYPE HLPMSU ;TYPE MESSAGE
POPJ P, ;RETURN
SUBTTL VARIOUS "EXIT" COMMANDS
;ALL RETURN .+1 IF ERROR, .+2 IF SUCCESSFUL
;EXIT UPDATE
.UEXIT: PUSHJ P,.UEND ;END UPDATE
POPJ P, ;ERROR - GIVE ERROR RETURN
EXIT 1, ;EXIT
JRST CPOPJ1 ;CONTINUE--GIVE SKIP RETURN
;EXIT CREATE
.CEXIT: PUSHJ P,.CEND ;END CREATE
POPJ P, ;ERROR - GIVE ERROR RETURN
EXIT 1, ;EXIT.
JRST CPOPJ1 ;CONTINUE--GIVE SKIP RETURN
;EXIT READ
.REXIT: PUSHJ P,.REND ;END READ
POPJ P, ;ERROR - GIVE ERROR RETURN
EXIT 1, ;EXIT.
JRST CPOPJ1 ;CONTINUE--GIVE SKIP RETURN
SUBTTL VARIOUS "END" COMMANDS
;ALL RETURN .+1 IF ERROR (MESSAGE TYPED),
; ELSE .+2 (SUCCESS).
;END UPDATE
.UEND: PUSHJ P,CONFRM ;CONFIRM COMMAND
PUSHJ P,GUEND ;GO END UPDATE
POPJ P, ;ERROR, single return
JRST CPOPJ1 ;Good return
;END CREATE
.CEND: PUSHJ P,CONFRM ;CONFIRM COMMAND
PUSHJ P,GCEND ;Go end create
POPJ P, ;Error, single return
JRST CPOPJ1 ;SKIP RETURN
;END READ
.REND: PUSHJ P,CONFRM ;CONFIRM COMMAND
PUSHJ P,GREND ;Go end read
POPJ P, ;Error, single return
JRST CPOPJ1 ;GOOD RETURN
;** HERE
;WHERE command (update mode)
CMDWHE: PUSHJ P,CONFRM
JRST GOWHER ;Do the actions
;INSERT, update mode
.UINS:
;INSERT, create mode
.CINS:
PUSHJ P,PRSMOD ;Parse module name
PUSHJ P,FSPFIX ;FIXUP FILESPEC BLOCK
PUSHJ P,PRSFIL ;PARSE THE FILESPEC
PUSHJ P,CONFRM ;CONFIRM
MOVE T1,[PRSFSP,,OFFFSP] ;COPY PARSED FILESPEC TO COMMAND FILESPEC
BLT T1,OFFFSP+.FSLEN-1
MOVEI P1,OFFFSP ;POINT TO OFFLINE FILESPEC
MOVEI P2,OFFFLP ;AND OFFLINE FILOP. BLOCK
PUSHJ P,SETFLP ;SETUP INITIAL FILOP. BLOCK
PUSHJ P,CHKOFT ;Check offline file for TTY:
JRST ERESET ;?Error
MOVE T1,LMODE ;WHICH MODE ARE WE IN?
CAIN T1,.LMCRE ;CREATE
JRST GOINSC ;INSERT-CREATE MODE
JRST GOINSU ;INSERT-UPDATE MODE
;EXTRACT, read mode
.REXTR: PUSHJ P,PRSMOD ;Parse module name
PUSHJ P,FSPFIX ;FIXUP FILESPEC BLOCK
PUSHJ P,PRSFIL ;PARSE THE FILESPEC
PUSHJ P,CONFRM ;CONFIRM
MOVE T1,[PRSFSP,,OFFFSP] ;COPY PARSED FILESPEC TO COMMAND FILESPEC
BLT T1,OFFFSP+.FSLEN-1
MOVEI P1,OFFFSP ;POINT TO OFFLINE FILESPEC
MOVEI P2,OFFFLP ;AND OFFLINE FILOP. BLOCK
PUSHJ P,SETFLP ;SETUP INITIAL FILOP. BLOCK
JRST GOEXTR ;Go extract
;DELETE, update mode
.UDELE: PUSHJ P,PRSMOD ;Parse module name
PUSHJ P,CONFRM ; Then CRLF should end
JRST GODELU ;Go delete module
;REPLACE, update mode
.UREP: PUSHJ P,PRSMOD ;Parse module name
PUSHJ P,FSPFIX ;FIXUP FILESPEC BLOCK
PUSHJ P,PRSFIL ;PARSE THE FILESPEC
PUSHJ P,CONFRM ;CONFIRM
MOVE T1,[PRSFSP,,OFFFSP] ;COPY PARSED FILESPEC TO COMMAND FILESPEC
BLT T1,OFFFSP+.FSLEN-1
MOVEI P1,OFFFSP ;POINT TO OFFLINE FILESPEC
MOVEI P2,OFFFLP ;AND OFFLINE FILOP. BLOCK
PUSHJ P,SETFLP ;SETUP INITIAL FILOP. BLOCK
PUSHJ P,CHKOFT ;Check offline file for TTY:
JRST ERESET ;?ERROR
JRST GOREPU ;Go replace
SUBTTL CHKOFT FOR TOPS10 - Check offline file for TTY:
;Called when we about to read from an offline file.
;Sets F.OFT if TTY:
;Clears it if not.
;Call:
; PUSHJ P,CHKOFT
; <here if errors, message typed>
; <here if ok with F.OFT on or not>
CHKOFT: TXZ F,F.OFT ;Clear flag
MOVE T1,OFFFLP+.FODEV ;Get device name in T1
DEVCHR T1, ;Get characteristics
TXNE T1,DV.TTY ;TTY?
TXO F,F.OFT ;Yes, set flag
JRST CPOPJ1 ;Return
SUBTTL GET AN COMMAND INPUT LINE
;READ A LINE FROM TTY OR COMMAND FILE
GETLIN: MOVE T2,[POINT 7,TXTBUF] ;POINT TO IT
;ALTERNATE ENTRY POINT TO PUT INPUT LINE ANYWHERE
;CALL: T2/ PTR TO DESTINATION BUFFER
; PUSHJ P,GETLI1
GETLI1: MOVEI T3,TXTLEN ;GET MAX SIZE OF BUFFER
MOVEM T2,TXTBBP ;SET INITIAL BP TO IT
DECOD0: PUSHJ P,GCHR ;GET INPUT CHARACTER
JRST EOFMID ;?EOF IN MIDDLE OF LINE
CAIE T1,33 ;ALTMODE?
CAIN T1,175
JRST DECALT ;YES, HANDLE THEM
CAIN T1,15 ;CR--IGNORE
JRST DECOD0
CAIE T1,32 ;CONTROL-Z
CAIN T1,7 ;CONTROL-G
JRST DECALT ;ALTERNATE FORM OF CRLF
CAIE T1,13 ;VT?
CAIN T1,14 ;FF?
MOVEI T1,12 ;PRETEND IT'S A LF
CAIN T1,12 ;GOT A LF NOW?
JRST DECEOL ;YES
IDPB T1,T2 ;STORE CHAR IN COMMAND LINE
SOJG T3,DECOD0 ;IF STILL ROOM, GO GET SOME MORE
MOVEI T1,[ASCIZ/?CPYLTL Command line too long/]
JRST LOSE10
EOFMID: MOVEI T1,[ASCIZ/?CPYEML EOF in middle of command line/]
JRST LOSE10
;HERE FOR ALTERNATE FORMS OF CRLF, WHERE THE EOL DOESN'T DO A CRLF
DECALT: TXNN F,F.CFL ;UNLESS COMMAND FILE,
TYPE CRLF ;TYPE A CRLF
MOVEI T1,12 ;PRETEND IT'S A LF
;HERE WHEN LINE IS DONE
DECEOL: IDPB T1,T2 ;STORE EOL CHAR
MOVEI T1,0 ;STORE NULL
IDPB T1,T2
;COMMAND LINE IS NOW IN "TXTBUF"
POPJ P, ;RETURN
;ROUTINE TO GET NEXT CHARACTER OF COMMAND LINE
;CALL: PUSHJ P,GCHR
; <RETURN HERE IF EOF IN FILE>
; <RETURN HERE IF GOT CHARACTER IN T1>
GCHR: TXNE F,F.CFL ;READING FROM COMMAND FILE?
JRST GCHRCF ;YES
INCHWL T1 ;GET CHAR FROM TTY INTO T1
JRST CPOPJ1 ;AND SKIP RETURN WITH IT
;GET CHAR FROM COMMAND FILE
GCHRCF: PUSH P,T2 ;Only use T1 here
MOVEI T1,.FLCMD ;IFN
PUSHJ P,$ITINB## ;Get character
JUMPE T1,[MOVE T1,T2 ;Char in T1
POP P,T2 ;Restore T2
JRST CPOPJ1] ;Skip return
CAIN T1,2 ;Status 2 = EOF?
JRST [POP P,T2 ;Yes, restore T2
POPJ P,] ;Single return
EXIT ;?IO error, die off
SUBTTL TOPS10 COMMAND ERROR ROUTINES
;HERE FOR THE EQUIVALENT OF "LOSE"
;CALL: T1/ ADDRESS OF ASCIZ STRING
; JRST LOSE10
; <RETURNS TO NEWCMD>
;USE THIS FOR PARSE ERRORS ONLY!
;WILL ASSUME P IS MESSED UP
;IF READING FROM THE TERMINAL, TTY INPUT BUFFER IS CLEARED
;IF READING FROM A FILE, THE FILE IS ABORTED AND TTY INPUT BUFFER IS CLEARED.
LOSE10: TYPE <(T1)> ;PRINT ERROR MESSAGE
LOSFIN: TYPE CRLF ;AND CRLF
;Here to reset after error
ERESET: TXNE F,F.CFL ;ARE WE READING FROM A COMMAND FILE?
JRST LOS10A ;YES
CLRBFI ;Clear TTY input buffer
ERSETT: MOVE T1,LMODE ;GET LIBRARY COMMAND MODE
CAIE T1,.LMTOP ;AT TOP LEVEL?
JRST EST1A ;No
MOVE P,SAVEP ;RESTORE SAVED PDL
JRST NEWCMD ;Go get new command
;Return to higher-level command scanner
EST1A: MOVE P,CM2P ;Get saved PDL for other command parser
JRST @PR2STA ;Restart command scanner
;READING FROM A COMMAND FILE.. ABORT THE FILE
LOS10A: TYPE [ASCIZ/(Command file aborted: /]
MOVEI P1,CMDFSP ;TYPE FILESPEC FROM HERE
PUSHJ P,TYPFIL
TYPE [ASCIZ/)
/]
PUSHJ P,CLSCMD ;Close command file
TXZ F,F.CFL ;CLEAR FLAG--NOW READING FROM TTY
JRST ERSETT ;Go get new command
;CLSCMD - Routine to close command file
;Call:
; PUSHJ P,CLSCMD
; <return here always>
;If error,
; the program dies
CLSCMD: MOVEI T1,.FLCMD ;IFN
SETZ T2, ;No special flags
PUSHJ P,$ITCLS## ;Go close file
JUMPE T1,CPOPJ ;Return if OK
EXIT ;Error, Die off.
SUBTTL TOPS10 KEYWORD PARSER
;ROUTINE TO PARSE AT KEYWORD. READS AND UPDATES BYTE POINTER TO COMMAND
; LINE (TXTBBP).
;CALL: T1/ -# OF KEYWORDS IN TABLE,,ADDR OF TABLE
; CH/ FIRST CHAR OF KEYWORD
; TABLE FORMAT IS [ASCIZ/KEYWORD/],,ADDR OF ROUTINE TO CALL
;
;RETURNS .+1 IF KEYWORD DOESN'T MATCH, OR IS NOT A UNIQUE ABBREVIATION
;RETURNS .+2 IF KEYWORD DOES MATCH, WITH ADDRESS OF ROUTINE IN T2
;
;UPPER AND LOWERCASE ARE TREATED AS EQUIVALENT
KEYWRD: MOVEM CH,PRSCHR ;SAVE 1ST PARSED CHARACTER
MOVE T4,[POINT 7,ATMBUF] ;PUT KEYWORD IN ATOM BUFFER FIRST
PUSH P,TXTBBP ;REMEMBER BP AT START OF KEYWORD
POP P,PRSBBP
KEYWR2: CAIL CH,"A"
CAILE CH,"Z" ;BETWEEN "A" AND "Z"?
JRST NOTLTR ;NO
OKLTR: IDPB CH,T4 ;OK, STORE CHARACTER
PUSHJ P,GETUCH ;GET NEXT CHARACTER OF KEYWORD
JRST KEYWR2 ;GO CHECK IT OUT
NOTLTR: CAIL CH,"0"
CAILE CH,"9" ;ALLOW 0 THRU 9 IN KEYWORD
CAIA
JRST OKLTR
CAIN CH,"-" ;ALLOW DASH IN KEYWORD
JRST OKLTR
;HMM THIS CHARACTER IS INVALID. MUST BE END OF KEYWORD.
;NOW WE TRY TO MATCH IT WITH TABLE ENTRIES.
KEYWD2: MOVEI T2,0 ;STORE NULL TO END KEYWORD ATOM
IDPB T2,T4
MOVE T4,[POINT 7,ATMBUF] ;GET POINTER TO ATOM BUFFER
ILDB T5,T4 ;GET FIRST CHARACTER OF KEYWORD
JUMPE T5,[MOVEI T1,[ASCIZ/?CPYKWE Keyword expected/]
JRST KEWERR]
KEYWD3: HLR T3,(T1) ;GET PTR TO AN ASCII STRING
HRLI T3,(POINT 7,)
ILDB T2,T3 ;GET FIRST CHAR OF THIS STRING
CAMN T2,T5 ;DOES IT MATCH SO FAR?
JRST KEYWD4 ;YES!
CAML T2,T5 ;GONE TOO FAR?
JRST NOMTCH ;YES, SAY "NO MATCH"
AOBJN T1,KEYWD3 ;NO, GET DOWN TO A COMMAND THAT STARTS WITH
;THIS CHARACTER
NOMTCH: TYPE [ASCIZ/?CPYIVK Invalid keyword: /]
TYPE ATMBUF ;TYPE IT
JRST KEWER1
;HERE WHEN WE GET A KEYWORD ERROR..
KEWERR: OUTSTR (T1) ;PRINT STANDARD MESSAGE
KEWER1: OUTSTR CRLF ;CRLF TO END MESSAGE
SETZM PRSCHR ;CLEAR 1ST PARSED CHAR
POPJ P, ;ERROR RETURN
;HERE IF FIRST CHARACTER OF KEYWORD MATCHES
KEYWD4: ILDB T5,T4 ;GET NEXT CHARACTER
ILDB T2,T3
JUMPE T5,[JUMPE T2,KWDMTC ;GOT A MATCH
JRST TRYUNI] ;ELSE TRY FOR A UNIQUE ABBREVIATION
CAMN T2,T5 ;STILL MATCH?
JRST KEYWD4 ;YES, CONTINUE TRYING TO MATCH
;STOPPED MATCHING. LOOK AT NEXT COMMAND FOR POSSIBLE MATCH.
CAML T2,T5 ;SKIP IF MAYBE NEXT COMMAND IS OK
JRST NOMTCH ;NO, INVALID KEYWORD
MOVE T4,[POINT 7,ATMBUF] ;POINT TO ATOM BUFFER AGAIN
ILDB T5,T4 ;GET 1ST CHAR AGAIN
AOBJN T1,KEYWD3 ;IF MORE COMMANDS, TRY NEXT ONE
JRST NOMTCH ;REACHED END OF TABLE, NO MATCH
;HERE TO TRY FOR A UNIQUE ABBREVIATION
TRYUNI: AOBJP T1,OKUNI ;NO MORE COMMANDS = IT MATCHES!
HLR T3,(T1) ;POINT TO NEXT COMMAND
HRLI T3,(POINT 7,)
MOVE T4,[POINT 7,ATMBUF] ;BETTER NOT MATCH TO UNIQUE ABBREV..
TRYUN1: ILDB T5,T4 ;GET CHAR TYPED
ILDB T2,T3 ;GET CHAR OF NEXT COMMAND
CAMN T5,T2 ;SAME SO FAR?
JRST TRYUN1 ;YES, KEEP LOOKING
JUMPN T5,OKUNI ;IT IS UNIQUE IF REAL CHAR TYPED AND NO MATCH
NOTUNI: TYPE [ASCIZ/?CPYKNU Keyword not unique: /]
TYPE ATMBUF ;TYPE THE WORD THAT WAS NOT UNIQUE
JRST KEWER1 ;TYPE CRLF AND LEAVE
OKUNI: SUBI T1,1 ;MAKE T1 POINT TO THE COMMAND THAT IS UNIQUE
;HERE WHEN WE GOT A MATCH. RETURN T2=ADDRESS OF ROUTINE TO CALL
KWDMTC: HRRZ T2,(T1) ;RH OF TABLE ENTRY = ADDRESS OF ROUTINE
SETZM ERRTXT ;CLEAR ERROR TEXT IF GIVEN
SETZM PRSCHR ;CLEAR 1ST PARSED CHAR
JRST CPOPJ1 ;GIVE GOOD RETURN
;ROUTINE TO TYPE ", GOT: ", 'REST OF LINE'
; CALL AFTER TYPING "?BLAH EXPECTED"
;RETURNS WITH POPJ
BUTGOT: TYPE [ASCIZ/, got: /]
SKIPN T1,PRSCHR ;A PARSED CHAR TO TYPE?
JRST BUTGT1 ;NO
SETZM PRSCHR ;CLEAR PARSED CHARACTER
CAIN T1,12 ;EOL
JRST TEOL ;YES
OUTCHR T1 ;NO, TYPE THE CHAR
BUTGT1: ILDB T1,PRSBBP
JUMPE T1,BGERR ;?INTERNAL COBDDT ERROR
CAIN T1,12 ;EOL
JRST TEOL
OUTCHR T1 ;TYPE THE CHARACTER
JRST BUTGT1 ;LOOP
TEOL: TYPE [ASCIZ/<EOL>
/]
POPJ P, ;RETURN
BGERR: TYPE [ASCIZ/
?CPYILE Internal CPYLIB error - a bug!
/]
POPJ P,
SUBTTL TOPS10 PRSMOD - Parse a module name
PRSMOD: MOVEI P1,^D8 ;Max # chars in name
MOVE P2,[POINT 7,ATMBUF] ;Put mod name in ATMBUF
PRSMD0: PUSHJ P,NONSP ;Get 1st non-space char
CAIN CH,.CHLFD ;EOL?
JRST MODNEX ;?module name expected
PRSMD1: CAIL CH,"A"
CAILE CH,"Z"
JRST NOTPML ;Not a letter
PRSMD2: SOJL P1,PRSMD3 ;Don't write more than 8 chars
IDPB CH,P2 ;Store char
JRST PRSMD3 ;Go check char
;Character is not a letter
NOTPML: CAIL CH,"0" ;[2] Digit ?
CAILE CH,"9" ;[2]
CAIN CH,"-" ;Dash legal in name
JRST PRSMD2 ;Go store it
CAIE CH,.CHTAB ;Check for legitimate end
CAIN CH," "
JRST PRSMD4 ;Got it
CAIN CH,12
JRST PRSMD4
TYPE [ASCIZ/?CPYICM Invalid character in module name: /]
OUTCHR CH ;Type it
JRST LOSFIN
;Get next char.
PRSMD3: PUSHJ P,GETUCH ;Get uppercase character
JRST PRSMD1
;HERE WHEN GOT TO END OF MODULE NAME
PRSMD4: SETZ T1, ;End with null
IDPB T1,P2
;Copy name to SIXBIT in INMODN
SETZM INMODN ;Clear it
SETZM INMODN+1
MOVE P1,[POINT 7,ATMBUF]
MOVE P2,[POINT 6,INMODN] ;Copy to INMODN
PRSMD5: ILDB T1,P1
JUMPE T1,CPOPJ ;Done if null seen
CAIN T1,"-" ;Convert dash
MOVEI T1,":" ; To colon
SUBI T1,40 ;Convert to SIXBIT
IDPB T1,P2 ;Store char in INMODN
JRST PRSMD5 ;Loop
;Module name expected
MODNEX: TYPE <[ASCIZ/?CPYMNE Module name expected, got: <EOL>/]>
JRST LOSFIN
;GET FIRST NON-SPACE
;GET FIRST CHAR WHICH IS A NON-SPACE
NONSP: CAIE CH,11
CAIN CH,40
CAIA
POPJ P,
PUSHJ P,GETUCH ;GET UPPERCASE CHAR
JRST NONSP
;ROUTINE TO RETURN NEXT CHARACTER OF COMMAND LINE AND MAKE IT UPPERCASE.
GETUCH: ILDB CH,TXTBBP ;GET NEXT CHAR
CAIL CH,"A"+40 ;CONVERT LOWERCASE
CAILE CH,"Z"+40
POPJ P,
SUBI CH,40 ;TO UPPERCASE
POPJ P, ;AND RETURN
;ROUTINE TO CONFIRM A COMMAND
; IT POPJ'S IF NEXT THING ON THE LINE IS A CRLF, WHICH CONFIRMS THE
;COMMAND. IF THE NEXT THING ISN'T A CRLF, IT TYPES AN ERROR MESSAGE
; AND GOES TO ERESET.
CONFRM: PUSHJ P,NONSP ;GET TO FIRST NON-BLANK
CAIN CH,12 ;CR?
POPJ P, ;YES, POPJ
NOTCFM: TYPE [ASCIZ/?Not confirmed/]
PUSH P,TXTBBP
POP P,PRSBBP
MOVEM CH,PRSCHR ;ALSO TYPE THIS CHAR
PUSHJ P,BUTGOT
JRST ERESET
SUBTTL TOPS10 FILESPEC UTILITY ROUTINES
;ROUTINE TO INIT THE PARSED FILESPEC BLOCKS.
;CLEARS PRSFSP BLOCK, SETS USUAL DEFAULTS FOR DEFFSP.
;* USER MUST CALL THIS ROUTINE BEFORE SETTING UP DEFAULTS *
FSPFIX: SETZM PRSFSP ;CLEAR THIS BLOCK
MOVE T1,[PRSFSP,,PRSFSP+1]
BLT T1,PRSFSP+.FSLEN-1
SETZM DEFFSP ;CLEAR DEFAULT BLOCK TOO
MOVE T1,[DEFFSP,,DEFFSP+1]
BLT T1,DEFFSP+.FSLEN-1
;SETUP TYPICAL DEFAULTS (DEVICE DSK:)
MOVSI T1,'DSK' ;DEFAULT DEVICE
MOVEM T1,DEFFSP+.FSDEV
POPJ P, ;RETURN
;ROUTINE TO SET UP FILOP. BLOCK
;P1= ADDRESS OF PARSED FILESPEC
;P2= ADDRESS OF FILOP. BLOCK TO SET UP
; PUSHJ P,SETFLP
; <RETURN HERE ALWAYS>
;SETS UP:
; PTR TO LOOKUP/ENTER BLOCK
; DEVICE NAME
; FILENAME, EXTENSION, PATH POINTER
SETFLP: SETZM (P2) ;Clear it out
HRRZI T1,1(P2) ;Clear it out
HRLI T1,(P2)
BLT T1,.FPLEN-1(P2) ;. .
MOVX T1,FO.ASC+FO.PRV ;Assign extended channel
;Note: FO.PRV is supposed to be like
;"ENABLE"ing on the -20, always set it
; for consistancy.
MOVEM T1,.FOFNC(P2) ;Save flags
MOVEI T1,.FPLKP(P2) ;Get address of LOOKUP/ENTER block
HRLI T1,.FPRNM(P2) ;Get address of RENAME block
MOVEM T1,.FOLEB(P2) ;Store in FILOP. block
MOVE T1,.FSDEV(P1) ;GET DEVICE
MOVEM T1,.FODEV(P2) ;STORE IN FILOP. BLOCK
MOVEI T1,.FPRPB(P2) ;Address of returned path block
MOVEM T1,.FOPAT(P2) ;Store in FILOP. block
MOVEI T1,.FPIBH(P2) ;Address of input buffer header
HRLI T1,.FPOBH(P2) ;Address of output buffer header
MOVEM T1,.FOBRH(P2) ;Store in FILOP. block
MOVEI T1,.FPIPB(P2) ;Addr of input path block
SKIPE .FSPPN(P1) ;IS THERE PPN INFO?
MOVEM T1,.FPLKP+3(P2) ;Yes, Store in LOOKUP/ENTER block
MOVE T1,.FSNAM(P1) ;GET FILENAME
MOVEM T1,.FPLKP+0(P2) ;STORE 1ST WORD IN LOOKUP/ENTER BLOCK
MOVE T1,.FSEXT(P1) ;EXT.
MOVEM T1,.FPLKP+1(P2) ;STORE 2ND WORD IN L/E BLOCK
SKIPN .FSPPN(P1) ;IS THERE PPN INFO?
JRST SETFL1 ;[7] No, then fill in default
MOVE T1,.FSPPN(P1) ;COPY PPN
MOVEM T1,.FPIPB+.PTPPN(P2)
HRLI T1,.FSSD1(P1) ;PREPARE TO BLT SFD WORDS
HRRI T1,.FPIPB+.PTSFD(P2)
BLT T1,.FPIPB+.PTSFD+MXSFD-1(P2)
POPJ P,
SETFL1: HRLI T1,PTHBLK+.PTPPN ;[7] Get default path
HRRI T1,.FPIPB+.PTPPN(P2) ;[7] and put in xxxFLP
BLT T1,.FPIPB+.PTSFD+MXSFD-1(P2) ;[7]
POPJ P, ;[7]
;ROUTINE TO PARSE A TOPS10 FILESPEC
;CALL: PRSFSP/ ALL 0
; DEFFSP/ (DEFAULTS)
; PUSHJ P,PRSFIL ;PARSE FILESPEC
; <HERE IF SUCCESS>
;JRSTS TO "ERESET" IF ERRORS FOUND, MESSAGE TYPED
PRSFIL: TXZ F,F.DOT!F.PPN ;Dot not seen, PPN not seen
CAIN CH,12 ;AT EOL?
JRST ENDFSP ;Yes, done
PUSHJ P,PRSSIX ;GET SOMETHING
JUMPE T5,NULWD ;NULL WORD, CHECK FOR "["
CAIN CH,":" ;COLON TO END DEVICE NAME?
JRST [MOVEM T5,PRSFSP+.FSDEV ;YES, STORE DEVICE NAME
JRST SAWDEV] ;GO GET THE REST
JRST CHKNAM ;SEE IF A NAME, ETC.
SAWDEV: PUSHJ P,PRSSIX ;GET NAME
JUMPE T5,NULWD ;?NULL WORD, GO SEE
CHKNAM: MOVEM T5,PRSFSP+.FSNAM ;STORE NAME
CAIN CH,"." ;DOT?
JRST GETEXT ;YES, GO GET EXT
CAIN CH,"[" ;START OF PPN?
JRST GETPPN ;YES, GO GET THE PPN
CAIE CH,11 ;TAB OR SPACE
CAIN CH," "
JRST ENDFSP ;END OF FILESPEC
CAIN CH,12 ;EOL?
JRST ENDFSP ;YES
TYPE [ASCIZ/?Invalid character in filename: /]
OUTCHR CH ;TYPE OFFENDING CHARACTER
JRST LOSFIN ;Type CRLF and restart
;DOT SEEN.. PARSE EXTENSION
GETEXT: TXO F,F.DOT ;SET FLAG SO WE KNOW HE TYPED ONE
PUSHJ P,PRSSIX ;GET EXTENSION
JUMPE T5,NULWD ;NULL WORD
HLLZM T5,PRSFSP+.FSEXT ;STORE EXTENSION
CAIE CH,11 ;SPACE OR TAB?
CAIN CH," "
JRST ENDFSP ;YES, END OF FILE SPEC
CAIN CH,"[" ;START OF PPN
JRST GETPPN ;YES
CAIN CH,12 ;EOL?
JRST ENDFSP ;YES, DONE
;GIVE ERROR
GARBAG: PUSH P,TXTBBP
POP P,PRSBBP
MOVEM CH,PRSCHR
TYPE [ASCIZ/?Garbage after filespec/]
PUSHJ P,BUTGOT
JRST ERESET ;Error, and give up
;NULL WORD
NULWD: CAIN CH,"[" ;START OF PPN?
JRST GETPPN
CAIN CH,12 ;EOL?
JRST ENDFSP ;End of filespec
PUSH P,TXTBBP ;COMPLAIN
POP P,PRSBBP
MOVEM CH,PRSCHR
TYPE [ASCIZ/?CPYEFS Error in filespec/]
PUSHJ P,BUTGOT
JRST ERESET
;[ SEEN TO START PPN
GETPPN: TXO F,F.PPN ;SET PPN FLAG SO WE CAN DEFAULT CORRECTLY
PUSHJ P,PRSOCT ;GET AN OCTAL NUMBER
SKIPN T1 ;0?
JRST [TXNE F,F.MIN ;"-"?
JRST GETEPN ;[-] means don't default ppn
HLRZ T1,PTHBLK+.PTPPN ;Get from default path
JRST .+1]
HRLM T1,PRSFSP+.FSPPN ;STORE PROJ NUMBER
CAIN CH,"," ;COMMA
JRST GETPRG ;YES
TYPE [ASCIZ/?CPYCEP Comma expected in PPN/]
PUSH P,TXTBBP
POP P,PRSBBP ;START HERE WITH TYPING OUT THE PROBLEM
MOVEM CH,PRSCHR
PUSHJ P,BUTGOT ;TYPE WHAT WE ACTUALLY GOT
JRST ERESET ;Reset after error
GETPRG: PUSHJ P,PRSOCT ;GET PROGRAMMER NUMBER
CAIN T1,0 ;None given?
HRRZ T1,PTHBLK+.PTPPN ;Yes, get from default path block
HRRM T1,PRSFSP+.FSPPN ;STORE IT
CAIN CH,"," ;ANOTHER COMMA
JRST GETSFD ;GET SFD'S
CAIN CH,12 ;EOL
JRST ENDFSP ;Yes
CAIE CH,.CHTAB ;Tab or space
CAIN CH," "
JRST ENDFSP ;Ends filespec
CAIN CH,"]" ;END OF PPN
JRST GOTEPN ;YES
PUSH P,TXTBBP
POP P,PRSBBP ;MAKE ERROR ROUTINE POINT TO INVALID TERMINATOR
MOVEM CH,PRSCHR
TYPE <[ASCIZ/?CPYEXP Expected "]" to end PPN/]>
PUSHJ P,BUTGOT
JRST ERESET ;Give up
;HERE TO PARSE SFD'S
GETSFD: MOVEI P1,0 ;SFD index
MOVEI P2,PRSFSP+.FSSD1 ;POINTER TO PLACE TO STORE IT
GETNFD: PUSHJ P,PRSSIX ;GET AN SFD NAME
SKIPN T5 ;Just a placeholder?
JRST [MOVE T5,PTHBLK+.PTPPN+1(P1) ;Get from default path block
JRST .+1]
MOVEM T5,(P2) ;STORE IT
AOJ P2, ;UPDATE POINTER
CAIN CH,"]" ;END OF PPN
JRST GOTEPN ;YES
CAIN CH,12 ;EOL
JRST ENDFSP ;Yes, done with filespec
CAIN CH,"," ;MORE SFD'S?
JRST [ADDI P1,1
CAIGE P1,MXSFD ;Possible more SFD's?
JRST GETNFD ;YES, GO GET MORE IF WE CAN
TYPE [ASCIZ/?CPYTMS Too many SFD's specified
/]
JRST ERESET]
PUSH P,TXTBBP
POP P,PRSBBP ;MAKE ERROR ROUTINE POINT TO INVALID TERMINATOR
MOVEM CH,PRSCHR
TYPE <[ASCIZ/?CPYEXP Expected "," or "]" to end SFD/]>
PUSHJ P,BUTGOT
JRST ERESET ;Give up
;HERE TO END [-] CORRECTLY
GETEPN: TXZ F,F.PPN ;CLEAR FLAG SO WE DON'T DEFAULT
PUSHJ P,GETUCH ;GET "]"
CAIN CH,"]" ;Better be end
JRST GOTEPN
CAIN CH,12 ;Could be CR
JRST ENDFSP ;OK
TYPE <[ASCIZ/?CPYEXP Expected "]" to end PPN/]>
PUSHJ P,BUTGOT
JRST ERESET ;Give up
;HERE WHEN GOT A "]" TO END PPN
GOTEPN: PUSHJ P,GETUCH ;NEXT CHAR AFTER PPN
CAIE CH,11 ;BLANKS AND TABS END THE FILESPEC
CAIN CH," "
JRST ENDFSP
CAIN CH,12 ;JUST A CRLF?
JRST ENDFSP ;YES
TYPE [ASCIZ/?CPYEXP Expecting delimiter after filespec/]
PUSHJ P,BUTGOT
JRST ERESET
;HERE AT END OF PARSING FILESPEC.. ALL OK SO FAR.
; APPLY DEFAULTS TO GET THE ACTUAL FILESPEC
ENDFSP: SKIPE PRSFSP+.FSDEV ;ANY DEVICE SPECIFIED?
JRST ENDFS1 ;YES
MOVE T1,DEFFSP+.FSDEV ;NO, GET DEFAULT
MOVEM T1,PRSFSP+.FSDEV ;STORE AWAY
ENDFS1: SKIPE PRSFSP+.FSNAM ;ANY NAME SPECIFIED?
JRST ENDFS2 ;YES
MOVE T1,DEFFSP+.FSNAM ;No, get default
MOVEM T1,PRSFSP+.FSNAM
ENDFS2: TXNE F,F.DOT ;DID WE SEE A "." FOR EXTENSION?
JRST ENDFS3 ;Yes, don't default it
SKIPE PRSFSP+.FSEXT ;Any ext specified?
JRST ENDFS3 ;Yes, go on
MOVE T1,DEFFSP+.FSEXT ;NO, GET DEFAULT
MOVEM T1,PRSFSP+.FSEXT
ENDFS3: TXNE F,F.PPN ;PPN seen?
POPJ P, ;Yes, return
SKIPN T1,DEFFSP+.FSPPN ;Any default PPN parts?
JRST ENDFS4 ;No
MOVE T1,DEFFSP+.FSPPN ;Copy all default stuff
TLNN T1,-1
HLL T1,PTHBLK+.PTPPN ;Get missing parts from PATH block
TRNN T1,-1
HRR T1,PTHBLK+.PTPPN
MOVEM T1,PRSFSP+.FSPPN
ENDFS4: MOVEI P2,0 ;SFD index
SKIPN T1,DEFFSP+.FSSD1(P2) ;Default SFD?
POPJ P, ;No, return now
SKIPN PRSFSP+.FSSD1(P2) ;And none specified?
MOVEM T1,PRSFSP+.FSSD1(P2) ;Right, store it
ADDI P2,1
CAIE P2,MXSFD ;Done?
JRST ENDFS4 ;No, loop
POPJ P, ;DONE-RETURN
;ERROR: FILESPEC EXPECTED
;ROUTINE TO PARSE A NUMBER
;RETURNS NUMBER PARSED IN T1
;RETURNS NUMBER OF DIGITS IN T2
PRSDEC: SKIPA T3,[^D10] ;PARSE A DECIMAL NUMBER
PRSOCT: MOVEI T3,^D8 ;PARSE AN OCTAL NUMBER
SETZB T1,T2 ;CLEAR RESULT ,T2=0 MEANS NO NUMBERS SEEN YET
MOVE T4,TXTBBP
MOVEM T4,PRSBBP
SETZM PRSCHR ;CHAR IN CH IS NOT USED
PRSRD1: ILDB CH,TXTBBP
CAIE CH,11
CAIN CH," "
JRST PRSRD1
CAIN CH,"-" ;MINUS SIGN
JRST [TXO F,F.MIN ;YES, SET FLAG
ILDB CH,TXTBBP ;GET NEXT CHAR
JRST PRSRD2] ;GO LOOK AT NUMBER
TXZ F,F.MIN ;NO, CLEAR FLAG
PRSRD2: CAIL CH,"0"
CAILE CH,"0"-1(T3) ;IS NUMBER IN RANGE?
JRST [TXNE F,F.MIN ;STOP PARSING, IF NUMBER NEGATIVE?
MOVN T1,T1 ;YES, NEGATE
POPJ P,] ;RETURN
IMUL T1,T3 ;MAKE ROOM FOR NEXT DIGIT
ADDI T1,-"0"(CH) ;ADD IT IN
ADDI T2,1 ;COUNT DIGITS SEEN
ILDB CH,TXTBBP ;GET NEXT CHARACTER
JRST PRSRD2 ;AND KEEP GOING...
;ROUTINE TO PARSE A SIXBIT WORD AND RETURN IT IN T5.
;CHAR IN CH IS NOT USED
PRSSIX: MOVE T3,[POINT 6,T5] ;GET A BYTE POINTER TO THE WORD.
SETZ T5, ;CLEAR IT TO START.
PRSSX1: PUSHJ P,GETUCH ;GET NEXT UPPERCASE CHAR.
PUSHJ P,NONSP ;SKIP LEADING SPACES AND TABS
PRSSX0: CAIL CH,"A" ;ALPHANUMERIC ONLY ALLOWED
CAILE CH,"Z"
JRST PRSSX2
PRSSXO: SUBI CH,40 ;CHAR OK, STASH IT
TLNE T3,770000 ;IF ROOM
IDPB CH,T3 ;STORE CHAR
PUSHJ P,GETUCH ;GET NEXT CHAR
JRST PRSSX0 ;GO ADD IT TO STRING
PRSSX2: CAIL CH,"0"
CAILE CH,"9" ;0 THRU 9 OK
POPJ P, ;HERE IF NON-SIXBIT CHAR, RETURN
JRST PRSSXO ;JUMP -- CHAR OK
;ROUTINE TO TYPE A FILESPEC
;CALL: P1/ POINTER TO FILESPEC BLOCK
; PUSHJ P,TYPFIL ;TYPE IT OUT
; <RETURN HERE ALWAYS>
TYPFIL: MOVE T1,.FSDEV(P1) ;GET DEVICE
PUSHJ P,TYPSIX ;TYPE IT
OUTCHR [":"]
MOVE T1,.FSNAM(P1) ;GET NAME
PUSHJ P,TYPSIX ;TYPE IT
OUTCHR ["."]
MOVE T1,.FSEXT(P1) ;GET EXT.
PUSHJ P,TYPSIX ;TYPE IT
SKIPN .FSPPN(P1) ;ANY PPN?
POPJ P, ;NO, DONE
OUTCHR ["["]
HLRZ T1,.FSPPN(P1) ;GET PROJ. NUMBER
PUSHJ P,TYPOCT
OUTCHR [","]
HRRZ T1,.FSPPN(P1) ;PROG. NUMBER
PUSHJ P,TYPOCT
MOVSI T3,-MXSFD ;MAX. NUMBER OF SFDS.
HRRI T3,.FSSD1(P1) ;ADDRESS OF 1ST SFD
TYPFL1: SKIPN T1,(T3) ;ARE THERE MORE SFD'S?
JRST TYPFL2 ;NO, DONE PPN
OUTCHR [","] ;TYPE COMMA SEPARATOR
PUSHJ P,TYPSIX ;TYPE SIXBIT NAME
AOBJN T3,TYPFL1 ;LOOP FOR ALL SFDS.
TYPFL2: OUTCHR ["]"] ;END PPN
POPJ P, ;RETURN
;ROUTINE TO TYPE AN OCTAL NUMBER
;CALL: T1/ NUMBER
; PUSHJ P,TYPOCT
; <RETURN HERE>
;USES T1,T2,T3
TYPOCT: MOVEI T3,^D8 ;GET BASE
TYPBAS: IDIV T1,T3 ;DIVIDE
PUSH P,T2 ;SAVE REMAINDER
SKIPE T1 ;SKIP IF DONE NOW
PUSHJ P,TYPBAS ;LOOP
POP P,T1 ;GET DIGIT
ADDI T1,"0" ;MAKE ASCII
OUTCHR T1 ;TYPE IT
POPJ P, ;RECURSE
;ROUTINE TO TYPE A SIXBIT WORD
;CALL: T1/ CONTENTS
; PUSHJ P,TYPSIX
; <RETURN HERE>
; USES T1,T2
TYPSIX: MOVE T2,T1 ;COPY ARG TO T2
TYPSX1: JUMPE T2,CPOPJ ;JUMP WHEN DONE
SETZ T1, ;CLEAR T1
LSHC T1,6 ;SHIFT HIGH ORDER BITS
ADDI T1,40 ;MAKE ASCII
OUTCHR T1 ;TYPE THE CHARACTER
JRST TYPSX1 ;LOOP UNTIL ALL CHARS TYPED
SUBTTL SETUP DEFAULT PATH
;CALL:
; PUSHJ P,SETPTH
; <RETURN HERE>
;SETS UP "PTHBLK"
SETPTH: MOVX T1,.PTFRD ;READ DEFAULT PATH
MOVEM T1,PTHBLK+.PTFCN ;STORE FUNCTION CODE
MOVE T1,[XWD .PTMAX+1,PTHBLK]
PATH. T1,
JRST PTHFAI ;PATH. UUO FAILED
POPJ P, ;DONE, RETURN
PTHFAI: TYPE [ASCIZ/?CPYPUF PATH. UUO failed, error code = /]
PUSHJ P,TYPOCT ;TYPE ERROR CODE
EXIT ;DIE OFF
;SETUP FILOP. blocks (for input to IOTMP)
SETFOB: MOVEI T1,DIRFLP ;Directory file
MOVEM T1,.ITDIR+2
MOVEI T1,LSTFLP ;Listing file
MOVEM T1,.ITLIS+2
MOVEI T1,OFFFLP ;Offline file
MOVEM T1,.ITOOF+2
MOVEM T1,.ITIOF+2 ;Same FILOP. block for Input and output files
MOVEI T1,INPFLP ;Input LIB file
MOVEM T1,.ITILF+2
MOVEI T1,OUTFLP ;Output LIB file
MOVEM T1,.ITOLF+2
POPJ P, ;Done, return
SUBTTL TOPS10 MEMORY MANAGEMENT
;SETUP PAGE MAP (INITIALIZE MEMORY MANAGER)
SETPMP: MOVE P2,[POINT 1,PAGMAP]
SETZ T4, ;Start with page 0
;Set aside some pages for CPYLIB itself
HRRZ T3,.JBFF## ;Get last used loc
TRNE T3,777 ;Round up to nearest page
ADDI T3,1000
LSH T3,-^D9 ;Get its page number
SETO T1, ;Mark all below it as not free
SETPM0: IDPB T1,P2
SOSLE T3
AOJA T4,SETPM0
ADDI T4,1 ;Now start looking at next page
SETZ T1, ;Mark all free until 400
IDPB T1,P2
CAIE T4,377
AOJA T4,.-2
ADDI T4,1 ;Start at page 400
SETO T1, ;Mark all not free after 400
IDPB T1,P2
CAIE T4,777
AOJA T4,.-2
POPJ P, ;Done, return
>;END IFE TOPS20
IFN TOPS20,<
LIST ;TURN LISTING BACK ON
>
SUBTTL LIST ACTIONS
;TOPS20: LISJFN/ JFN of output list file
;TOPS10: LSTFLP/ Addr of FILOP. block
GOLIST: PUSHJ P,READIR ;READ DIRECTORY OF INPUT FILE
; ERRORS DO NOT RETURN
PUSHJ P,OLISOU ;Open list file for output
JRST ERESET ;Error, return
PUSHJ P,GDATIM ;Get date and time for printing
MOVEI T1,1 ;Start with page 1
MOVEM T1,PAGNO
MOVEI T1,.LINPP ;Get lines/page
MOVEM T1,LINECT ;Save
MOVE P1,IFPTR ;Point to input fine table
MOVE P2,IFINUM ;Get # of entries
JUMPE P2,GOLSDE ;Jump and complain if directory is empty
ADD P2,P1 ;Get end+2
GOLIS1: PUSHJ P,LIST1 ;Go list one module
JRST GOLSEE ;Error, close listing file, kill it and
; go to "ERESET"
ADDI P1,2 ;Bump ptr by 2
CAMN P1,P2 ;Done all of the directory?
JRST DONLIS ;yes, finish up
TXNE F,F.LFT ;List to TTY:?
JRST GOLIS1 ;Yes, no FF
PUSHJ P,SKPLPG ;Skip to next page of listing
JRST GOLSEE ;Error, close list file and abort
JRST GOLIS1 ;Go back for more
;Error somewhere, message has been typed
GOLSEE: PUSHJ P,CLOSLK ;Close list file and abort
PJRST ERESET ;Go to "error reset"
GOLSDE: TYPE [ASCIZ/%CPYNLM Directory is empty-- no listing made
/]
JRST CLOSLK ;Go close listing file and abort
;Normal end to listing
DONLIS: TXNN F,F.LFT ;Skip if listing to TTY:
PJRST CLOSL ;No, just close listing and return
MOVE T1,[POINT 7,[ASCIZ/
*** End of library file listing ***
/]]
PUSHJ P,LSTSTR
JRST GOLSEE ;Error
PJRST CLOSL ;Now go close listing and return
;LIST1: List one module
;Inputs:
; P1 points to fine table entry
; input library file is positioned to that module
; Listing file is open for output
; F.LFT is set if listing to TTY:
;Outputs:
; Listing of current module is appended to list file
;Call:
; PUSHJ P,LIST1
; <Error return, message typed>
; <OK return>
;Uses T1-T4
LIST1: PUSHJ P,GMODN ;Get module name to print
TXNE F,F.LFT ;Listing to TTY:?
JRST [PUSHJ P,LSTHDT ;Yes, special header
POPJ P, ;Error
JRST LIST2] ;Then go list module
PUSHJ P,LSTHDG ;List heading
POPJ P, ;Error
;List the module
;Here at start of lines
LIST2: PUSHJ P,GETOIF ;Get word from old input file
TRNN WD,1 ;First word must be a line number
JRST LIS2E1 ;?No, complain
CAMN WD,[<ASCII / />+1] ;SOS page mark?
JRST LSTF11 ;Yes
MOVE T1,WD
AOJE T1,LSTF10 ;End of module if line number is -1
SKIPN LINECT ;At end of page?
JRST [PUSHJ P,LSNPAG ;Yes, put out new header
POPJ P, ;Error, return
JRST .+1] ;Go on
LSH WD,-1 ;Divide line number by 2
PUSHJ P,LINOUT ;Print it
POPJ P, ;Error
;Read and output the line text itself
LIST3: PUSHJ P,GETOIF ;Get word from old input file
TRNE WD,1 ;Better not be spurious line numbers
JRST LIS3E1 ;Complain
MOVE T4,[POINT 7,WD] ;Look at this word
LIST4: ILDB T2,T4 ;Get character
CAIL T2,.CHLFD ;Is character a line-feed?
CAILE T2,.CHFFD ;Or VT, FF?
TRNA ;No
JRST LIST5 ;yes
PUSHJ P,LSTCH ;Output character
POPJ P, ;Error, give error return
TLNE T4,760000 ;Is word fully output?
JRST LIST4 ;No
JRST LIST3 ;Yes, get another
;End-of-line character
LIST5: MOVE T4,T2 ;Remember end-of-line character
MOVE T1,[POINT 7,CRLF] ;CRLF
PUSHJ P,LSTSTR ;List CRLF
POPJ P, ;Error
SOS LINECT ;Remember one less line on this page
CAIN T4,.CHLFD ;Was eol char LINEFEED?
JRST LIST2 ;Yes, don't output it again
MOVE T2,T4 ;EOL character
PUSHJ P,LSTCH ;Output it
POPJ P, ;Error, return
JRST LIST2 ;Go back for next line
;End-of-module reached
LSTF10: JRST CPOPJ1 ;Skip return
;sos page mark
LSTF11: PUSHJ P,GETOIF ;Get word after page mark
MOVEI T2,.CHFFD ;Fake printing a form feed
PUSHJ P,LSTCH
POPJ P, ;Error
JRST LIST2 ;Get next line
;Errors
LIS2E1: TYPE [ASCIZ/?CPYFWN First word in library line not line number
/]
POPJ P, ;Error return
LIS3E1: TYPE [ASCIZ/?CPYLNE Line number embedded in library module
/]
POPJ P, ;Error return
;List header
;Inputs:
; INMODN contains the ASCIZ name of module (with /S if necessary)
; DATIMA contains the ASCIZ date and time
;Call:
; PUSHJ P,LSTHDG
; <error return>
; <success>
;Uses T1-t4
LSTHDG: MOVE T1,[POINT 7,INMODN] ;Point to name string
PUSHJ P,LSTSTR ;List the string
POPJ P, ;Error return
MOVE T1,[POINT 7,LHDR1] ;Some header text
PUSHJ P,LSTSTR
POPJ P, ;Error
MOVE T1,[POINT 7,DATIMA] ;Date/time
PUSHJ P,LSTSTR
POPJ P, ;Error
MOVE T1,[POINT 7,[ASCIZ/ Page /]]
PUSHJ P,LSTSTR
POPJ P, ;Error
MOVE T1,PAGNO ;Get page number
PUSHJ P,LSTDCN ;List decimal number
POPJ P, ;Error
MOVE T1,[POINT 7,[ASCIZ/
/]] ;Two CRLFS
PUSHJ P,LSTSTR
POPJ P, ;Error
MOVE T1,LINECT
SUBI T1,3 ;Start at 3rd line
MOVEM T1,LINECT
JRST CPOPJ1 ;Success return
LHDR1: $TEXT < COBOL Library >
;Same as LSTHDG, but listing is to TTY:
LSTHDT: MOVE T1,[POINT 7,[ASCIZ/
*** Program /]]
PUSHJ P,LSTSTR ;*** Program<space>
POPJ P, ;Error
MOVE T1,[POINT 7,INMODN]
PUSHJ P,LSTSTR ;List name
POPJ P, ;Error
MOVE T1,[POINT 7,[ASCIZ/
/]]
PUSHJ P,LSTSTR ;Two CRLF's
POPJ P, ;Error
JRST CPOPJ1 ;Done, return
;SKPLPG- Skip to next page of listing
SKPLPG: MOVEI T2,.CHFFD ;Write a form-feed
PUSHJ P,LSTCH ; . .
POPJ P, ;Error, single return
AOS PAGNO ;Bump page number
MOVEI T1,.LINPP ;Lines/page
MOVEM T1,LINECT ;Store it
JRST CPOPJ1 ;Skip return
;LSTCH - Output a character to listing file
;Inputs:
; T2/ character
;Call:
; PUSHJ P,LSTCH
; <error return, message typed>
; <success>
LSTCH: MOVEI T1,.FLLIS ;IFN
PUSHJ P,$ITOUB## ;Go output the byte
JUMPE T1,CPOPJ1 ;If ok, skip return
POPJ P, ;Error return
;Skip to new page of listing and put out a header.
; This is only done if LINECT gets to be 0 in the middle
; of a module listing.
LSNPAG: TXNE F,F.LFT ;Listing file to TTY:?
JRST CPOPJ1 ;Yes, don't worry about page delimination
PUSHJ P,SKPLPG ;Skip to new page of listing
POPJ P, ;Error
PUSHJ P,LSTHDG ;List heading
POPJ P, ;Error
JRST CPOPJ1 ;Ok, return
;LSTDCN - List decimal number
;Input:
; T1/ number to print (must be positive)
;Call:
; PUSHJ P,LSTDCN
; <error return>
; <OK>
LSTDCN: IDIVI T1,^D10 ;Divide by 10
PUSH P,T2 ;Save remainder
JUMPE T1,LSTDC1 ;Jump when done
PUSHJ P,LSTDCN ;Recurse
POPJ P, ;Error return
LSTDC1: POP P,T2 ;Get digit to print
ADDI T2,"0" ;Make it ASCII
PUSHJ P,LSTCH
POPJ P, ;Error
JRST CPOPJ1 ;Success
;LINOUT - List line number, followed by a tab
;Inputs:
; WD/ Line number to print
;Call:
; PUSHJ P,LINOUT
; <error return>
; <good return>
LINOUT: MOVE T1,WD
MOVEI T3,0
MOVEI T4,6 ; # characters in line number - 1
LINOT1: IDIVI T1,^D10 ;Get a digit
ADDI T2,"0" ;Make ASCII
LSHC T2,-6 ;Shift into T3
SOJG T4,LINOT1 ;Loop 5 times
LINOT2: MOVEI T2,0
LSHC T2,6 ;Get character back
PUSHJ P,LSTCH ;Print it
POPJ P, ;Error return
JUMPN T3,LINOT2 ;Loop until no more characters
MOVEI T2,.CHTAB ;Print a tab
PUSHJ P,LSTCH
POPJ P, ;Error
JRST CPOPJ1 ;Good return
;LSTSTR - Output ASCIZ string to listing file
;Inputs:
; T1/ Byte ptr to string
;Call:
; PUSHJ P,LSTSTR
; <error return, message typed>
; <here if ok>
;The caller is responsible for keeping track of the lines output
LSTSTR: MOVE T3,T1 ;Get byte ptr
MOVEI T1,.FLLIS ;IFN
SETO T2, ;Stop when get to null
PUSHJ P,$ITOSB## ;Output string of bytes
JUMPE T1,CPOPJ1 ;Skip return if ok
POPJ P, ;No, bad return
;GDATIM - Get date and time for listing
;Inputs:
; --none--
;Outputs:
; DATIMA/ ASCIZ date/time text
;Call:
; PUSHJ P,GDATIM
; <Return here always>
;Uses T1-T4
GDATIM: SETZM DATIMA ;Clear the area
MOVE T1,[DATIMA,,DATIMA+1]
BLT T1,DATME
IFE TOPS20,<
;DATIMA area is:
; DD-MM
; M-YY
; HH:
; MM
MOVEI T1,"-" ;Put dash where appropriate
DPB T1,[POINT 7,DATIMA,20]
DPB T1,[POINT 7,DATIMA+1,13]
MOVEI T1,":" ;And colon
DPB T1,[POINT 7,DATIMA+2,34]
MOVEI T1," " ;And space
DPB T1,[POINT 7,DATIMA+1,34]
DPB T1,[POINT 7,DATIMA+2,6]
DPB T1,[POINT 7,DATIMA+2,13]
DATE T1, ;Get date
IDIVI T1,^D31*^D12 ;T1=YEAR
IDIVI T2,^D31 ;T2=MONTH,T3=DAY
ADDI T3,1
PUSHJ P,DATIM9 ;Get ascii two characters for day
TRNN T3,3600 ;If first digit 0,
TRZ T3,4000 ;Make it a space
DPB T3,[POINT 14,DATIMA,13] ;Store "DD"
MOVE T3,MOTABL(T2) ;Get ASCII stuff for month
DPB T3,[POINT 7,DATIMA+1,6] ;Store last character
LSH T3,-^D7 ;Get rid of last character
DPB T3,[POINT 14,DATIMA,34] ;Store first two characters
MOVEI T3,^D64(T1)
CAIL T3,^D100 ;CK FOR YR 2000+
SUBI T3,^D100 ;IF SO, CHANGE TO 00+
PUSHJ P,DATIM9 ;Get two ASCII characters for year
DPB T3,[POINT 14,DATIMA+1,27]
MSTIME T2, ;GET TIME IN MILLISECONDS
IDIVI T2,^D1000*^D60 ;CONVERT TO MINUTES
IDIVI T2,^D60 ;T2= hours, T3= minutes
PUSHJ P,DATIM9 ;Get two ASCII digits for Minutes
DPB T3,[POINT 14,DATIMA+3,13]
MOVE T3,T2
PUSHJ P,DATIM9 ;Get two ASCII digits for Hours
DPB T3,[POINT 14,DATIMA+2,27]
POPJ P,
;Make ASCIZ two digits out of number in T3
DATIM9: IDIVI T3,^D10
LSH T3,7
ADDI T3,"00"(T4)
POPJ P, ;Return
;Table of months, right-justified ASCII.
MOTABL: "Jan"
"Feb"
"Mar"
"Apr"
"Jun"
"Jul"
"Aug"
"Sep"
"Oct"
"Nov"
"Dec"
>;END IFE TOPS20
IFN TOPS20,< ;You can see how much easier this is!
MOVE T1,[POINT 7,DATIMA] ;Store date and time
SETO T2, ;Current time
MOVX T3,OT%NTM ;Not the time
ODTIM% ;Monitor does all the work
MOVEI T2," " ;Separate by three spaces
IDPB T2,T1
IDPB T2,T1
IDPB T2,T1
SETO T2, ;Current time
MOVX T3,OT%NDA!OT%NSC ;Don't output date or seconds
ODTIM%
POPJ P, ;Return
>;END IFN TOPS20
;OLISOU: Open list file for output
;Inputs:
; T20: LISJFN/ JFN of output list file
;Call:
; PUSHJ P,OLISOU
; <return here if errors, message typed, JFN released>
; <Return here if OK>
OLISOU:
IFN TOPS20,<
MOVE T1,LISJFN
MOVEM T1,.ITLIS+2 ;Store in file block
>;END IFN TOPS20
MOVEI T1,.ITLIS ;Point to block
PUSHJ P,$ITOPO## ;Go open file for output
JUMPE T1,CPOPJ1 ;Skip return if OK
IFN TOPS20,<
HRRZ T1,LISJFN ;Release JFN
RLJFN%
ERJMP .+1 ;Ignore errors
>;END IFN TOPS20
POPJ P, ;Error return
;CLOSL - Close listing file
CLOSL: MOVEI T1,.FLLIS ;IFN
SETZ T2, ;No special flags
PUSHJ P,$ITCLS ;Close file
POPJ P, ;Return, whether status is 0 or 1
;CLOSLK - Close listing file and kill it because of an error
CLOSLK: MOVEI T1,.FLLIS ;IFN
MOVX T2,IT%NRF ;Don't retain file
PUSHJ P,$ITCLS ;Go close file
POPJ P, ;Return, whether status is 0 or 1
SUBTTL Where command (in update mode)
;Type last 3 entries we made, and next three in input file
GOWHER: TXO F,F.DTY ;Set flag (DIRECTORY to TTY:)
TYPE CRLF ;CRLF to start
MOVE P1,OFPTR ;Point to output table
SUBI P1,6 ;Go back three entries
MOVEI P2,3 ;# entries to type
GOWHE1: CAIL P1,OFINTB ;Before beginning?
PUSHJ P,TYPDRE ;No, type it
GOWH1A: ADDI P1,2 ;Bump ptr
SOJG P2,GOWHE1 ;Loop
JRST GOWHE3 ;No (more) entries to type
GOWHE2: PUSHJ P,TYPDRE ;Type a directory entry
JRST GOWH1A
GOWHE3: TYPE <[ASCIZ/----- <Current pointer>
/]> ;Show current pointer
;Type next three entries in input (if any)
MOVE P1,IFPTR ;Get current input ptr
MOVEI P2,3 ;# entries to type
GOWHE4: MOVE T1,(P1) ;Look at current entry
CAMN T1,[-1] ;At end?
JRST GOWHE5 ;Yes, That's all
PUSHJ P,TYPDRE ;No, type it
ADDI P1,2 ;Bump ptr
SOJG P2,GOWHE4 ;Loop if didn't do three yet
GOWHE5: TYPE CRLF ;CRLF to end
POPJ P, ;Done, return
SUBTTL DIRECTORY ACTIONS
GODIR: PUSHJ P,READIR ;READ DIRECTORY OF INPUT FILE
;ERRORS DO NOT RETURN
PUSHJ P,ODIROU ;OPEN DIRECTORY FILE FOR OUTPUT
POPJ P, ;ERROR, RETURN
TXZ F,F.DTY ;Clear flag (DIRECTORY to TTY:)
;TYPE ENTRIES FROM INPUT DIRECTORY START TO END
GODIR2: MOVE P1,IFPTR ;GET PTR TO CURRENT INPUT ENTRY
MOVE P2,IFINUM ;GET # OF ENTRIES
ADD P2,P1 ;GET END+2
GODIR3: CAMN P1,P2 ;DONE ALL OF THE DIRECTORY?
JRST GODIR4 ;YES
PUSHJ P,TYPDRE ;TYPE DIRECTORY ENTRY
ADDI P1,2 ;BUMP PTR BY 2.
JRST GODIR3 ;GO BACK FOR MORE
;DONE PRINTING DIRECTORY
GODIR4: PJRST CLOSD ;CLOSE DIRECTORY FILE AND RETURN
;ROUTINE TO PRINT A DIRECTORY ENTRY
;CALL: P1 POINTS TO THE 2-WORD ENTRY IN THE FINE TABLE
; PUSHJ P,TYPDRE
; <RETURN HERE>
; IF THERE IS AN OUTPUT ERROR, JRSTS TO LOSE (TOPS20) OR DIES (TOPS10)
TYPDRE: PUSHJ P,GMODN ;Get module name to print
MOVE T3,[POINT 7,INMODN] ;Point to name
PUSHJ P,DROUTS ;Print it
MOVE T3,[POINT 7,CRLF]
PJRST DROUTS ;Type CRLF and return
;Get module name into INMODN
;Inputs:
; P1 points to directory entry
;Uses T1-T4
GMODN: MOVEI T1,(P1) ;POINT TO DIRECTORY ENTRY
HRLI T1,(POINT 6,) ;MAKE BP TO IT
MOVEI T2,^D8 ;EIGHT CHARS IN NAME
MOVE T3,[POINT 7,INMODN] ;PUT ASCII NAME HERE
SETZM INMODN
SETZM INMODN+1 ;CLEAR PREVIOUS NAME
GMODN1: ILDB T4,T1 ;GET A SIXBIT CHAR
JUMPE T4,GMODN2 ;END OF NAME
ADDI T4,40 ;MAKE ASCII
CAIN T4,":" ;Is it colon?
MOVEI T4,"-" ;Yes, convert to "-"
IDPB T4,T3 ;STORE
SOJG T2,GMODN1 ;LOOP FOR ALL CHARS OF NAME
GMODN2: MOVE T1,[POINT 7,[ASCIZ \ /S\]] ;INCASE /S MUST BE TYPED
MOVE T2,1(P1) ;GET WORD THAT CONTAINS THE FLAG
TXNN T2,F%%SEQ ;/S?
POPJ P, ;No, return now
ILDB T4,T1 ;Get a sixbit char
IDPB T4,T3 ;Store it
JUMPN T4,.-2 ;Loop until stored 0 byte
POPJ P, ;Return
;DIRECTORY ROUTINES
;ROUTINE TO PUT STRING INTO DIRECTORY FILE, T3= BYTE PTR TO IT
DROUTS: TXNE F,F.DTY ;Output directory stuff to TTY:?
JRST DROTS1 ;Yes
MOVEI T1,.FLDIR ;IFN
SETO T2, ;Terminate with 0 byte
PUSHJ P,$ITOSB## ;Output string of bytes
JUMPN T1,ERESET ;Error reset if errors
POPJ P, ;Else just return
;Type directory info on TTY:
DROTS1: TYPE <(T3)> ;Type string
POPJ P, ;Return
;ROUTINE TO CLOSE A DIRECTORY FILE
CLOSD: MOVEI T1,.FLDIR ;IFN
SETZ T2, ;No special flags
PUSHJ P,$ITCLS## ;Close file
POPJ P, ;Return, whether status 0 or not
SUBTTL ROUTINE TO READ DIRECTORY OF THE FILE INTO CORE
;CALL:
;T20: LFJFN/ JFN OF UN-OPENED INPUT FILE
; PUSHJ P,READIR
; <RETURN HERE, FILE OPEN, DIRECTORY READ IN, TABLES SET UP>
; JRSTS TO "LOSE" IF ERROR.
READIR:
IFN TOPS20,<
MOVE T1,LFJFN ;Get JFN
MOVEM T1,.ITILF+2 ;Store in block
>
MOVEI T1,.ITILF ;Point to block
PUSHJ P,$ITOPI## ;Call IOTMP routine to open file for input
JUMPN T1,ERESET ;If can't, return
TXO F,F.LOP ;FILE IS OPEN.. SET FLAG
IFN TOPS20,<
;MAKE SURE FILE IS 36-BIT BYTES
MOVE T1,LFJFN ;T1/ JFN
MOVE T2,[1,,.FBBYV] ;FIND FILE'S BYTE SIZE
MOVEI T3,OFFFBS ;FILE'S BYTE SIZE
GTFDB% ;READ THE WORD IN THE FDB
ERJMP RDDRE5 ;FAILED
LDB T3,[POINTR OFFFBS,FB%BSZ] ;Get file's byte size
CAIE T3,^D36 ;BETTER BE 36
JRST RDDRE4 ;?ERROR
>;END IFN TOPS20
MOVEI T1,IFINTB ;POINTER TO INITIAL FINE-TABLE
MOVEM T1,IFBPT ;SAVE PTR TO BEGINNING
MOVEM T1,IFPTR ;AND CURRENT POINTER
SETZM IFINUM ;NUMBER OF WORDS = 0
;READ 1ST 200 WORDS INTO ROUGH TABLE
MOVEI T1,.FLILF
MOVEI T2,200 ;Number of bytes
MOVE T3,[POINT 36,RUFTBI] ;Put 'em here
PUSHJ P,$ITISB## ;Input string of bytes
JUMPN T1,RDDRE1 ;Problem.. go see
;USING INFORMATION IN THE "ROUGH" TABLE, READ THE FINE TABLE
; INTO CORE.
MOVSI P1,-200 ;AOBJN PTR TO RUFTBI
RDDIR1: MOVE T1,RUFTBI(P1) ;GET 1ST WORD
AOJE T1,RDDIR2 ;ALL DONE WHEN -1 SEEN
ADD P1,[2,,2] ;BUMP PTR
JUMPL P1,RDDIR1 ;FIND OUT HOW MANY BLOCKS THERE ARE
;READ SOME BLOCKS
RDDIR2: HRREI T2,-2(P1) ;HOW MANY BLOCKS?
JUMPLE T2,RDDIR3 ;NO COMPLETE BLOCKS TO READ
IMULI T2,100 ; BLKS/2*200: READ THIS MANY WORDS
MOVEI T1,.FLILF ;IFN
MOVE T3,[POINT 36,IFINTB] ;To here
PUSHJ P,$ITISB## ;Input string of bytes
JUMPN T1,RDDRE1 ;? End of file..
JRST RDDR3A ;Read last incomplete block
;READ SOME MORE OF THE INCOMPLETE BLOCK
RDDIR3: HRREI P2,-2(P1) ;Possibly -2
CAMN P2,[-2]
TDZA P2,P2 ;Should find an empty file
RDDR3A: HRRZI P2,-2(P1) ;How many have we read so far?
MOVEI P3,100 ;LIMIT ON # ENTRIES LEFT
IMULI P2,100 ;START AT BEGINNING + THIS
RDDIR4: MOVEI T1,.FLILF ;IFN
PUSHJ P,$ITINB ;Read byte
JUMPN T1,RDDRE1 ;?Can't read directory
MOVEM T2,IFINTB(P2) ;STORE BYTE HERE
AOJE T2,RDDIR5 ;JUMP IF DONE NOW
MOVEI T1,.FLILF ;Read next byte
PUSHJ P,$ITINB
JUMPN T1,RDDRE1
MOVEM T2,IFINTB+1(P2) ; AND STORE THAT TOO
ADDI P2,2 ;BUMP PTR
SOJGE P3,RDDIR4 ;[4] LOOP AS LONG AS THERE IS ROOM
RDDIR5: MOVEM P2,IFINUM ;SAVE TOTAL # WORDS READ
POPJ P, ;DIRECTORY ALL READ IN, RETURN
;ERRORS
RDDRE1: CAIN T1,2 ;EOF?
JRST RDDE1A ;Yes, bad eof
JRST ERESET ;Reset after error.. IOTMP has typed the message
RDDE1A: TYPE [ASCIZ/?CPYPEF Premature EOF reading directory of input library file/]
JRST LOSFIN
RDDRE2: TYPE [ASCIZ/?CPYFFD Input file format is bad-- not a COBOL library file/]
JRST LOSFIN ;FINISH ERROR
IFN TOPS20,<
RDDRE4: TYPE [ASCIZ/?CPYBLF Bad library file: Byte size is not 36
/]
JRST ERESET ;RESET AFTER ERROR
RDDRE5: TYPE [ASCIZ/?CPYJSE Can't open input library file:
GTFDB% JSYS failed: /]
PUSHJ P,LSTFER
JRST LOSFIN ;TYPE WHY
>;END IFN TOPS20
;ROUTINE TO OPEN DIRECTORY FILE FOR OUTPUT
;CALL:
;T20: DIRJFN/ JFN OF THE FILE
; PUSHJ P,ODIROU
; <RETURN HERE IF ERROR> (MESSAGE TYPED, JFN RELEASED)
; <SUCCESS RETURN>
ODIROU:
IFN TOPS20,<
HRRZ T1,DIRJFN
MOVEM T1,.ITDIR+2 ;Save JFN
>
MOVEI T1,.ITDIR ;Block for IOTMP routine
PUSHJ P,$ITOPO## ;OPEN file for output
JUMPE T1,CPOPJ1 ;Ok return
IFN TOPS20,<
HRRZ T1,DIRJFN ;Release JFN
RLJFN%
ERJMP .+1 ;Can't, oh well
SETZM DIRJFN
>;END IFN TOPS20
POPJ P, ;Problems, single return
SUBTTL INSERT ACTIONS
;INSERT IN UPDATE MODE
GOINSU: PUSHJ P,SRMOUT ;IS MODULE ALREADY IN OUTPUT DIRECTORY?
JRST GOISU1 ;NO, GOOD
BENPSD: TYPE [ASCIZ/?CPYMBP Module /]
PUSHJ P,TYPIMN ;TYPE INPUT MODULE NAME
TYPE [ASCIZ/ has been passed, type "END" then UPDATE again
/]
JRST ERESET ;BOMB OUT
GOISU1: TXZ F,F.EXC ;DON'T WANT EXACT MATCH
PUSHJ P,USRCH ;SEARCH
JRST ERESET ;ERROR, GO RESET
PJRST COPOFT ;COPY OFFLINE FILE TO TEMP, RETURN
;INSERT IN CREATE MODE
GOINSC: PUSHJ P,SRMOUT ;IS MODULE ALREADY IN OUTPUT DIRECTORY?
JRST GOISC1 ;NO, GOOD
TYPE [ASCIZ/?CPYAIM Already inserted that module
/]
JRST ERESET ;BOMB OUT
GOISC1: MOVE P1,OFPTR ;POINT TO CURRENT OUTPUT MODULE
CAMN P1,OFBPT ;ANY OTHER MODULES TO COMPARE?
JRST COPOFT ;No, just copy it now
SUBI P1,2 ;Look at last module
PUSHJ P,CMPMOD ;COMPARE WITH INPUT MODULE NAME
PJRST COPOFT ;Less, copy offline file to temp now
HALT . ;EQUAL (SHOULD NOT HAPPEN)
; PJRST GOISC2 ;GREATER, complain
;ERROR - MODULES NOT INSERTED IN CORRECT ORDER
GOISC2: TYPE [ASCIZ/?CPYMMI Modules must be inserted in alphabetical order
/]
JRST ERESET
SUBTTL DELETE, REPLACE, AND EXTRACT ACTIONS
GODELU: PUSHJ P,SRMOUT ;MAKE SURE DIDN'T OUTPUT IT YET
TRNA ;DIDN'T, GOOD
JRST BENPSD ;?MODULE HAS BEEN PASSED
TXO F,F.EXC ;EXACT MATCH
PUSHJ P,USRCH ;SEARCH
JRST ERESET ;?NOT FOUND..ERROR
PJRST SKIPM ;SKIP MODULE FROM INPUT FILE, AND RETURN
;REPLACE IN UPDATE MODE
GOREPU: PUSHJ P,SRMOUT ;MAKE SURE DIDN'T OUTPUT IT YET
TRNA ;DIDN'T, GOOD
JRST BENPSD ;?MODULE HAS BEEN PASSED
TXO F,F.EXC ;EXACT MATCH
PUSHJ P,USRCH ;SEARCH
JRST ERESET ;ERROR
PUSHJ P,SKIPM ;SKIP MODULE FROM INPUT FILE
PJRST COPOFT ;COPY OFFLINE FILE TO TEMP, THEN RETURN
;EXTRACT IN READ MODE
GOEXTR: PUSHJ P,POSFIL ;POSITION FILE
JRST ERESET ;NOT FOUND
PUSHJ P,COPIOF ;COPY INPUT TO OFFLINE FILE
POPJ P, ;RETURN
SUBTTL END ACTIONS
;END READ
GREND: PUSHJ P,ILCLS ;Close library file
POPJ P, ;Error, single return
JRST CPOPJ1 ;All done
;END CREATE
GCEND: PUSHJ P,DOMOU ;Make output file from temp
POPJ P, ;Error, single return
JRST CPOPJ1 ;Done
;END UPDATE
GUEND: MOVE P1,IFPTR
MOVE T1,(P1) ;Get entry
AOJE T1,GUEND1 ;-1 = end
PUSHJ P,COPITM ;Copy input module to temp
JRST GUEND ;Loop
GUEND1: PUSHJ P,ILCLS ;Close input library file
POPJ P, ;Error, single return
PUSHJ P,DOMOU ;Make output file from temp
POPJ P, ;Error, single return
JRST CPOPJ1 ;Good return
SUBTTL ILCLS - Close input library file
ILCLS: MOVEI T1,.FLILF ;Get IFN of file to close
IFE TOPS20,<
TXNE F,F.BAK ;Rename file to .bak?
SKIPA T2,[IT%NRJ] ;Yes, don't release channel
>;END IFE TOPS20
SETZ T2, ;No special flags
PUSHJ P,$ITCLS## ;Go close file
JUMPE T1,ILCLS1 ;Good return--clear bit
POPJ P, ;Error return
ILCLS1: TXZ F,F.LOP ;Good return--Clear bit
IFN TOPS20, SETZM LFJFN ;Clear JFN
JRST CPOPJ1 ;Give skip return
SUBTTL DOMOU - Make output file from temp file
;Come here when:
; All output files have been copied to temp file
;Inputs:
;Call:
; PUSHJ P,DOMOU
; <here if problems, message typed>
; <HERE IF OK>
DOMOU: MOVEI T1,.FLTMP ;Close temp file
SETZ T2, ;No special flags
PUSHJ P,$ITCLS## ;. .
JUMPN T1,CPOPJ ;If error, single return
MOVEI T1,.ITTMP ;Now open it again for reading
PUSHJ P,$ITOPI##
JUMPN T1,CPOPJ ;?error
IFN TOPS20,<
HRRZ T1,OUTJFN ;Write to here
MOVEM T1,.ITOLF+2
>
IFE TOPS20,<
;If we must output to same file as we input from, get returned
; path and stick it in the input path block for the output file.
TXNN F,F.BAK ;Write .BAK file?
JRST NOBAKF ;No
MOVE T1,[SIXBIT /BAK/] ;Extension to write
MOVEM T1,INPFLP+.FPRNM+1 ;Save in RENAME block
MOVE T1,INPFLP+.FPLKP+0 ;Copy filename
MOVEM T1,INPFLP+.FPRNM+0 ;To RENAME block
MOVEI T1,INPFLP+.FPIPB ;[7] Put address of Path block
MOVEM T1,INPFLP+.FPLKP+3 ;[7] into Lookup block
MOVEM T1,INPFLP+.FPRNM+3 ;[7] and Rename block
;Do RENAME
;The input library file has been closed, but the channel
; is still INIT'd.
MOVEI T1,.FLILF ;IFN
MOVX T2,IT%RLS ;"Release channel"
PUSHJ P,$ITRNF## ;RENAME the file
JUMPN T1,[EXIT] ;Quit if bad return
NOBAKF:
;Copy path block returned to input block so we really write the same file
MOVE T1,[INPFLP+.FPIPB,,OUTFLP+.FPIPB] ;[7]
BLT T1,OUTFLP+.FPIPB+.PTMAX-1
>;END IFE TOPS20
MOVEI T1,.ITOLF ;Open library file for writing
PUSHJ P,$ITOPO## ; . .
JUMPN T1,CPOPJ ;?Can't
;Write rough table
MOVEI T1,.FLOLF ;Write to output library file
MOVEI T2,200 ;200 bytes
MOVE T3,[POINT 36,RUFTBO] ;Output rough table
PUSHJ P,$ITOSB##
JUMPN T1,CPOPJ ;Error
;Write output directory
PUSHJ P,FIXOFT ;Fixup output fine table
MOVEI T1,.FLOLF ;Write to output library file
MOVE T2,OFINUM ;# words in output fine table
MOVE T3,[POINT 36,OFINTB] ;Starts here
PUSHJ P,$ITOSB##
JUMPN T1,CPOPJ ;?Error
;Append temp file
DOML1: MOVEI T1,.FLTMP ;Get a word
PUSHJ P,$ITINB##
JUMPN T1,DOML2 ;EOF or problem
MOVEI T1,.FLOLF ;Write it
PUSHJ P,$ITOUB## ;To output file
JUMPN T1,DOML3 ;Error
JRST DOML1 ;Loop
;Non-zero status on input
DOML2: CAIE T1,2 ;EOF?
POPJ P, ;No, error return
JRST DOML4 ;Done
;Non-zero status on output
DOML3: POPJ P, ;Error return
;EOF on input
DOML4: MOVEI T1,.FLTMP ;Close input temp file
SETZ T2, ;No special flags
PUSHJ P,$ITCLS##
JUMPN T1,CPOPJ ;?Can't
TXZ F,F.TMO ;Clear flag
MOVEI T1,.FLOLF ;Close output library file
SETZ T2, ;No special flags
PUSHJ P,$ITCLS##
JUMPN T1,CPOPJ ;?Can't
AOS (P) ;Success return
POPJ P, ;Error return
SUBTTL Routine to fixup output fine table
;Fixes the addresses, puts a -1 at end, updates
; OFINUM to be the true number of words including the -1
;Returns .+1 always
;Uses t1-t4
FIXOFT: MOVE T1,OFINUM ;Get # words in output fine table
SETOM OFINTB(T1) ;Set following word to -1
JUMPE T1,FIXOFE ;If empty, return
MOVEI T2,201 ;Rough table + the -1 word
ADD T2,OFINUM ;This is true offset in file
;Add (T2) to all the offsets in the fine table
MOVN T1,T1 ;Form AOBJN word
HRLZ T1,T1 ;. .
FIXOF1: LDB T3,[POINT 23,OFINTB+1(T1),35] ;[3] Get offset
ADD T3,T2 ;Get true offset
DPB T3,[POINT 23,OFINTB+1(T1),35] ;[3] Store it
ADD T1,[2,,2]
JUMPL T1,FIXOF1 ;Loop
FIXOFE: AOS OFINUM ;Update number to include the -1
POPJ P, ;Return
SUBTTL ROUTINE TO DO UPDATE-MODE SEARCH
;CALL: F.EXC=1 IF EXACT MATCH NEEDED
; F.EXC=0 IF MODULE MUST NOT ALREADY EXIST
;RETURN:
; .+1 IF ERROR, MESSAGE TYPED
; .+2 IF OK, INPUT FILE POSITIONED TO THE RIGHT PLACE
;NOTE:
; IN POSITIONING THE FILE, INPUT IS COPIED TO TEMP
; AND OUTPUT DIRECTORY IS BUILT
; SERIOUS FILE ERRORS MAKE THE PROGRAM DIE, YOU CAN "CONTINUE"
; IF POSSIBLE.
;THIS ROUTINE SMASHES P1.
USRCH: PUSHJ P,SRCMOD ;SEARCH FOR MODULE NAME
JRST USRCH1 ;DOES NOT EXIST
TXNE F,F.EXC ;MUST IT EXIST?
JRST USRCH2 ;YES, OK
TYPE [ASCIZ/?CPYMAE Module is already in the library: /]
PUSHJ P,TYPIMN ;TYPE INPUT MODULE NAME
TYPE CRLF
POPJ P, ;ERROR
USRCH1: TXNN F,F.EXC ;DOESN'T EXIST, SKIP IF IT SHOULD
JRST USRCH3 ;NO, OK
TYPE [ASCIZ/?CPYMNE Module not found in the library: /]
PUSHJ P,TYPIMN ;TYPE INPUT MODULE NAME
TYPE CRLF
POPJ P, ;ERROR
;HERE TO POSITION TO EXACT PLACE
;COPYING FILES ALL THE WAY
USRCH2: MOVE P1,IFPTR ;START AT CURRENT ENTRY
PUSHJ P,CMPMOD ;COMPARE CURRENT MODULE NAME
JRST USRC2A ;NOT THERE YET
JRST CPOPJ1 ;FOUND--GIVE SKIP RETURN
JRST USRCE1 ;ERROR: WE'VE GONE PAST IT
USRC2A: PUSHJ P,COPITM ;COPY INPUT MODULE TO TEMP
ADDI P1,2 ;GO ON TO NEXT DIR. ENTRY
PUSHJ P,CMPMOD ;COMPARE NEXT MODULE NAME
JRST USRC2A ;LOOP UNTIL FOUND
JRST CPOPJ1 ;FOUND--GIVE SKIP RETURN
HALT . ;??CAN'T HAPPEN
;GONE PAST IT
USRCE1: TYPE [ASCIZ/?CPYMBP Module /]
PUSHJ P,TYPIMN ;TYPE INPUT MODULE NAME
TYPE [ASCIZ/ has been passed, type "END" then UPDATE again
/]
POPJ P, ;ERROR
;HERE TO POSITION TO PLACE JUST BEFORE THE NEXT ONE
;COPYING FILES ALL THE WAY
USRCH3: MOVE P1,OFPTR ;BETTER BE AFTER THE LAST ONE..
CAMN P1,OFBPT ; ARE WE AT BEGINNING?
JRST USRC3A ;YES
SUBI P1,2 ;POINT TO LAST ONE WRITTEN
PUSHJ P,CMPMOD ;COMPARE AGAINST INPUT MODULE
JRST USRC3A ;After the last one written
HALT . ;?CAN'T HAPPEN
JRST USRCE1 ;?Before the last one written
;OK, CURRENT NAME IS AFTER THE LAST ONE WRITTEN
USRC3A: MOVE P1,IFPTR ;START AT CURRENT ENTRY
PUSHJ P,CMPMOD ;COMPARE CURRENT MODULE NAME
JRST USRC3B ;Not there yet
HALT . ;?CAN'T BE THE SAME!!
JRST CPOPJ1 ;Just before it, now
USRC3B: PUSHJ P,COPITM ;COPY INPUT TO TEMP
ADDI P1,2 ;LOOK AT NEXT MODULE NAME
;** CHECK TO SEE IF DIRECTORY HAS RUN OUT. IF SO, JRST CPOPJ1**
PUSHJ P,CMPMOD ;COMPARE CURRENT MODULE NAME
JRST USRC3B ;WAIT UNTIL NEXT ONE IS PAST..
HALT . ;?CAN'T BE THE SAME
JRST CPOPJ1 ;WE ARE JUST BEFORE IT, NOW
SUBTTL SRCMOD - MODULE SEARCH ROUTINE
;SRCMOD SEARCHES THRU THE INPUT DIRECTORY FROM CURRENT ENTRY TO END
; AND LOOKS FOR THE MODULE NAME IN INMODN.
;CALL: INMODN/ SIXBIT MODULE NAME TO SEARCH FOR
; PUSHJ P,SRCMOD
; <RETURN HERE IF NOT FOUND>
; <RETURN HERE IF FOUND,ADDRESS OF DIRECTORY ENTRY IN T1>
;NOTE: LAST DIRECTORY SHOULD BE -1, WHICH WILL SKIP+2 WHEN CMPMOD IS CALLED
SRCMOD: PUSH P,P1 ;PRESERVE P1
MOVE P1,IFPTR ;GET CURRENT POINTER TO INPUT
SRCMD1: PUSHJ P,CMPMOD ;COMPARE THIS MODULE
JRST SRCMD2 ;NOT HERE
JRST SRCFND ;FOUND!
JRST SRCNFD ;WE'VE GONE PAST IT
;NOT YET, GO ON TO NEXT ENTRY
SRCMD2: ADDI P1,2
JRST SRCMD1 ;NO, KEEP LOOKING
;NOT FOUND
SRCNFD: POP P,P1 ;RESTORE P1
POPJ P, ;NOT FOUND RETURN
SRCFND: HRRZ T1,P1 ;GET ADDRESS OF ENTRY
POP P,P1 ;RESTORE P1
JRST CPOPJ1 ;SKIP RETURN
SUBTTL SRMOUT - SEARCH FOR MODULE IN OUTPUT ENTRIES
;SRMOUT CHECKS TO SEE IF THE INPUT MODULE NAME IS ONE OF THE
; ONES WE'VE PUT IN THE OUTPUT DIRECTORY SO FAR (AND OUTPUT)
;CALL: INMODN/ SIXBIT MODULE NAME
; PUSHJ P,SRMOUT
; <RETURN HERE IF NO>
; <RETURN HERE IF YES>
SRMOUT: PUSH P,P1 ;PRESERVE P1
MOVE P1,OFBPT ;GET STARTING BP TO OUTPUT DIRECTORY
SRMOU1: CAMN P1,OFPTR ;AT END YET?
JRST SRMNFD ;YES, RETURN "NOT FOUND"
PUSHJ P,CMPMOD ;COMPARE THIS MODULE
JRST SRMOU2 ;NOT YET
JRST SRMFND ;FOUND
JRST SRMNFD ;?PAST= NOT FOUND
SRMOU2: ADDI P1,2 ;GO ON TO NEXT ENTRY
JRST SRMOU1
SRMFND: AOS -1(P) ;SKIP RETURN
SRMNFD: POP P,P1 ;RESTORE P1
POPJ P, ;"NOT FOUND" RETURN
SUBTTL CMPMOD - MODULE NAME COMPARE ROUTINE
;CMPMOD COMPARES INMODN WITH THE DIRECTORY ENTRY WITH PTR IN P1
;CALL: INMODN/ SIXBIT MODULE NAME
; P1/ PTR TO DIRECTORY ENTRY
; PUSHJ P,CMPMOD
; <RETURN HERE IF INMODN GREATER>
; <RETURN HERE IF EQUAL>
; <RETURN HERE IF INMODN LESS>
CMPMOD: MOVE T1,(P1) ;GET 1ST SIX CHARS
LSH T1,-6 ;FORGET SIXTH FOR NOW
MOVE T2,INMODN
LSH T2,-6 ;SAME WITH INPUT NAME
CAMLE T2,T1 ;COMPARE
POPJ P, ;LESS, RETURN NOW
CAME T2,T1 ;EQUAL SO FAR?
JRST CPOPJ2 ;GREATER, RETURN NOW
LDB T1,[POINT 12,1(P1),11] ;GET LAST TWO CHARS
LDB T2,[POINT 6,0(P1),35] ;SIXTH CHAR
DPB T2,[POINT 6,T1,23] ;MAKE 3-CHAR BYTE TO COMPARE
LDB T2,[POINT 12,INMODN+1,11] ;GET LAST TWO CHARS
LDB T3,[POINT 6,INMODN,35] ;AND SIXTH CHAR
DPB T3,[POINT 6,T2,23] ;MAKE 3-CHAR BYTE TO COMPARE
CAMLE T2,T1 ;COMPARE
POPJ P, ;LESS, RETURN NOW
CAME T2,T1 ;EQUAL ALL THE WAY?
JRST CPOPJ2 ;NO, GREATER
JRST CPOPJ1 ;YES, EQUAL
;RETURNS
CPOPJ2: AOS (P) ;DOUBLE SKIP RETURN
CPOPJ1: AOS (P) ;SKIP RETURN
CPOPJ: POPJ P, ;NORMAL RETURN
;Routine to initialize output directory
;For update or create
FIXOUD: MOVEI T1,OFINTB ;POINTER TO INITIAL OUTPUT FINE TABLE
MOVEM T1,OFBPT ;SAVE PTR TO BEGINNING
MOVEM T1,OFPTR ;AND CURRENT POITNER
SETZM OFINUM ;Number of words = 0
SETOM OFINTB ;Put a -1 in table to mark end
SETOM RUFTBO ;SET OUTPUT ROUGH TABLE TO -1'S
MOVE T1,[RUFTBO,,RUFTBO+1]
BLT T1,RUFTBO+177
SETZM TOFCTR ;NO WORDS WRITTEN INTO TEMP FILE YET
POPJ P, ;RETURN
SUBTTL COPOFT - COPY OFFLINE FILE TO TEMP
COPOFT: PUSHJ P,OPNOFI ;OPEN OFFLINE FILE FOR INPUT
MOVE T1,SEQ ;GET /S FLAG
MOVEM T1,OUTSEQ ; REMEMBER..
PUSHJ P,WRTDRE ;WRITE A DIRECTORY ENTRY
MOVEI WD,1 ;SET LINE # TO ZERO
MOVEM WD,OUTLIN
;COME HERE AT START OF LINES
COPOF7: PUSHJ P,GETOFF ;GET 1ST CHAR IN LINE
COPO70: JUMPE CH,COPOFE ;JUMP IF EOF
;OUTPUT LINE NUMBER WORD
MOVEI WD,^D10*2 ;PUT OUT LINE-NUMBER
ADD WD,OUTLIN
MOVEM WD,OUTLIN ;NEW OUTPUT LINE #
PUSHJ P,COPFWB ;WRITE WORD AND RESET B.P.
;WRITE CHARS UNTIL EOL APPEARS
COPO71: TLNN P2,760000 ;STILL ROOM IN B.P.?
PUSHJ P,COPFWB ;NO, WRITE ANOTHER WORD
IDPB CH,P2 ;STORE CHAR
CAIG CH,.CHFFD ;END OF LINE?
CAIGE CH,.CHLFD ;I.E. LF, VT, OR FF?
TRNA ;NO
JRST COPO72 ;EOL SEEN
PUSHJ P,GETOFF ;GET NEXT CHARACTER
JUMPE CH,[PUSHJ P,PUTLFT ;EOF--STORE LINE-FEED
PUSHJ P,COPFWB ;WRITE LAST WORD
JRST COPOFE] ;And return
JRST COPO71 ;LOOP BACK FOR MORE CHARS
COPO73: DPB CH,P2 ;REPLACE LF BY VT OR FF
COPO72: PUSHJ P,GETOFF ;GET CHARACTER AFTER LF
CAIE CH,13 ;VT
CAIN CH,.CHFFD ;AND FORM-FEED
JRST COPO73 ;THEY ARE SPECIAL
PUSHJ P,COPFWB ;WRITE END OF LAST LINE
JRST COPO70 ;GO BACK TO START NEW LINE
; (COULD BE END-OF-FILE)
;HERE AT END-OF-FILE: PUT -1 IN FILE TO MARK "END OF PROGRAM"
COPOFE: SETO WD, ;-1 = END-OF-FILE MARKER
PJRST PUTTOF ;Write word and return
;SUBROUTINE TO WRITE A LINEFEED
PUTLFT: MOVEI CH,.CHLFD ;STASH LF
TLNE P2,760000 ;IS BP FULL?
PUSHJ P,COPFWB ;Yes, write word
IDPB CH,P2 ;Store char
POPJ P, ;Return
;Subroutine to write a word into temp output file
; and reset BP to P2.
COPFWB: PUSHJ P,PUTTOF ;Put out one word (Line #)
MOVE P2,[POINT 7,WD] ;Reset
MOVEI WD,0 ;Word
POPJ P, ;Return
SUBTTL WRTDRE AND WRTDE - WRITE DIRECTORY ENTRY FOR OUTPUT FILE
;CALL: INMODN/ INPUT MODULE NAME
; OUTSEQ/ SEQUENCED FLAG
; PUSHJ P,WRTDRE
; <RETURN HERE IF OK (ELSE GOES TO 'ERESET')>
WRTDRE: DMOVE T1,INMODN ;GET NAME
SKIPE OUTSEQ
TXO T2,F%%SEQ ;/S SPECIFIED
PJRST WRTDE ;GO TO GENERAL ROUTINE
;WRTDE- WRITE DIRECTORY ENTRY FROM DATA IN T1&T2
; <RETURN .+1 IF OK, GOES TO "ERESET" IF TOO MANY MODULES>
WRTDE: HRRZ T3,OFINUM ;NUMBER OF DIRECTORY WORDS OUTPUT SO FAR
TRNN T3,177 ;AT START OF NEW BLOCK?
JRST WRTDER ;YES, GO DO THE "ROUGH TABLE" STUFF
WRTDE1: ADDI T3,2 ;INCREMENT # WORDS OUTPUT
MOVEM T3,OFINUM
MOVE T3,TOFCTR ;[3] GET WORD ADDRESS
TLNE T3,777740 ;[3] MAKE SURE WE CAN HOLD ADDRESS
JRST WRTDE2 ;[3] NO - CAN'T HOLD IT
DPB T3,[POINT 23,T2,35] ;[3] STICK IN ENTRY
HRRZ T3,OFPTR ;GET PTR TO FINE TABLE
DMOVEM T1,(T3) ;STORE THIS ENTRY
SETOM 2(T3) ;MAKE NEXT ENTRY -1
SETOM 3(T3) ; . .
MOVEI T1,2 ;BUMP OUTPUT PTR
ADDM T1,OFPTR
POPJ P, ;RETURN
WRTDE2: TYPE [ASCIZ/?CPYATL The module address is too large to store
/] ;[3]
JRST ERESET ;[3] ERROR-RESET
;MAKE NEW ENTRY IN OUTPUT "ROUGH" TABLE
WRTDER: MOVEI T4,200(T3) ;GET ADDRESS IN DIRECTORY OF THIS ENTRY
DPB T4,[POINT 23,T2,35] ;[3] STICK IN ENTRY
MOVE T5,T2 ;[5] GET SECOND WORD OF FINE TABLE ENTRY
LSH T4,-6 ;GET # OF BLOCKS * 2
CAIN T4,202 ;PAST THE END?
JRST WRTDEE ;YES
MOVEM T1,RUFTBO-2(T4) ;[1]STORE ENTRY HERE
TXZ T5,F%%SEQ ;[6][5] TURN OFF /SEQUENCE BIT
MOVEM T5,RUFTBO-1(T4) ;[5] STORE SECOND WORD OF ROUGH TABLE ENTRY
JRST WRTDE1 ;THEN GO DO FINE TABLE
WRTDEE: TYPE [ASCIZ/?CPYTMM Too many modules in the library
/]
JRST ERESET ;ERROR-RESET
SUBTTL COPIOF - COPY INPUT TO OFFLINE FILE (EXTRACT)
;FOR TOPS20: OFFJFN/ JFN OF OFFLINE FILE
;
COPIOF: PUSHJ P,OPNOFO ;OPEN OFFLINE FILE FOR OUTPUT
COPIO1: MOVE P2,[POINT 7,WD] ;SETUP BP
PUSHJ P,GETOIF ;GET A WORD
TRNE WD,1 ;LINE #
JRST COPIOL ;YES
COPIO2: ILDB CH,P2 ;GET CHAR
JUMPE CH,COPIO4 ;IGNORE NULLS
CAIG CH,.CHFFD ;IS IT AN EOL?
CAIGE CH,.CHLFD
JRST COPIO3 ;NO
PUSH P,CH ;YES, SAVE THIS
MOVEI CH,.CHCRT ;WRITE <CARRIAGE-RETURN>
PUSHJ P,PUTOFF
POP P,CH ;AND THEN THIS CHAR
COPIO3: PUSHJ P,PUTOFF
COPIO4: TLNE P2,760000 ;BP RAN OUT YET?
JRST COPIO2 ;NO
JRST COPIO1 ;GO GET A NEW WORD
;LINE # WORD SEEN
COPIOL: CAME WD,[-1] ;END-OF-PROGRAM MARK?
JRST COPIO1 ;NO, SKIP LINE #
;END OF PROGRAM
PJRST CLSOFF ;CLOSE OFFLINE FILE, THEN RETURN
SUBTTL COPITM - COPY INPUT TO TEMP
;THE DIRECTORY ENTRIES ARE UPDATED.
COPITM: DMOVE T1,@IFPTR ;GET CURRENT INPUT SPEC
PUSHJ P,WRTDE ;WRITE OUTPUT DIRECTORY ENTRY
MOVEI T1,2 ;BUMP INPUT PTR
ADDM T1,IFPTR
;COPY THE MODULE
COPIT0: PUSHJ P,GETOIF ;GET INPUT WORD
PUSHJ P,PUTTOF ;WRITE TO TEMP FILE
TRNN WD,1B35 ;LINE NUMBER WORD?
JRST COPIT0 ;NO, LOOP
CAME WD,[-1] ;END-OF-PROGRAM?
JRST COPIT0 ;NO, CONTINUE
POPJ P, ;DONE, RETURN
SUBTTL COMMON action routines
;ROUTINE TO OPEN TEMP FILE FOR OUTPUT
;CALL: PUSHJ P,OPNTMP
; <RETURN HERE, FLAG "F.TMO" SET>
;If there are any errors, the input file must be closed and released.
OPNTMP: MOVEI T1,.ITTMP ;Get ptr to temp file block
PUSHJ P,$ITOPO## ;Open temp file for output
JUMPE T1,OPNTM1 ;Jump if ok
JRST LOSFIN ;No, lose
OPNTM1: TXO F,F.TMO ;OK, SET FLAG (TEMP FILE OPEN)
POPJ P, ;RETURN
;ROUTINE TO KILL TEMP FILE IF OUTPUT MUST BE ABORTED
;CALL:
; PUSHJ P,KILTMP
; <RETURN HERE ALWAYS>
KILTMP: MOVEI T1,.FLTMP ;Temp file IFN
MOVX T2,IT%NRF ;Don't retain file
PUSHJ P,$ITCLS## ;Close it
JUMPN T1,KILTM1 ;Jump if problem
POPJ P,
KILTM1: $QUIT ;Problem, quit
;Routine to position file to word address in P1
;RETURN: .+1 IF OK
; IF ERROR, TYPES MESSAGE AND DIES
POSFT1: MOVEI T1,.FLILF ;IFN
MOVE T2,P1 ;Byte # to start at
PUSHJ P,$ITPSF## ;Go position file
SKIPN T1 ;Non-zero status?
POPJ P, ;No, just return
CAIE T1,2 ;Skip if file not that big
JRST ERESET ;Other error, start fresh
POSFTE: TYPE FDBMSG ;?FILE DIRECTORY IS BAD:
TYPE [ASCIZ/Word address too large/]
$QUIT ;Quit
FDBMSG: $TEXT <?CPYFDB Library file directory is bad: >
SUBTTL PUTTOF - PUT WORD INTO TEMP OUTPUT FILE
PUTTOF: AOS TOFCTR
PUTTO1: MOVE T2,WD ;GET WORD
MOVEI T1,.FLTMP ;IFN of temp file
PUSHJ P,$ITOUB## ;Output one byte
JUMPE T1,CPOPJ ;OK, return
$QUIT ;Can't...Quit
;GETTOF - GET WORD FOR TEMP OUTPUT FILE
;RETURN: .+1 IF EOF
; .+2 IF GOT WORD IN "WD"
GETTOF: MOVEI T1,.FLTMP
PUSHJ P,$ITINB## ;Get one byte
MOVE WD,T2 ;Copy byte
JUMPE T1,CPOPJ1 ;If not EOF, skip return
CAIN T1,2 ;EOF?
POPJ P, ;Yes, return "EOF"
$QUIT ;No, serious problem, quit
;GETOIF - GET WORD FROM OLD INPUT FILE (LIBRARY)
GETOIF: TXNE F,F.EOF ;ANY MORE INPUT FILE?
JRST GOIF3 ;NO
MOVEI T1,.FLILF ;Get IFN
PUSHJ P,$ITINB## ;Get word
MOVE WD,T2 ;Copy byte
JUMPE T1,CPOPJ ;Return if got it
CAIN T1,2 ;EOF?
JRST GOIF2 ;Yes, complain
$QUIT ;No, random error
;UNEXPECTED EOF
GOIF2: TYPE [ASCIZ/?CPYPEL Premature EOF in library file
/]
$QUIT ;Bad error
;EXPECTED EOF
GOIF3: SETO WD, ;-1 TO INDICATE EOF
POPJ P,
;OPEN OFFLINE FILE FOR INPUT
;SET UP BUFFERS, ETC.
;CALL: OFFJFN/ JFN OF UN-OPENED OFFLINE FILE
; PUSHJ P,OPNOFI
; <RETURN HERE IF OK>
;IF ERROR:
; MESSAGE TYPED, GOES TO "LOSE"
; <SUCCESS, BUFFERS SET UP, ETC, F.OFO SET>
;NOTES:
; IF THE FILE HAS A BYTE SIZE OTHER THAN 7 AND 36, IT IS
; AN ERROR.
OPNOFI:
IFN TOPS20,<
HRRZ T1,OFFJFN ;GET JFN
MOVEM T1,.ITIOF+2 ; Store info for IOTMP
>
TXNE F,F.OFT ;TTY:?
JRST OPNOFT ;YES
TXNE F,F.OFN ;NUL:?
JRST OPNOFN ;Yes
IFN TOPS20,<
MOVE T2,[1,,.FBBYV] ;FIND FILE'S BYTE SIZE
MOVEI T3,OFFFBS ;FILE'S BYTE SIZE
GTFDB% ;READ THE WORD IN THE FDB
ERJMP OPFIE0 ;FAILED
LDB T3,[POINTR OFFFBS,FB%BSZ] ;Get file's byte size
CAIE T3,7 ;CAN BE EITHER 7
CAIN T3,^D36 ; OR 36
TRNA ;OK, SKIP
JRST OPFIE2 ;?OOPS, NEITHER
CAIN T3,7 ;7-BIT BYTES?
TXOA F,F.BS7 ;YES
TXZ F,F.BS7 ;NO
>;END IFN TOPS20
OPFOF4: MOVEI T3,^D36 ;Assume 36-bit bytes
TXNE F,F.BS7 ;7-bit?
MOVEI T3,^D7 ;Yes
HRLM T3,.ITIOF+1 ;Store byte size
MOVEI T1,.ITIOF ;Point to arg block
PUSHJ P,$ITOPI## ;OPEN offline file for input
JUMPN T1,ERESET ;Error, go reset
TXZ F,F.OFE ;CLEAR "EOF" BIT
MOVEI T1,.FLIOF ;Which IFN..
MOVEM T1,OFOIFN ;Save it incase we abort.
TXO F,F.OFO ;Set "OFFLINE file is open" bit
POPJ P, ;DONE, RETURN
;OPEN OFFLINE TTY FILE
OPNOFT: TXO F,F.BS7 ;SET "7-BIT BYTES IN FILE"
JRST OPFOF4 ;Go open it
;OPEN OFFLINE NUL: FILE
OPNOFN: TXZ F,F.BS7 ;Not 7-bit bytes
JRST OPFOF4 ;Go open it
IFN TOPS20,<
;GTFDB FAILED
OPFIE0: TYPE [ASCIZ/?CPYCOF Cannot read file's byte size: /]
PUSHJ P,LSTFER
JRST LOSFIN
;BYTE SIZE NOT 7 OR 36
OPFIE2: TYPE [ASCIZ/?CPYIBS Invalid byte size for input file: /]
TYPE [ASCIZ/
(It must be either 7 or 36.)/]
JRST LOSFIN
>;END IFN TOPS20
;CLOSE OFFLINE FILE OPENED FOR INPUT
;CALL: PUSHJ P,CLZOFI
; <RETURN HERE>
CLZOFI:
IFN TOPS20, SETZM OFFJFN ;Clear JFN
TXZN F,F.OFO ;Was it open?
POPJ P, ;No, just return
MOVEI T1,.FLIOF ;Offline input file
SETZ T2, ;No special flags
PUSHJ P,$ITCLS## ;** Close file**
JUMPN T1,CLZOIE ;?Error
POPJ P, ;Return
CLZOIE: $QUIT
;OPEN OFFLINE FILE FOR OUTPUT
;SET UP BUFFERS, ETC.
;CALL:
;T20: OFFJFN/ JFN OF UN-OPENED OFFLINE FILE
; PUSHJ P,OPNOFO
; <RETURN HERE IF OK>
;IF ERROR:
; MESSAGE TYPED, GOES TO "ERESET"
; <SUCCESS, BUFFERS SET UP, ETC, F.OFO SET>
OPNOFO:
IFN TOPS20,<
HRRZ T1,OFFJFN ;Get JFN
MOVEM T1,.ITOOF+2 ;Store info for IOTMP
>
MOVEI T1,.ITOOF ;Output offline file IFN
PUSHJ P,$ITOPO## ;Open for output
JUMPN T1,ERESET ;Can't, reset after error
MOVEI T1,.FLOOF ;Save IFN
MOVEM T1,OFOIFN ; Incase we abort
TXO F,F.OFO ;SET "OFFLINE FILE IS OPEN" BIT
POPJ P, ;Return
;PUTOFF - WRITE CHARACTER TO OFFLINE FILE
;INPUT CHAR IN "CH"
PUTOFF: MOVEI T1,.FLOOF ;Output offline file
MOVE T2,CH ;Get char
PUSHJ P,$ITOUB## ;Output the byte
JUMPE T1,CPOPJ ;Return if ok
$QUIT ;Problem, quit
;CLSOFF - CLOSE OFFLINE FILE AFTER WRITING
CLSOFF: MOVEI T1,.FLOOF ;IFN
SETZ T2, ;No special flags
PUSHJ P,$ITCLS## ;** Close file **
TXZ F,F.OFO ;Clear flag
JUMPN T1,CLSOF1 ;Error
IFN TOPS20, SETZM OFFJFN ;CLEAR JFN
POPJ P, ;RETURN
;CLSOFF ERRORS
CLSOF1: $QUIT ;Message typed
;GETOFF - GET CHARACTER FROM OFFLINE FILE
;ALWAYS RETURNS A 7-BIT CHARACTER.
;IF SOS LINE NUMBER EXISTS, IT MAY BE OBTAINED BY LOOKING AT @OFFPTR
; AFTER THE CHARACTER IS RETURNED
GETOFF: PUSHJ P,IOFFCH ;CALL MONITOR-SPECIFIC ROUTINE
JUMPE CH,CPOPJ ;RETURN EOF
CAILE CH,32 ;POSSIBLY AN INTERESTING CONTROL CHAR?
POPJ P, ;NO, JUST RETURN WHAT WE FOUND
CAIN CH,.CHCRT ;IGNORE CARRIAGE-RETURN
JRST GETOFF
CAIG CH,24 ;JUST RETURN THE NON-INTERESTING CONTROL CHRS.
CAIGE CH,.CHLFD
POPJ P,
CAIL CH,20 ;CONVERT 20-24 INTO LF
GETOF2: MOVEI CH,.CHLFD
POPJ P, ;RETURN LF, VT, FF
;GET CHAR FROM OFF-LINE FILE
;RETURNS .+1 ALWAYS, 7-BIT CHAR IN CH
;RETURNS CH=0 IF EOF, FILE CLOSED
IOFFCH: SKIPE CHRSLF ;Any chars left?
JRST IOFFC1 ;Yes, get it
MOVEI T1,.FLIOF ;From input offline file
PUSHJ P,$ITINB## ;Input 1 byte
JUMPN T1,IOFFCD ;Non-zero status, check EOF
TXNN F,F.BS7 ;7-bit bytes?
JRST IOFFC2 ;No
MOVE CH,T2 ;Get character in CH
IOFFC0: JUMPE CH,IOFFCH ;Ignore nulls
POPJ P, ;Return
;Get next 7-bit char
IOFFC1: ILDB CH,CHRSBP ;Get another char
SOS CHRSLF ;1 LESS CHAR LEFT
JUMPE CH,IOFFCH ;Ignore nulls
POPJ P, ;Return
;Store bunch of 7-bit chars, unless bit 35=1 (LSA file)
IOFFC2: TRNE T2,1B35 ;Is this word a line number?
JRST IOFFC3 ;Yes, ignore first char in next word
MOVEM T2,CHRSWD ;Save word
MOVE T1,[POINT 7,CHRSWD,6]
MOVEM T1,CHRSBP ;Store bp
MOVEI T1,4 ;# CHARS LEFT
MOVEM T1,CHRSLF
LDB CH,CHRSBP ;Get 1st byte
JUMPE CH,IOFFCH ;Ignore nulls
POPJ P, ;Return
;Reading 36-bit bytes, and got a line number
IOFFC3: MOVEI T1,.FLIOF ;From input offline file
PUSHJ P,$ITINB## ;Input 1 byte
JUMPN T1,IOFFCD ;Non-zero status, check EOF
MOVEM T2,CHRSWD ;Save word
;Ignore first character in word following line number. This is the spacing
; character, usually a TAB.
MOVE T1,[POINT 7,CHRSWD,13]
MOVEM T1,CHRSBP ;Store bp
MOVEI T1,3 ;# CHARS LEFT
MOVEM T1,CHRSLF
LDB CH,CHRSBP ;Get 1st byte
JUMPE CH,IOFFCH ;Ignore nulls
POPJ P, ;Return
;Non-zero status on input
IOFFCD: CAIN T1,2 ;EOF?
JRST IOFFEF ;Yes
$QUIT ;Problem, quit
;EOF on input external file
IOFFEF: PUSHJ P,CLZOFI ;Close offline file for input
; JRST IOFFRT ;Return "EOF"
;Return "EOF"
;T20: OFFJFN has been set to zero
IOFFRT: SETZ CH, ;RETURN "EOF"
POPJ P,
SUBTTL POSFIL - POSITION FILE FOR EXTRACT
;CALL:
; INMODN/ NAME OF MODULE YOU WANT TO EXTRACT
; PUSHJ P,POSFIL
;RETURNS:
; .+1 IF MODULE NOT FOUND IN DIRECTORY, MESSAGE TYPED
; .+2 IF OK, ALL READY FOR CALL TO COPIOF
POSFIL: PUSHJ P,SRCMOD ;SEARCH FOR MODULE NAME
JRST POSFLE ;NOT FOUND
PUSH P,P1 ;PRESERVE PERM AC
LDB P1,[POINT 23,1(T1),35] ;[3] GET FILE ADDRESS
PUSHJ P,POSFT1 ;POSITION FILE (OTS-SPECIFIC)
POP P,P1 ;RESTORE PERM AC
JRST CPOPJ1 ;SKIP RETURN
POSFLE: TYPE [ASCIZ/?CPYMNF Module /]
PUSHJ P,TYPIMN ;TYPE INPUT MODULE NAME
TYPE [ASCIZ/ not found
/]
POPJ P, ;ERROR RETURN
;SUBROUTINE SKIPM - SKIP MODULE IN INPUT FILE
;RETURNS:
; .+1, UNLESS FATAL ERROR: (PROGRAM DIES)
SKIPM: PUSHJ P,GETOIF ;GET WORD FROM INPUT FILE
CAME WD,[-1] ; FIND -1 = END-OF-PROGRAM
JRST SKIPM
MOVEI T1,2 ;BUMP DIRECTORY POINTER
ADDM T1,IFPTR
POPJ P, ;AND RETURN
SUBTTL ROUTINES TO TYPE MODULE NAMES
;TYPIMN - TYPE INPUT MODULE NAME
;CALL: INMODN/ SIXBIT MODULE NAME
; PUSHJ P,TYPIMN
; <RETURN HERE>
TYPIMN: MOVEI T4,INMODN ;POINT TO INPUT MODULE NAME
; PJRST TYPMNM ;GO TO GENERAL ROUTINE
;TYPMNM - TYPE MODULE NAME
;CALL: T4/ ADDRESS OF MODULE NAME
; PUSHJ P,TYPMNM
; <RETURN HERE>
TYPMNM: HRLI T4,(POINT 6,) ;MAKE BP.
MOVEI T3,^D8 ;MAX NUMBER OF CHARACTERS
TYPMN1: ILDB T1,T4 ;GET NEXT CHARACTER
JUMPE T1,CPOPJ ;JUMP IF DONE
ADDI T1,40 ;MAKE ASCII CHARACTER
CAIN T1,":" ;Convert colon
MOVEI T1,"-" ;To dash
TYPT1 ;TYPE IT
SOJG T3,TYPMN1 ;LOOP
POPJ P, ;RETURN
SUBTTL DATA SECTION
IFE TOPS20,<RELOC 0> ; RELOCATE TO LOW SEGMENT
PDL: BLOCK .PDSIZ ;PUSH-DOWN LIST
SAVEP: BLOCK 1 ;SAVED PUSHDOWN PTR
PAGMAP: BLOCK ^D512/^D36 + 1 ;BIT TABLE FOR PAGE MAP
LMODE: BLOCK 1 ;LIBRARY MODE (.LMTOP,.LMREA, ETC.)
INMODN: BLOCK 2 ;INPUT (PARSED) MODULE NAME (IN SIXBIT)
RUFTBI: BLOCK 200 ;INPUT "ROUGH" TABLE
RUFTBO: BLOCK 200 ;OUTPUT "ROUGH" TABLE
IFPTR: BLOCK 1 ;POINTER TO INPUT FINE TABLE
IFBPT: BLOCK 1 ;POINTER TO BEGINNING OF INPUT FINE TABLE
OFPTR: BLOCK 1 ;POINTER TO OUTPUT FINE TABLE
OFBPT: BLOCK 1 ;POINTER TO BEGINNING OF OUTPUT FINE TABLE
IFINUM: BLOCK 1 ;NUMBER OF WORDS IN INPUT FINE TABLE
OFINUM: BLOCK 1 ;NUMBER OF WORDS IN OUTPUT FINE TABLE
IFINTB: BLOCK 100*200+1 ;Input "FINE" table
OFINTB: BLOCK 100*200+1 ;Output "FINE" table
TOFCTR: BLOCK 1 ;NUMBER OF 36-BIT BYTES IN TEMP OUTPUT FILE
INLIN: BLOCK 1 ;INPUT LINE #
OUTLIN: BLOCK 1 ;OUTPUT LINE #
INSEQ: BLOCK 1 ;INPUT FILE IS /S
OUTSEQ: BLOCK 1 ;OUTPUT FILE IS /S
SEQ: BLOCK 1 ;/S SPECIFIED FOR OFFLINE FILE
OFFSIZ: BLOCK 1 ;TOTAL SIZE (BYTES) OF OFFLINE FILE
OFFSZL: BLOCK 1 ;SIZE LEFT AFTER WHAT WE'VE READ
OFFCNT: BLOCK 1 ;NUMBER OF BYTES IN OFFLINE FILE BUFFER
OFFPTR: BLOCK 1 ;BYTE PTR TO CHARACTERS IN BUFFER
OFF36W: BLOCK 1 ;HOLDS CURRENT 36-BIT BYTE IN OFFLINE FILE
OFF36P: BLOCK 1 ;HOLDS POINTER TO OFF36W
OFFBLF: BLOCK 1 ;# 7-BIT BYTES STILL IN OFF36W
CHRSLF: BLOCK 1 ;Chars left in input word
CHRSBP: BLOCK 1 ;Byte ptr to chars left
CHRSWD: BLOCK 1 ;A word of chars
DATIMA: BLOCK ^D20 ;ASCIZ date/time for listing
DATME==.-1 ;Last location of date/time text
PAGNO: BLOCK 1 ;Page number
LINECT: BLOCK 1 ;Lines in this page left to write on
PR2STA: BLOCK 1 ;START ADDR OF 2ND PARSE CODE
CM2P: BLOCK 1 ;PDL AT START OF 2ND PARSE
OFOIFN: BLOCK 1 ;IFN of the offline file that is open
;, if F.OFO is set.
;$ITOPI block for input library file
.ITILF: IT%OEF+.FLILF ;Flags,,IFN
^D36,,0 ;Byte size,,# pages in core
0 ;JFN or FILOP. block address
[ASCIZ/input library file/] ;Generic filename
;$ITOPO block for output library file
.ITOLF: IT%OEF+.FLOLF ;Flags,,IFN
^D36,,0 ;Byte size,,# pages in core
0 ;JFN or FILOP. block address
[ASCIZ/output library file/] ;generic filename
;ITOPI block-- input offline file
.ITIOF: IT%OEF+.FLIOF ;Flags,,IFN
0 ;Byte size,,# pages in core
0 ;JFN or FILOP. block address
[ASCIZ/input offline file/] ;address of generic filename
;ITOPO Block -- Output offline file
.ITOOF: IT%OEF+.FLOOF ;Flags,,IFN
^D7,,0 ;Byte size,,# pages in core
0 ;JFN or FILOP. block address
[ASCIZ/output offline file/] ;generic filename
;ITOPO/I block for temp file
.ITTMP: .FLTMP ;IFN
^D36,,0 ;Byte size,,# pages in core
0
[ASCIZ/temp file/] ;generic filename
;Passed to ITOPO for directory file
.ITDIR: IT%OEF+.FLDIR ;External file flag,,file #
^D7,,1 ;Byte size,,# pages
0 ;JFN or FILOP. block
[ASCIZ/output directory file/] ;Generic filename
;Passed to ITOPO for list file
.ITLIS: IT%OEF+.FLLIS ;External file flag,,file #
^D7,,0 ;BYte size,, # pages
0 ;JFN or FILOP. block address
[ASCIZ/listing/] ;Generic filename
;TOPS20-ONLY LOCATIONS
IFN TOPS20,<
NOIBLK: FLDDB. (.CMNOI)
;COMMAND JSYS BLOCK
CMDLIT: EXP NEWPAR ;ADDRESS OF REPARSE ROUTINE
.PRIIN,,.PRIOU ;INPUT,,OUTPUT JFNS
-1,,APROMP ;CONTROL-R BUFFER
-1,,TXTBUF ;POINTER TO TEXT BUFFER
-1,,TXTBUF ;POINTER TO CURRENT POSITION
TXTLEN ;NUMBER OF CHARACTERS IN BUFFER
0 ;NUMBER OF UNPARSED CHARACTERS
-1,,ATMBUF ;POINTER TO ATOM BUFFER
TXTLEN ;NUMBER OF CHARACTERS IN BUFFER
EXP JFNBLK ;POINTER TO JFN BLOCK
.CMBLN==.-CMDLIT ;LENGTH OF COMMAND JSYS BLOCK
;2ND COMMAND BLOCK
CM2LIT: EXP NEWPR2 ;ADDRESS OF REPARSE ROUTINE
.PRIIN,,.PRIOU ;INPUT,,OUTPUT JFNS
0 ;CONTROL-R BUFFER (FILLED IN)
-1,,TXTBUF ;POINTER TO TEXT BUFFER
-1,,TXTBUF ;POINTER TO CURRENT POSITION
TXTLEN ;NUMBER OF CHARACTERS IN BUFFER
0 ;NUMBER OF UNPARSED CHARACTERS
-1,,ATMBUF ;POINTER TO ATOM BUFFER
TXTLEN ;NUMBER OF CHARACTERS IN BUFFER
EXP JFNBLK ;POINTER TO JFN BLOCK
CM2LEN==.-CM2LIT ;LENGTH OF 2ND COMMAND JSYS BLOCK
;TEXTI BLOCK FOR READING LINES
TXTIBL: .RDRTY ;LAST WORD GIVEN
0 ;FLAGS
.PRIIN,,.PRIOU ;INPUT,,OUTPUT JFNS
0 ;DESTINATION PTR (FILLED IN)
0 ;BYTES AVAILABLE (FILLED IN)
0 ;USE START OF BUFFER AS ABOVE
0 ;CONTROL-R TEXT (FILLED IN)
CMDBLK: BLOCK .CMBLN ;COMMAND PARSING BLOCK
CM2BLK: BLOCK CM2LEN ;2ND COMMAND JSYS PARSING BLOCK
JFNBLK: BLOCK ^D20 ;FOR PARSING JFNS
JFNBE==.-1 ;LAST ITEM TO ZERO BLT
LFJFN: BLOCK 1 ;JFN FOR LIBRARY FILE
PRSJFN: BLOCK 1 ;PARSED JFN (IF ANY)
OFFJFN: BLOCK 1 ;OFFLINE FILE JFN
OFFBDP: BLOCK 1 ;PAGE # OF BUFFER
OFFBAD: BLOCK 1 ;BUFFER ADDRESS OF OFFLINE INPUT FILE
OFFFBS: BLOCK 1 ;GETS BYTE SIZE IN GTFDB
OFFPGR: BLOCK 1 ;NUMBER PAGES READ SO FAR
TAKJFN: BLOCK 1 ;TAKE FILE JFN
LISJFN: BLOCK 1 ;LIST FILE JFN
DIRJFN: BLOCK 1 ;DIRECTORY FILE JFN
OUTJFN: BLOCK 1 ;JFN OF OUTPUT FILE
TXTBUF: BLOCK <TXTLEN/5+1> ;BUFFER FOR COMMAND JSYS
ATMBUF: BLOCK <TXTLEN/5+1> ;BUFFER FOR ATOM BUFFER
TLINE: BLOCK <TXTLEN/5+1> ;INPUT TTY LINE
DEFDEV: BLOCK 30 ;DEFAULT DEVICE NAME (ASCII)
DEFDIR: BLOCK 30 ;DEFAULT DIRECTORY NAME (ASCII)
DEFNAM: BLOCK 30 ;DEFAULT FILENAME (ASCII)
DEFEXT: BLOCK 30 ;DEFAULT EXTENSION (ASCII)
>;END IFN TOPS20
;TOPS10-ONLY LOCATIONS
IFE TOPS20,<
;COMMAND SCANNER THINGS
TXTBUF: BLOCK TXTLEN/5+1 ;COMMAND LINE
TXTBBP: BLOCK 1 ;CURRENT BP TO COMMAND LINE
PRSCHR: BLOCK 1 ;FIRST PARSED CHARACTER
PRSBBP: BLOCK 1 ;BP AT START OF A PARSE
ATMBUF: BLOCK TXTLEN/5+1 ;BUFFER FOR ATOM BUFFER
ERRTXT: BLOCK 1 ;ADDRESS OF ASCII ERROR TEXT
;DEFAULT PATH BLOCK
PTHBLK: BLOCK .PTMAX+1 ;PATH BLOCK
;FILESPEC STUFF
PRSFSP: BLOCK .FSLEN ;PARSED FILE SPEC
DEFFSP: BLOCK .FSLEN ;DEFAULT FILE SPEC
DIRFSP: BLOCK .FSLEN ;DIRECTORY FILE FILESPEC
DIRFLP: BLOCK .FPLEN ;Directory file FILOP. block
LSTFSP: BLOCK .FSLEN ;LISTING FILE FILESPEC
LSTFLP: BLOCK .FPLEN ;Listing file FILOP. block
INPFSP: BLOCK .FSLEN ;INPUT FILE SPEC
INPFLP: BLOCK .FPLEN ;Input LIB file FILOP. block
OUTFSP: BLOCK .FSLEN ;OUTPUT FILE FILESPEC
OUTFLP: BLOCK .FPLEN ;Output file FILOP. block
CMDFSP: BLOCK .FSLEN ;COMMAND FILE
CMDFLP: BLOCK .FPLEN ;COMMAND FILE FILOP. BLOCK
OFFFSP: BLOCK .FSLEN ;Offline file filespec block
OFFFLP: BLOCK .FPLEN ;Offline file FILOP. block
;Passed to ITOPI for command file
.ITCMF: IT%OEF+.FLCMD ;External file flag,,file #
^D7,,0 ;Byte size,,default # pages in core
EXP CMDFLP ;Ptr to FILOP. block
[ASCIZ/command file/] ;Generic filename
RACS: BLOCK ^D16 ;Saved ACS when MERGEing
PR2CMT: BLOCK 1 ;Saved -n,,addr for 2nd command parse
>;END IFE TOPS20
LASTLC==.-1 ;LAST NON-FREE LOC
IFN TOPS20,<
END <ENTLEN,,ENTVEC>>
IFE TOPS20,<
END ST>