Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/tapeio.fai
There are no other files named tapeio.fai in the archive.
;Added New-Fangled feature which adds new formats for sites [13]
;fixed open,close and release of JFN so all works in harmony [12]
;added mucho code to do logging of session. This will work if type-outs
;to terminal use the TMSG macro. Also if output go out to .PRIOU, make
;sure it also goes out to LOGJFN. Example in routine ERROR: [11]
;changed to SCU site dependent stuff [10]
;do tape assignment check, if they give more than one TAPE command [9]
;added mucho code to dump to devices other than disk e.g. LPT:,TTY:,NUL: [8]
;add ERCAL ERROR after PMAP in EXREOF [7]
;if error, close all files and deassign the tape drive [6]
;get tape JFN at $QUIT so that QUIT command works as advertised [5]
;replaced losing RET at the end of .REWIN to RETSKP [4]
;allow DEFAULT, REVERT commands before the TAPE-DRIVE command [3]
;<TAPE>TAPEIO.FAI.500, 7-May-82 21:35:40, Edit by DAIR
; put in error recover traps from Off-Line condition edit [2]
;<TAPE>TAPEIO.FAI.497, 29-Apr-82 22:46:30, Edit by DAIR
; Added 6250 BPI option in DENTAB (Density Table) [1]
;ACCT:<UTILITIES.SUBSYS>TAPEIO.FAI.496, 15-Jan-82 12:58:47, Edit by R.RMK
;ACCT:<UTILITIES.SUBSYS>TAPEIO.FAI.495, 15-Jan-82 11:58:20, Edit by R.RMK
; Fix losing check for LRECL multiple of four.
;ACCT:<UTILITIES.SUBSYS>TAPEIO.FAI.493, 14-Jan-82 16:22:35, Edit J.JQJOHNSON
; Permit reading of null data files on labelled tape
; Forbid writing FB tapes unless LRECL is multiple of 4
; Fix $DCHK
;<B.BOMBADIL>TAPEIO.FAI.492, 6-Jan-82 17:38:21, Edit by B.BOMBADIL
;<B.BOMBADIL>TAPEIO.FAI.491, 6-Jan-82 16:44:44, Edit by B.BOMBADIL
; Don't check DATA-TYPE/LABEL consistency during the parse.
; ERROR restores all clobbered AC's and haltfs uncontinuably
; Minor code cleanups
;<B.BOMBADIL>TAPEIO.FAI.489, 1-Jan-82 18:36:16, Edit by B.BOMBADIL
; TAPJFN doesn't automatically rewind the tape drive
;<B.BOMBADIL>TAPEIO.FAI.488, 1-Jan-82 18:06:01, Edit by B.BOMBADIL
;<B.BOMBADIL>TAPEIO.FAI.481, 1-Jan-82 17:04:09, Edit by B.BOMBADIL
;<B.BOMBADIL>TAPEIO.FAI.480, 1-Jan-82 16:21:25, Edit by B.BOMBADIL
; Organize HELP keyword table into three tables (general, commands, switches)
;<B.BOMBADIL>TAPEIO.FAI.479, 1-Jan-82 16:05:31, Edit by B.BOMBADIL
;<B.BOMBADIL>TAPEIO.FAI.477, 1-Jan-82 15:55:01, Edit by B.BOMBADIL
; Add a REVERT command to get back initial switch settings. Document it.
; Fix broken DISPLAY command
;<B.BOMBADIL>TAPEIO.FAI.474, 31-Dec-81 20:08:19, Edit by B.BOMBADIL
; Move output buffer page from page 20 to page 100 (was overlapping code!)
;<B.BOMBADIL>TAPEIO.FAI.464, 31-Dec-81 18:57:17, Edit by B.BOMBADIL
; Set new switch values after command line is confirmed
;<B.BOMBADIL>TAPEIO.FAI.460, 31-Dec-81 16:20:25, Edit by B.BOMBADIL
;<B.BOMBADIL>TAPEIO.FAI.454, 31-Dec-81 15:26:42, Edit by B.BOMBADIL
; Make possible either MACRO or FAIL assembly
;<B.BOMBADIL>TAPEIO.FAI.453, 31-Dec-81 15:09:47, Edit by B.BOMBADIL
; Try to assign MTA-DUMPER: if possible. If not possible, force user
; to use TAPE command to assign the drive.
;<B.BOMBADIL>TAPEIO.FAI.450, 31-Dec-81 13:55:35, Edit by B.BOMBADIL
; fix up HELP documentation
; more code cleanups
;<B.BOMBADIL>TAPEIO.FAI.447, 31-Dec-81 12:41:32, Edit by B.BOMBADIL
;<B.BOMBADIL>TAPEIO.FAI.445, 30-Dec-81 20:37:54, Edit by B.BOMBADIL
; Rework parsing so a user can recover without retyping the entire line
;<B.BOMBADIL>TAPEIO.FAI.436, 30-Dec-81 18:54:16, Edit by B.BOMBADIL
; Flush most of the FDBxx nonsense in favor of the FLDDB. macro
;<B.BOMBADIL>TAPEIO.FAI.435, 30-Dec-81 17:22:19, Edit by B.BOMBADIL
;<B.BOMBADIL>TAPEIO.FAI.428, 30-Dec-81 16:22:46, Edit by B.BOMBADIL
; Add TAPE and UNLOAD commands
; Begin code cleanup
;<A.JPBION.TAPEIO>TAPEIO.FAI.426, 23-Oct-81 15:33:24, Edit by A.JPBION
; Fix bug in REWIND command; assign the tape drive first!
;<A.JPBION.TAPEIO>TAPEIO.FAI.424, 22-Oct-81 17:51:35, Edit by A.JPBION
; Add the REWIND command. Not really needed, but it SURE helps the user!
;<A.JPBION.TAPEIO>TAPEIO.FAI.422, 15-Oct-81 16:56:13, Edit by A.JPBION
; Add EXIT as an invisible command.
;<A.JPBION.TAPEIO>TAPEIO.FAI.419, 15-Oct-81 16:23:22, Edit by A.JPBION
; Add the DISPLAY command to do the equivalent to HELP VALUES...
; This code is going to be cleaned up! (ie: by code I mean TAPEIO)
; Improvements include doing such things as adding a command to go back
; to the default switches...
;MRC:<UTILITIES>TAPEIO.FAI.416, 7-Sep-81 22:35:41, Edit by ADMIN.LOUGHEED
; Incorporate RMK's fixes to handling of option errors
;MRC:<UTILITIES>TAPEIO.FAI.415, 10-May-81 10:55:39, Edit by ADMIN.JQJ
; -VPRINT, VCARD, and DEFAULT documentation
; -parameterize lengths of various keyword tables so adding won't break them
; -TO DO: * On write, if BLKPFX=0, don't write a block prefix, but do
; pad the block with "^" to the record length.
; * Rework parsing so that /switch1:value<ESC>^U does not set switch1.
; * Handle short last block in FB -- pad to multiple of record length
;<J.JQJOHNSON>TAPEIO.FAI.20, 15-Apr-81 18:38:00, Edit by B.BOMBADIL
; change FMFTAB+0 from 6,,6 to 7,,7 to get back VPRINT keyword
;<J.JQJOHNSON>TAPEIO.FAI.19, 10-Apr-81 15:23:05, Edit by J.JQJOHNSON
; -change "beware" message to reflect changed CIT policies
; -change VPRINT and VCARD to LRECL 235 (for Mark Lawrence)
;<J.JQJOHNSON>TAPEIO.FAI.18, 4-Apr-81 14:25:50, Edit by J.JQJOHNSON
; clear output buffer on READ by big BLT (at WDSET) to fix null-in-b35 problem
;<ADMIN.JQJ>TAPEIO.FAI.16, 23-Mar-81 14:45:14, Edit by ADMIN.JQJ
;fix THDRRD and take out check for LRECL mult of 4.
;<ADMIN.JQJ>TAPEIO.FAI.15, 11-Mar-81 11:25:53, Edit by ADMIN.JQJ
; -correction to previous edit. Used wrong AC in RTSOR
; -On reading, permit filename of "*" to mean "use file name from label, or
; TAPEIO-FILE-n if NL".
;<ADMIN.JQJ>TAPEIO.FAI.12, 5-Mar-81 12:03:56, Edit by ADMIN.JQJ
; -bump version number
; -if D format, flush padding record containing "^" in record descriptor
; -clean up code around RTLSOR and following
; -free 3 ACs for future use by moving TJFN, OJFNP, IJFNP to memory
;<ADMIN.JQJ>TAPEIO.FAI.11, 3-Mar-81 14:34:09, Edit by ADMIN.JQJ
; -start fixing problems with BDW -- default to 4, which is probably wrong
;<ADMIN.JQJ>TAPEIO.FAI.10, 3-Mar-81 12:46:26, Edit by ADMIN.JQJ
; -default to CTRL-L:NO on reading tapes
; -on ASCII D tapes, write block prefix as at least 4 instead of 0
; -clean up VOL label code, read volid for HDR1
; -HDR label reading: on ASCII tapes, believe CC="A" & don't require HDR2
; -HDR label writing: write VOLID and FILE SEQUENCE NUMBER
; -JULDAT and DONOUT cleaner
; -fix UNIT command to work after reparse
;<IN.JQJ>TAPEIO.FAI.7, 22-Feb-81 18:13:41, Edit by ADMIN.JQJ
; make error handling reasonable even if don't have CM%FIX
;<ADMIN.JQJ>TAPEIO.FAI.6, 21-Feb-81 11:43:14, Edit by ADMIN.JQJ
; fix switches to end with colon
;<ADMIN.JQJ>TAPEIO.FAI.5, 21-Feb-81 11:03:25, Edit by ADMIN.JQJ
; redo listing of HELP texts to print text but not binary (via macro)
; add /FORMAT:ANSI for DEC-style format (DB, 2044, 2048, with ^L)
; add DEFAULT command
; still to do: /UNIT should clear knowledge of position, and should rewind
;<ADMIN.JQJ>TAPEIO.FAI.4, 12-Feb-81 13:19:20, Edit by ADMIN.JQJ
; clean up format of listing. Eliminate noise words on switches
; clean up HELP and QUIT parsing
; don't write generation number in DSN field of header
; translate EBCDIC <not> to tilde rather than ^.
;<ADMIN.JQJ>TAPEIO.FAI.3, 11-Feb-81 20:55:53, Edit by ADMIN.JQJ
; fix "COLUMN OVERFLOW" with ANSI D tapes.
;Edit by T.TOPAZ
; Change arguments to switches, edit help, minor touch-ups.
;<W.WOODRUFF>TAPEIO.FAI.1, 15-Aug-80 13:33:10, Edit by W.WOODRUFF
; Install HELP command
TITLE TAPEIO -- READ & WRITE TAPES
;
; a program to read & write IBM format tapes
; written by Brian Cox <a.brian> @ GSB, 1979.
;
SUBTTL PARAMETERS
SEARCH MONSYM, MACSYM ;SYMBOL LIBRARIES
PURGE .CASE, .CASE ;WE USE THIS SYMBOL (WAS DEFINED IN MACSYM)
.REQUIRE SYS:MACREL.REL ;USEFUL SUBROUTINES
ASUPPRESS ;DON'T OUTPUT UNUSED SYMBOLS
IFDEF SALL,<SALL> ;PRETTY LISTINGS
IFNDEF SALL,<XALL NOLIT> ;PRETTY LISTINGS
.DIRECT .XTABM ;FLUSH WHITE SPACE IN MACRO EXPANSIONS
Extern .JBSA ;[13]
;
; REGISTER USAGE
;
FLAGS= 0 ;FLAG BITS (SEE FLAGS BELOW)
AC1= 1 ;JSYS PARAMETER AC'S
AC2= 2
AC3= 3
AC4= 4
;5 IS FREE (RESERVED FOR FLAGS WHEN PARSING REWORKED)
INRCT= 6 ;INPUT RECORD COUNT
INCOL= INRCT ;INPUT COLUMN COUNT
INBCT= 7 ;INPUT BLOCK COUNT
INBPT= 10 ;INPUT BYTE POINTER
;11 IS FREE
OUTRCT= 12 ;OUTPUT RECORD COUNT (SEE SBKCOL)
OUTCOL= OUTRCT ;OUTPUT COLUMN COUNT
OUTBCT= OUTCOL+1 ;13 OUTPUT BLOCK COUNT
OUTBPT= OUTBCT+1 ;14 OUTPUT BYTE POINTER
OUTEOF= OUTBPT+1 ;15 OUTPUT EOF COUNT
;16 IS FREE (RESERVED FOR MACSYM)
P= 17 ;STACK POINTER
;
; FLAGS (RIGHT)
;
%BLKSZ== 1 ;BLKSIZE SPECIFIED
%LRECL== 2 ;LRECL "
%DEN== 4 ;DENSITY "
%RECFM== 10 ;RECFM "
%PARTY== 20 ;PARITY "
%DATA== 40 ;DATA "
%CASE== 100 ;CASE "
%COUNT== 200 ;COUNT "
%SKIP== 400 ;SKIP "
%EOR== 1000 ;EOR "
%XTAB== 2000 ;EXPANDING TAB IN INPUT
%EOL== 10000 ;CR/LF IN INPUT
%CHOP== 20000 ;RECORD(S) TRUNCATED ON WRITE/ > LRECL ON READ
%STRIP== 40000 ;STRIP SPECIFIED
%BLK== 100000 ;LAST CHAR WRITTEN WAS BLANK
%BIGBK== 200000 ;BLOCK(S) > BLKSIZE
%EOT== 400000 ;ALLOW EOT
%FMT== %BLKSZ+%LRECL+%RECFM
;
; FLAGS (LEFT)
;
%NULL== 1 ;NULLS SPECIFIED
%TAB== 2 ;TAB "
%FF== 4 ;FORM FEEDS "
%BLNKS== 10 ;BLANKS SPECIFIED
%LINOS== 20 ;LINE #S SPECIFIED
%CC== 40 ;RECFM== xA (CARRIAGE CONTROL IN 1ST BYTE)
%EOF== 100 ;READ EOF
%BPFX== 200 ;BLOCK
%VLR== 400 ;RECFM== Dx or Vx (VARIABLE LENGTH)
%LTM== 1000 ;LEADING TAPE MARK SPECIFIED
%LABEL== 2000 ;LABEL SPECIFIED
%WRITE== 200000 ;COMMAND BIT (1==WRITE COMMAND)
%READ== 400000 ;COMMAND BIT (1==READ COMMAND)
;
; RECFMs
;
$A== 10 ;ANSI CARRIAGE CONTROL
$B== 4 ;BLOCKED RECORDS
$D== 0 ;ASCII UNBLOCKED VARIABLE
$DA== $D+$A ; " " " WITH CC
$DB== $D+$B ; " BLOCKED "
$DBA== $D+$B+$A; " " " " "
$F== 1 ;BOTH UNBLOCKED FIXED
$FA== $F+$A ; " " " " "
$FB== $F+$B ; " BLOCKED "
$FBA== $F+$B+$A; " " " " "
$U== 2 ;BOTH UNDEFINED
$UA== $U+$A ;BOTH " " "
$V== 3 ;IBM UNBLOCKED VARIABLE
$VA== $V+$A ; " " " " "
$VB== $V+$B ; " BLOCKED "
$VBA== $V+$B+$A; " " " " "
;
; MISC PARAMETERS
;
MINREC== ^D18 ;SMALLEST RECORD LENGTH (ANSI MIN: 18)
MAXREC== ^D30720 ;LARGEST RECORD LENGTH (DEC MAX, IBM MAX IS 32760)
MINBLK== MINREC ;SMALLEST BLKSIZE
MAXBLK== MAXREC ;LARGEST BLKSIZE
OUTBPG== 100 ;OUTPUT BUFFER PAGE
OUTBF1= 1000*OUTBPG
OUTBF2= OUTBF1+<MAXBLK+3>/4
INBPG= OUTBPG+2*<<MAXBLK+3777>/4000> ;INPUT BUFFER PAGE
INBUF1= 1000*INBPG
INBUF2= INBUF1+<MAXBLK+3>/4
OutLen== 1000*<INBPG-OUTBPG> ;[8] length of output buffer in words
BUFL== INBPG-OUTBPG ;BUFFER LENGTH (BOTH BUFFERS)
MaxNew=^D10 ;[13] 10. new definitions
SUBTTL MACROS
DEFINE NOISE (STR) <
MOVEI AC2,[FLDDB. .CMNOI,,<-1,,[ASCIZ\STR\]>]
CALL DOCMND
>
DEFINE WARN (STR) <
JRST [ HRROI AC1,[ASCIZ/STR/]
JRST $WARN ]
>
DEFINE FMTERR (STR) <
JRST [ HRROI AC1,[ASCIZ/STR/]
JRST $INCOM ]
>
Define TMSG ($MSG)< ;[11]
HrrOI AC1,[Asciz \$MSG\] ;[11]
Move AC2,AC1 ;[11]
Call PrTMSG ;[11]
>
;T - KEYWORD TABLE ENTRY
DEFINE T (KEYWRD,ADDRSS,FLAGS) <
IFNB <ADDRSS>,<DEFINE ..ADDR ' <ADDRSS>>
IFB <ADDRSS>,<DEFINE ..ADDR ' <$'KEYWRD>>
IFNB <FLAGS>,<DEFINE ..FLAG <CM%FW!FLAGS>>
IFB <FLAGS>,<DEFINE ..FLAG <CM%FW>>
[..FLAG
ASCIZ/KEYWRD/],,..ADDR
PURGE ..ADDR
>
;TABLE - START A KEYWORD TABLE
DEFINE TABLE <
..PPP==. ;;PPP IS THE TOP OF THE TABLE
XWD 0,0 ;;LEAVE BLANK FOR NOW.
>
;TEND - FINISH UP KEYWORD TABLE
DEFINE TEND <
..QQQ==.-..PPP-1 ;;DEFINE THE VALUE OF ..QQQ
.ORG ..PPP
..QQQ,,..QQQ ;;THE BEGINNING OF THE TABLE.
.ORG
>
SUBTTL SWITCH VALUE TABLES
;THE SWUSE, SWDEF, AND SWSET TABLES ARE IN PARALLEL.
;INFORMATION BEARING MACRO FOR DEFAULT SWITCH SETTINGS
DEFINE SWINF <
XX DEN,.SJD16 ;DENSITY - 1600 BPI
XX LRECL,^D80 ;LOGICAL RECORD LENGTH - 80
XX RECFM,$FB ;RECORD FORMAT - FB
XX BLKSZ,^D8000 ;BLOCKSIZE - 8000
XX CASE,0 ;CASE CONVERSION - NOCHANGE
XX DATA,0 ;DATA TYPE - ASCII
XX PARITY,.SJPRO ;PARITY - ODD
XX COUNT,<377777,,777777> ;COUNT - ALL
XX SKIP,0 ;RECORDS TO SKIP - NONE
XX EOR,1 ;END OF RECORD - LRECL FOR READ, CRLF FOR WRITE
XX NULL,1 ;FLUSH NULLS - YES
XX TAB,1 ;EXPAND TABS - NO FOR READ, YES FOR WRITE
XX FF,1 ;FLUSH FORMFEEDS - NO FOR READ, YES FOR WRITE
XX BLANKS,1 ;STRIP TRAILING OR PAD WITH BLANKS - YES
XX LINOS,1 ;FLUSH LINE NOS. - NO FOR READ, YES FOR WRITE
XX BLKPFX,0 ;BLOCK PREFIX - 0
XX LTM,0 ;LEADING TAPE MARK - NO
XX LABEL,1 ;LABEL - SL
>;END SWINF MACRO
;SET UP INITIAL TABLE OF CURRENT SWITCH VALUES
DEFINE XX (NAME,VALUE) <
NAME: VALUE
>
SWUSE:: SWINF
SWLEN==.-SWUSE
;SET UP TABLE OF DEFAULT SWITCH VALUES
DEFINE XX ' (NAME,VALUE) <
VALUE
>
SWDEF: SWINF ;SAVE DEFAULT SWITCH VALUES HERE
;TABLE OF SWITCH SETTINGS THAT HAVEN'T YET BEEN CONFIRMED
DEFINE XX ' (NAME,VALUE) <
.'NAME: -1 ;;INITIAL VALUE OF -1
>
SWSET: SWINF ;SWITCH VALUES THAT WERE SET
SUBTTL IMPURE STORAGE
JFNLSZ== ^D20
IJFNL: BLOCK JFNLSZ+1 ;INPUT JFN LIST
OJFNL: BLOCK JFNLSZ+1 ;OUTPUT JFN LIST
CMIBUF: BLOCK 200 ;COMMAND INPUT BUFFER
CMABUF: BLOCK 20 ;COMMAND ATOM BUFFER
JFNBLK: BLOCK 16 ;COMMAND JFN BLOCK
TJFN: 0 ;TAPE JFN (WAS AC5)
IJFNP: 0 ;INPUT JFN POINTER (WAS AC11)
OJFNP: 0 ;OUTPUT JFN POINTER (WAS AC16)
OCMPTR: 0 ;PREVIOUS VALUE OF POINTER IN CSB+.CMPTR
LOGJFN: 0 ;[11] JFN of file doing logging of session
DefJFN: Block 1 ;[13] JFN of new format definitions
DmpJFN: Block 1 ;[13] JFN of dump file
SavJFN: Block 1 ;[13] JFN of new TAPEIO program
MBfCnt: 0 ;[8] mapped buffer count
NotDSK: 0 ;[8] 0 output to disk, -1 output to non-disk dev.
DelPtr: 0 ;[13] deleted stack pointer for user defined formats
DelStk: Block MaxNew ;[13] deleted stack of delete formats
NewCnt: -1 ;[13] number of new formats
CurPtr: Block 1 ;[13] current ptr to user defined formats
EOFflg: Block 1 ;[13] End of file flag for parsing in files
ReDef: Block 1 ;[13] flag - indicate if redefining a user format
VOLID: BLOCK 2 ;VOLUME NAME
TAPSTR: BLOCK 2 ;TAPE DRIVE STRING, e.g. "MTA0:"
TAPDES: BLOCK 1 ;TAPE DRIVE DEVICE DESIGNATOR
; THE FOLLOWING TWO PAIRS OF CELLS SHOULD STAY IN THE SAME ORDER
IORCNT: 0 ;# OF RECORDS READ/WRITTEN
IOBCNT: 0 ;# OF BLOCKS READ/WRITTEN
IORSAV: 0 ;IORCNT SAVE AREA (FOR REMOVING BLANK LINES)
IOBSAV: 0 ;IOBCNT SAVE AREA (IORCNT-IOBSAV MUST BE CONTIGUOUS)
RTEEOR: 0 ;EFFECTIVE EOR (FOR REMOVING SEQ #S)
CC: " " ;CARRIAGE CONTROL (DEFAULT: " ")
INEOF: 0 ;INPUT EOF COUNT
TFN: 1 ;TAPE FILE #
TSKPCT: 0 ;TAPE SKIP COUNT
INPG: 0 ;INPUT PAGE #
OUTPG: 0 ;OUTPUT PAGE #
EORFLG: 0 ;EOR EVER SPECIFIED FLAG(0=N,#0=Y) [THE DEFAULT
TABFLG: 0 ;TAB " " " " DEPENDS ON
LINFLG: 0 ;LINOS " " " " WHETHER READ
FFFLG: 0 ;FF " " " " OR WRITE]
BDWFLG: 0
LBLFLG: 0 ;LABEL " " " "
RDWPT: 0 ;RECORD DESCRIPTOR POINTER
RDWCT: 0 ; " " COUNT
BDWCT: 0 ; " " COUNT
WXTRAP: 0 ;PTR TO CHARS IN VAR LEN WRITE THAT DIDN'T FIT IN BLOCK
WXTRAC: 0 ;# OF CHARS (AS ABOVE)
; DON'T CHANGE ORDER OF OUTCOL-OUTEOF,SBKCOL-SBKEOF,LNBCOL-LNBEOF
SBKCOL: 0 ;START OF BLANKS COLUMN
SBKBCT: 0 ; " " " PAGE COUNTER
SBKBPT: 0 ; " " " BYTE POINTER
SBKEOF: 0 ; " " " EOF COUNTER
LNBCOL: 0 ;LAST NON-BLANK LINE COLUMN
LNBBCT: 0 ; " " " PAGE COUNTER
LNBBPT: 0 ; " " " BYTE POINTER
LNBEOF: 0 ; " " " EOF COUNT
STKL= ^D30 ;STACK LENGTH
STACK: BLOCK STKL ;STACK
DSL1: BLOCK 20 ;DATA SET LABEL 1 BUFFER
DSL2: BLOCK 20 ;DATA SET LABEL 2 BUFFER
DSL1T: ASCII !HDR1 ! ;DATA SET LABEL 1 TEMPLATE, 1. - 20.
ASCII ! 0000100010001 ! ;21.-40.
ASCII ! yyddd 00000x000000! ;41.-60.
ASCII !OS360 ! ;61.-80.
DSL2T: ASCII !HDR2x000000000030TAP! ;DATA SET LABEL 2 TEMPLATE, 1. - 20.
ASCII !EIO /GO ! ;21. - 40.
ASCII ! ! ;41. - 60.
ASCII ! ! ;61. - 80.
INLST: INLST1 ;INPUT IO LIST PTR
POINT 8,INBUF1 ;BYTE POINTER TO BUFFER
INLST2 ;PTR TO OTHER IO LIST
INLST1: IOWD MAXBLK/4,INBUF1 ;DUMPI COMMAND LIST
0
POINT 8,INBUF2
INLST1
INLST2: IOWD MAXBLK/4,INBUF2
0
OUTLST: OUTLS1 ;OUTPUT IO LIST PTR
POINT 8,OUTBF1
OUTLS2
OUTLS1: IOWD 0,OUTBF1
0
POINT 8,OUTBF2
OUTLS1
OUTLS2: IOWD 0,OUTBF2
0
LBREAD: IOWD ^D20,INBUF1 ;LABEL READ IO LIST
0
LBWRIT: IOWD ^D20,0 ;LABEL WRITE IO LIST
0
;COMMAND STATE BLOCK
CSB: XWD 0,$REPAR
.PRIIN,,.PRIOU
POINT 7,[ASCIZ/TAPEIO>/]
POINT 7,CMIBUF
POINT 7,CMIBUF
^D400
0
POINT 7,CMABUF
^D50
JFNBLK
SUBTTL TABLES
;POWERS OF 10
PWR10: 1
^D10
^D100
^D1000
^D10000
^D100000
;TOP LEVEL TAPEIO COMMANDS
COMTAB: TABLE
T DEFAULT
T DEFINE ;[13] define new formats
T DELETE ;[13] delete a new format
T DISPLAY
T DUMP ;[13] dump new formats to file
T EXIT,$QUIT,CM%INV ;"EXIT" is a synonym of QUIT
T HELP
T LOG ;[11]
T NOLOG ;[11]
T QUIT
T READ
T REVERT
T REWIND
T SAVE ;[13]
T TAPE-DRIVE,$TAPE
T UNLOAD
T WRITE
TEND
;/DENSITY:
DENTAB: TABLE
T 1600,.SJD16
T 6250,.SJD62 ; [1] Add 6250 bpi
T 800,.SJDN8
TEND
DenNam: 0 ;[1] add table for VALUE and DmpWrt
0 ;[1] routines.
0 ;[1]
[Asciz/800/] ;[1]
[Asciz/1600/] ;[1]
[Asciz/6250/] ;[1]
;READ RECFMS
RCFMTB: TABLE
T D,$D
T DA,$DA
T DB,$DB
T DBA,$DBA
T F,$F
T FA,$FA
T FB,$FB
T FBA,$FBA
T U,$U
T UA,$UA
T V,$V
T VA,$VA
T VB,$VB
T VBA,$VBA
TEND
;/PARITY:
PARTAB: TABLE
T EVEN,.SJPRE
T ODD,.SJPRO
TEND
;/DATA-TYPE:
DATAB: TABLE
T ASCII,0
T EBCDIC,1
TEND
;/CASE:
CASTAB: TABLE
T LOWER,-1
T NOCHANGE,0
T UPPER,1
TEND
;MOBY OPTION TABLE
OPTTAB: TABLE
T BLANKS:,$BLNKS
T BLKSIZE:,$BLKSZ
T BLOCK-FIX-LENGTH:,$BKPFX
T CASE:,$CASE
T COUNT:,$COUNT
T CTRL-L:,$FF
T DATA-TYPE:,$DATA
T DENSITY:,$DEN
T EOR:,$EOR
T FORMAT:,$FMT
T LABEL:,$LABEL
T LEADING-TAPE-MARK:,$LTM
T LINE-NUMS:,$LINOS
T LRECL:,$LRECL
T NULLS:,$NULL
T PARITY:,$PARTY
T RECFM:,$RECFM
T SKIP:,$SKIP
T TABS:,$TAB
TEND
;SYMBOLIC TAPE FILE #S FOR WRITE
TFN1: TABLE
T END,-1
T LAST,-2
T NEXT,0
TEND
;SYMBOLIC TAPE FILE #S FOR READ
TFN2: TABLE
T LAST,-2
T NEXT,0
TEND
;BLANKS, ETC.
YNTAB: TABLE
T NO,0
T YES,1
TEND
;QUIT OPTIONS
QUITAB: TABLE
T NOCHANGE,-1
T REWIND,0
T UNLOAD,1
TEND
;SYMBOLIC COUNT
CNTAB: TABLE
T ALL,0
TEND
;SYMBOLIC SKIP
SKPTAB: TABLE
T NONE,0
TEND
;END OF RECORD
EORTAB: TABLE
T CRLF,0
T LRECL-CHARACTERS,1
TEND
;FORMATS
FMTAB: FMLen,,FMLen+MaxNew ;[13]
T ANSI,7
T FCARD,1
T FPRINT,2
T TCARD,5
T TPRINT,6
T VCARD,3
T VPRINT,4
FMLen==.-FMTAB-1 ;[13]
;[13] note: NewTab cannot be moved from this position
NewTab: Block MaxNew ;[13] new table entries
NewNam: Block MaxNew*^D10 ;[13] the names of the new formats
NewDef: Block MaxNew*SWLEN ;[13] the switch settings for new formats
;LABEL KEYWORDS
LBLTAB: TABLE
T AL,-1
T NL,0
T SL,1
TEND
SUBTTL MISCELLANEOUS ROUTINES
ERROR: PUSH P,AC1
PUSH P,AC2
PUSH P,AC3
CALL PCRIF
TMSG <?JSYS error at location >
MOVEI AC1,.PRIOU
HRRZ AC2,-3(P)
SUBI AC2,2
MOVEI AC3,10
NOUT
JFCL
SkipN AC1,LOGJFN ;[11]
Jrst .+3 ;[11]
NOUT ;[11]
JFCL ;[11]
TMSG < - >
MOVEI AC1,.PRIOU
HRLOI AC2,.FHSLF
MOVEI AC3,0
ERSTR
JFCL
JFCL
SkipN AC1,LOGJFN ;[11]
Jrst .+4 ;[11]
ERSTR ;[11]
JFCL ;[11]
JFCL ;[11]
TMSG <
>
HRROI AC1,-1 ;[6] ALL JFNS IN THIS PROCESS
CLOSF ;[6] CLOSE ALL JFN'S
JFCL ;[6] ERROR OK
MOVE AC1,TAPDES ;[6] GET TAPE DRIVE DEVICE
RELD ;[6] RELEASE THE TAPE DRIVE
JFCL ;[6] ERROR OK
POP P,AC3
POP P,AC2
POP P,AC1
HALTF
JRST .-1
;
; UNMAP -- UNMAP FILE
;
UNMAP: HRROI AC1,-1
MOVE AC2,[XWD .FHSLF,INBPG]
MOVE AC3,[PM%CNT+BUFL]
PMAP
RET
;
; MISC PRINT
;
PRTTFN: MOVE AC2,TFN ;PRINT TAPE FILE #
PRTNUM: MOVEI AC1,.PRIOU ;PRINT NUMBER (AC2= #)
MOVEI AC3,^D10
NOUT
ERCAL ERROR
SkipN AC1,LOGJFN ;[11]
Jrst .+3 ;[11]
NOUT ;[11]
Ercal Error ;[11]
RET
PRTFIL: MOVEI AC1,.PRIOU ;PRINT FILE NAME
MOVEI AC3,0 ;CALLED WITH AC2= JFN
JFNS
SkipE AC1,LOGJFN ;[11]
JFNS ;[11]
RET
;PCRIF - PRETTY PRINTING AID
PCRIF: MOVEI AC1,.PRIOU ;READING FROM THE TTY
RFPOS ;GET CURSOR POSITION
TRNE AC2,-1 ;SKIP IF AGAINST LEFT MARGIN
CALL PRTEOL ;PRINT A CRLF
RET ;RETURN TO CALLER
PRTARW: HRROI AC1,[ASCIZ/ => /]
Move AC2,AC1 ;[11]
PSOUT
SkipN AC1,LOGJFN ;[11]
RET
SetZ AC3, ;[11]
SOUT ;[11]
Ret ;[11]
PRTCFM: MOVE AC2,IORCNT ;PRINT # OF RECORDS
CALL PRTNUM
HRROI AC1,[ASCIZ/ records, /]
CAIN AC2,1
HRROI AC1,[ASCIZ/ record, /]
Move AC2,AC1 ;[11]
PSOUT
SkipN AC1,LOGJFN ;[11]
Jrst .+3 ;[11]
SetZ AC3, ;[11]
SOUT ;[11]
MOVE AC2,IOBCNT ;PRINT # OF BLOCKS
CALL PRTNUM
HRROI AC1,[ASCIZ/ blocks processed/]
CAIN AC2,1
HRROI AC1,[ASCIZ/ block processed/]
Move AC2,AC1 ;[11]
PSOUT
SkipN AC1,LOGJFN ;[11]
Jrst .+3 ;[11]
SetZ AC3, ;[11]
SOUT ;[11]
TMSG <
>
RET
;
; PROCESS TRAILING BLANKS
;
TRLBLK: TRZN FLAGS,%BLK
RET ;NONE
SKIPN BLANKS
JRST SQUEEZ ;REPLACE WITH TAB(S)
;
; REMOVE BLANKS
;
RESET: CAMLE OUTBCT,SBKBCT ;RESET POINTERS TO START OF BLANKS
CALL REMAP ;START IS ON PAGE ALREADY MAPPED
MOVE AC1,[XWD SBKCOL,OUTCOL]
BLT AC1,OUTEOF
RET
REMAP: SOS OUTPG ;REMAP LAST PAGE
MOVE AC1,OUTPG
MOVE AC2,[XWD .FHSLF,OUTBPG+BUFL-1]
HRLZI AC3,(PM%RD+PM%PLD)
PMAP
MOVE AC1,[XWD OUTBF1,OUTBF1+1000]
BLT AC1,OUTBF1+1777 ;REPOSTION CURRENT PAGE
MOVE AC1,[XWD 1000*<OUTBPG+BUFL-1>,OUTBF1]
BLT AC1,OUTBF1+777 ;TRANSFER LAST TO START OF OUTBUF
HRROI AC1,-1 ;UNMAP PAGE LAST
MOVEI AC3,0
PMAP
MOVE AC1,SBKBCT ;ADJUST PAGE COUNTER
ADDI AC1,5000*<BUFL-1>
MOVEM AC1,SBKBCT
MOVE AC1,SBKBPT ;ADJUST BYTE POINTER
SUBI AC1,1000*<BUFL-1>
MOVEM AC1,SBKBPT
RET
;
; REPLACE BLANKS WITH TAB(S)
;
SQUEEZ: SKIPN TAB ;REPLACE BLANKS WITH TAB(S)
RET
MOVE AC1,SBKCOL
AOJ AC1,
CAML AC1,OUTCOL
RET ;ONLY 1 BLANK
CAMN OUTBPT,[POINT 7,OUTBF1]
MOVE OUTBPT,[10700,,OUTBF1-1] ;ILDB WON'T = POINT 7,OUTBUF
CAMLE OUTBCT,SBKBCT
ADDI OUTBPT,1000 ;CURRENT PAGE WILL BE REPOSITIONED
PUSH P,OUTBPT ;SAVE POINTER TO END OF BLANKS
MOVEI AC1,0
PUSH P,AC1 ;INIT TAB COUNT
CALL RESET ;RESTORE PTR TO START OF BLANKS
SQZCNT: ILDB AC1,OUTBPT ;COMPUTE # OF TABS
AOJ OUTEOF,
AOJ OUTCOL,
SOJ OUTBCT,
TRNN OUTCOL,7 ;REPLACE THESE BLANKS
AOS (P) ;YES, INCR TAB COUNT
CAME OUTBPT,-1(P) ;END OF BLANKS?
JRST SQZCNT ;NO
SKIPN (P) ;ANY TABS?
JRST SQZPOP ;NO
MOVEM OUTCOL,-1(P) ;SAVE TO INSERT BLANK(S) NOT REMOVED
CALL RESET ;ADD TAB(S)
MOVEI AC1,11
CALL SQZWRT
SOSLE (P)
JRST .-2
MOVEI OUTCOL,0 ;SIMPLE MULTIPLE OF 8
MOVEI AC1," " ;REWRITE BLANK(S) NOT REMOVED
MOVE AC2,-1(P)
JRST .+3
CALL SQZWRT
SOJ AC2,
TRNE AC2,7
JRST .-3
SQZPOP: POP P,AC1 ;RESTORE STACK
POP P,AC1
RET
SQZWRT: IDPB AC1,OUTBPT
AOJ OUTEOF,
AOJ OUTCOL,
SOJ OUTBCT,
RET
;
; ADD DESCRIPTOR WORD
;
; INPUT: AC1=BUFFER PTR, AC2=BYTE COUNT
; RETURNS: AC2=BYTE COUNT
;
ADDDW: MOVE AC3,RECFM ;ADD BLOCK/RECORD DESCRIPTOR TO BUFFER
TRNE AC3,3
JRST BINDW
MOVEI AC3,4 ;4 DIGITS
PUSH P,AC2 ;ADDDW SHOULD PRESERVE AC2!
CALL DONOUT ;RECFM=D: DESCRIPTOR IN ASCII
POP P,AC2
RET
BINDW: MOVE AC3,AC2 ;RECFM=V: DESCRIPTOR IN BINARY
LSH AC3,-10
IDPB AC3,AC1
IDPB AC2,AC1
MOVEI AC3,0
IDPB AC3,AC1 ;PAD WITH TRAILING ZERO BYTES
IDPB AC3,AC1
RET
SUBTTL TAPE DRIVE ASSIGNMENT ROUTINES
;ASSIGN - TRY TO QUIETLY GET A TAPE DRIVE
;WE LOOK FOR THE LOGICAL NAME MTA-DUMPER:
;RETURN +1 ALWAYS. TAPDES IS ZERO IF WE DIDN'T FIND OR ASSIGN A DRIVE
ASSIGN: SETZM TAPDES
SETZM TAPSTR
MOVX AC1,GJ%SHT
HRROI AC2,[ASCIZ/MTA-DUMPER:/]
GTJFN
ERJMP R
MOVEM AC1,TJFN
DVCHR
LDB AC2,[POINT 9,AC2,17]
CAIE AC2,.DVMTA
JRST [ MOVE AC1,TJFN
RLJFN
JFCL
SETZM TJFN
RET ]
MOVEM AC1,TAPDES
MOVE AC1,TJFN
RLJFN ;RELEASE THE JFN NOW
JFCL
ASSGN0: HRROI AC1,TAPSTR
MOVE AC2,TAPDES
DEVST ;WRITE OUT DEVICE STRING
ERCAL ERROR
MOVEI AC2,":"
IDPB AC2,AC1 ;END WITH A COLON
MOVEI AC2,.CHNUL
IDPB AC2,AC1 ;AND A NULL
SETZM TJFN ;NO JFN ON FLAG
SETZM LBLFLG ;DON'T KNOW ABOUT LABEL
MOVE AC1,TAPDES ;AC1/ DRIVE DESIGNATOR
ASND ;TRY TO ASSIGN THE TAPE DRIVE
ERJMP ASSGNX ;FAILED, GO COMPLAIN
CALL .REWIN ;REWIND TAPE, SET INITIAL FILE NUMBER
JFCL ;IGNORE AN ERROR HERE
RET ;RETURN TO CALLER
ASSGNX: CALL PCRIF
TMSG <?Unable to assign tape drive >
HRROI AC1,TAPSTR
Move AC2,AC1 ;[11]
PSOUT
SkipN AC1,LOGJFN ;[11]
Jrst .+3 ;[11]
SetZ AC3, ;[11]
SOUT ;[11]
TMSG <
>
SETZM TAPDES
SETZM TAPSTR
RET
;TAPE-DRIVE COMMAND
$TAPE: SkipN AC1,TAPDES ;[9] see if there is a tape drive assigned
Jrst TAPE0 ;[9] nope.
RELD ;[9] release old tape drive
Jfcl ;[9] error oh, well
SETZM TAPDES ;FLAG THAT NO DEVICE IS ASSIGNED
TAPE0: ;[9] new label
NOISE (TO USE IS)
MOVEI AC2,[FLDDB. .CMDEV,CM%SDH!CM%HPP,,<Tape unit, e.g. MTA0:>,<MTA0:>]
CALL DOCMND
MOVEM AC2,TAPDES ;STORE DEVICE DESIGNATOR
CALL CONFRM ;WAIT FOR CONFIRMATION
MOVE AC1,TAPDES
DVCHR ;GET DEVICE INFORMATION
LDB AC1,[POINT 9,AC2,17] ;GET DEVICE CODE
CAIE AC1,.DVMTA ;TAPE DRIVE?
JRST [ CALL PCRIF
TMSG <?You must specify a tape drive.>
SETZM TAPDES
SETZM TAPSTR
RET ]
CALLRET ASSGN0 ;JOIN DEVICE ASSIGNMENT CODE
;TAPJFN - GET A JFN ON THE TAPE DRIVE
;RELEASES ANY PREVIOUS JFN ON THE DRIVE
;RETURNS JFN IN TJFN
TAPJFN: SKIPE AC1,TJFN ;SKIP IF NO JFN
RLJFN ;ELSE RELEASE IT
JFCL ;IGNORE BAD JFNS
MOVX AC1,GJ%SHT
HRROI AC2,TAPSTR
GTJFN ;GET JFN FOR TAPE
ERCAL ERROR
MOVEM AC1,TJFN ;SAVE
RET
SUBTTL DONIN, DONOUT
;
; DONIN -- CONVERT ASCII (EBCDIC) # TO BINARY
;
; INPUT: AC1= BYTE PTR, AC2= # OF CHARACTERS
; OUTPUT: AC1= UPDATED BYTE PTR, AC3= #
;
DONIN: MOVEI AC3,0
ILDB AC4,AC1 ;GET NEXT CHAR
SKIPE DATA
HRRZ AC4,TRNTAB(AC4) ;TRANSLATE TO ASCII
SUBI AC4,"0"
CAIG AC4,^D9
CAIGE AC4,0
MOVEI AC4,0 ;TREAT ERRONEOUS CHARS AS 0
IMUL AC4,PWR10-1(AC2) ;CONVERT TO BINARY
ADD AC3,AC4
SOJG AC2,DONIN+1
RET
;
; DONOUT -- CONVERT BINARY TO ASCII (BASE 10), WITH LEADING 0-FILL
;
;CALL: AC1/ BYTE POINTER TO DESTINATION
; AC2/ NUMBER TO CONVERT
; AC3/ FIELD WIDTH
;RET: AC1/ UPDATED AS FOR NOUT JSYS
DONOUT: MOVE AC4,AC1
HRROI AC1,CMABUF ;USE NOUT TO CONVERT
HRLZ AC3,AC3
TLO AC3,(NO%LFL+NO%ZRO) ;LEADING FILLER, PAD WITH ZEROS
HRRI AC3,^D10 ;BASE 10.
NOUT
ERCAL ERROR
MOVE AC1,AC4 ;MOVE (SANS NULL)
MOVE AC2,[POINT 7,CMABUF]
MOVEI AC3,0
;
; MOVBYT -- MOVE BYTES TILL NULL OR AC3=0
;
; INPUT: AC1=DESTINATION, AC2=SOURCE, AC3=MAX MOVED
; OUTPUT: AC1= UPDATED BYTE PTR
;
MOVBYT: ILDB AC4,AC2
JUMPE AC4,R
IDPB AC4,AC1
SOJN AC3,MOVBYT
RET
;COPY A STRING FROM STRING POINTED TO BY AC2 TO STRING POINTED TO BY
;AC1, WITH EBCDIC TO ASCII TRANSLATION IF "DATA" GT 0
;CALL: AC1/ DEST STRING PTR
; AC2/ SOURCE STRING PTR
; AC3/ NUMBER OF CHARACTERS TO COPY
;RET: +1 ALWAYS
CPYSTR: ILDB AC4,AC2
SKIPE DATA ;EBCDIC?
HRRZ AC4,TRNTAB(AC4) ;YES. CONVERT TO ASCII
IDPB AC4,AC1
SOJG AC3,CPYSTR
IDPB AC3,AC1
RET
;CALL: AC2/ INTERNAL D&T
;RET: AC1/ JULIAN DATE (YYDDD) AS INTEGER
JULDAT: MOVSI AC4,(IC%JUD) ;GET JULIAN DATE
ODCNV
HLRZ AC1,AC2
SUBI AC1,^D1900 ;YY
IMULI AC1,^D1000 ;YYxxx
ADDI AC1,(AC2) ;YYDDD
RET
SUBTTL TAPE CONTROL ROUTINES
TCLEAR: MOVE AC1,TJFN ;CLEAR MT FLAGS
MOVEI AC2,.MOCLE
MTOPR
ERCAL ERROR
RET
TOPEN: MOVE AC1,TJFN ;OPEN TAPE
MOVE AC2,[17B9+OF%RD]
TLNN FLAGS,%READ
MOVE AC2,[17B9+OF%WR]
OPENF
Jrst [ CaiE AC1,OPNX8 ;[2] off-line?
ERCAL ERROR ;[2]
HrroI AC1,[asciz/
?Device is Off-Line/] ;[2]
Jrst $PARSE ] ;[2] back to parse
SETPRM: CALL TCLEAR ;SET TAPE PARAMETERS
MOVEI AC2,.MOSDN ;SET DENSITY
MOVE AC3,DEN
MTOPR
ERCAL ERROR
MOVEI AC2,.MOSDM ;SET DATA MODE= INDUSTRY
MOVEI AC3,.SJDM8
MTOPR
ERCAL ERROR
MOVEI AC2,.MOSPR ;SET PARITY
MOVE AC3,PARITY
MTOPR
ERCAL ERROR
RET
TCLOSE: MOVE AC1,TJFN ;CLOSE TAPE & SAVE JFN
TLO AC1,(CO%NRJ)
CLOSF
ERCAL ERROR
RET
TSKPTM: MOVE AC1,TJFN ;SKIP NEXT TAPE MARK
MOVEI AC2,.MOFWF
MTOPR
ERCAL ERROR
RET
TLTM: SKIPE LTM ;SKIP LEADING TAPE MARK
TLNN FLAGS,%READ ;ONLY WORKS ON READ
RET
MOVE AC1,TFN
CAIE AC1,1 ;AND ONLY AT BOT
RET
CALL TOPEN
CALL TSKPTM
CALL TCLOSE
RET
;
; TLBLCK -- DETERMINE/VERIFY TAPE LABEL
;
; INPUT: NONE
; OUTPUT: NONE
; RETURNS: +1=ERROR, +2=OK
;
TLBLCK: MOVE AC1,TFN
CAIE AC1,1
RETSKP ;###serious logic error?
SETOM LBLFLG
SKIPN LABEL
RETSKP ;USER SPECIFIED NL--TREAT AS BLP
CALL SKPOPN
MOVEI AC2,LBREAD ;READ VOLUME LABEL
DUMPI
JRST TLBLER
MOVEI AC2,0 ;DATA-TYPE= ASCII
SETO AC3, ;LABEL= AL
MOVE AC1,INBUF1
TRZ AC1,000017
CAMN AC1,[BYTE (8) 126,117,114,61]
JRST TLBLOK
MOVEI AC2,1 ;DATA-TYPE= EBCDIC
MOVEI AC3,1 ;LABEL= SL
CAME AC1,[BYTE (8) 345,326,323,361]
JRST TLBLER
TLBLOK: TLNE FLAGS,%LABEL ;LABEL NOT SPECIFIED?
CAMN AC3,LABEL ;OR MATCHING?
AOS (P) ; YES. GOOD RETURN
MOVEM AC2,DATA ;SET DATA-TYPE
MOVEM AC3,LABEL ;SET LABEL
MOVE AC1,[POINT 7,VOLID]
MOVE AC2,[POINT 8,INBUF1+1] ;POINT AT VOLUME ID
MOVEI AC3,6
CALL CPYSTR ;COPY STRING FROM LABEL
CALL TCLOSE
RET ;RETURN +1 OR +2
TLBLER: CALL TCLEAR ;BAD LABEL SPECIFIED
SETZM LABEL ;TREAT AS LABELLED
MOVE AC1,TJFN
MOVEI AC2,.MOREW
SKIPN LABEL
MTOPR ;REWIND TAPE IF NL
ERCAL ERROR
CALL TCLOSE
TLNE FLAGS,%LABEL ;LABEL EVER SPECIFIED?
RET ;YES. ERROR
RETSKP ;NO
;
; THDRRD -- READ HEADER LABELS
;
; INPUT: NONE
; OUTPUT: NONE
; RETURNS: +1=ERROR, +2=OK
;
THDRRD: SKIPN LABEL
RETSKP ;NL
CALL TOPEN
MOVEI AC2,LBREAD
DUMPI ;READ HDR1 LABEL
RET ;ERROR
MOVE AC3,INBUF1
TRZ AC3,17
MOVE AC2,[BYTE (8) "H","D","R","1"]
SKIPLE LABEL ;SL?
MOVE AC2,[BYTE (8) 310,304,331,361] ;NO
CAME AC2,AC3
RET ;BAD LABEL
MOVE AC1,[POINT 7,CMABUF]
MOVE AC2,[POINT 8,INBUF1+1] ;POINT TO FILE IDENTIFIER
MOVEI AC3,^D17
CALL CPYSTR ;READ FILE NAME
DPB AC3,AC1 ;MAKE SURE IT ENDS WITH NULL
MOVE AC1,TJFN
MOVEI AC2,LBREAD
DUMPI ;READ HDR2 LABEL
JRST THDRR0 ;NO HDR2
MOVE AC3,INBUF1
TRZ AC3,17
MOVE AC2,[BYTE (8) "H","D","R","2"]
SKIPLE LABEL ;SL?
MOVE AC2,[BYTE (8) 310,304,331,362] ;NO
CAME AC2,AC3
JRST THDRR0 ;NO HDR2
MOVE AC1,[POINT 8,INBUF1+1]
ILDB AC3,AC1 ;GET RECORD FORMAT FROM LABEL
SKIPLE LABEL ;SL?
HRRZ AC3,TRNTAB(AC3) ;CONVERT TO ASCII
CAIN AC3,"D"
MOVEI AC2,$D
CAIN AC3,"F"
MOVEI AC2,$F
CAIN AC3,"U"
MOVEI AC2,$U
CAIN AC3,"V"
MOVEI AC2,$V
MOVEM AC2,RECFM
MOVEI AC2,5
CALL DONIN ;BLKSIZE
MOVEM AC3,BLKSZ
MOVEI AC2,5
CALL DONIN ;LRECL
MOVEM AC3,LRECL
MOVE AC2,RECFM ;COMPLETE RECFM
CAME AC3,BLKSZ
TRO AC2,$B ;BLOCKED
ILDB AC3,[POINT 8,INBUF1+9,7] ;CARRIAGE CONTROL?
HRRZ AC3,TRNTAB(AC3)
CAIN AC3,"A"
TRO AC2,$A ;YES
MOVEM AC2,RECFM
TRNE AC2,$A
TLO FLAGS,%CC
SKIPG LABEL ;SL?
JRST THDRAL ;ANSI LABEL
SETZM BLKPFX ;ZERO BLOCK PREFIX
CALL TSKPTM
CALL TCLOSE
RETSKP
THDRAL: MOVE AC1,[POINT 8,INBUF1+^D12,15]
MOVEI AC2,2
CALL DONIN ;BLOCK PREFIX
MOVEM AC3,BLKPFX
CALL TSKPTM
CALL TCLOSE
RETSKP
THDRR0: RETSKP ;WE DON'T YET KNOW WHAT DEFAULTS IF NO HDR2
;SO USE WHATEVER USER SPECIFIED
;
; TEOFRD -- READ EOF LABELS
;
TEOFRD: SKIPN LABEL
RET
CALL TOPEN
CALL TSKPTM
CALL TCLOSE
RET
;
; THDRWT -- WRITE HEADER LABELS
;
; INPUT: NONE
; OUTPUT: NONE
; RETURNS: +1=OK
;
THDRWT: SKIPN LABEL
RET ;TAPE NOT LABELLED
CALL TOPEN
MOVE AC1,[XWD DSL1T,DSL1]
BLT AC1,DSL1+^D15 ;CREATE HDR1 LABEL
HRROI AC1,CMABUF
HRRZ AC2,@IJFNP ;DATA SET NAME
MOVE AC3,[JS%NAM!JS%TYP!JS%PAF] ;OUTPUT name.ext ONLY
JFNS
MOVE AC1,[POINT 7,DSL1,27]
MOVE AC2,[POINT 7,CMABUF]
MOVEI AC3,^D17 ;MOVE TO DSL1
CALL MOVBYT
MOVE AC1,[POINT 7,DSL1+4,6] ;DATA SET ID
MOVE AC2,[POINT 7,VOLID]
MOVEI AC3,6
CALL MOVBYT
MOVE AC1,[POINT 7,DSL1+6,6] ;FILE SEQUENCE
MOVE AC2,TFN
MOVEI AC3,4 ;FIELD WIDTH
CALL DONOUT
SETO AC2, ;JULIAN CREATION DATE IS NOW
CALL JULDAT ;CONVERT TO JULIAN DATE
MOVE AC2,AC1
MOVE AC1,[POINT 7,DSL1+^D8,13] ;CREATION-DATE FIELD
MOVEI AC3,5 ;FIELD WIDTH
CALL DONOUT
MOVE AC1,[POINT 7,DSL1+^D10,20]
MOVEI AC2,"0" ;SECURITY CODE
SKIPG LABEL
MOVEI AC2," "
IDPB AC2,AC1 ;"0" FOR SL, " " FOR AL MEANS NO SECURITY
MOVE AC2,[POINT 7,[ASCIZ/000000/]]
MOVEI AC3,0
CALL MOVBYT ;BLOCK COUNT
MOVE AC1,[POINT 7,DSL1]
MOVE AC2,[POINT 8,OUTBF1]
CALL TLBLWT ;WRITE HDR1 LABEL
MOVE AC1,[XWD DSL2T,DSL2]
BLT AC1,DSL2+^D15 ;CREATE HDR2 LABEL
MOVE AC1,RECFM
ANDI AC1,$B-1 ;RECFM
MOVE AC2,@FMTRFM(AC1)
LSH AC2,-^D29
MOVE AC1,[POINT 7,DSL2,27]
IDPB AC2,AC1
MOVE AC2,BLKSZ ;BLOCK SIZE
MOVEI AC3,5
CALL DONOUT
MOVE AC2,LRECL ;LRECL
MOVEI AC3,5
CALL DONOUT
MOVE AC2,DEN
SUBI AC2,1 ;CONVERT TO STANDARD DENSITY
MOVEI AC3,1 ;ONLY 1 PLACE WIDE
SKIPLE LABEL ;SL?
CALL DONOUT ;YES. WRITE DENSITY
MOVEI AC2,"A" ;CARRIAGE CONTROL
MOVE AC3,RECFM
TRNE AC3,$A
DPB AC2,[POINT 7,DSL2+7,13]
MOVEI AC2,"B" ;BLOCK ATTRIBUTE
TRNE AC3,$B
DPB AC2,[POINT 7,DSL2+7,27]
MOVE AC1,[POINT 7,DSL2+^D10]
MOVE AC2,BLKPFX ;BLOCK PREFIX
MOVEI AC3,2
SKIPG LABEL ;SL?
CALL DONOUT ;NO--AL.
MOVE AC1,[POINT 7,DSL2]
MOVE AC2,[POINT 8,OUTBF2]
CALL TLBLWT ;WRITE HDR2 LABEL
CALL TCLOSE
RET
TLBLWT: SOJ AC2, ;SET BUFFER ADDR IN IO LIST
HRRM AC2,LBWRIT
AOJ AC2,
MOVEI AC3,^D80 ;TRANSFER TO OUTPUT BUFFER
ILDB AC4,AC1
SKIPLE LABEL ;SL?
HLRZ AC4,TRNTAB(AC4) ;TRANSLATE TO EBCDIC
IDPB AC4,AC2
SOJG AC3,.-4
MOVE AC1,TJFN
MOVEI AC2,LBWRIT
TLO AC2,(DM%NWT)
DUMPO ;WRITE LABEL
ERCAL ERROR
RET
;
; TEOFWT -- WRITE EOF LABELS
;
; INPUT: NONE
; OUTPUT: NONE
; RETURNS: +1=OK
;
TEOFWT: SKIPN LABEL
RET ;NO LABELS
CALL TOPEN
MOVE AC2,[POINT 7,[ASCIZ/EOF1/]]
MOVE AC1,[POINT 7,DSL1]
MOVEI AC3,0
CALL MOVBYT
MOVE AC1,[POINT 7,DSL1+^D10,27]
MOVE AC2,IOBCNT
MOVEI AC3,6
CALL DONOUT ;BLOCK COUNT
MOVE AC1,[POINT 7,DSL1]
MOVE AC2,[POINT 8,OUTBF1]
CALL TLBLWT ;WRITE EOF1
MOVE AC2,[POINT 7,[ASCIZ/EOF2/]]
MOVE AC1,[POINT 7,DSL2]
MOVEI AC3,0
CALL MOVBYT
MOVE AC1,[POINT 7,DSL2]
MOVE AC2,[POINT 8,OUTBF2]
CALL TLBLWT ;WRITE EOF2
CALL TCLOSE
RET
SUBTTL TAPE INPUT
;
; TAPE INPUT
; INPUT: NONE
; OUTPUT: INBCT,INRCT,INBPT
; RETURN: +1=EOF, +2=OK
;
TREAD: MOVE AC1,TJFN ;GET STATUS OF LAST READ
GDSTS
TRNE AC2,MT%DVE+MT%DAE
;[2] CALL ERROR
Jrst [ TMSG <
?Device or Data Error> ;[2]
HRRZ AC1,@OJFNP ;[2] CLOSE OUTPUT
TLO AC1,(CO%NRJ) ;[2] DON'T RELEASE JFN
CLOSF ;[2] close file
Jfcl ;[2] ok error
Call TCLOSE ;[2] close tape drive
Jrst $PARSE ] ;[2] parse again
TRNE AC2,MT%EOF ;EOF?
JRST TREOF ;YES
AOS IOBCNT ;COUNT # OF BLOCKS
HLRZ AC3,AC3
MOVE INBCT,AC3 ;SET INBCT,INRCT,INBPT
MOVEI INRCT,0
MOVE AC1,INLST
MOVE INBPT,-2(AC1)
MOVE AC1,-1(AC1) ;SWITCH BUFFERS
MOVEM AC1,INLST
TRD1ST: CALL TCLEAR
MOVE AC2,INLST ;IO LIST PTR
TLO AC2,(DM%NWT) ;DON'T WAIT FOR I/O
DUMPI
ERCAL ERROR
RETSKP
TREOF: TLO FLAGS,%EOF ;FLAG EOF
RET
SUBTTL TAPE OUTPUT
;
; TAPE OUTPUT
; INPUT: NONE
; OUTPUT: OUTBPT,OUTBCT,OUTRCT
; RETURN: +1=OK
;
TWRLST: MOVE AC3,BLKSZ ;WRITE LAST BLOCK IF NON-EMPTY
TLNE FLAGS,%VLR
SUBI AC3,8
CAMG AC3,OUTBCT
RET ;EMPTY
MOVE AC3,LRECL
TLNE FLAGS,%VLR
SUBI AC3,4
CAME AC3,OUTRCT
CALL TWLREC ;END LAST RECORD
TWRITE: TLNN FLAGS,%VLR
JRST TWNVLR ;NOT VARIABLE LENGTH RECORDS
MOVSI AC1,41000
HRR AC1,@OUTLST ;CONSTRUCT BYTE PTR TO BDW
MOVE AC2,BDWCT
CALL ADDDW ;ADD BLOCK DESCRIPTOR
LSH AC2,-2 ;UPDATE I/O LIST WRITE COUNT
MOVN AC2,AC2
HRLM AC2,@OUTLST
TWNVLR: MOVE AC1,TJFN ;GET STATUS OF LAST READ
GDSTS
TRNE AC2,MT%DVE+MT%DAE
;[2] CALL ERROR
Jrst [ TMSG <
?Device or Data Error> ;[2]
HRRZ AC1,@OJFNP ;[2] CLOSE OUTPUT
TLO AC1,(CO%NRJ) ;[2] DON'T RELEASE JFN
CLOSF ;[2] close file
Jfcl ;[2] ok error
RESET ;[2]
Jrst $PARSE ] ;[2] parse again
MOVE AC1,TJFN ;WRITE CURRENT OUTPUT BUFFER
MOVE AC2,OUTLST
TLO AC2,(DM%NWT)
DUMPO
ERCAL ERROR
AOS IOBCNT ;INCR BLOCK COUNT
MOVE AC2,OUTLST ;SWITCH BUFFERS
MOVE AC2,-1(AC2)
MOVEM AC2,OUTLST
TLNN FLAGS,%VLR
JRST TWBFCL ;FIXED LENGTH RECORDS
MOVE AC1,RDWPT ;SAVE PTR TO BYTES ALREADY READ FROM NXT RECORD
MOVEM AC1,WXTRAP ;(IF ANY) SINCE THEY DIDN'T FIT INTO THIS BLOCK
MOVE AC1,LRECL
SUB AC1,OUTRCT ;COMPUTE # OF SUCH BYTES
SUBI AC1,4
MOVEM AC1,WXTRAC
TWBFCL: MOVE AC2,OUTLST
MOVE OUTBPT,-2(AC2) ;SET OUTBPT, OUTBCT, OUTRCT
MOVE OUTBCT,BLKSZ
MOVE OUTRCT,LRECL
MOVE AC3,[BYTE (8) 40,40,40,40]
SKIPE DATA
MOVE AC3,[BYTE (8) 100,100,100,100]
SKIPN BLANKS
MOVEI AC3,0
MOVEM AC3,(OUTBPT) ;CLEAR OUTPUT BUFFER
HRL AC1,OUTBPT
HRR AC1,OUTBPT
ADDI AC1,1
HRRZ AC2,OUTBPT
BLT AC1,<<MAXBLK+3>/4-1>(AC2)
TLNN FLAGS,%VLR
RET ;WRITING FIXED LENGTH RECORDS
MOVEI AC1,4 ;ALLOCATE BLOCK DESCRIPTOR
MOVEM AC1,BDWCT ;INIT BLOCK DESCRIPTOR COUNT
SUB OUTBCT,AC1 ;ADJUST BLOCK COUNTER
ADJBP AC1,OUTBPT ;AND OUTPUT POINTER
MOVE OUTBPT,AC1
CALL TWRDW ;ALLOCATE RECORD DESCRIPTOR
SKIPG WXTRAC
RET ;NO BYTES READ FROM NEXT RECORD
MOVE AC2,WXTRAP
MOVE AC3,WXTRAC ;MOVE BYTES ALREADY READ TO START OF BUFFER
MOVEI AC1,4
ADJBP AC1,AC2
ILDB AC2,AC1
IDPB AC2,OUTBPT
SOJ OUTBCT,
SOJ OUTRCT,
AOS RDWCT
SOJG AC3,.-5
RET
TWRDW: MOVEM OUTBPT,RDWPT ;ALLOCATE RECORD DESCRIPTOR
MOVEI AC1,4
MOVEM AC1,RDWCT ;INIT RECORD DESCRIPTOR COUNT
SUB OUTBCT,AC1 ;ADJUST BLOCK COUNTER
SUB OUTRCT,AC1 ;AND RECORD COUNTER
ADJBP AC1,OUTBPT ;AND OUTPUT POINTER
MOVE OUTBPT,AC1
RET
TWLREC: AOS IORCNT ;BUMP RECORD COUNTER
TLNE FLAGS,%VLR
JRST WTVLRE ;VARIABLE LENGTH RECORDS
MOVE AC3,BLKSZ
SUB AC3,OUTBCT ;FIXED LENGTH
ADDI AC3,3
LSH AC3,-2 ;ROUND BYTES WRITTEN TO MULTIPLE OF 4
MOVN AC3,AC3 ;ADJUST I/O LIST WRITE COUNT
HRLM AC3,@OUTLST
RET
SUBTTL SKIP FILES
;
; SKIP FILES (TAPE MARKS)
; INPUT: AC4= FILE #
; OUTPUT: NONE
; RETURNS: +1=USER ERROR, +2=OK
;
SKPOPN: MOVE AC1,TJFN ;OPEN FOR SKIP ROUTINES
MOVE AC2,[17B9+OF%RD]
OPENF
Jrst [ CaiE AC1,OPNX8 ;[2] off-line?
ERCAL ERROR ;[2]
TMSG <?Device is Off-Line> ;[2]
Jrst $PARSE ] ;[2] back to parse
JRST SETPRM
;
LAST ;SKIP TO LAST FILE
EOT ;SKIP TO END OF TAPE
RSKP ;SKIP TO NEXT FILE
TSKIP: CAIG AC4,0 ;SYMBOLIC FILE #?
JRST @TSKIP-1(AC4) ;YES
SUB AC4,TFN ;COMPUTE # FILES TO SKIP
JUMPE AC4,RSKP ;NOTHING TO SKIP
JUMPL AC4,SKPBK ;BACKSPACE
SKIPE LABEL
IMULI AC4,3 ;3 FILES FOR EACH DATA FILE IF LABELLED
TRZ FLAGS,%EOT ;EOT IS ERROR
SKPFW: SETZM TSKPCT
CALL SKPOPN ;OPEN TAPE & SET PARAMETERS
MOVEI AC2,INLST1
DUMPI
JRST SKPEOT ;CHECK FOR EOF
SKPFOK: CALL TCLEAR
CALL TSKPTM ;SKIP A TAPE MARK
AOS TSKPCT
CALL TCLOSE
SOJG AC4,SKPFW+1 ;SKIP ALL FILES
MOVE AC3,TSKPCT
SKIPE LABEL
IDIVI AC3,3 ;UPDATE FILE #
ADD AC3,TFN
MOVEM AC3,TFN
RETSKP
SKPEOT: CAIE AC1,IOX4
JRST SKPFOK ;IGNORE ERRORS
MOVE AC3,TSKPCT
SKIPE LABEL ;UPDATE FILE #
IDIVI AC3,3
ADD AC3,TFN
MOVEM AC3,TFN
TRZE FLAGS,%EOT ;EOT OK?
RET ;YES
EOTERR: MOVE AC1,TJFN
MOVEI AC2,.MOBKF ;REPOSITION BEFORE LAST TM
MTOPR
ERCAL ERROR
CALL PCRIF
TMSG <?End of tape before specified file>
CALL TCLOSE
RET
SKPBK: CALL SKPOPN ;OPEN TAPE & SET PARAMETERS
MOVE AC3,TFN
ADD AC3,AC4 ;UPDATE FILE #
MOVEM AC3,TFN
CAIE AC3,1
JRST SKPBK1
MOVEI AC2,.MOREW ;1ST FILE= REWIND
MTOPR
ERCAL ERROR
CALL TCLOSE
SKIPN LABEL
RETSKP
CALL SKPOPN ;READ VOL LABEL
MOVEI AC2,LBREAD
DUMPI
ERCAL ERROR
CALL TCLOSE
RETSKP
SKPBK1: SKIPE LABEL
IMULI AC4,3 ;3 FILES FOR EACH DATA FILE IF LABELLED
MOVEI AC2,.MOBKF ;BACKSPACE TAPE
MTOPR
ERCAL ERROR
AOJLE AC4,.-1 ;BACKSPACE COUNT+1 TAPE MARKS
CALL TSKPTM ;SKIP OVER LAST TM
CALL TCLOSE
RETSKP
EOT: TRO FLAGS,%EOT ;ALLOW EOT
MOVEI AC4,-1 ;SKIP TO EOT
CALL SKPFW
MOVE AC1,TJFN
MOVEI AC2,.MOBKF ;BACKSPACE OVER LAST TAPE MARK
MTOPR
ERCAL ERROR
CALL TCLOSE
RETSKP
LAST: CALL EOT ;SKIP TO EOT
JFCL
HRROI AC4,-1 ;BACKSPACE 1 FILE
JRST SKPBK
SUBTTL CONVERT INPUT BYTE
;
; TRANSLATION TABLE: ASCII->EBCDIC,,EBCDIC->ASCII
; NON-TRANSLATABLES ARE TRANSLATED TO SUB'S
; BELIEVED TO BE THE SAME AS OPTCD=Q, EXCEPT:
; ASCII->EBCDIC: ! -> ! (INSTEAD OF VERT BAR)
; ^ -> CENT (NOT)
; TILDE -> NOT (TILDE)
; EBCDIC->ASCII: CENT -> ^ ([)
; NOT -> TILDE (^)
; ! -> ! (])
; [ -> [ (^Z)
; ] -> ] (^Z)
;
TRNTAB: 0,,0 ; NULL,,NULL
1,,1 ; SOH,,SOH
2,,2 ; STX,,STX
3,,3 ; ETX,,ETX
67,,32 ; EOT,,PF
55,,11 ; ENQ,,HT
56,,32 ; ACK,,LC
57,,177 ; BEL,,DEL
26,,32 ; BS,,GE
5,,32 ; HT,,RLF
45,,32 ; LF,,SMM
13,,13 ; VT,,VT
14,,14 ; FF,,FF
15,,15 ; CR,,CR
16,,16 ; SO,,SO
17,,17 ; SI,,SI
20,,20 ; DLE,,DLE
21,,21 ; DC1,,DC1
22,,22 ; DC2,,DC2
23,,23 ; DC3,,TM
74,,32 ; DC4,,RES
75,,32 ; NAK,,NL
62,,10 ; SYN,,BS
46,,32 ; ETB,,IL
30,,30 ; CAN,,CAN
31,,31 ; EM,,EM
77,,32 ; SUB,,CC
47,,32 ; ESC,,CU1
34,,34 ; FS,,IFS
35,,35 ; GS,,IGS
36,,36 ; RS,,IRS
37,,37 ; US,,IUS
100,,32 ; BLANK,,DS
132,,32 ; !,,SOS
177,,32 ; ",,FS
173,,32 ; #,,
133,,32 ; $,,BYP
154,,12 ; %,,LF
120,,27 ; &,,ETB
175,,33 ; ',,ESC
115,,32 ; (,,
135,,32 ; ),,
134,,32 ; *,,SM
116,,32 ; +,,CU2
153,,32 ; ,,,
140,,5 ; -,,ENQ
113,,6 ; .,,ACK
141,,7 ; /,,BEL
360,,32 ; 0,,
361,,32 ; 1,,
362,,26 ; 2,,SYN
363,,32 ; 3,,
364,,32 ; 4,,PN
365,,32 ; 5,,RS
366,,32 ; 6,,UC
367,,4 ; 7,,EOT
370,,32 ; 8,,
371,,32 ; 9,,
172,,32 ; :,,
136,,32 ; ;,,CU3
114,,24 ; <,,DC4
176,,25 ; =,,NAK
156,,32 ; >,,
157,,32 ; ?,,SUB
174,,40 ; @,,BLANK
301,,32 ; A,,
302,,32 ; B,,
303,,32 ; C,,
304,,32 ; D,,
305,,32 ; E,,
306,,32 ; F,,
307,,32 ; G,,
310,,32 ; H,,
311,,32 ; I,,
321,,136 ; J,,CENT SIGN
322,,56 ; K,,.
323,,74 ; L,,<
324,,50 ; M,,(
325,,53 ; N,,+
326,,41 ; O,,VERTICAL BAR
327,,46 ; P,,&
330,,32 ; Q,,
331,,32 ; R,,
342,,32 ; S,,
343,,32 ; T,,
344,,32 ; U,,
345,,32 ; V,,
346,,32 ; W,,
347,,32 ; X,,
350,,32 ; Y,,
351,,41 ; Z,,!
255,,44 ; [,,$
340,,52 ; \,,*
275,,51 ; ],,)
112,,73 ; ^,,;
155,,176 ; _,,NOT SIGN [136]
171,,55 ; GRAVE,,-
201,,57 ; a,,/
202,,32 ; b,,
203,,32 ; c,,
204,,32 ; d,,
205,,32 ; e,,
206,,32 ; f,,
207,,32 ; g,,
210,,32 ; h,,
211,,32 ; i,,
221,,174 ; j,,|
222,,54 ; k,,,
223,,45 ; l,,%
224,,137 ; m,,_
225,,76 ; n,,>
226,,77 ; o,,?
227,,32 ; p,,
230,,32 ; q,,
231,,32 ; r,,
242,,32 ; s,,
243,,32 ; t,,
244,,32 ; u,,
245,,32 ; v,,
246,,32 ; w,,
247,,32 ; x,,
250,,140 ; y,,GRAVE
251,,72 ; z,,:
300,,43 ; {,,#
152,,100 ; |,,@
320,,47 ; },,'
137,,75 ; TILDE,,=
7,,42 ; DEL,,"
77,,32 ;
77,,141 ; ,,a
77,,142 ; ,,b
77,,143 ; ,,c
77,,144 ; ,,d
77,,145 ; ,,e
77,,146 ; ,,f
77,,147 ; ,,g
77,,150 ; ,,h
77,,151 ; ,,i
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,152 ; ,,j
77,,153 ; ,,k
77,,154 ; ,,l
77,,155 ; ,,m
77,,156 ; ,,n
77,,157 ; ,,o
77,,160 ; ,,p
77,,161 ; ,,q
77,,162 ; ,,r
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,176 ; ,,TILDE
77,,163 ; ,,s
77,,164 ; ,,t
77,,165 ; ,,u
77,,166 ; ,,v
77,,167 ; ,,w
77,,170 ; ,,x
77,,171 ; ,,y
77,,172 ; ,,z
77,,32 ;
77,,32 ;
77,,32 ;
77,,133 ; ,,[
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,135 ; ,,]
77,,32 ;
77,,32 ;
77,,173 ; ,,{
77,,101 ; ,,A
77,,102 ; ,,B
77,,103 ; ,,C
77,,104 ; ,,D
77,,105 ; ,,E
77,,106 ; ,,F
77,,107 ; ,,G
77,,110 ; ,,H
77,,111 ; ,,I
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,175 ; ,,}
77,,112 ; ,,J
77,,113 ; ,,K
77,,114 ; ,,L
77,,115 ; ,,M
77,,116 ; ,,N
77,,117 ; ,,O
77,,120 ; ,,P
77,,121 ; ,,Q
77,,122 ; ,,R
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,134 ; ,,\
77,,32 ;
77,,123 ; ,,S
77,,124 ; ,,T
77,,125 ; ,,U
77,,126 ; ,,V
77,,127 ; ,,W
77,,130 ; ,,X
77,,131 ; ,,Y
77,,132 ; ,,Z
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,60 ; ,,0
77,,61 ; ,,1
77,,62 ; ,,2
77,,63 ; ,,3
77,,64 ; ,,4
77,,65 ; ,,5
77,,66 ; ,,6
77,,67 ; ,,7
77,,70 ; ,,8
77,,71 ; ,,9
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
;
; INPUT: AC1=BYTE
; OUTPUT: AC1=CONVERTED BYTE
; RETURNS: +1 ALWAYS
;
CHCASE: SKIPN CASE
RET ;NOCHANGE
SKIPG CASE
JRST LOWER ;LOWER
UPPER: CAIGE AC1,"a" ;CAPITALIZE ASCII LOWER CASE
RET ;NOT LOWER CASE
CAILE AC1,"z"
RET
TRZ AC1,40
RET
LOWER: CAIGE AC1,"A" ;CONVERT ASCII UPPER TO LOWER
RET ;NOT UPPER CASE
CAILE AC1,"Z"
RET
TRO AC1,40
RET
CONVRT: MOVE AC2,DATA ;CONVERT BYTE IN AC1
JRST @.+1(AC2)
CHCASE ;ASCII
CVT1 ;EBCDIC
CVT3: HRRZ AC1,TRNTAB(AC1) ;EBCDIC(READ), I.E EBCDIC->ASCII
JRST CHCASE
CVT1: TLNE FLAGS,%READ ;WRITE?
JRST CVT3 ;NO, READ
CALL CHCASE ;EBCDIC(WRITE), I.E. ASCII->EBCDIC
HLRZ AC1,TRNTAB(AC1) ;ASCII->EBCDIC
RET
SUBTTL READ INPUT BYTE
; INPUT: NONE
; OUTPUT: AC1=BYTE
; RETURNS: +1=EOF/COUNT EXHAUSTED, +2=BYTE IN AC1
;
READ: TLNE FLAGS,%READ ;READING FROM TAPE?
JRST RTAPE ;YES
RDISK: TRNE FLAGS,%XTAB ;EXPANDING TAB?
JRST RDTABX ;YES
RDGETB: CALL RDNXTB ;GET NEXT BYTE
RET ;EOF
SKIPG SKIP ;SKIP?
JRST RDPMK
CAIE AC1,15 ;END OF LINE?
JRST RDGETB
CALL RDNXTB
RET
CAIN AC1,12
SOS SKIP ;YES, DECR SKIP COUNT
JRST RDGETB
RDPMK: SKIPN LINOS ;FLUSH PAGE MARKS & LINE #S?
JRST RDNULL ;NO
MOVE AC2,(INBPT)
TRNN AC2,1 ;PAGE MARK OR LINE #?
JRST RDNULL ;NO
MOVEI AC3,5 ;FLUSH LINE # & TAB OR PAGE MARK & CR
MOVE AC2,INEOF ;DECR EOF COUNT
SUB AC2,AC3
MOVEM AC2,INEOF
SUB INBCT,AC3 ;DECR BLOCK COUNT
ADJBP AC3,INBPT ;ADJ BYTE PTR
MOVE INBPT,AC3
JRST RDGETB
RDNULL: SKIPE NULL ;FLUSH NULLS?
JUMPE AC1,RDGETB
JUMPN INCOL,RDCHK
TLNN FLAGS,%CC ;START OF RECORD: CC?
JRST RDCHK ;NO
CAIE AC1,12 ;LF?
JRST RDCCPG ;NO, CHECK FOR FF
MOVEI AC1,"0" ;1 LF => CC=0
MOVEM AC1,CC
CALL RDNXTB
RET
CAIE AC1,12
JRST RDCCPG
MOVEI AC1,"-" ;2 LF'S => CC=-
MOVEM AC1,CC
CALL RDNXTB
RET
CAIE AC1,12
JRST RDCCPG
RDCCBK: MOVE AC1,CC ;3 LF'S => CC= "-" & BLANK LINE
CALL WRITE
RET
TRO FLAGS,%EOL
MOVEI AC1," "
MOVEM AC1,CC
RETSKP
RDCCPG: CAIE AC1,14 ;^L?
JRST RDCCWR
MOVEI AC1,"1" ;CC="1"
MOVEM AC1,CC
CALL RDNXTB ;READ NEXT BYTE
RET
CAIN AC1,12
JRST RDCCBK ;^L & LF => CC= "1" & BLANK LINE
RDCCWR: PUSH P,AC1 ;SAVE CHAR
MOVE AC1,CC ;WRITE CARRIAGE CONTROL
CALL WRITE
JFCL
MOVEI AC1," " ;RESET CC
MOVEM AC1,CC
POP P,AC1 ;RESTORE CHAR
SKIPG COUNT
RET ;COUNT EXHAUSTED
RDCHK: CAIN AC1,14 ;FF?
JRST RDFF
CAIN AC1,11 ;TAB?
JRST RDTAB
CAIE AC1,15 ;CR?
JRST RDICOL
RDCR: CALL RDNXTB ;CRLF?
RETSKP ;EOF, WRITE CR
CAIN AC1,12
JRST RDEOL ;YES
TLNN FLAGS,%CC ;CC?
JRST RDWRCR ;NO, WRITE CR
MOVEI AC2,"+" ;SET CC
MOVEM AC2,CC
PUSH P,AC1 ;SAVE NEXT CHAR
TRO FLAGS,%EOL ;FLAG END OF LINE
MOVEI AC1," " ;REPLACE CR WITH BLANK
MOVEI INCOL,0
JRST RDWRTB
RDEOL: HRROI INCOL,-2 ;RESET COL CNT IN CASE EOR=LRECL
SKIPE EOR ;EOR=CRLF?
JRST RDWRCR ;NO, WRITE CRLF
TRO FLAGS,%EOL ;FLAG EOL
MOVEI AC1," " ;REPLACE WITH BLANK
MOVEI INCOL,0 ;RESET INPUT COLUMN
RETSKP
RDWRCR: PUSH P,AC1 ;SAVE NEXT CHAR
AOJ INCOL,
MOVEI AC1,15 ;WRITE CR
RDWRTB: CALL WRITE
JFCL
POP P,AC1 ;WRITE NEXT CHAR
SKIPG COUNT
RET ;COUNT EXHAUSTED
JRST RDPMK
RDFF: SKIPE FF ;FLUSH FF?
JRST RDGETB
RDICOL: AOJ INCOL, ;INCR COLUMN COUNT
RETSKP
RDTAB: SKIPN TAB ;EXPAND TABS?
JRST RDICOL ;NO
TRO FLAGS,%XTAB ;SET TAB FLAG
RDTABX: AOJ INCOL, ;RETURN BLANKS TILL COL MOD 8=0
TRNN INCOL,7
TRZ FLAGS,%XTAB
MOVEI AC1," "
RETSKP
RDNXTB: SKIPG INEOF
RET ;EOF
JUMPG INBCT,RDNXLD
MOVE AC1,INPG ;MAP NEW DISK PAGE
MOVE AC2,[XWD .FHSLF,INBPG]
MOVE AC3,[PM%CNT+PM%RD+BUFL]
PMAP
MOVEI INBCT,5000*BUFL ;RESET PAGE COUNT & BYTE POINTER
MOVE INBPT,[POINT 7,INBUF1]
MOVE AC1,INPG ;INCR INPUT PAGE #
ADDI AC1,BUFL
MOVEM AC1,INPG
RDNXLD: ILDB AC1,INBPT ;GET NEXT BYTE
SOS INEOF ;DECR EOF COUNT
SOJ INBCT, ;DECR PAGE COUNT
RETSKP
RTAPE: CALL RTNXTB ;GET NEXT BYTE
RET ;EOF
SKIPLE SKIP
JRST RTAPE ;SKIP
RTFL72: CAMGE INRCT,RTEEOR
JRST RTAPE ;THROW OUT 72-80
SKIPE NULL ;FLUSH NULLS?
JUMPE AC1,RTAPE
CAIN AC1,14 ;FF?
JRST RTFF
SKIPE EOR
RETSKP ;LOGICAL EOR AT LRECL CHARS
CAIE AC1,15 ;CR?
RETSKP
CALL RTNXTB ;CRLF?
RET ;EOF
CAIE AC1,12
JRST RTCR ;NO, ONLY CR
CALL RTLEOR ;LOGICAL EOR
RET ;EOF
JRST RTAPE
RTCR: PUSH P,AC1 ;NO, ONLY CR
MOVEI AC1,15
CALL WRITE ;SO WRITE IT
JFCL
POP P,AC1 ;RESTORE NEXT CHAR
SKIPG COUNT
RET ;COUNT EXHAUSTED
JRST RTFL72
RTFF: SKIPE FF ;FLUSH FF?
JRST RTAPE
RETSKP
RTNXTB: JUMPG INBCT,RTRCT ;READ NEXT BYTE
RTNXT1: CALL RTREAD ;READ NEXT RECORD
RET
RTRCT: JUMPG INRCT,RTGETB
SKIPG SKIP
AOS IORCNT ;INCR RECORD COUNT
CALL RTSOR ;TAPE EOR
JRST RTNXT1 ;RECORD CONTAINED PADDING ONLY
SKIPN EOR
JRST RTNXTB ;LOGICAL EOR IS AT CRLF
CALL RTLEOR ;LOGICAL EOR AT TAPE EOR
RET ;EOF
JRST RTNXTB
RTGETB: ILDB AC1,INBPT ;GET NEXT BYTE
CALL CONVRT ;CONVERT BYTE
SOJ INBCT,
SOJA INRCT,RSKP
RTREAD: CALL TREAD ;START NEXT READ
JRST RTEOF ;EOF
CAMLE INBCT,BLKSZ ;RECORD(S)>BLKSIZE?
TRO FLAGS,%BIGBK ;YES
MOVE AC1,BLKPFX ;STRIP OFF BLOCK PREFIX (BDW)
MOVE AC2,RECFM
ANDI AC2,$B-1
CAIN AC2,$V
MOVEI AC1,4
JUMPE AC1,RSKP
SUB INBCT,AC1
ADJBP AC1,INBPT
MOVE INBPT,AC1
RETSKP
RTEOF: SKIPLE SKIP ;EOF -> EOR
RET
AOS IORCNT ;COUNT LAST RECORD
CALL TRLBLK ;DEAL WITH BLANKS
MOVE AC2,[POINT 7,[BYTE (7) 15,12]]
CALL RTWEOR ;WRITE EOR
JFCL
RET
RTSOR: MOVE AC1,RECFM ;START OF TAPE RECORD
ANDI AC1,$B-1
JRST @[ RTD
RTF
RTU
RTV ](AC1) ;DISPATCH ON RECFM
RTF: MOVE INRCT,LRECL ;RESET RECORD COUNT
RETSKP
RTD: MOVE AC1,INBPT ;READ 4 BYTE ASCII LENGTH
MOVEI AC2,4
CALL DONIN
JUMPG AC3,RTD1
ILDB AC2,INBPT ;CHECK FOR END OF BLOCK (PADDING)
CAIN AC2,"^"
RET ;END OF BLOCK
RTD1: MOVE INBPT,AC1
MOVE INRCT,AC3
JRST RTVEND
RTV: ILDB INRCT,INBPT ;READ 2 BYTE BINARY LENGTH
LSH INRCT,10
ILDB AC2,INBPT
IOR INRCT,AC2
IBP INBPT ;SKIP 2 UNUSED BYTES
IBP INBPT
RTVEND: SUBI INBCT,4 ;DECR BLOCK COUNT
CAMLE INRCT,LRECL ;RECORD > LRECL?
TRO FLAGS,%CHOP ;YES (PROBABLY NOT VARIABLE LENGTH)
SUBI INRCT,4 ;RECORD COUNT INCLUDES 4 BYTE LENGTH
CAIGE INRCT,0
MOVEI INBCT,0 ;PROCESS NULL RECORD, RECFM=V
RETSKP
RTU: MOVE INRCT,INBCT ;RECFM=U, SET RECORD COUNT=BLOCK COUNT
RETSKP
RTLEOR: SOS SKIP ;END OF LOGICAL RECORD
JUMPE OUTEOF,RTLSOR ;1ST RECORD
CALL TRLBLK ;DEAL WITH TRAILING BLANKS
MOVE AC2,[POINT 7,[BYTE (7) 15]]
TLNN FLAGS,%CC
MOVE AC2,[POINT 7,[BYTE (7) 15,12]]
CALL RTWEOR ;WRITE CR(LF)
RET
SOSG COUNT
RET ;COUNT EXHAUSTED
RTLSOR: SKIPLE SKIP ;START OF LOGICAL RECORD
RETSKP
TLNN FLAGS,%CC ;CC?
JRST RTCLRC
CALL RTNXTB ;YES, PROCESS IT
RET ;EOF
CAIN AC1,"+" ;CC="+"?
JRST RTCLRC
MOVE AC2,[POINT 7,[BYTE (7) 12]]
CAIN AC1,"0"
MOVE AC2,[POINT 7,[BYTE (7) 12,12]]
CAIN AC1,"-"
MOVE AC2,[POINT 7,[BYTE (7) 12,12,12]]
CAIE AC1,"1"
MOVE AC2,[POINT 7,[BYTE (7) 12,14]]
RTWCC: CAIG OUTEOF,0
ILDB AC1,AC2 ;REMOVE 1 LF IF 1ST RECORD
CALL RTWTCC ;WRITE CC
RET
RTCLRC: MOVEI OUTCOL,0 ;RESET COLUMN COUNT
RETSKP
RTWEOR: LDB AC1,OUTBPT ;WRITE EOR
CAIE AC1,12 ;BLANK LINE?
SETZM LNBEOF ;NO
SKIPN LNBEOF
JRST RTWTCC
MOVE AC1,[XWD IORCNT,IORSAV]
BLT AC1,IOBSAV ;SAVE RECORD/BLOCK COUNTS TO REMOVE BLANK LINES
MOVE AC1,[XWD OUTCOL,LNBCOL]
BLT AC1,LNBEOF ;SET LAST NONBLANK LINE PTRS
RTWTCC: MOVEM AC2,CC ;WRITE CC
RTWTC1: ILDB AC1,CC
JUMPE AC1,RSKP ;DONE
CALL WRITE
RET
JRST RTWTC1 ;LOOP
SUBTTL WRITE OUTPUT BYTE
; INPUT: AC1=BYTE
; OUTPUT: NONE
; RETURNS: +1=COUNT EXHAUSTED, +2=OK
;
WRITE: TLNE FLAGS,%READ ;WRITING TO DISK?
JRST WDISK ;YES
JUMPLE OUTRCT,WTEOR ;JUMP IF END OF RECORD
WTAPE: CALL CONVRT ;CONVERT BYTE
IDPB AC1,OUTBPT ;WRITE NEXT BYTE
AOS RDWCT ;INCR RECORD DESCRIPTOR COUNT
SOJ OUTBCT, ;DECR BLOCK COUNT
SOJG OUTRCT,.+3 ;DECR RECORD COUNT
SKIPE EOR ;EOR
JRST WTEOL ;EOR IS EOL ALSO
TRZN FLAGS,%EOL ;END OF LINE?
JRST WTOUT ;NO
WTEOL: TLNN FLAGS,%VLR
JRST WTFLR ;WRITING FIXED LENGTH RECORDS
CALL WTVLRE ;END VARIABLE RECORD
MOVE OUTRCT,LRECL
CALL TWRDW ;RESERVE SPACE FOR RECORD DESCRIPTOR
JRST WTCNT
WTFLR: JUMPE OUTRCT,WTCNT-1 ;END OF RECORD?
SUB OUTBCT,OUTRCT ;NO, SKIP TO NEW LRECL
ADJBP OUTRCT,OUTBPT ;DECR BLOCK COUNT, ADJ BYTE POINTER
MOVE OUTBPT,OUTRCT
MOVE OUTRCT,LRECL ;RESET RECORD COUNTER
WTCNT: SOS COUNT ;DECR COUNT
AOS IORCNT ;INCR RECORDS PROCESSED
WTOUT: MOVEI AC1,<MINREC+3>/4*4
TLNN FLAGS,%VLR
MOVEI AC1,1
CAMGE OUTBCT,AC1
CALL WTFBLK ;WRITE FULL BLOCK
SKIPG COUNT
RET ;COUNT EXHAUSTED
RETSKP
WTFBLK: CAIG OUTRCT,0
AOS IORCNT ;HERE ONLY IF RECFM=F & LINE=BLKSIZE
JRST TWRITE
WTEOR: CAIE AC1," " ;TRUNCATING?
TRO FLAGS,%CHOP ;YES
TRZE FLAGS,%EOL ;END OF LINE?
JRST WTEOL ;YES, PROCESS EOL
RETSKP
IBP OUTBPT ;ROUND RECORD LENGTH TO MULTIPLE OF 4
SOJ OUTBCT, ;NOTE THAT LRECL IS A MULT OF 4
AOS RDWCT
WTVLRE: MOVE AC1,RDWCT
TRNE AC1,3
JRST .-5
MOVEI AC4,<MINREC+3>/4*4
SUB AC4,RDWCT
JUMPLE AC4,WTRLOK
SUB OUTBCT,AC4 ;INSURE RECORD IS (AT LEAST) 20 BYTES LONG
ADJBP AC4,OUTBPT
MOVE OUTBPT,AC4
MOVEI AC4,<MINREC+3>/4*4
MOVEM AC4,RDWCT
WTRLOK: MOVE AC1,RDWPT ;ADD DESCRIPTOR TO RECORD
MOVE AC2,RDWCT
CALL ADDDW
ADD AC2,BDWCT ;INCR BLOCK DESCRIPTOR COUNT
MOVEM AC2,BDWCT
MOVE AC1,RECFM
TRNN AC1,$B
MOVEI OUTBCT,0 ;NOT BLOCKED: EOR IS EOB
RET
WDISK: MOVE AC2,BLANKS ;STRIP BLANKS OR REPLACE WITH TABS?
ADD AC2,TAB
JUMPE AC2,WDDPB ;NO
CAIE AC1," " ;BLANK?
JRST WDNBK ;NO
TRNE FLAGS,%BLK ;1ST BLANK OF BLANK(S)?
JRST WDDPB ;NO
MOVE AC2,[XWD OUTCOL,SBKCOL]
BLT AC2,SBKEOF ;SET PTRS TO START OF BLANKS
TRO FLAGS,%BLK ;SET FLAG
JRST WDDPB
WDNBK: PUSH P,AC1 ;SAVE CURRENT CHARACTER
TRZE FLAGS,%BLK ;RESET BLANKS FLAG
CALL SQUEEZ ;REPLACE BLANKS WITH TAB(S)?
POP P,AC1
WDDPB: IDPB AC1,OUTBPT ;WRITE NEXT BYTE
AOJ OUTEOF, ;INCR EOF COUNT
AOJ OUTCOL, ;INCR COLUMN COUNT
SOJG OUTBCT,RSKP ;DECR PAGE COUNT
WDMAP: HlrZ AC1,OUTPG ;[8] Get JFN of output device
DVCHR ;[8] get Device characteristics
And AC2,[777,,0] ;[8] mask out junk and get type of device
JumpE AC2,WrDSK ;[8] if disk do efficient PMAP to disk
HlrZ AC1,OUTPG ;[8] get JFN of Output again
MoveI AC2,OUTBPG ;[8] get page number of output
LSH AC2,11 ;[8] make it an address
HrlI AC2,440700 ;[8] now a byte pointer
MoveI AC3,OutLen ;[8] number of bytes
IMulI AC3,5 ;[8] 5 chars per word
WrLp: SetZ AC4, ;[8] stop on NULL
SOUT ;[8] dump to device
ERCAL ERROR ;[8] just in case of error
Aos MBfCnt ;[8] add one to mapped buffer count
Call WDSET ;[8] init
RetSkp ;[8] return
WrDsk: ;[8] new label
MOVE AC1,[XWD .FHSLF,OUTBPG]
MOVE AC2,OUTPG
MOVE AC3,[PM%WR+PM%CNT+BUFL]
PMAP ;WRITE TO DISK
MOVE AC1,OUTPG ;INCR OUTPUT PAGE #
ADDI AC1,BUFL
MOVEM AC1,OUTPG
CALL WDSET ;INITIALIZE
RETSKP
WDSET: MOVEI OUTBCT,5000*BUFL ;RESET OUTPUT BLOCK COUNT & BYTE POINTER
MOVE OUTBPT,[XWD OUTBF1,OUTBF1+1]
SETZM OUTBF1
BLT OUTBPT,OUTBF1+1000*BUFL-1 ;CLEAR THE OUTPUT BUFFER
MOVE OUTBPT,[POINT 7,OUTBF1]
RET
SUBTTL EXECUTE COMMAND
; INPUT: NONE
; OUTPUT: NONE
; RETURNS: +1=DONE
;
EXEC: TLCE FLAGS,%READ+%WRITE ;CHECK FOR CONSISTENCY
TLCN FLAGS,%READ+%WRITE
WARN <Internal error: both read and write flags set>
TLNE FLAGS,%READ ;READ?
JRST EXREAD ;YES
MOVE AC4,@OJFNP
CALL TSKIP ;POSITION TAPE
RET ;POSITION ERROR
EXWRT: MOVE AC1,BLKSZ
LSH AC1,-2 ;COMPUTE # OF WORDS FOR I/O LISTS
MOVN AC1,AC1
HRLM AC1,OUTLS1
HRLM AC1,OUTLS2
CALL THDRWT ;WRITE ANY HEADER LABELS
CALL TOPEN
SETZM IORCNT ;RESET RECORDS PROCESSED
SETZM IOBCNT ;RESET BLOCKS PROCESSED
CALL TWBFCL ;INIT OUTPUT VARIABLES
HRRZ AC1,@IJFNP ;GET INPUT JFN
MOVE AC2,[7B5+OF%RD+OF%PLN]
OPENF ;OPEN INPUT FILE
ERCAL ERROR
HRLZM AC1,INPG ;INIT INPUT PAGE
MOVE AC2,[2,,11] ;CALCULATE EOF
MOVEI AC3,AC1
GTFDB ;AC1=BYTE SIZE, AC2=EOF COUNT
LSH AC1,6 ;ISOLATE BYTE SIZE
LSH AC1,-^D30
MOVEI AC3,^D36
IDIV AC3,AC1 ;# BYTES/WORD
IDIV AC2,AC3 ;# WORDS IN FILE
CAIE AC3,0
AOJ AC2,
IMULI AC2,5 ;# 7 BIT BYTES IN FILE
MOVEM AC2,INEOF ;INIT EOF COUNT
MOVEI INBCT,0 ;INIT PAGE COUNT
MOVEI INCOL,0 ;INIT COLUMN COUNT
HRRZ AC2,@IJFNP ;PRINT INPUT FILE NAME
CALL PRTFIL
CALL PRTARW ;PRINT =>
CALL PRTTFN ;PRINT TAPE FILE #
EXGO: CALL READ ;READ NEXT BYTE
JRST EXEOF ;EOF
CALL WRITE ;WRITE BYTE
JRST EXEOF ;COUNT EXHAUSTED
JRST EXGO
EXREAD: MOVE AC4,@IJFNP ;GET TAPE FILE #
CALL TSKIP ;POSITION TAPE
RET ;POSITION ERROR
CALL THDRRD ;READ ANY HEADER LABELS
FMTERR <Tape not labelled as specified>
CALL TOPEN
SETZM IORCNT ;RESET RECORDS PROCESSED
SETZM IOBCNT ;RESET BLOCKS PROCESSED
SetZM MBfCnt ;[8] zero mapped buffer count
CALL TRD1ST ;START 1ST READ
JFCL
MOVEI OUTEOF,0 ;INIT OUTPUT EOF COUNT
MOVE AC1,@OJFNP ;OPEN DISK FOR OUTPUT
JUMPG AC1,EXREA5 ;A GOOD JFN WAS SPECIFIED
SKIPE LABEL ;WE BETTER HAVE A LABEL!
JRST EXREA4 ;WE DO. USE IT
EXREA3: HRROI AC1,CMABUF ;BAD LABEL, OR NONE. MAKE A FILE NAME
HRROI AC2,[ASCIZ/TAPEIO-FILE-/]
SETZ AC3,
SOUT
MOVE AC2,TFN
MOVEI AC3,^D10
NOUT
SETZ AC3, ;END WITH A NULL
IDPB AC3,AC1
EXREA4: MOVSI AC1,(GJ%FOU+GJ%SHT)
HRROI AC2,CMABUF ;POINT TO STRING FROM HEADER, IF ANY
GTJFN
ERJMP EXREA3
MOVEM AC1,@OJFNP
EXREA5: MOVE AC2,[7B5+OF%WR]
OPENF
ERCAL ERROR
HRLZM AC1,OUTPG ;INIT OUTPUT PAGE
CALL WDSET ;INIT OUTPUT VARS
CALL PRTTFN ;PRINT TAPE FILE #
CALL PRTARW ;PRINT =>
HRRZ AC2,@OJFNP ;PRINT OUTPUT FILE
CALL PRTFIL
EXREA6: CALL RTREAD ;START 2ND READ
JRST [ SKIPN LABEL ;A NULL FILE ON A LABELLED TAPE IS NOT ERROR
JRST EOTERR ;TAPE EMPTY IS AN ERROR IF UNLABELLED
JRST EXEOF ]
CALL RTSOR ;START OF 1ST TAPE RECORD
JRST EXREA6 ;IT WAS ALL PADDING???
CALL RTLSOR ;START OF 1ST LOGICAL RECORD
JFCL
JRST EXGO ;READ THE TAPE
EXEOF: TLNN FLAGS,%READ ;READ?
JRST EXWEOF ;NO, WRITE
EXREOF: MOVE AC1,[XWD LNBCOL,SBKCOL]
BLT AC1,SBKEOF ;POINT TO LAST NONBLANK LINE
SKIPN BLANKS
SETZM LNBEOF ;NOT REMOVING
SKIPE LNBEOF
CALL RESET ;REMOVE BLANK LINE(S)
SOS IORSAV
MOVE AC1,[XWD IORSAV,IORCNT]
SKIPE LNBEOF
BLT AC1,IOBCNT ;RESET RECORD/BLOCK COUNTERS
CAIN OUTBCT,5000*BUFL ;[8] EMPTY PAGE?
Jrst ClosFl ;[8] nothing there to output!
SetZM NotDSK ;[8] assume a disk output
HlrZ AC1,OUTPG ;[8] Get JFN of output device
DVCHR ;[8] get Device characteristics
And AC2,[777,,0] ;[8] mask out junk and get type of device
JumpE AC2,OnDSK ;[8] if disk do efficient PMAP to disk
SetOM NotDSK ;[8] device is non-disk
HlrZ AC1,OUTPG ;[8] get JFN of Output again
MoveI AC2,OUTBPG ;[8] get page number of output
LSH AC2,11 ;[8] make it an address
HrlI AC2,440700 ;[8] now a byte pointer
Move AC3,OUTEOF ;[8] number of bytes
Move AC4,MBfCnt ;[8] get number of times buffer was mapped
IMulI AC4,OutLen ;[8] times number of words per buffer
IMulI AC4,5 ;[8] times number of bytes per word
Sub AC3,AC4 ;[8] find difference
SetZ AC4, ;[8] stop on NULL
SOUT ;[8] dump to device
ERCAL ERROR ;[8] just in case of error
Jrst ClosFl ;[8] close output device
OnDsk: ;[8] new label
MOVE AC1,[XWD .FHSLF,OUTBPG]
MOVE AC2,OUTPG ;MAP LAST PAGE(S)
HRRZ AC3,OUTBPT ;COMPUTE REPEAT COUNT
LSH AC3,-11
SUBI AC3,OUTBPG-1
HRLI AC3,(PM%WR+PM%CNT)
;[8] remove next instruction and move it up to check before calculating
;[8] CAIE OUTBCT,5000*BUFL ;EMPTY PAGE?
PMAP ;NO
ERCAL ERROR ;[7] trap errors
ClosFl: ;[8] new label
HRRZ AC1,@OJFNP ;CLOSE OUTPUT
TLO AC1,(CO%NRJ) ;DON'T RELEASE JFN
CLOSF
ERCAL ERROR
SkipE NotDSK ;[8] on Disk?
Jrst RdDone ;[8] nope, so forget the FDB stuff
HRRZ AC1,@OJFNP ;UPDATE FILE BYTE SIZE
TLO AC1,(CF%NUD+11B17)
HRLZI AC2,(FB%BSZ)
MOVSI AC3,700 ;TO 7 BIT BYTES
CHFDB
HRRZ AC1,@OJFNP ;UPDATE FILE EOF COUNT
TLO AC1,(12B17)
HRROI AC2,-1
MOVE AC3,OUTEOF
CHFDB
RdDone: ;[8] new label
HRROI AC1,[ASCIZ/ [OK] /]
TRZE FLAGS,%BIGBK
HRROI AC1,[ASCIZ/ [block(s) > blksize] /]
TRZE FLAGS,%CHOP
HRROI AC1,[ASCIZ/ [record(s) > lrecl] /]
Move AC2,AC1 ;[11]
PSOUT
SkipN AC1,LOGJFN ;[11]
Jrst .+3 ;[11]
SetZ AC3, ;[11]
SOUT ;[11]
CALL PRTCFM ;PRINT CONFIRMATION
HRRZ AC1,@OJFNP
RLJFN ;RELEASE JFN
ERCAL ERROR
AOS TFN ;INCR FILE #
TLNN FLAGS,%EOF
CALL TSKPTM ;COUNT EXHAUSTED, SKIP TM
CALL TCLOSE
CALL TEOFRD ;READ EOF LABELS
MOVE AC1,@IJFNP ;END OF INPUT FILES?
CAIE AC1,0
AOS IJFNP ;NO, INCR TO NEXT
AOS OJFNP ;INCR OUTPUT JFN POINTER
MOVE AC1,@OJFNP ;GET NEXT JFN
JUMPN AC1,EXREAD ;PROCESS IT
RET ;0->DONE
EXWEOF: CALL TWRLST ;WRITE LAST BLOCK IF NOT EMPTY
CALL TCLOSE
AOS TFN ;INCR TAPE FILE #
CALL TEOFWT ;WRITE EOF LABELS
HRROI AC1,[ASCIZ/ [OK] /]
TRZE FLAGS,%CHOP
HRROI AC1,[ASCIZ/ [record(s) truncated] /]
Move AC2,AC1 ;[11]
PSOUT
SkipN AC1,LOGJFN ;[11]
Jrst .+3 ;[11]
SetZ AC3, ;[11]
SOUT ;[11]
CALL PRTCFM ;PRINT CONFIRMATION
CALL UNMAP ;UNMAP INPUT FILE
HRRZ AC1,@IJFNP ;CLOSE INPUT
TLO AC1,(CO%NRJ) ;DON'T RELEASE JFN
CLOSF
ERCAL ERROR
EXWJFN: MOVE AC1,@IJFNP ;ANOTHER FILE FOR THIS JFN?
GNJFN
JRST EXWNFL ;NO, LOOK FOR ANOTHER FILE
HRRZ AC1,AC1
MOVE AC2,[1,,1] ;CHECK IF THIS IS A DIRECTORY
MOVEI AC3,3
GTFDB
TLNE AC3,(FB%DIR)
JRST EXWJFN ;DON'T PROCESS DIRECTORIES
JRST EXWRT
EXWNFL: AOS IJFNP ;ANOTHER INPUT FILE?
SKIPE AC1,@IJFNP
JRST EXWRT ;YES, PROCESS IT
RET ;NO, DONE
SUBTTL MAIN PROGRAM
TAPEIO: RESET ;START HERE
SETZM TAPDES ;[9] assume no tape drives
SetZM LOGJFN ;[11] assume not logging
MOVE P,[IOWD STKL,STACK]
TMSG <TAPEIO version of 14-January-1982.
Modified by Willis Dair@SCU 18-Oct-82
Type "HELP" for help.
>
CALL ASSIGN ;GET A TAPE DRIVE IF POSSIBLE
$PARSE: MOVEI AC2,[FLDDB. .CMINI] ;INIT COMND
CALL DOCMND
$REPAR: MOVE P,[IOWD STKL,STACK] ;RESET THE STACK ON A REPARSE
HRROI AC1,-1 ;REPARSE STARTS HERE
RLJFN ;RELEASE ALL JFN'S
JFCL
SETZM TJFN ;NOTE THAT TAPE JFN HAS BEEN RELEASED
CALL INIT ;INITIALIZE THE VARIOUS PARAMETERS
MOVEI AC2,[FLDDB. .CMKEY,,COMTAB] ;PARSE COMMAND
CALL DOCMND
HRRZ AC2,(AC2)
CALL CHKTAP ;DO WE HAVE A TAPE DRIVE ASSIGNED?
JRST $PARSE ;NO, USER MUST GIVE TAPE COMMAND
CALL (AC2) ;PARSE REST OF COMMAND
JRST $PARSE
;CHKTAP - MAKE SURE USER HAS TAPE DRIVE ASSIGNED
;TAKES AC2/ ADDRESS OF A COMMAND
;RETURNS +1 IF ASSIGNED OR ONE OF HELP OR TAPE COMMANDS
; +2 USER HAS BEEN TOLD TO USE TAPE COMMAND
CHKTAP: SKIPE TAPDES ;DO WE HAVE A TAPE DRIVE?
RETSKP ;YES, SKIP RETURN
CAIE AC2,$HELP
CAIN AC2,$TAPE
RETSKP ;ALLOW HELP OR TAPE IF NO DRIVE ASSIGNED
CAIE AC2,$QUIT
CAIN AC2,$DISPL
RETSKP ;ALLOW QUIT OR DISPLAY AS WELL
CAIE AC2,$REVER ;[3] allow REVERT
CAIN AC2,$DEFAU ;[3] also allow DEFAULT
RETSKP ;[3]
CAIE AC2,$LOG ;[3] allow logging
CAIN AC2,$NOLOG ;[3] and nolog too
RETSKP ;[3]
CAIE AC2,$DELET ;[3]
CAIN AC2,$DEFIN ;[3]
RETSKP ;[3]
CAIE AC2,$DUMP ;[3]
CAIN AC2,$SAVE ;[3]
RETSKP ;[3]
CALL PCRIF
TMSG <?You must use the TAPE-DRIVE command to specify a tape drive.>
RET ;TELL USER WHAT'S UP
;INITIALIZE VARIABLES BETWEEN REPARSES
INIT: SETOM SWSET ;-1 MEANS NO VALUE SET
MOVE AC1,[XWD SWSET,SWSET+1]
BLT AC1,SWSET+SWLEN-1 ;NO NEW SWITCH VALUES SET YET
MOVEI FLAGS,0 ;RESET FLAGS
MOVEI AC1,IJFNL ;INIT INPUT JFN POINTER
MOVEM AC1,IJFNP
MOVEI AC1,OJFNL ;INIT OUTPUT JFN POINTER
MOVEM AC1,OJFNP
MOVE AC1,[377777,,777777]
MOVEM AC1,COUNT ;INIT COUNT TO ALL
SETZM SKIP ;INIT SKIP TO NONE
MOVEI AC1," " ;INIT CARRIAGE CONTROL
MOVEM AC1,CC
SETZM LNBEOF ;INIT LAST BLANK LINE FLAG
SETZM WXTRAC ;INIT EXTRA READ COUNTER
RET
;ROUTINE TO ACTUALLY DO A COMND% JSYS
;CALL: AC2/ SET UP FOR COMND
;RET: +1 NORMALLY
; ON ERR, RETURNS VIA NONLOCAL GOTO TO $PARSE.
DOCMND: MOVE AC1,CSB+.CMPTR
MOVEM AC1,OCMPTR ;SAVE CURRENT .CMPTR VALUE
MOVEI AC1,CSB
SetZM EOFFlg
COMND ;THE ONLY COMND JSYS IN THE PROGRAM
Erjmp [MoveI AC1,.FHSLF ;[13] this process
GETER ;[13] Get the last error
HrrZ AC2,AC2 ;[13] get the right side
CaiE AC2,IOX4 ;[13] see if end of file
ERCAL ERROR ;[13] nope, may be REAL error
SetOM EOFflg ;[13] lite flag
Ret ] ;[13] return
TXNN AC1,CM%NOP
RET ;GOOD RETURN
CALL PCRIF
TMSG <?Unrecognized command - >
MOVEI AC1,.PRIOU
HRLOI AC2,.FHSLF
SETZ AC3,
ERSTR
JFCL
JFCL
SkipN AC1,LOGJFN ;[11]
Jrst .+4 ;[11]
ERSTR ;[11]
JFCL ;[11]
JFCL ;[11]
DOCMN0: TMSG < - >
MOVE AC1,CSB+.CMPTR ;POINTER TO REST OF "BAD" LINE
Move AC2,AC1 ;[11]
PSOUT
SkipN AC1,LOGJFN ;[11]
Jrst .+3 ;[11]
SetZ AC3, ;[11]
SOUT ;[11]
CALL PCRIF
TMSG <(Hint: Type BACKSPACE and a question mark for help.)
>
JRST $PARSE ;NONLOCAL GOTO
;CONFRM - PARSE A CARRIAGE RETURN
CONFRM: MOVEI AC2,[FLDDB. .CMCFM]
CALL DOCMND
SkipN LOGJFN ;[11]
Ret ;[11]
PUSH P,AC1 ;[11]
PUSH P,AC2 ;[11]
PUSH P,AC3 ;[11]
Move AC1,LOGJFN ;[11]
Move AC2,CSB+.CMRTY ;[11]
SetZ AC3, ;[11]
SOUT ;[11]
Move AC2,CSB+.CMBFP ;[11]
SetZ AC3, ;[11]
SOUT ;[11]
Pop P,AC3 ;[11]
Pop P,AC2 ;[11]
Pop P,AC1 ;[11]
RET
;$WARN - USED BY WARN MACRO TO REPORT USER ERRORS WHILE PARSING
$WARN: PUSH P,AC1
CALL PCRIF
TMSG <?Invalid option - >
POP P,AC1
Move AC2,AC1 ;[11]
PSOUT
SkipN AC1,LOGJFN ;[11]
Jrst .+3 ;[11]
SetZ AC3, ;[11]
SOUT ;[11]
TMSG < - ">
MOVE AC1,OCMPTR
Move AC2,AC1 ;[11]
PSOUT
SkipN AC1,LOGJFN ;[11]
Jrst .+3 ;[11]
SetZ AC3, ;[11]
SOUT ;[11]
TMSG <"
(Hint: Type BACKSPACE, then enter correct value.)
>
MOVE AC1,OCMPTR
MOVEM AC1,CSB+.CMPTR ;PUT BACK OLD .CMPTR VALUE
MOVEI AC1,.CHNUL
IDPB AC1,OCMPTR ;TIE OFF BAD FIELD WITH A NULL
JRST $PARSE ;GO TO TOP OF PARSING LOOP
;REPORTING INCOMPATIBLE FORMAT OPTIONS
;$INCOM IS USED BY THE FMTERR MACRO
$INCOM: PUSH P,AC1
CALL PCRIF
TMSG <?Incompatible format options - >
POP P,AC1
Move AC2,AC1 ;[11]
PSOUT
SkipN AC1,LOGJFN ;[11]
Jrst .+3 ;[11]
SetZ AC3, ;[11]
SOUT ;[11]
TMSG <
>
JRST $PARSE
SUBTTL READ Command
$READ: TLO FLAGS,%READ ;SET READ FLAG
NOISE (FROM TAPE TO)
MOVSI AC2,(GJ%FOU+GJ%XTN)
MOVEM AC2,JFNBLK ;SET JFN FLAG BITS
$RTFN: MOVEI AC2,[FLDDB. .CMKEY,,TFN2,<a file on the tape>,<NEXT>,<[
FLDDB. .CMNUM,CM%SDH,^D10,<the tape file(s) to be read>]>]
CALL DOCMND
JUMPLE AC2,[WARN <File number must be positive>]
LDB AC3,[POINT 9,(AC3),8]
CAIN AC3,.CMKEY ;SYMBOLIC FILE #?
HRRE AC2,(AC2) ;YES
MOVEM AC2,@IJFNP ;ADD FILE # TO LIST
AOS AC2,IJFNP ;INCR INPUT POINTER
CAILE AC2,IJFNL+JFNLSZ
WARN <Too many input files specified>
MOVEI AC2,[FLDDB. .CMCMA,CM%SDH,,<a "," followed by additional file(s) to be read>,<*>,<[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/*/]>,<"*" for default output file name>,,<[
FLDDB. .CMFIL,CM%SDH,,<one or more output file(s)>]>]>]
CALL DOCMND
LDB AC3,[POINT 9,(AC3),8]
CAIN AC3,.CMCMA
JRST $RTFN ;COMMA->MORE INPUT FILE(S)
JRST ROJFN1 ;OUTPUT FILE SPECIFIED
$ROJFN: MOVEI AC2,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/*/]>,<"*" for default output file name>,,<[
FLDDB. .CMFIL,CM%SDH,,<one or more output file(s)>]>]
CALL DOCMND
LDB AC3,[POINT 9,(AC3),8]
ROJFN1: CAIN AC3,.CMTOK ;WAS IT "*"?
SETO AC2, ;YES. TREAT JFN AS -1
MOVEM AC2,@OJFNP ;ADD JFN TO LIST
AOS AC2,OJFNP ;INCR OUTPUT JFN POINTER
CAILE AC2,OJFNL+JFNLSZ
WARN <Too many output files specified>
MOVEI AC2,[FLDDB. .CMCMA,CM%SDH,,<a "," followed by additional output files>,,<[
FLDDB. .CMSWI,,OPTTAB,,,<[
FLDDB. .CMCFM]>]>]
CALL DOCMND
LDB AC3,[POINT 9,(AC3),8]
CAIN AC3,.CMCMA
JRST $ROJFN ;COMMA->MORE OUTPUT FILE(S)
CALL $OPTS1 ;EITHER SWITCH OR CR
JRST $PARSE
JRST $GO ;GO DO IT
SUBTTL REWIND and UNLOAD Commands
;REWIND COMMAND
$REWIN: NOISE (TAPE)
CALL CONFRM
CALL .REWIN
CALL ERROR
RET
.REWIN: MOVEI AC1,1 ;RESET TAPE FILE #
MOVEM AC1,TFN
CALL TAPJFN ;GET A JFN ON THE TAPE DRIVE
MOVE AC1,TJFN
MOVX AC2,OF%RD
OPENF ;OPEN THE DRIVE
Jrst [ CaiE AC1,OPNX8 ;[2] off-line?
Jrst R ;[2]
TMSG <?Device is Off-Line> ;[2]
Jrst $PARSE ] ;[2] back to parse
MOVE AC1,TJFN
MOVEI AC2,.MOREW ;REWIND
MTOPR
ERJMP R
CALL TCLOSE ;CLOSE JFN
;[4] RET ;RETURN TO TOP LEVEL
RetSkp ;[4] should be a retskp if OK
;UNLOAD COMMAND
$UNLOA: NOISE (TAPE)
CALL CONFRM
CALL TAPJFN ;GET A JFN ON THE TAPE DRIVE
MOVE AC1,TJFN
MOVX AC2,OF%RD
OPENF ;OPEN THE DRIVE
Jrst [ CaiE AC1,OPNX8 ;[2] off-line?
Jrst R ;[2]
TMSG <?Device is Off-Line> ;[2]
Jrst $PARSE ] ;[2] back to parse
MOVE AC1,TJFN
MOVEI AC2,.MORUL
MTOPR ;REWIND AND UNLOAD TAPE
ERCAL ERROR
CALL TCLOSE ;CLOSE THE JFN
MOVE AC1,TAPDES
RELD ;RELEASE THE TAPE DRIVE
ERCAL ERROR
SETZM TAPDES ;CLEAR DRIVE DESIGNATOR
RET ;RETURN TO TOP LEVEL
SUBTTL WRITE Command
$WRITE: TLO FLAGS,%WRITE
NOISE (FROM DISK TO TAPE)
MOVSI AC2,(GJ%OLD+GJ%IFG+GJ%XTN)
MOVEM AC2,JFNBLK ;SET JFN FLAGS
$WIJFN: MOVEI AC2,[FLDDB. .CMFIL,CM%SDH,,<the file(s) to be written to tape>]
CALL DOCMND
MOVEM AC2,@IJFNP ;ADD JFN TO LIST
AOS AC2,IJFNP ;INCR INPUT JFN POINTER
CAILE AC2,IJFNL+JFNLSZ
WARN <Too many files specified>
MOVEI AC2,[FLDDB. .CMCMA,,,<a "," followed by additional files to be written>,<END>,<[
FLDDB. .CMKEY,,TFN1,<a position on the tape>,,<[
FLDDB. .CMNUM,CM%SDH,^D10,<the tape file sequence number to be written>]>]>]
CALL DOCMND
LDB AC3,[POINT 9,(AC3),8] ;GET TYPE OF FIELD WE LAST PARSED
CAIN AC3,.CMCMA
JRST $WIJFN ;COMMA->MORE INPUT FILE(S)
JUMPLE AC2,[WARN <File number must be positive>]
CAIN AC3,.CMKEY ;TAPE FILE #
HRRE AC2,(AC2) ;SYMBOLIC FILE #
MOVEM AC2,@OJFNP ;ADD FILE # TO LIST
AOS OJFNP ;INCR OUTPUT POINTER
CALL $OPTS
JRST $PARSE
JRST $GO
SUBTTL DEFAULT and REVERT Commands
;DEFAULT COMMAND
;SET NEW DEFAULT SWITCH SETTINGS
$DEFAU: NOISE (SWITCHES)
CALL $OPTS ;GO PARSE OPTIONS
JFCL
RET ;THEN GET ANOTHER COMMAND
;REVERT COMMAND
;COPIES THE DEFAULT SWITCH VALUE TABLE INTO THE TABLE OF
;CURRENTLY USED SWITCH VALUES AND RESETS SOME ASSOCIATED FLAG WORDS.
$REVER: NOISE (TO DEFAULT SWITCH VALUES) ;SOME NOISE
CALL CONFRM ;WAIT FOR CONFIRMATION
Rever0: ;[13] new label
MOVE AC1,[XWD SWDEF,SWUSE] ;FORM A BLT POINTER
BLT AC1,SWUSE+SWLEN-1 ;COPY SWDEF INTO SWUSE
SETZM EORFLG ;CLEAR THESE FLAGS
SETZM TABFLG
SETZM FFFLG
SETZM LINFLG
RET ;RETURN TO CALLER
SUBTTL DISPLAY Command
$DISPL: NOISE (DEFAULT SWITCH VALUES)
CALL CONFRM
CALL VALUES ;DISPLAY THE DEFAULTS
RET ;THEN GET ANOTHER COMMAND
;VALUES will print the default values of the switches
;[13] NOTE any changes here should be also made in routine DmpWrt
VALUES: TMSG <Current switch settings:
>
HRROI AC1,[ASCIZ/BLANKS/]
CALL PRT1ST
MOVE AC1,BLANKS
HLRO AC1,YNTAB+1(AC1)
ADDI AC1,1
CALL PRTLST
HRROI AC1,[ASCIZ/BLKSIZE/]
CALL PRT1ST
MOVE AC2,BLKSZ
CALL PRTNUM
CALL PRTEOL
HRROI AC1,[ASCIZ/BLOCK-PREFIX-LENGTH/]
CALL PRT1ST
MOVE AC2,BLKPFX
CALL PRTNUM
CALL PRTEOL
HRROI AC1,[ASCIZ/CASE/]
CALL PRT1ST
MOVE AC1,CASE
HLRO AC1,CASTAB+2(AC1)
ADDI AC1,1
CALL PRTLST
HRROI AC1,[ASCIZ/COUNT= ALL/]
CALL PRTLST
HRROI AC1,[ASCIZ/CTRL-L/]
CALL PRT1ST
MOVE AC1,FF
HLRO AC1,YNTAB+1(AC1)
ADDI AC1,1
CALL PRTLST
HRROI AC1,[ASCIZ/DATA-TYPE/]
CALL PRT1ST
MOVE AC1,DATA
HLRO AC1,DATAB+1(AC1)
ADDI AC1,1
CALL PRTLST
HRROI AC1,[ASCIZ/DENSITY/]
CALL PRT1ST
;[1] MOVN AC1,DEN
Move AC1,DEN ;[1]
;[1] HLRO AC1,DENTAB+5(AC1)
HRRO AC1,DenNam(AC1) ;[1]
;[1] ADDI AC1,1
CALL PRTLST
HRROI AC1,[ASCIZ/EOR/]
CALL PRT1ST
MOVE AC1,EOR
HLRO AC1,EORTAB+1(AC1)
ADDI AC1,1
SKIPN EORFLG
HRROI AC1,[ASCIZ/LRECL(read) or CRLF(write)/]
CALL PRTLST
HRROI AC1,[ASCIZ/LABEL/]
CALL PRT1ST
MOVE AC1,LABEL
HLRO AC1,LBLTAB+2(AC1)
ADDI AC1,1
SKIPN LBLFLG
HRROI AC1,[ASCIZ/???/]
CALL PRTLST
HRROI AC1,[ASCIZ/LEADING-TAPE-MARK/]
CALL PRT1ST
MOVE AC1,LTM
HLRO AC1,YNTAB+1(AC1)
ADDI AC1,1
CALL PRTLST
HRROI AC1,[ASCIZ/LINE-NUMS/]
CALL PRT1ST
MOVE AC1,LINOS
HLRO AC1,YNTAB+1(AC1)
ADDI AC1,1
SKIPN LINFLG
HRROI AC1,[ASCIZ/NO(read) or YES(write)/]
CALL PRTLST
HRROI AC1,[ASCIZ/LRECL/]
CALL PRT1ST
MOVE AC2,LRECL
CALL PRTNUM
CALL PRTEOL
HRROI AC1,[ASCIZ/NULLS/]
CALL PRT1ST
MOVE AC1,NULL
HLRO AC1,YNTAB+1(AC1)
ADDI AC1,1
CALL PRTLST
HRROI AC1,[ASCIZ/PARITY/]
CALL PRT1ST
MOVN AC1,PARITY
HLRO AC1,PARTAB+2(AC1)
ADDI AC1,1
CALL PRTLST
HRROI AC1,[ASCIZ/RECFM/]
CALL PRT1ST
MOVE AC1,RECFM
HRRO AC1,FMTRFM(AC1)
CALL PRTLST
HRROI AC1,[ASCIZ/SKIP= NONE/]
CALL PRTLST
HRROI AC1,[ASCIZ/TAB/]
CALL PRT1ST
MOVE AC1,TAB
HLRO AC1,YNTAB+1(AC1)
ADDI AC1,1
SKIPN TABFLG
HRROI AC1,[ASCIZ/NO(read) or YES(write)/]
CALL PRTLST
CALL PRTEOL
RET
FMTRFM: [ASCIZ/D/] ;TABLE TO CONVERT RECFM TO STRING
[ASCIZ/F/]
[ASCIZ/U/]
[ASCIZ/V/]
[ASCIZ/DB/]
[ASCIZ/FB/]
0 ;no UB
[ASCIZ/VB/]
[ASCIZ/DA/]
[ASCIZ/FA/]
[ASCIZ/UA/]
[ASCIZ/VA/]
[ASCIZ/DBA/]
[ASCIZ/FBA/]
0 ;no UBA
[ASCIZ/VBA/]
PrTMSG: Move AC2,AC1 ;[11]
PSOUT
SkipN AC1,LOGJFN ;[11]
Jrst .+3 ;[11]
SetZ AC3, ;[11]
SOUT ;[11]
Ret ;[11]
PRTLST: Move AC2,AC1 ;[11]
PSOUT
SkipN AC1,LOGJFN ;[11]
Jrst .+3 ;[11]
SetZ AC3, ;[11]
SOUT ;[11]
PRTEOL: HRROI AC1,[ASCIZ/
/]
Move AC2,AC1 ;[11]
PSOUT
SkipN AC1,LOGJFN ;[11]
Jrst .+3 ;[11]
SetZ AC3, ;[11]
SOUT ;[11]
RET
PRT1ST: Move AC2,AC1 ;[11]
PSOUT
SkipN AC1,LOGJFN ;[11]
Jrst .+3 ;[11]
SetZ AC3, ;[11]
SOUT ;[11]
HRROI AC1,[ASCIZ/= /]
Move AC2,AC1 ;[11]
PSOUT
SkipN AC1,LOGJFN ;[11]
Jrst .+3 ;[11]
SetZ AC3, ;[11]
SOUT ;[11]
RET
SUBTTL QUIT Command
$QUIT: NOISE (AND)
MOVEI AC2,[FLDDB. .CMKEY,,QUITAB,,<NOCHANGE>] ;[10]
CALL DOCMND
HRRE AC4,(AC2) ;GET OPTION
CALL CONFRM
SKIPN TAPDES ;TAPE DRIVE NOT ASSIGNED?
JRST $QUIT1 ;YES....
Call TapJFN ;[5] get a JFN for Tape Drive
CAIGE AC4,0 ;OPTION= NOCHANGE?
JRST $QMSG ;YES
$QOPN: MOVE AC1,TJFN
MOVE AC2,[17B9+OF%RD]
OPENF ;OPEN TO REWIND/UNLOAD
ERJMP $QUIT0 ;PROBABLY NOT ONLINE
MOVEI AC2,.MORUL ;UNLOAD IS DEFAULT
CAIG AC4,0
MOVEI AC2,.MOREW ;REWIND SPECIFIED
MTOPR
ERCAL ERROR
MOVEI AC1,1 ;RESET TAPE FILE #
MOVEM AC1,TFN
SETZM LBLFLG ;RESET LABEL FLAG
Call TCLOSE ;[12] close tape drive here so $QMSG works
$QMSG: CAILE AC4,0
JRST $QUIT1 ;RELEASE AFTER UNLOAD
CALL PCRIF
TMSG <%You still have the tape drive assigned!>
;[12] since tape drive is not opened, don't need to close it but release it
MOVE AC1,TJFN ;CLOSE TAPE JFN
;[12] CLOSF
RLJFN ;[12] and release it
ERCAL ERROR
SETZM TJFN
$QUIT0: SkipN AC1,LOGJFN ;[11]
Jrst .+3
CLOSF
JFCL
HALTF
RET
$QUIT1: HRROI AC1,-1 ;CLOSE ALL FILES
CLOSF
JFCL
SETZM TJFN ;RESET TAPE JFN
MOVE AC1,TAPDES
RELD ;RELEASE THE TAPE DRIVE
JFCL
SETZM TAPDES
HALTF
JRST TAPEIO
SUBTTL Switch Value Parsing
; FOR READ AND WRITE COMMANDS
; PARSE A SWITCH NAME, THEN DISPATCH TO THE APPROPRIATE VALUE
; +1 ERROR
; +2 GOOD PARSE
$OPTS: SETOM SWSET ;[13] -1 MEANS NO VALUE SET
MOVE AC1,[XWD SWSET,SWSET+1] ;[13]
BLT AC1,SWSET+SWLEN-1 ;[13] NO NEW SWITCH VALUES SET YET
$OPTS0: ;[13] new label
MOVEI AC2,[FLDDB. .CMSWI,,OPTTAB,,,<[
FLDDB. .CMCFM]>]
CALL DOCMND
LDB AC3,[POINT 9,(AC3),8]
$OPTS1: CAIN AC3,.CMCFM
JRST $OPTS2 ;<CR>->EXECUTE COMMAND
HRRZ AC2,(AC2)
CALL (AC2) ;PARSE REST OF OPTION
JFCL ;ERROR (NEVER USED)
SkipE EOFflg ;[13] see if EOF
Jrst $OPTS2 ;[13] yes, finish up
JRST $OPTS0 ;[13] new label jump
;AFTER CONFIRMATION WE COPY THE SWSET VALUES INTO SWUSE
DEFINE YY ' (FOO,BAR) <
MOVE AC1,.'FOO ;;GET NEW SWITCH VALUE
CAMN AC1,[-1] ;;WAS ONE SET?
JRST .+3 ;;NO, SKIP OUT OF THIS MACRO
MOVEM AC1,FOO ;;YES, SET NEW VALUE
IFIDN <BAR> <> <JFCL> ;;IF NO FLAG, USE A NO-OP
IFDIF <BAR> <> <SETOM BAR> ;;ELSE SET THE FLAG
>
;NOTE WELL: THE FOLLOWING IS NOT A TABLE!
$OPTS2: YY (DEN)
YY (BLKSZ)
YY (LRECL)
YY (RECFM)
YY (PARITY)
YY (DATA)
YY (CASE)
YY (BLANKS)
YY (COUNT)
YY (SKIP)
YY (EOR,EORFLG)
YY (TAB,TABFLG)
YY (NULL)
YY (FF,FFFLG)
YY (LINOS,LINFLG)
YY (LTM)
YY (BLKPFX,BDWFLG)
YY (LABEL)
RETSKP
; VALUE PARSING ROUTINES. ALL RETURN +1 ON ERROR, +2 NORMALLY
$BLKSZ: TROE FLAGS,%BLKSZ ;BLKSIZE OPTION
WARN <Duplicate option specified>
MOVEI AC2,[FLDDB. .CMNUM,CM%SDH,^D10,<block size of tape>,<8000>]
CALL DOCMND
CAIL AC2,MINBLK ;CHECK
CAILE AC2,MAXBLK
WARN <BLKSIZE out of range 18-30720>
MOVEM AC2,.BLKSZ ;SET BLKSIZE
RETSKP
$DEN: TROE FLAGS,%DEN ;DENSITY OPTION
WARN <Duplicate option specified>
MOVEI AC2,[FLDDB. .CMKEY,,DENTAB,,<1600>]
CALL DOCMND
HRRE AC2,(AC2)
MOVEM AC2,.DEN
RETSKP
$LRECL: TROE FLAGS,%LRECL ;LRECL OPTION
WARN <Duplicate option specified>
MOVEI AC2,[FLDDB. .CMNUM,CM%SDH,^D10,<logical record length of tape>,<80>]
CALL DOCMND
CAIL AC2,MINREC
CAILE AC2,MAXREC
WARN <LRECL not in range 18-30720>
MOVEM AC2,.LRECL
RETSKP
$RECFM: TROE FLAGS,%RECFM ;RECFM OPTION
WARN <Duplicate option specified>
MOVEI AC2,[FLDDB. .CMKEY,,RCFMTB,,<FB>]
CALL DOCMND
HRRE AC2,(AC2)
MOVEM AC2,.RECFM
ANDI AC2,$B-1 ;CLEAR BLOCKED AND CC ATTRIBUTES
CAIE AC2,$D ;D AND V IMPLY CHARACTER SET CONSTRAINTS
CAIN AC2,$V
JRST [TROE FLAGS,%DATA
WARN <Duplicate option specified>
LSH AC2,-1
MOVEM AC2,.DATA ;DATA TYPE IMPLIED BY RECFM=D,V
JRST .+1 ]
RETSKP
$PARTY: TROE FLAGS,%PARTY ;PARITY OPTION
WARN <Duplicate option specified>
MOVEI AC2,[FLDDB. .CMKEY,,PARTAB,,<ODD>]
CALL DOCMND
HRRE AC2,(AC2)
MOVEM AC2,.PARITY
RETSKP
$DATA: TROE FLAGS,%DATA ;DATA OPTION
WARN <Duplicate option specified>
MOVEI AC2,[FLDDB. .CMKEY,,DATAB,,<ASCII>]
CALL DOCMND
HRRE AC2,(AC2)
MOVEM AC2,.DATA
RETSKP
$CASE: TROE FLAGS,%CASE ;CASE OPTION
WARN <Duplicate option specified>
MOVEI AC2,[FLDDB. .CMKEY,,CASTAB,,<NOCHANGE>]
CALL DOCMND
HRRE AC2,(AC2)
MOVEM AC2,.CASE
RETSKP
$BLNKS: TLOE FLAGS,%BLNKS
WARN <Duplicate option specified>
MOVEI AC2,[FLDDB. .CMKEY,,YNTAB,,<YES>] ;PARSE YES OR NO
CALL DOCMND
HRRE AC2,(AC2)
MOVEM AC2,.BLANKS
RETSKP
$COUNT: TROE FLAGS,%COUNT
WARN <Duplicate option specified>
MOVEI AC2,[FLDDB. .CMKEY,,CNTAB,,<ALL>,<[
FLDDB. .CMNUM,CM%SDH,^D10,<number of records to write>]>]
CALL DOCMND
LDB AC3,[POINT 9,(AC3),8] ;GET TYPE OF FIELD PARSED
CAIN AC3,.CMKEY ;KEYWORD?
MOVE AC2,[377777,,777777] ;ALL SPECIFIED
JUMPLE AC2,[WARN <COUNT must be positive>] ;ERROR IF <= 0
MOVEM AC2,.COUNT
RETSKP
$SKIP: TROE FLAGS,%SKIP
WARN <Duplicate option specified>
MOVEI AC2,[FLDDB. .CMKEY,,SKPTAB,,<NONE>,<[
FLDDB. .CMNUM,CM%SDH,^D10,<# records to ignore>,<none>]>]
CALL DOCMND
JUMPL AC2,[WARN <SKIP value must be zero or greater>]
LDB AC3,[POINT 9,(AC3),8] ;GET TYPE OF FIELD WE PARSED
CAIN AC3,.CMKEY
HRRE AC2,(AC2) ;NONE SPECIFIED
MOVEM AC2,.SKIP
RETSKP
$EOR: TROE FLAGS,%EOR
WARN <Duplicate option specified>
MOVEI AC2,[FLDDB. .CMKEY,,EORTAB,,<LRECL-CHARACTERS>]
TLNN FLAGS,%READ
MOVEI AC2,[FLDDB. .CMKEY,,EORTAB,,<CRLF>]
CALL DOCMND
HRRE AC2,(AC2)
MOVEM AC2,.EOR
RETSKP
$TAB: TLOE FLAGS,%TAB
WARN <Duplicate option specified>
MOVEI AC2,[FLDDB. .CMKEY,,YNTAB,,<YES>]
CALL DOCMND
HRRE AC2,(AC2)
MOVEM AC2,.TAB
RETSKP
$NULL: TLOE FLAGS,%NULL
WARN <Duplicate option specified>
MOVEI AC2,[FLDDB. .CMKEY,,YNTAB,,<YES>]
CALL DOCMND
HRRE AC2,(AC2)
MOVEM AC2,.NULL
RETSKP
$FF: TLOE FLAGS,%FF
WARN <Duplicate option specified>
MOVEI AC2,[FLDDB. .CMKEY,,YNTAB,,<YES>]
CALL DOCMND
HRRE AC2,(AC2)
MOVEM AC2,.FF
RETSKP
$LINOS: TLOE FLAGS,%LINOS
WARN <Duplicate option specified>
MOVEI AC2,[FLDDB. .CMKEY,,YNTAB,,<YES>]
CALL DOCMND
HRRE AC2,(AC2)
MOVEM AC2,.LINOS
RETSKP
$LTM: TLOE FLAGS,%LTM ;LEADING TAPE MARK
WARN <Duplicate option specified>
MOVEI AC2,[FLDDB. .CMKEY,,YNTAB,,<NO>]
CALL DOCMND
HRRE AC2,(AC2)
MOVEM AC2,.LTM
RETSKP
$BKPFX: TLOE FLAGS,%BPFX
WARN <Duplicate option specified>
TLNE FLAGS,%WRITE
WARN <Invalid when writing>
MOVEI AC2,[FLDDB. .CMNUM,CM%SDH,^D10,<the block prefix length in bytes [0-99]>,<0>]
CALL DOCMND
CAIL AC2,0
CAILE AC2,^D99
WARN <Block prefix length must be 0-99>
MOVEM AC2,.BLKPFX
RETSKP
$LABEL: TLOE FLAGS,%LABEL
WARN <Duplicate option specified>
MOVEI AC2,[FLDDB. .CMKEY,,LBLTAB,,<NL>]
CALL DOCMND
HRRE AC2,(AC2)
MOVEM AC2,.LABEL
RETSKP
$FMT: TROE FLAGS,%FMT
WARN <Duplicate option specified>
MOVEI AC2,[FLDDB. .CMKEY,,FMTAB,,<VCARD>]
CALL DOCMND
HRRE AC2,(AC2)
TRNE AC2,400000 ;[13] See if user format
Jrst USRFMT ;[13] yes, user format-different routine
JRST @[$FMT0
$FMT1
$FMT2
$FMT3
$FMT4
$FMT5
$FMT6
$FMT7](AC2)
$FMT0: ;ILLEGAL
$FMT1: MOVEI AC1,^D80 ;FCARD
MOVEI AC2,MAXBLK
MOVEI AC3,$FB
JRST $FMTRT
$FMT2: MOVEI AC1,^D80 ;FPRINT
MOVEI AC2,MAXBLK
MOVEI AC3,$FBA
JRST $FMTRT
$FMT3: SKIPA AC3,[$VB] ;VCARD
$FMT4: MOVEI AC3,$VBA ;VPRINT
MOVEI AC1,^D235 ;lrecl for Wylbur
MOVEI AC2,MAXBLK ;maximum block size
TROE FLAGS,%DATA
WARN <Duplicate option specified>
MOVEI AC4,1
MOVEM AC4,.DATA ;RECFM=V IMPLIES DATA EBCDIC
JRST $FMTRT
$FMT5: MOVEI AC1,^D80 ;TCARD
MOVEI AC2,^D8000
MOVEI AC3,$FB
JRST $FMTRT
$FMT6: MOVEI AC1,^D133 ;TPRINT
MOVEI AC2,^D7980
MOVEI AC3,$FB
JRST $FMTRT
$FMT7: TROE FLAGS,%DATA ;ANSI
SETZM .DATA ;RECFM=DB IMPLIES DATA ASCII
SETZM .FF ;DON'T STRIP FF
MOVEI AC3,$DB
MOVEI AC1,^D2048-4 ;SMALL BLOCKSIZE
MOVEI AC2,^D2048
$FMTRT: MOVEM AC1,.LRECL
MOVEM AC2,.BLKSZ
MOVEM AC3,.RECFM
RETSKP
USRFMT: MovSI AC3,-SWLEN ;[13] number of switches to transfer
Move AC1,AC2 ;[13] get the table entry into AC1
AndI AC1,377777 ;[13] strip everthing except tale index
IMulI AC1,SWLEN ;[13] calc beginning of record
MoveI AC1,NewDef(AC1) ;[13] AC1/ start of record
MovLp: Move AC2,(AC1) ;[13] get a switch value
MoveM AC2,SWSET(AC3) ;[13] put it into SWSET table
AddI AC1,1 ;[13] bump source pointer
AobJN AC3,MovLp ;[13] if not done tranferring goto MovLp
RetSkp ;[13] everthing fine, return
SUBTTL FORMAT VERIFICATION
$FCHK: MOVE AC1,BLKSZ ;RECFM=F: LRECL=BLKSIZE?
CAMN AC1,LRECL
RETSKP ;YES
$FBCHK: MOVE AC1,BLKSZ ;RECFM=FB: BLKSIZE MOD LRECL=0
IDIV AC1,LRECL
JUMPN AC2,[FMTERR<For RECFM=FB, BLKSIZE must be a multiple of LRECL>]
TLNE FLAGS,%READ ;WRITE?
RETSKP ;NO. READ.
MOVE AC1,LRECL
TRNE AC1,3 ;IS LRECL A MULTIPLE OF 4?
FMTERR<For RECFM=FB, LRECL must be a multiple of 4>
RETSKP
$VCHK: SKIPN DATA ;RECFM=V,VB: EBCDIC & BLKSIZE>=LRECL+4
FMTERR <For RECFM=V,VB data-type must be EBCDIC>
SKIPE BLKPFX
FMTERR <For RECFM=V,BB BLOCK-PREFIX-LENGTH not allowed>
MOVE AC1,BLKSZ
SUBI AC1,4
CAMGE AC1,LRECL
FMTERR (For RECFM=V,VB: DATA-TYPE must be EBCDIC and BLKSIZE>=LRECL+4)
TLO FLAGS,%VLR ;SET VARIABLE LENGTH RECORDS FLAG
RETSKP
$DCHK: SKIPE DATA ;RECFM=D,DB: ASCII & BLKSIZE >= LRECL+PREFIX
FMTERR <For RECFM=D,DB data-type must be ASCII>
MOVEI AC1,4 ;PREFIX MUST BE = 4 ON WRITING
SKIPE BDWFLG ;BLOCK DESCRIPTOR NEVER SPECIFIED?
TLNE FLAGS,%WRITE ;OR WRITING?
MOVEM AC1,BLKPFX ;USE 4
SKIPLE AC1,LRECL
CAILE AC1,^D9999
WARN <LRECL out of range 18-9999>
SKIPLE AC1,BLKSZ
CAILE AC1,^D9999
WARN <BLKSIZE out of range 18-9999>
TLO FLAGS,%VLR
TLNN FLAGS,%READ ;IGNORE LENGTH CHECKS ON READ
CAML AC1,LRECL
RETSKP
FMTERR (For RECFM=D: BLKSIZE >= LRECL+4)
$RFMU: TLNE FLAGS,%WRITE
WARN <RECFM=U illegal when writing>
RETSKP
; DISPATCH TABLE FOR BLKSIZE/LRECL CHECK
$BLRCK: $DCHK ;D
$FCHK ;F
$RFMU ;U
$VCHK ;V
$DCHK ;DB
$FBCHK ;FB
$RFMU ;UB
$VCHK ;VB
$GO: MOVE AC1,RECFM ;CHECK BLKSIZE/LRECL/DATA-TYPE
TRNE AC1,$A
TLO FLAGS,%CC ;SET CARRIAGE CONTROL FLAG
ANDI AC1,$A-1
CALL @$BLRCK(AC1)
RET ;BLKSIZE/LRECL CONFLICT
TLNE FLAGS,%READ
JRST $GO1
MOVE AC1,BLKSZ ;CHECK BLKSIZE FOR MULT OF 4
TRNE AC1,3
FMTERR <BLKSIZE must be multiple of 4>
$GO1:
$GO2: CALL TAPJFN ;GET A JFN ON THE TAPE DRIVE
CALL TLTM ;SKIP LEADING TAPE MARK
CALL TLBLCK ;VERIFY LABEL
FMTERR <Tape not labelled as specified>
SETZM @IJFNP ;MARK END OF INPUT FILE(S)
SETZM @OJFNP ;MARK END OF OUTPUT FILE(S)
MOVEI AC1,IJFNL ;RESET INPUT LIST POINTER
MOVEM AC1,IJFNP
MOVEI AC1,OJFNL ;RESET OUTPUT LIST POINTER
MOVEM AC1,OJFNP
MOVEI AC1,1
TLNN FLAGS,%READ
MOVEI AC1,0
SKIPN EORFLG
MOVEM AC1,EOR ;EOR NEVER SPECIFIED, SET TO DEFAULT
TRC AC1,1
SKIPN TABFLG
MOVEM AC1,TAB ;TAB NEVER SPECIFIED, SET TO DEFAULT
SKIPN FFFLG
MOVEM AC1,FF ;FF NEVER SPECIFIED. SET TO DEFAULT
SKIPN LINFLG
MOVEM AC1,LINOS ;LINOS NEVER SET, SET TO DEFAULT
TLNN FLAGS,%READ
JRST $GOEX
SETZM RTEEOR ;IF READ, SET EFFECTIVE EOR TO 8
MOVE AC1,LRECL ;IF LRECL=80, RECFM=FB, LINE #S=Y
CAIE AC1,^D80 ;& EOR=LRECL; OTHERWISE TO 0
JRST $GOEX
MOVE AC1,RECFM
ANDI AC1,$A-1
CAIE AC1,$FB
JRST $GOEX
SKIPN EOR
JRST $GOEX
MOVEI AC1,^D8
SKIPE LINOS
MOVEM AC1,RTEEOR
$GOEX: CALL EXEC ;EXECUTE COMMAND
RET
SUBTTL HELP Command
; #########################################################
; ### Warning: Do not include unmatched "<" or ">" in ###
; ### any help msgs on this page! ###
; #########################################################
;The HELP text is a giant macro so we can turn off code listing.
DEFINE %HELP% ' (LABEL,TEXT) <
H.'LABEL:
XLIST
ASCIZ\TEXT\
LIST
>;%HELP%
;
; HELP on general-informational topics
;
%HELP% (INTRO,<
This program may be used to read tape(s) written in IBM format (i.e.
written at CIT or on the HP) or write tape(s) in this format (i.e for use
at CIT or on the HP-3000). The tape must be nine-track and contain only
character data; this means that some of the things you CANNOT read or
write are: SPSS save files, files written with FORTRAN unformatted i/o,
compiled (.REL files) or executable (.EXE files) programs.
The following commands are recognized: READ, WRITE, QUIT, HELP, and
DEFAULT. The READ command reads tape file(s) to disk, the WRITE command
writes disk file(s) to tape, the QUIT command stops the program & returns
you to TOPS-20, the HELP command prints this and other information about the
program, and the DEFAULT command sets default switch values for later READ
and WRITE commands.
The HELP command may be followed by an optional argument (a topic). For
instance, HELP READ gives information relevant to the READ command, while
HELP LRECL gives information pertaining to the use of the LRECL switch.
The WRITE command must be followed by the list of disk files to be copied
to tape, and the location on the tape where the files should be written,
followed by the optional switches. The allowable tape positions for
writing are: END (writes a file to the end of the tape), LAST (writes a file
over the last file on the tape), NEXT (writes a file into the next position
on the tape), or 'n' (where 'n' is the number of the tape file to write).
The READ command must be followed by the positions of the files to be read
from tape, and the disk files they are to be written into, followed by any
switches. The allowable tape positions for reading are: LAST (read the
last file on the tape), NEXT (read the next file on the tape), 'n' (where n is
the number of the tape file to read).
The switches which may be specified in DEFAULT, READ, and WRITE and as
topics in the HELP command are:
/BLANKS (specifies the treatment of blanks and nulls),
/BLKSIZE (size of physical records on the tape)
/BLOCK-PREFIX-LENGTH (length of an optional block prefix for ascii tapes)
/CASE (specifies sensitivity to case)
/COUNT (number of logical records to be processed)
/CTRL-L (specifies that form-feeds are to be flushed)
/DATA-TYPE (specifies whether the tape is ASCII or EBCDIC)
/DENSITY (either 1600 or 800 bpi)
/EOR (specifies the method of determining the end of the record)
/FORMAT (specifies LRECL, BLKSIZE and RECFM in a single switch)
/LABEL (gives the label characteristics of the tape)
/LEADING-TAPE-MARK (specifies the presence of a leading tape mark)
/LINE-NUMS (specifies the handling of line numbers)
/LRECL (size of logical records on the tape)
/NULLS (specifies that nulls are to be flushed)
/PARITY (the parity of the tape)
/RECFM (the record format of the tape)
/SKIP (the number of logical records to skip over)
/TAB (specifies the handling of tabs)
Almost all of these swtiches require an argument. For instance, "/skip:5"
means that five records should be skiped and "/nulls:no" means that nulls
are not to be flushed. The defaults for each of these arguments can be
obtained by "HELP VALUES".
To read the first file on a tape written with default parameters:
read 1 myfile.typ
To write a file on to the end of a tape with the default parameters:
write myfile.typ end
To write a file on to the end of the tape, including carriage control,
in a format suitable to be taken to CIT for printing on their printer:
[Make sure your tape is IBM labelled. Use TAPELABEL if necessary.]
write mythesis.mem/format:vprint
To write a file on to the end of a tape with a density of 800bpi and
without flushing nulls:
write myfile.typ end /density:800 /nulls:no
>);END OF HELP MACRO
%HELP% (CIT,<
The following is general information on transfering files to and from
the Stanford Center for Information Technology (CIT).
The CIT Execfiles TOLOTS and FROMLOTS expect labelled tapes, so if you are
moving a file to CIT, and your tape is currently unlabelled, please run the
TAPELABEL program before using TAPEIO. Then use /FORMAT:VCARD or
/FORMAT:VPRINT when writing the tape.
If you are reading a labelled tape from CIT then you don't need to know
anything about the format of the tape, since TAPEIO will figure it out for you.
However, the tape must be 9-track, 800 or 1600 bpi density.
Give the exec command HELP TAPEIO for more details.
>);END OF HELP MACRO
%HELP% (SWITC,<
The syntax of the DEFAULT, READ, and WRITE commands includes optional
switches which describe the format of the tape & any transformations to
be done to the data. The following are the recognized switches:
BLANKS BLKSIZE BLOCK-PREFIX-LENGTH CASE COUNT CTRL-L
DATA-TYPE DENSITY EOR FORMAT LINE-NUMS LABEL LEADING-TAPE-MARK
LRECL NULLS PARITY RECFM SKIP TAB.
BLKSIZE, BLOCK-PREFIX-LENGTH, DENSITY, LABEL, LEADING-TAPE-MARK, LRECL,
PARITY & RECFM describe, respectively, the block size, length of the
optional block prefix, density, whether the tape is labelled, whether it
has an initial null file, the logical record length, parity & record
format of the tape. FORMAT specifies useful mixes of LRECL, BLKSIZE and
RECFM in one switch. BLANKS, CASE, CTRL-L, DATA-TYPE, EOR, LINE-NUMS,
NULLS & TAB specify data transformations. SKIP and COUNT give,
respectively, the number of logical records to be ignored and processed.
Once assigned a value, all switches, except COUNT & SKIP, retain this
value until explicitly changed (this means that you only have to specify
the block size or density or etc. of a tape on the DEFAULT command
before any READ or WRITE commands); COUNT & SKIP, on the other hand, are
re-initialized to their default values ("ALL" & "NONE" respectively)
before each command (Note: this means that using SKIP and/or COUNT when
reading or writing multiple files probably doesn't make sense).
Try HELP on these for more details.
>);END OF HELP MACRO
;
; HELP on commands:
;
%HELP% (HELP,<
Help is available on the following topics:
- an INTRODUCTION to this program;
- the commands READ, WRITE, DEFAULT, DISPLAY, UNLOAD, REWIND, REVERT,
TAPE-DRIVE, and QUIT;
- VALUES which displays the current values of all switches;
- SWITCHES which explains switches for READ and WRITE; and
- the switches BLANKS, BLKSIZE,BLOCK-PREFIX-LENGTH, CASE, COUNT, CTRL-L,
DATA-TYPE, DENSITY, EOR, FORMAT,LABEL, LEADING-TAPE-MARK,
LINE-NUMS, LRECL, NULLS, PARITY, SKIP, and TAB.
To obtain help on a particular topic, type "HELP", a space and then the
topic (abbreviations and recognition can be used).
>);END OF HELP MACRO
%HELP% (DEFA,<
The DEFAULT command allows you to specify the values for switches before
giving your first READ or WRITE command. It accepts as arguments any
switches (see HELP SWITCHES for details). All switches (except COUNT and
SKIP) are sticky -- their values are remembered and used on succeeding READ
or WRITE commands.
For example, to read two files from an unlabelled 800 bpi tape
with LRECL=133, BLKSIZE=1330, and carriage control characters:
default /density:800
default /lrecl:133/blksize:1330/recfm:fba
read 1 foo.txt
read 5 bar.txt
Note that, had you preferred, you could have combined the above commands
into 3, 2, or even 1 lines:
read 1,5 foo.txt,bar.txt/den:800/lr:133/blk:1330/recfm:fba
>);END OF HELP MACRO
%HELP% (UNLOAD,<
The UNLOAD command causes the tape to rewind and unload itself. This is
the same action that is taken by the QUIT command without any arguments.
>);END OF HELP MACRO
%HELP% (REWIND,<
The REWIND command causes the tape to be positioned at the beginning of the
of the reel.
>);END OF HELP MACRO
%HELP% (TAPE,<
The TAPE-DRIVE command is used to specify which tape drive you want to use.
This command is useful only if the facility has more than one tape drive.
>);END OF HELP MACRO
%HELP% (DISPLAY,<
The DISPLAY command shows the current switch settings.
>);END OF HELP MACRO
;[11] add help messages for LOG and NOLOG
%HELP% (LOG,<
The LOG command logs everthing that is printed on the screen to a
file that you specify. If you do not specify a file name, the name
TAPEIO.LOG will be taken as default.
>);END OF HELP MACRO
%HELP% (NOLG,<
The NOLOG command stops the logging of the session and closes the
logging file. Things printed on the screen after this command will not
be recorded anymore.
>);END OF HELP MACRO
%HELP% (REVERT,<
The REVERT command resets all switch settings to their default values.
>);END OF HELP MACRO
%HELP% (QUIT,<
The QUIT command stops the program and returns you to TOPS-20 command
level. This command has 3 options ("NOCHANGE", "REWIND" & "UNLOAD") which
describe where to position the tape before returning to TOPS-20. These
are specified immediately after the command. "NOCHANGE" and "REWIND" leave
the tape drive assigned; "UNLOAD" deassigns it.
The default is UNLOAD.
>);END OF HELP MACRO
%HELP% (READ,<
The READ command reads file(s) from tape to disk. The syntax is:
READ input file(s) output file(s) /switch(es)
where "input file(s)" is a list (separated by commas) of tape file #(s),
"output file(s)" is a list of disk file name(s), and "switch(es)" is any
of the optional tape and data switches (try HELP SWITCHES for details).
After each file is copied to tape, a "confirmation" message is printed;
the messages are one of "OK", "BLOCK(S) GT BLKSIZE" or "RECORD(S) GT LRECL"
plus the number of records and blocks that were read from the tape. The
1st indicates the obvious; the 2nd, that physical block(s) on the tape
were greater than the specified BLKSIZE; and the 3rd, that record(s)
(for RECFMs V, VB, D or DB) were greater than the specified LRECL. These
last two messages indicate that the format of the tape was not specified
correctly and that data may have been lost.
This command terminates when the OUTPUT list is exhausted. If there
are more output files than input, succeeding file(s) are read from tape
until the output list is exhausted; if there are more input files than
output, the extra input file(s) are ignored. When reading more than one
file with a single READ command, note that they all must have the same
LRECL, BLKSIZE, etc.
A single "output file" may be either a disk file name or "*". If "*"
is specified, then the file name found on the corresponding tape file label is
used, or "TAPEIO-FILE-n" if the tape is unlabelled.
Examples:
READ 1 T.TXT (tape file 1 to t.txt)
READ 1 T1.TXT,T2.TXT (tape file 1 to t1.txt, tape file 2 to t2.txt)
READ 1,3 T1.TXT,T3.TXT (tape file 1 to t1.txt, tape file 3 to t3.txt)
READ 1,3 T1.TXT (tape file 1 to t1.txt)
READ NEXT T.TXT (next tape file to t.txt)
READ LAST T.TXT (last tape file to t.txt)
READ 1 T.TXT /BLK 6400 (tape file 1 to t.txt, block size= 6400)
READ 1 T.TXT /REC DB (tape file 1 to t.txt, record format= db)
READ 4 * /LABEL NL (tape file 4 to tapeio-file-4..1)
>);END OF HELP MACRO
%HELP% (WRIT,<
The WRITE command writes disk file(s) to tape. The syntax is:
WRITE input file(s)
or
WRITE input file(s) output file /switch(es)
where "input file(s)" is a list (separated by commas) of disk file name(s)
that may include wildcard characters, "output file" is a tape file # and
"switch(es)" are any of the optional tape & data switches (try HELP
SWITCHES for more details).
After each file is copied to disk, a "confirmation" message is printed;
the possible messages are either "OK" or "RECORD(S) TRUNCATED" plus the
number of records and blocks that were written to tape. The 1st indicates
the obvious and the 2nd, that record(s) in the input file were greater than
the specified LRECL and were truncated to fit (data was lost).
This command terminates when the INPUT list is exhausted. When writing
more than one file with a single WRITE command, each file will have the same
LRECL, BLKSIZE, etc.
Notes: when writing variable length records, RECFM=Dx or Vx, EACH record is
padded on the right with an appropriate number of either blank(s) or null(s)
[depending on the setting of the BLANKS switch], if necessary, to force
the length to the next multiple of 4 (note that this means that the smallest
block written is 24 bytes long). Also, with variable length ASCII records,
RECFM=Dx, a 4 byte block prefix containing the length of the block is written
(corresponding to the IBM DCB parameter BUFOFF=L).
Examples:
WRITE T.TXT (t.txt to end of tape)
WRITE T1.TXT,T2.TXT 1 (t1.txt to tape file 1, t2.txt to tape file 2)
WRITE T.*.* END (t.*.* to end of tape)
WRITE T.TXT NEXT (t.txt to next tape file)
WRITE T.TXT LAST (t.txt to last tape file)
WRITE T.TXT 1 /LR 100 (t.txt to tape file 1, lrecl=100)
WRITE T.TXT 1 /DE 800 (t.txt to tape file 1, density=800)
>);END OF HELP MACRO
;
; HELP on individual switches
;
%HELP% (BLAN,<
The BLANKS switch specifies the following data transformation:
when reading, remove trailing blanks; when writing, use blank(s), if
necessary, to pad each line to LRECL characters (otherwise use NULLS).
The default is YES.
>);END OF HELP MACRO
%HELP% (BLKS,<
The BLKSIZE switch specifies the maximum size of the physical
records on the tape. It must be a decimal # between 18 & 30720 which,
if the RECFM is F, equal to LRECL; FB, exactly divisible by LRECL; D or DB,
greater than or equal to LRECL + the block prefix (if any); V or VB, greater
than or equal to LRECL+4 (i.e. it includes the 4 byte block switch word).
Also, when writing, the BLKSIZE (and LRECL for FB) must be a multiple of four.
The default is 8000.
Notes: when writing variable length ASCII tapes (RECFM=Dx), remember
that the ANSI standard is a maximum BLKSIZE and LRECL of 2048; you can
write up to 9999, but the tape may not be readable elsewhere (it can,
however, be read at CIT).
>);END OF HELP MACRO
%HELP% (BPL,<
The BLOCK-PREFIX-LENGTH switch specifies the length (in bytes) of the
optional block prefix for all ASCII format tapes. It must be in the range
0-99 and can only be specified when reading (when writing variable length
ASCII records, RECFM=Dx, a 4 byte block prefix containing the length of the
block is written. To read an unlabelled D-format tape at CIT, specify the
DCB parameter BUFOFF=L in your JCL to inform the system of this fact).
The default is 0 (no block prefix) on reading, and 4 (BUFOFF=L) on writing.
>);END OF HELP MACRO
%HELP% (CASE,<
The CASE switch specifies whether the case of the output is to
be changed: "UPPER" capitalizes lower case characters, "LOWER" makes
capitals lower case & "NOCHANGE" leaves the output "as is".
The default is NOCHANGE.
>);END OF HELP MACRO
%HELP% (COUN,<
The COUNT switch specifies the # of logical records to be processed.
It must be a positive integer or the keyword "ALL".
The default is ALL.
>);END OF HELP MACRO
%HELP% (CTRL,<
The CTRL-L switch specifies that CTRL-L's (form feeds) are to be
flushed (removed) when reading & writing.
The default is YES on writing and NO on reading.
Note: the translation specified by RECFM= xA of form feeds at
beginnings of lines to ANSI carriage control takes precedence over
CTRL-L. Also, /FORMAT:ANSI implies that CTRL-L's are to be retained.
>);END OF HELP MACRO
%HELP% (DATA,<
The DATA-TYPE switch specifies the data type of the tape. The
choices are "ASCII" or "EBCDIC". "ASCII" transfers the data "as is" when
both reading and writing and "EBCDIC" translates EBCDIC to ASCII when
reading and ASCII to EBCDIC when writing.
The default is ASCII.
Notes: the translation table used is the same as is used by IBM when
you specify OPTCD=Q in your JCL except(!):
translation input output output
char TAPEIO IBM
=========== ===== ====== ======
EBCDIC to ASCII CENT ^Z [
NOT TILDE ^
! ! ]
[ [ ^Z
] ] ^Z
ASCII to EBCDIC ! ! VERTICAL BAR
^ CENT NOT
TILDE NOT TILDE
>);END OF HELP MACRO
%HELP% (DENS,<
The DENSITY switch specifies the density of the tape, either 800
or 1600 bpi.
The default is 1600.
>);END OF HELP MACRO
%HELP% (EOR,<
The EOR switch specifies how to determine the logical end of a record.
The choices are "CRLF" or "LRECL-CHARACTERS". The 1st indicates that a
carriage-return/line feed (CRLF) terminates each logical record; the 2nd, that
every LRECL characters does (i.e. if LRECL=80, then each 80 characters, includ-
ing CR's, LF's, CRLF's etc., determines a logical record).
The default is LRECL-CHARACTERS when reading and CRLF when writing.
>);END OF HELP MACRO
%HELP% (FORM,<
The FORMAT switch allows you to specify certain useful combinations of
LRECL, BLKSIZE and RECFM in a single switch. The following are the
recognized combinations:
Keyword LRECL BLKSIZE RECFM Notes
======= ===== ======= ===== =====
VCARD 235 30720 VB cheapest for non-printing data
VPRINT 235 30720 VBA cheapest for data to be printed
FCARD 80 30720 FB good fixed length for data
FPRINT 80 30720 FBA good fixed length for printing
(if each line is LEQ 80 chars)
TCARD 80 8000 FB TOSCIP's CARD format
TPRINT 133 7980 FB TOSCIP's PRINT format
(read only)
ANSI 2044 2048 DB DEC's default labelled format
The default is VCARD.
Notes: since RECFM=Vx implies DATA-TYPE EBCDIC, VCARD and VPRINT set the
data type to EBCDIC. ANSI sets the data type to ASCII and retains form feeds.
>);END OF HELP MACRO
%HELP% (LABE,<
The LABEL switch specifies what kind of label (if any) the tape should
be presumed to have. The choices are: "NL", "AL" and "SL". "NL" indicates
that the tape doesn't have a label, "AL" that it has ANSI labels and "SL" that
it has IBM labels. Specifying NL really means "bypass label processing", i.e.
when reading treat labels as ordinary files on the tape. You should not
specify NL when writing a labelled tape.
Notes: when reading a labelled tape, you don't have to specify the RECFM,
LRECL, BLKSIZE, BLOCK-PREFIX-LENGTH, or DATA-TYPE since this information can
be obtained from the label; when writing, this information, which you have
supplied either explicitly [by typing] or implicitly [through defaults], is
written into the label. An unlabelled tape MUST be converted to a labelled
one by using IEHINIT at CIT or TAPELABEL here at LOTS before you can use it
as a labelled tape.
>);END OF HELP MACRO
%HELP% (LEAD,<
The LEADING-TAPE-MARK switch specifies whether or not the tape has a
leading tape mark, i.e. a null file at the start.
The default is NO.
Notes: tapes written at IBM installations running under DOS have this
somewhat bizarre format.
>);END OF HELP MACRO
%HELP% (LINE,<
The LINE-NUMS switch specifies the following: when reading, remove
columns 73-80 of every logical record (presumed to contain WYLBUR line
numbers or sequence numbers) if (and only if!) LRECL=80, RECFM=FB and
EOR=LRECL; when writing, flush EDIT line numbers.
The default is NO when reading & YES when writing.
>);END OF HELP MACRO
%HELP% (LREC,<
The LRECL switch specifies the size of the logical records on the tape.
For fixed length records, RECFM=Fx, it is the exact length of each record; for
variable length records, RECFM=Vx or Dx, it is the maximum record length+4,
i.e. it includes the length of the record switch word (RDW). LRECL must
be a decimal # between 18 & 30720 which, if writing, must be a multiple
of 4 (see BLKSIZE for other restrictions) and is ignored if RECFM=U.
The default is 80.
>);END OF HELP MACRO
%HELP% (NULL,<
The NULLS switch specifies that nulls are to be flushed (removed) when
reading and writing.
The default is YES.
>);END OF HELP MACRO
%HELP% (PARI,<
The PARITY switch specifies the parity of the tape, either
"EVEN" or "ODD".
The default is ODD. Since odd parity is an almost universal
standard for 9-track tapes, you will never have to specify this
switch.
>);END OF HELP MACRO
%HELP% (RECF,<
The RECFM switch describes the record format of the tape. The possible
RECFMs are:
F unblocked fixed length records
FB blocked fixed length records
FBA as FB with ANSI carriage control (CC) in column 1
U undefined length records (only on READ)
UA undefined length records with CC (only on READ)
V IBM unblocked variable length records
VA IBM unblocked variable length records with CC
D ASCII unblocked variable length records
DA ASCII unblocked variable length records with CC
VB IBM blocked variable length records
VBA IBM blocked variable length records with CC
DB ASCII blocked variable length records
DBA ASCII blocked variable length records with CC
The default is FB.
Notes: the "A" causes CR's, LF's, FF's (^L's) & CRLF's to be translated to
and from ANSI carriage control characters as appropriate; however, LF's & FF's
are only recognized as carriage control at the start of a line. RECFM=Dx
implies DATA-TYPE ASCII and RECFM=Vx implies DATA-TYPE EBCDIC, specifing one
of these automatically sets the appropriate data-type.
>);END OF HELP MACRO
%HELP% (SKIP,<
The SKIP switch specifies the # of logical records to be ignored (read
and discarded). It must be a non-negative integer or the keyword "NONE".
The default is NONE.
>);END OF HELP MACRO
%HELP% (TABS,<
The TAB switch specifies the following: when reading, replace multiple
blanks with tab(s); when writing, expand tab(s) to blank(s).
The default is NO when reading & YES when writing.
Note: when reading, BLANKS takes precedence over TAB.
>);END OF HELP MACRO
;GENERAL HELP TOPICS
HLPTB0: TABLE
T CIT-TRANSFERS,H.CIT
T DESCRIPTORS,H.SWITC,CM%INV ;"DESCRIPTORS" IS NOW "SWITCHES"
T FORMAT,H.FORM
T HELP-TOPICS,H.HELP
T INTRODUCTION,H.INTRO
T SWITCHES,H.SWITC
TEND
;COMMANDS
HLPTB1: TABLE
T DEFAULT,H.DEFA
T DISPLAY,H.DISP
T HELP,H.HELP
T LOG,H.LOG ;[11]
T NOLOG,H.NOLG ;[11]
T QUIT,H.QUIT
T READ,H.READ
T REVERT,H.REVE
T REWIND,H.REWI
T TAPE-DRIVE,H.TAPE
T UNLOAD,H.UNLO
T WRITE,H.WRIT
TEND
;SWITCHES
HLPTB2: TABLE
T BLANKS,H.BLAN
T BLKSIZE,H.BLKS
T BLOCK-PREFIX-LENGTH,H.BPL
T CASE,H.CASE
T COUNT,H.COUN
T CTRL-L,H.CTRL
T DATA-TYPE,H.DATA
T DENSITY,H.DENS
T EOR,H.EOR
T LABEL,H.LABE
T LEADING-TAPE-MARK,H.LEAD
T LINE-NUMS,H.LINE
T LRECL,H.LREC
T NULLS,H.NULL
T PARITY,H.PARI
T RECFM,H.RECF
T SKIP,H.SKIP
T TABS,H.TABS
TEND
$HELP: NOISE (ON TOPIC)
MOVEI AC2,[FLDDB. .CMKEY,,HLPTB0,<a general topic,>,<HELP-TOPICS>,<[
FLDDB. .CMKEY,,HLPTB1,<a TAPEIO command,>,,<[
FLDDB. .CMKEY,,HLPTB2,<a switch setting,>]>]>]
CALL DOCMND
HRRZ AC4,(AC2) ;NO, GET TOPIC POINTER
CALL CONFRM
HRRO AC1,AC4 ;CONVERT TO POINTER
CALL PRTLST
RET
$LOG: SkipN LOGJFN ;[11] see if logging
Jrst LOG0 ;[11] nope
TMSG <%You are logging already> ;[11] warning message
Ret ;[11] return
LOG0: Noise (SESSION INTO FILE) ;[11] noise
MoveI AC2,[FLDDB. .CMOFI,,,,<TAPEIO.LOG>] ;[11] parse file
Call DOCMND ;[11] COMND
Move AC4,AC2 ;[11] save JFN of log file
Call CONFRM ;[11] confirm it
MoveM AC4,LOGJFN ;[11] save JFN
Move AC1,AC4 ;[11] get JFN of log file
Move AC2,[7B5!OF%WR] ;[11] access bits
OPENF ;[11] open it
Ercal ERROR ;[11] oops..
Ret ;[11] return
$NOLOG: SkipE LOGJFN ;[11] logging?
Jrst NOLOG0 ;[11] yes.
TMSG <%You are not logging> ;[11] warning message
Ret ;[11] return
NOLOG0: Noise (THIS SESSION) ;[11] noise
Call CONFRM ;[11] confirm it
Move AC1,LOGJFN ;[11] get the JFN of log file
CLOSF ;[11] close the file
Ercal ERROR ;[11] error...
SetZM LOGJFN ;[11] say there is no logging
Ret ;[11] return
;[13] added whole routine to delete a User Format
$DELET: Noise (USER FORMAT) ;noise
MoveI AC2,[FLDDB. .CMKEY,,FMTAB] ;parse keyword from format table
Call DOCMND ;do parsing
Move AC4,AC2 ;save the table addr in AC4
Call Confrm ;confirm it
Move AC2,(AC4) ;AC2/table entry pointed by AC4
TRNN AC2,400000 ;see if user format
Jrst [ TMSG <?Illegal to delete a resident format
> ;nope, error...
Ret ]
MoveI AC1,FMTAB ;start of format table
Move AC2,AC4 ;get the addr back for AC4
Move AC4,(AC4) ;save the table entry in AC4
TBDEL ;delete the table entry from table
AndI AC4,377777 ;strip off the user format flag (400000)
Move AC2,DelPtr ;get the current stack pointer for del. items
MoveM AC4,DelStk(AC2) ;push item on stack
AoS DelPtr ;bump stack pointer
IMulI AC4,SWLEN ;calculate addr of first entry of table
SetZ AC2, ;AC2/0
MoveM AC2,(AC4) ;mark as deleted record
TMSG <[OK]> ;confirmation message
Ret ;return
;[13] End of routine
;[13] added whole routine to define a new user format
$DEFIN: Noise (USER FORMAT FROM FILE) ;noise
MoveI AC2,[FLDDB. .CMIFI] ;parse an input filename
Call DOCMND ;parse
MoveM AC2,DefJFN ;save JFN of file
Call CONFRM ;confirm
Move AC1,DefJFN ;get JFN
Move AC2,[7B5!OF%RD] ;7 bits/byte and read access
OPENF ;open the file
Ercal Error ;oops...
HrlM AC1,CSB+.CMIOJ ;stick JFN in command state block
MoveI AC2,.NULIO
HrrM AC2,CSB+.CMIOJ ;also type to null device
DefLp: MoveI AC2,[FLDDB. .CMINI] ;init the line
Call DOCMND ;do it
MoveI AC2,[FLDDB. .CMFLD] ;parse a field
Call DOCMND ;for the name of format
SkipE EOFFlg ;see if EOF
Jrst DefCls ;yes, close the file off
MoveI AC1,FMTAB ;header word of the format table
HrrOI AC2,CMABUF ;here is the name of the new format
TBLUK ;look through table
TLNE AC2,(TL%NOM) ;is there one like this already?
Jrst DefNew ;nope, new definition
SetZM ReDef ;say not redefining
Move AC1,(AC1) ;found one like it... lets get the table entry
TRNN AC1,400000 ;does it have a user format flag?
Jrst [ TMSG <?Illegal to redefine a resident format
> ;nope. error
SetZ Flags, ;reset flag register
Jrst DefLp ] ;loop back
Push P,AC1 ;save 1 - table entry
TMSG <Redefining > ;type message that we are going to redefine
HrrOI AC1,CMABUF ;get the name of format
Call PRTLST ;and print it out
Pop P,AC1 ;get table entry back
AndI AC1,377777 ;only keep the pointer
MoveM AC1,CurPtr ;save in current pointer
SetOM ReDef ;redefining!
Jrst GetOpt ;join common code
; here if defining a brand-new format
DefNew: SkipE DelPtr ;check in deleted stack for avail record
Jrst [ Move AC1,DelPtr ;found a deleted record-get del. stack pointer
SubI AC1,1 ;normalize
Move AC2,DelStk(AC1) ;and get a deleted record
MoveM AC2,CurPtr ;save it in the current pointer
MoveM AC1,DelPtr ;and save updated del stack pointer
Jrst GAddr ] ;join command code
Move AC1,NewCnt ;get the number of new formats
CaiL AC1,MaxNew-1 ;less that maximum allowed?
Jrst [ TMSG <
?No more room for new user formats>
Jrst DefCls ] ;close format file and end
AoS NewCnt ;didnt find a deleted one so get a new one
Move AC1,NewCnt ;get the new record
MoveM AC1,CurPtr ;save in the current pointer
GAddr: Move AC1,CurPtr ;get current pointer
IMulI AC1,^D10 ;mult by number of words/name
MoveI AC1,NewNam(AC1) ;get addr of start of record
Move AC4,AC1 ;save the address in 4
HrrO AC1,AC1 ;make the address a byte pointer
HrrOI AC2,CMABUF ;point to the name of new format
SetZ AC3, ;stop on null
SOUT ;transfer
Idpb AC1,AC3 ;save a null on the end of string
Hrl AC2,AC4 ;get address of string into left half
Hrr AC2,CurPtr ;and the pointer number in the right half
TRO AC2,400000 ;set the user format flag
MoveI AC1,FMTAB ;header word of format table
TBADD ;add this table entry to table
GetOpt: Call $OPTS ;call routine to get options for this format
JFCL ;forget errors
MovSI AC3,-SWLEN ;transfer the config to permanent space
Move AC1,CurPtr ;by copying SWSET to the a record in table
IMulI AC1,SWLEN
MoveI AC1,NewDef(AC1)
CopLp: Move AC2,SWSET(AC3)
MoveM AC2,(AC1)
AddI AC1,1
AobJN AC3,CopLp
;done copying
SkipE ReDef ;redefined?
Jrst DefBot ;yes, don't print name of format
Move AC2,CurPtr
IMulI AC2,^D10
HrrOI AC1,NewNam(AC2) ;get the name of the format
Call PRTLST ;and print it out
DefBot: SetZ FLAGS, ;reset the flags so that we can do $OPTS again
Jrst DefLp ;loop back
DefCls: Move AC1,DefJFN ;get the JFN of defaults file
CLOSF ;and close it
Ercal Error ;error
DefEnd: Move AC1,[.PRIIN,,.PRIOU] ;primary input and output devices
MoveM AC1,CSB+.CMIOJ ;stuff back into the command state block
Ret ;return
;[13] end of new routine
;subroutine to print a string pointed by AC2 to the dump file (DmpJFN)
;accepts in AC2/ a byte pointer to string to transfer
;
DStr: Push P,AC1 ;save ACs
Push P,AC3
Push P,AC4
Move AC1,DmpJFN ;get the JFN of the dump file
SetZ AC3, ;stop on Nulls
SOUT ;dump...
Pop P,AC4 ;restore ACs
Pop P,AC3
Pop P,AC1
Ret ;return
;subroutine to print a number to the dump file
; accepts in AC2/ the value to print out
DNum: Push P,AC1 ;save ACs
Push P,AC3
Push P,AC4
Move AC1,DmpJFN ;get the JFN of the dump file
MoveI AC3,^D10 ;say it is to be dump in decimal
NOUT ;do the printing
ErCal Error ;error
Pop P,AC4 ;restore ACs
Pop P,AC3
Pop P,AC1
Ret ;return
;subroutine to Write the specifications to the dump file
; accepts in AC1/ the table entry of the format to dump
;[13] any changes here should also be made to routine VALUES
DmpWrt: HlrO AC2,AC1 ;addr of format string in AC2 (byte pointer)
Call DStr ;print string to file
AndI AC1,377777 ;strip everything except index into the table
IMulI AC1,SWLEN ;SWLEN units per record
SkipGE NewDef(AC1) ;density switch set?
Jrst DLRecl ;nope, try LRECL
HrrOI AC2,[Asciz?/DENSITY:?]
Call DStr ;print /DENSITY: to file
Move AC2,NewDef(AC1) ;get value
HrrO AC2,DenNam(AC2) ;offset into table
Call DStr ;print the density out
DLRecl: SkipGE NewDef+1(AC1) ;LRECL switch?
Jrst DRecfm ;nope, try RECFM
HrrOI AC2,[Asciz?/LRECL:?]
Call DStr ;print /LRECL: to file
Move AC2,NewDef+1(AC1) ;get value
Call DNum ;print the number out
DRecfm: SkipGE NewDef+2(AC1) ;RECFM switch set?
Jrst DBlk ;nope, try BLKSIZE
HrrOI AC2,[Asciz?/RECFM:?]
Call DStr ;print /RECFM: to file
Move AC2,NewDef+2(AC1) ;get value
HrrO AC2,FMTRFM(AC2) ;index into table
Call DStr ;print it
DBlk: SkipGE NewDef+3(AC1) ;BLKSIZE switch?
Jrst DCase ;nope, try CASE
HrrOI AC2,[Asciz?/BLKSIZE:?]
Call DStr ;print /BLKSIZE:
Move AC2,NewDef+3(AC1) ;get value
Call DNum ;and dump the number
DCase: SkipGE NewDef+4(AC1) ;CASE?
Jrst DData ;nope, try DATA-TYPE
HrrOI AC2,[Asciz?/CASE:?]
Call DStr ;print /CASE:
Move AC2,NewDef+4(AC1) ;get value
HlrO AC2,CASTAB+2(AC2) ;index
AddI AC2,1 ;normalize
Call DStr ;print the string
DData: SkipGE NewDef+5(AC1) ;DATA switch?
Jrst DPar ;nope, try parity
HrrOI AC2,[Asciz?/DATA-TYPE:?]
Call DStr ;print /DATA-TYPE:
Move AC2,NewDef+5(AC1) ;get value
HlrO AC2,DATAB+1(AC2) ;index
AddI AC2,1 ;normalize
Call DStr ;print the string
DPar: SkipGE NewDef+6(AC1) ;PARITY switch?
Jrst DCnt ;nope, try COUNT
HrrOI AC2,[Asciz?/PARITY:?]
Call DStr ;Print /PARITY: to file
MovN AC2,NewDef+6(AC1) ;get value
HlrO AC2,PARTAB+2(AC2) ;index into table
AddI AC2,1 ;normalize
Call DStr ;print option
DCnt: SkipGE NewDef+7(AC1) ;COUNT switch?
Jrst DSkip ;nope try SKIP
HrrOI AC2,[Asciz?/COUNT:?]
Call DStr ;prit /COUNT:
Move AC2,NewDef+7(AC1) ;get the number
Call DNum ;and print it
DSkip: SkipGE NewDef+10(AC1) ;SKIP switch?
Jrst DEOR ;nope, try EOR
HrrOI AC2,[Asciz?/SKIP:?]
Call DStr ;print /SKIP:
Move AC2,NewDef+10(AC1) ;get number
Call DNum ;print it
DEOR: SkipGE NewDef+11(AC1) ;EOR switch?
Jrst DNull ;nope, try NULL
HrrOI AC2,[Asciz?/EOR:?]
Call DStr ;print /EOR:
Move AC2,NewDef+11(AC1) ;get value
HlrO AC2,EORTAB+1(AC2) ;index
AddI AC2,1 ;normalize
Call DStr ;print it
DNull: SkipGE NewDef+12(AC1) ;NULL switch?
Jrst DTab ;nope, try TAB
HrrOI AC2,[Asciz?/NULLS:?]
Call DStr ;Print /NULL:
Move AC2,NewDef+12(AC1) ;get value
HlrO AC2,YNTAB+1(AC2) ;index in table
AddI AC2,1 ;normalize
Call DStr ;print option
DTab: SkipGE NewDef+13(AC1) ;TAB switch?
Jrst DFF ;nope, try CTRL-L
HrrOI AC2,[Asciz?/TABS:?]
Call DStr ;Print /TABS:
Move AC2,NewDef+13(AC1) ;get value
HlrO AC2,YNTAB+1(AC2) ;index in table
AddI AC2,1 ;normalize
Call DStr ;print option
DFF: SkipGE NewDef+14(AC1) ;CTRL-L switch?
Jrst DBlnks ;nope, try BLANKS
HrrOI AC2,[Asciz?/CTRL-L:?]
Call DStr ;print /CTRL-L:
Move AC2,NewDef+14(AC1) ;get value
HlrO AC2,YNTAB+1(AC2) ;index in table
AddI AC2,1 ;normalize
Call DStr ;print option
DBlnks: SkipGE NewDef+15(AC1) ;BLANKS switch?
Jrst DLinos ;no, try LINE-NUMS:
HrrOI AC2,[Asciz?/BLANKS:?]
Call DStr ;print /BLANKS:
Move AC2,NewDef+15(AC1) ;get value
HlrO AC2,YNTAB+1(AC2) ;index in table
AddI AC2,1 ;normalize
Call DStr ;print option
DLinos: SkipGE NewDef+16(AC1) ;LINE-NUMS switch?
Jrst DPref ;nope, try BLOCK-PREFIX-LENGTH
HrrOI AC2,[Asciz?/LINE-NUMS?]
Call DStr ;print /LINE-NUMS:
Move AC2,NewDef+16(AC1) ;get value
HlrO AC2,YNTAB+1(AC2) ;index in table
AddI AC2,1 ;normalize
Call DStr ;print option
DPref: SkipGE NewDef+17(AC1) ;BLOCK-FIX-LENGTH switch?
Jrst DLTM ;nope, try LEADING-TAPE-MARK
HrrOI AC2,[Asciz?/BLOCK-FIX-LENGTH:?]
Call DStr ;print /BLOCK-FIX-LENGTH:
Move AC2,NewDef+17(AC1) ;get value
Call DNum ;print number
DLTM: SkipGE NewDef+20(AC1) ;LEADING-TAPE-MARK?
Jrst DLabel ;nope, try LABEL
HrrOI AC2,[Asciz?/LEADING-TAPE-MARK:?]
Call DStr ;print /LEADING-TAPE-MARK:
Move AC2,NewDef+20(AC1) ;get value
HlrO AC2,YNTAB+1(AC2) ;index in table
AddI AC2,1 ;normalize
Call DStr ;print option
DLabel: SkipGE NewDef+21(AC1) ;LABEL?
Jrst DmpEnd ;nope. goto the end
HrrOI AC2,[Asciz?/LABEL:?]
Call DStr ;Print /LABEL:
Move AC2,NewDef+21(AC1) ;get value
HlrO AC2,LBLTAB+2(AC2) ;index in table
AddI AC2,1 ;normalize
Call DStr ;print option
DmpEnd: Move AC1,DmpJFN ;get JFN of dump file
HrrOI AC2,[Asciz/
/]
SetZ AC3,
SOUT ;CRLF
Ret ;return
;[13] routine to make a dump of the user formats
MakDmp: HllZ AC4,FMTAB ;get the number of entries in table
MovN AC4,AC4 ;negate
AddI AC4,1 ;and start at 1
MLoop: Move AC1,FMTAB(AC4) ;get the table entry
TRNE AC1,400000 ;is a user format?
Call DmpWrt ;yes, dump it
AobJN AC4,MLoop ;loop back
Ret ;return
;[13] here to ask for a dump of the user formats to a file
$DUMP: Noise (USER FORMATS TO) ;Noise
MoveI AC2,[FLDDB. .CMOFI] ;parse an output filename
Call DOCMND ;do parse
MoveM AC2,DmpJFN ;save the JFN
Call CONFRM ;confirm
Move AC1,DmpJFN ;get the JFN
Move AC2,[7B5!OF%WR] ;7 bits/byte, write access
OPENF ;open the file
Ercal Error ;errorororor
Call MakDmp ;do the dump
Move AC1,DmpJFN ;get the JFN
CLOSF ;close the file
Ercal Error ;error
TMSG <Dump completed.> ;confirmation
Ret ;return
;[13] routine to save the complete program, including the user formats
$SAVE: Noise (CORE IMAGE INTO) ;noise
MoveI AC2,[FLDDB. .CMOFI,,,,<TAPEIO.EXE>] ;parse output
Call DOCMND ;do parse
MoveM AC2,SavJFN ;save JFN
Call CONFRM ;confirm
TMSG <
An implicit REVERT is being done to cause the program
to have default settings when started up.
> ;small message
Call Rever0 ;do a revert
Move AC1,SavJFN ;get the JFN in right
HrlI AC1,.FHSLF ;and process in the left
HlrZ AC2,.JBSA ;get addr. of end of where to save
IDivI AC2,1000 ;make into page number
AddI AC2,1 ;normalize
MovS AC2,AC2 ;swap AC2/page numbers,,0
MovN AC2,AC2 ;negate AC2/-page numbers,,0
TRO AC2,760000 ;AC2/-page numbers,,760000
SSAVE ;save this program
TMSG <[Saved]> ;confirmation
Ret ;return
END TAPEIO