Trailing-Edge
-
PDP-10 Archives
-
bb-bt99r-bb
-
nip.x24
There are no other files named nip.x24 in the archive.
TITLE NIP NFT Network Interchange Program module
SUBTTL Robert Houk/RDH
SEARCH JOBDAT, MACTEN, UUOSYM ;STANDARD DEFINITIONS
SEARCH NFTDEF ;NFT-WIDE DEFINITIONS
SEARCH SWIL ;SWIL PACKAGE DEFINITIONS
SALL ;PRETTY LISTINGS
.DIREC FLBLST ;PRETTIER LISTINGS
TWOSEG 400000 ;NICE PURE CODE
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1986,1988. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO
COMMENT \
NIP -- NFT "Network Interchange Program" module
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1986,1988. ALL RIGHTS RESERVED.
THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ONLY
IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE INCLUSION OF THE
ABOVE NOTICE. THIS SOFTWARE OR ANY OTHER COPIES THEROF MAY NOT BE PROVIDED
OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO AND OWNERSHIP
OF THIS SOFTWARE IS HEREBY TRANSFERRED.
THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE AND
SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
\
SUBTTL Revision history
;INITIAL VERSION CREATED FROM NIK 25-MAR-80
;7 RDH 31-Mar-84
; Fix RT11 file DELETE (set IM.SMD so not send RFM to remote).
;13 RDH 30-Apr-85
; Version 2. Add "SET DEFAULT" and "SET NAME" commands.
;14 RDH 12-May-85
; Problem with copying ASCII file which ended in <CR><EOF> - COACS9
; trashed the error code in M0 prior to dispatch to COASE.
;
;15 LEO 15-Aug-85
; Do copyrights
;
;16 RDH 30-Oct-85
; Fix [15]
;
;17 RDH 4-Jan-86 SPR 10-35424
; Can't send LSNs over network link.
;
;20 RDH 23-Jan-86
; Extra null byte in record-oriented byte copy.
;
;22 KDO 20-Mar-87
; Add ULTRIX support.
;
;23 KDO 3-Apr-89
; Suppress appending extension ".*" for quoted input file specs.
;
;24 KDO 9-Jun-89
; Extend edit 23 to SUBMIT and DSUBMIT, which attempt to append
; the extension ".CTL".
;
;25 KDO 10-Jul-89
; Make the DIRECT command use the DAP DIRECTORY-LIST access.
SUBTTL External linkages
;TO NFT EXECUTIVE
EXTERN ERRMSG ;ERROR MESSAGE PROCESSOR
;TO NFT/SCAN INTERFACE
EXTERN CLRFIL, CLRALL ;CLEAR FOR NEW SPECS
EXTERN CLRSTK, MEMSTK, APLSTK ;STICKY DEFAULT PROCESSORS
EXTERN INX, OUX ;ALLOCATE FSB'S
;TO SWITCH DATA BASE
EXTERN S.BAUD ;/BAUD
EXTERN S.MOAN ;/MOAN
EXTERN S.DIAL ;/DIAL
EXTERN S.OKER ;/OKERROR
EXTERN S.PASS ;/PASSWORD
EXTERN S.TOTA ;/TOTALS
EXTERN S.USER ;/USERID
;*** EXTERN S.UACC ;/UACCOUNT
;*** EXTERN S.UPAS ;/UPASSWORD
EXTERN S.XUO0, S.XUO1, S.XUO2, S.XUO3, S.XUO4, S.XUO5, S.XUO6, S.XUO7
SUBTTL Program parameters
ND $SZRSZ,^D256 ;DEFAULT RECORD SIZE
SUBTTL Command base table definition
DEFINE CMNDS,<
CM COPY,COP,<Make new copy(s) of extant file(s)>
CM DDELET,DDEL,<DAP-mode DELETE command>
CM DDIREC,DDIR,<DAP-mode DIRECT command>
CM DRENAM,DREN,<DAP-mode RENAME command>
CM DSUBMI,DSBM,<DAP-mode SUBMIT command>
;CM DEFAUL,DEF,<Set/show program defaults>
CM DELETE,DEL,<Delete extant file(s)>
CM DIRECT,DIR,<List extant file(s)>
;CM MOVE,MOV,<Move extant file(s) - effectively COPY then DELETE>
CM NETWOR,NET,<List network/node information>
CM PRINT,PRI,<Print ("spool") to line printer>
CM RENAME,REN,<Change the name(s) and/or attribute(s) of extant file(s)>
CM RESET,RES,<Reset/clear NIP operation parameters>
;CM REVIEW,REV,<Peruse extant file(s)>
CM SET,SET,<Set NIP operation parameters>
CM SUBMIT,SBM,<Submit control files to batch processor>
CM TYPE,TYP,<Type extant file(s) on controlling terminal>
IFN FT$FAL,<
CM FAL,FAL##,<Enter File Access Listner mode>
>
IFN FT$TSC,<
CM TLINK,TLINK##,<Cross-connect ("link") two terminals>
CM TSC,TSC##,<Enter Terminal Services Controller mode>
>
IFN FT$CCM,<
CM NCOPY,COP,<"CCL" monitor command, same as COPY>
CM NDELET,DEL,<"CCL" monitor command, same as DELETE>
CM NDIREC,DIR,<"CCL" monitor command, same as DIRECT>
;CM NMOVE,MOV,<"CCL" monitor command, same as MOVE>
CM NRENAM,REN,<"CCL" monitor command, same as RENAME>
;CM NREVIE,REV,<"CCL" monitor command, same as REVIEW>
CM NTYPE,TYP,<"CCL" monitor command, same as TYPE>
>
> ;END OF COMMANDS MACRO
;NOW BUILD THE NIP COMMAND BASE TABLE
DOCMND(NIP)
;NOW MAKE NIP STUFF AVAILABLE TO NFT FOR START-UP (.ISCAN) PURPOSES
INTERN NIPBAS, NIPLEN, NIPNAM
SUBTTL Local keyword lists
;MUST MATCH TT$XXX DEFINITIONS IN ND UNIVERSAL MODULE
KEYS (TOT,<BITS,BYTES,WORDS,RECORDS,BLOCKS,PAGES,FILES,BAUD,ERRORS>)
SUBTTL NIP command
NIP:: PUSHJ P,NIP00 ;DO NIP-STARTUP STUFF
JFCL ;DUH?
PUSHJ P,.CLEOL## ;EAT REST OF LINE'S JUNK
JRST .POPJ1## ;WE ARE NOW A NIP!
;NIP STARTUP STUFF
NIP00:: MOVEI T1,NIPBAS ;SELECT NIP COMMAND BASE
MOVEM T1,CMDBAS## ;AS THE COMMAND BASE
;Now check for a /INITFILE spec and set it up if requested
; PUSHJ P,CLRFIL ;CLEAR OUT "FILE ANSWERS"
; SETZM NIPFSB+.FXFLD ;IN PARTICULAR, CLEAR OUT /INITFILE
; MOVE T1,[NIPOL,,NIPOS] ;.OSCAN BLOCK
; PUSHJ P,.OSCAN## ;CHECK OUT SWITCH.INI
; SKIPN NIPFSB+.FXFLD ;WAS THERE A /INITFILE?
; JRST .POPJ1## ;NO, NIP INITIALIZED
;/INITFILE was specified, convince SWISCN to take indirect file
JRST .POPJ1## ;ALL FOR HERE
SUBTTL NIP command - switch definitions
;"NIP" SWITCHS
DEFINE SWTCHS,<
;SP INITFILE,NIPFSB,.SWFIL##,,FS.NFS!FS.VRQ
SN MOAN,S.MOAN,FS.NFS
SN OKERROR,S.OKER,FS.NFS
SP PASSWORD,<POINT <^D65-$ASCMX>,S.PASS>,.SWASQ##,,
SL TOTALS,S.TOTA,TOT,7777,FS.OBV
SP USERID,<POINT <^D65-<3*$ASCMX>>,S.USER>,.SWUID##,,
>
;DOSCAN(NIPSW)
SUBTTL COPY command
;COPY COMMAND
;
; COPY <OUTPUT-SPECIFICATION> = <INPUT-EXPRESSION>
TTLCOP==TT$BIT!TT$BYT!TT$WRD!TT$BLK!TT$FIL!TT$BAU!TT$ERR
TTMCOP==TT$WRD!TT$BLK!TT$FIL!TT$ERR
COP: SETZM DDCMDF## ;NORMAL COMMAND STUFF
JUMPLE CH,ERRNIF## ;EOL HERE IS JUNK
PUSHJ P,CLRTOT## ;CLEAR TOTALS
PUSHJ P,COPC ;READ IN THE REST OF THE COMMAND
JRST COP70 ;COMMAND ERROR
PUSHJ P,COPD ;HANDLE ANY DEFAULTING
JRST COP70 ;ERROR
PUSHJ P,COPL ;DO THE FILE TRANSFER(S)
JFCL ;IGNORE ERROR (SO COMES OUT IN SUMMARY)
MOVE T1,[TTLCOP,,TTMCOP] ;/TOTALS CONTROL
SKIPLE S.BAUD ;WANT BAUD RATE TOO?
TXO T1,TT$BAU ;YES
PUSHJ P,.TOTAL## ;ISSUE TOTALS SUMMARY
JFCL ;DUH??
;NOW CLEAN UP ANY RANDOM I/O LEFT OVER
;
;INPUT IS RELEASED FIRST IN ORDER TO DE-ALLOCATE MANAGED MEMORY
;IN OPPOSITE ORDER OF ALLOCATION . . .
COP50: MOVEI T1,CDBLI## ;INPUT CHANNEL CDB
PUSHJ P,.IORLS## ;INDICATE WE ARE DONE WITH IT
JFCL ;DUH???
MOVEI T1,CDBLO## ;OUTPUT CHANNEL CDB
PUSHJ P,.IORLS## ;INDICATE WE ARE DONE WITH IT
JFCL ;DUH???
;NOW FREE UP THE FILE SPEC BLOCKS
COP60: PUSHJ P,FRESB## ;FREE UP THE FILE SPEC BLOCKS
JRST COP77 ;???
;ALL DONE WITH COPY COMMAND
JRST .POPJ1## ;RETURN FOR NEXT COMMAND
;COPY ERROR
COP70: PUSHJ P,FRESB## ;MAKE SURE FILE SPEC BLOCKS FREED UP
JFCL ;???
COP77: POPJ P, ;PROPAGATE ERROR
SUBTTL COPY command - parsing
;HERE TO READ THE COPY FILE SPECIFICATIONS
COPC: SETZM SIFIR## ;CLEAR OUT THE OLD DATA BASE
PUSHJ P,.REEAT## ;WANT .TSCAN TO SEE CURRENT CHARACTER!
MOVE T1,[COPTL,,COPTS] ;.TSCAN BLOCK
PUSHJ P,.TSCAN## ;READ A COMMAND LINE
PUSHJ P,CLRFIL ;CLEAR FILE ANSWERS BEFORE SWITCH.INI
MOVE T1,[COPOL,,COPOS] ;.OSCAN BLOCK
PUSHJ P,.OSCAN## ;CHECK SWITCH.INI
;ALL FOR NOW
JRST .POPJ1## ;RETURN HAPPILY
SUBTTL COPY command - defaulting
;HERE TO SUPPLY INPUT AND OUTPUT DEFAULTS
COPD: SKIPN P1,SIFIR## ;ADDRESS OF FIRST INPUT SPEC
JRST ERRNIF## ;NO INPUT FILE SPECIFIED
;HANDLE INPUT DEFAULTING
COPD10: MOVE T1,P1 ;ADDRESS OF CURRENT INPUT SPEC
PUSHJ P,DOSDF ;DO ANY GENERAL FILE-SPEC DEFAULTING
SKIPE .FXNAM(P1) ;GOT A FILE NAME?
JRST COPD17 ;YES
MOVSI T1,'* ' ;FULL WILD NAME
SETZ T2, ;FULL WILD MASK
DMOVEM T1,.FXNAM(P1) ;SUPPLY DEFAULT FILE NAME
XMOVEI T1,[ASCIZ\*\] ;FULL WILD NAME
MOVEM T1,.FSNAM(P1) ;SUPPLY DEFAULT FILE NAME
MOVX T3,FX.WNM ;THE WILDCARDS-IN-NAME FLAG
IORM T3,.FXFLD(P1) ;SET IN FIELDS FLAGS
COPD17: MOVX T1,FX.UQN ;
TDNN T1,.FXFLD(P1) ;USER-SPECIFIED QUOTED FILE NAME?
SKIPE .FXEXT(P1) ;GOT AN EXTENSION?
JRST COPD18 ;YES
MOVSI T1,'* ' ;FULL WILD NAME
HLLZM T1,.FXEXT(P1) ;SUPPLY DEFAULT FILE EXTENSION
XMOVEI T1,[ASCIZ\*\] ;FULL WILD NAME
MOVEM T1,.FSEXT(P1) ;SUPPLY DEFAULT FILE EXTENSION
MOVX T3,FX.WEX ;THE WILDCARDS-IN-EXTENSION FLAG
IORM T3,.FXFLD(P1) ;SET THAT TOO
COPD18: MOVX T1,FX.PRT ;THE /OKPROT SWITCH BIT
TDNN T1,.FXMOM(P1) ;EXPLICIT /OKPROT/ERPROT?
ANDCAM T1,.FXMOD(P1) ;NO, DEFAULT TO /ERPROT
; CONSIDER "26_NUL:=ACCT.SYS[1,4]"
IORM T1,.FXMOM(P1) ;MAKE SURE NOBODY ELSE UNDEFAULTS US!
MOVX T1,FX.STR ;THE /STRS SWITCH BIT
TDNN T1,.FXMOM(P1) ;EXPLICIT /[NO]STRS?
IORM T1,.FXMOD(P1) ;NO, SET IMPLICIT /STRS
MOVX T1,FX.QRY ;/QUERY MASK
MOVX T2,FX.QRT ;/QUERY:TELL
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T2,.FXCTL(P1) ;NO, DEFAULT TO /QUERY:TELL
ADDI P1,.FXMAX ;STEP TO NEXT SPEC
CAMG P1,SILAS## ;REACHED LAST ONE YET?
JRST COPD10 ;NOPE, LOOP BACK FOR MORE DEFAULTS
;HANDLE OUTPUT DEFAULTING
COPD50: SKIPE P1,SOFIR## ;OUTPUT FILE SPEC BLOCK
JRST COPD52 ;USER TYPED ONE IN, GO FILL IT OUT
;NO OUTPUT FILE SPECIFIED, DEFAULT TO DSK:[]*.*
PUSHJ P,CLRFIL## ;CLEAR OUT FILE SPECIFICATION
PUSHJ P,OUX## ;ALLOCATE A FILE SPEC BLOCK
MOVE P1,T1 ;WANT ADDRESS IN P1 ON G.P.S
MOVSI T1,'DSK' ;DEFAULT OUTPUT DEVICE
SETO T2, ;NON-WILD MASK
DMOVEM T1,.FXDEV(P1) ;SET DEFAULT DEVICE
XMOVEI T1,[ASCIZ\DSK\] ;DEFAULT OUTPUT DEVICE
MOVEM T1,.FSDEV(P1) ;SUPPLY DEFAULT OUTPUT DEVICE
;FLESH OUT THE OUTPUT FILE SPEC
COPD52: MOVE T1,P1 ;POSITION ADDRESS OF FILE SPEC BLOCK
PUSHJ P,DOSDF ;DO ANY GENERAL FILE-SPEC DEFAULTING
SKIPE .FXNAM(P1) ;OUTPUT FILE NAME GIVEN?
JRST COPD57 ;YES
MOVSI T1,'* ' ;FULL WILD NAME
SETZ T2, ;FULL WILD MASK
DMOVEM T1,.FXNAM(P1) ;SET DEFAULT FILE NAME
XMOVEI T1,[ASCIZ\*\] ;FULL WILD NAME
MOVEM T1,.FSNAM(P1) ;SUPPLY DEFAULT FILE NAME
MOVX T3,FX.WNM ;THE WILDCARDS-IN-NAME FLAG
IORM T3,.FXFLD(P1) ;NOTE THAT TOO
COPD57: MOVX T1,FX.UQN ;
TDNN T1,.FXFLD(P1) ;USER-SPECIFIED QUOTED FILE NAME?
SKIPE .FXEXT(P1) ;OUTPUT EXTENSION GIVEN?
JRST COPD58 ;YES
MOVSI T1,'* ' ;FULL WILD NAME
HLLZM T1,.FXEXT(P1) ;NO, DEFAULT TO FULL WILD
XMOVEI T1,[ASCIZ\*\] ;FULL WILD NAME
MOVEM T1,.FSEXT(P1) ;SUPPLY DEFAULT FILE EXTENSION
MOVX T3,FX.WEX ;THE WILDCARDS-IN-EXTENSION FLAG
IORM T3,.FXFLD(P1) ;NOTE THAT TOO
COPD58: MOVX T1,FX.PRT ;THE /OKPROT BIT
TDNN T1,.FXMOM(P1) ;DID USER SPECIFY /[NO]ERPROT?
ANDCAM T1,.FXMOD(P1) ;NO, FORCE /ERPROT FOR OUTPUT FILE
TDNN T1,.FXMOM(P1) ;DID USER SPECIFY /[NO]ERPROT?
IORM T1,.FXMOM(P1) ;AND MAKE IT STICKY
MOVX T1,FX.QRY ;/QUERY MASK
MOVX T2,FX.QRT ;/QUERY:TELL
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T2,.FXCTL(P1) ;NO, DEFAULT TO /QUERY:TELL
;ALL DONE HERE
JRST .POPJ1## ;DEFAULTS DEFAULTED
SUBTTL COPY command - main file transfer loop
;LOOP FINDING AND TRANSFERRING THE FILE(S)
COPL: XMOVEI CI,CDBLI## ;INPUT CDB
XMOVEI CO,CDBLO## ;OUTPUT CDB
MOVE T1,CI ;ADDRESS OF INPUT I/O CDB
MOVEI T2,COPIV ;ADDRESS OF CDB INITIALIZATION VECTOR
PUSHJ P,.IOINI## ;INITIALIZE THE CDB
JRST ERRCDI## ;CAN'T INITIALIZE INPUT CDB
MOVE T3,SIFIR## ;FIRST INPUT FILE SPEC
MOVEM T3,.IOFSB(T1) ;SET FIRST ADDRESS IN CDB
MOVE T3,SILAS## ;LAST INPUT FILE SPEC
MOVEM T3,.IOFSL(T1) ;SET LAST INPUT FILE SPEC
MOVE T1,CO ;ADDRESS OF OUTPUT I/O CDB
MOVEI T2,COPOV ;ADDRESS OF CDB INITIALIZATION VECTOR
PUSHJ P,.IOINI## ;INITIALIZE THE CDB
JRST ERRCDO## ;CAN'T INITIALIZE OUTPUT CDB
MOVE T3,SOFIR## ;FIRST (AND ONLY) OUTPUT SPEC
MOVEM T3,.IOFSB(T1) ;SET FIRST ADDRESS IN CDB
MOVEM T3,.IOFSL(T1) ;ALSO THE LAST ADDRESS
COPL10: MOVE T3,COPIVC ;PROTOTYPE INPUT I/O CONTROL FLAGS
MOVE T1,.IOFSB(CO) ;GET OUTPUT FILE SPEC BLOCK ADDRESS
DMOVE T1,.FXUSW(T1) ;GET OUTPUT FILE SWITCHES (/[NO]LSN)
TXNE T1,US$LSN ;OUTPUT SELECT LSN?
TXO T3,IC.LSN ;YES, PRESERVE INCOMING LSN'S THEN
MOVE T1,.IOFSB(CI) ;GET INPUT FILE SPEC BLOCK ADDRESS
DMOVE T1,.FXUSW(T1) ;GET INPUT FILE SWITCHES (/[NO]LSN)
TXNE T1,US$LSN ;WAS /LSN?
TXO T3,IC.LSN ;YES, PRESERVE INPUT LSN'S
TXNE T2,US$LSN ;DID INPUT SPECIFY SOME FLAVOR OF /[NO]LSN?
TXNE T1,US$LSN ;YES, WAS IT /NOLSN?
CAIA ;NOT TO WORRY
TXZ T3,IC.LSN ;/NOLSN, SUPPRESS INPUT LSNS
MOVEM T3,.IOIOC(CI) ;RE/SET I/O CONTROL FOR NEW INPUT FILE
PUSHJ P,.NXTFI## ;GET NEXT INPUT FILE
JRST COPLIE ;GO CHECK OUT FAILURE
PUSHJ P,CIOX ;SET OUTPUT FILE ATTRIBUTES FROM INPUT FILE
JFCL ;DUH?
PUSHJ P,.NXTFO## ;SET NEXT OUTPUT FILE
JRST COPLOE ;BUMMER
MOVE T1,CDBLI+.IOCCF ;GET INPUT CHANNEL CONTROL FLAGS
IOR T1,CDBLO+.IOCCF ;MERGE IN OUTPUT CHANNEL CONTROL FLAGS
SKIPGE S.BAUD ;UNLESS USER EXPLICITLY SPECIFIED /[NO]BAUD
TXNN T1,IO.NET ;DEFAULT /BAUD IF A NETWORK CHANNEL
CAIA ;NO DEFAULT
HRRZM P,S.BAUD ;DEFAULT /BAUD FOR NETWORK FILE TRANSFER
MSTIME T1, ;GET TIME OF DAY
MOVEM T1,TIME## ;AND REMEMBER IT FOR LATER
MOVE P4,CDBLO##+.IOBSZ ;GET OUTPUT BYTE SIZE
; (ALL "TOTAL"S ARE BASED ON OUTPUT FILE)
MOVEM P4,TOTBSZ ;SAVE FOR LATER TOTALS CALCULATION
SETZ P4, ;TOTAL BYTES TRANSFERRED SO FAR
;LOOP COPYING FILE DATA
COPL50: PUSHJ P,COPY ;LET THE COPY PROCESSOR RIP
JRST COPL10 ;ABORTED, TRY FOR ANOTHER FILE
;INPUT FILE FINISHED, ACCUMULATE TOTALS
COPL80: MSTIME T1, ;GET NEW TIME OF DAY
SUB T1,TIME## ;GET INCREMENTAL TIME OF DAY
CAIGE T1,0 ;WRAP AROUND?
ADDX T1,^D24*^D60*^D60*^D1000 ;WRAPPED PAST MIDNIGHT
CAIG T1,0 ;IF CAME BACK THE SAME TICK
MOVEI T1,1 ;DON'T DIVIDE BY ZERO
ADDM T1,MSECS## ;COUNT UP TIME
;NOW ACCOUNT FOR THE ACTUAL AMOUNT OF DATA TRANSFERRED
MOVE T2,TOTBSZ ;T2:=BITS PER LOGICAL DATA BYTE
JFCL 17,.+1 ;CLEAR OUT ARITHMETIC FLAGS
IMUL T2,P4 ;T2:=TOTAL DATA BITS EFFECTIVELY TRANSFERRED
ADDM T2,BITS## ;ACCUMULATE TOTAL BITS FOR BAUD SUMMARY
JOV [PUSHJ P,TOTGBT ;SINGLE PRECISION OVERFLOW
JRST .+1] ;HO HUM
ADDM P4,BYTES## ;ACCUMULATE TOTAL BYTES
MOVEI T2,^D36 ;BITS PER -10 WORD
IDIV T2,TOTBSZ ;T2:=NUMBER OF DATA BYTES PER -10 WORD
MOVE T1,P4 ;GET TOTAL BYTES TRANSFERRED
IDIV T1,T2 ;T2:=TOTAL -10 WORDS XFERRED
CAIE T2,0 ;GOT ANYTHING LEFTOVER?
ADDI T1,1 ;ROUND UP WORD COUNT
ADDM T1,WORDS## ;ACCUMULATE TOTALS
ADDI T1,177 ;ROUND UP
LSH T1,-7 ;AND CHOP DOWN TO BLOCKS
ADDM T1,BLOCKS## ;COUNT UP BLOCKS
AOS FILES## ;COUNT UP FILES
JRST COPL10 ;BACK FOR MORE FILES
;INPUT FILE ACCESS ERROR (.NXTFI/.IOPIN)
COPLIE: CAIN M0,$EFIXN ;INPUT EXHAUSTED?
JRST .POPJ1## ;YES, SUCCESSFUL COMPLETION OF COMMAND
PUSHJ P,NERFAE ;HANDLE FILE OPEN ERROR
POPJ P, ;ABORT ON ERROR
JRST COPL10 ;CONTINUE ON ERROR
;FILE CREATE ERROR (.NXTFO/.IOPOU)
COPLOE: CAIN M0,$EFRJU ;REJECTED BY USER?
JRST [PUSHJ P,NERFAB ;ABORT I/O
JRST COPL10] ;SKIP INTO NEXT FILE
AOS ERRORS## ;COUNT UP FILE ERROR
MOVEI T1,CDBLO## ;*** ADDRESS OF OUTPUT CDB
PUSHJ P,.ERPOU## ;TYPE FILE CREATE ERROR MESSAGE
PUSHJ P,NERFAB ;ABORT THE FILE
PUSHJ P,ONERCK## ;WANT TO ABORT ON ERROR?
POPJ P, ;ABORT ON ERROR
JRST COPL10 ;CONTINUE ON ERROR
;HERE ON INFINITE BITS (SINGLE PRECISION /TOTALS OVERFLOW)
TOTGBT: SKIPE S.TOTA ;GOING TO GIVE A TOTALS SUMARY?
WARN GBT,<More than 3435938367 data bits, /TOTALS overflowed!>
HRLOI T2,377777 ;POSITIVE INFINITY
MOVEM T2,BITS## ;PEG THE BITS COUNTER
SETZ T2, ;CLEAR
POPJ P, ;AND RETURN
SUBTTL COPY command - switch definitions
;"COPY" SWITCHS
DEFINE SWTCHS,<
SN ARROW,<POINTR (F.BLK##+.FXUSW,US$ARR)>,
SN BAUD,S.BAUD,FS.NFS
;SN CHOP,<POINTR (F.BLK##+.FXUSW,US$CHO)>,
SN CONCATENATE,<POINTR (F.BLK##+.FXUSW,US$CON)>,
SP CRLF,S.XUO0,.SWDEC##,,FS.VRQ
SN CSN,<POINTR (F.BLK##+.FXUSW,US$CSN)>,
SP CSNCOLUMN,S.XUO2,.SWDEC##,CSC,FS.VRQ
SP CSNINCREMENT,S.XUO3,.SWDEC##,CSI,FS.VRQ
SP CSNWIDTH,S.XUO4,.SWDEC##,CSW,FS.VRQ
SP DIAL,<POINT <^D65-2>,S.DIAL>,.SWPNM##,,
SN EBCDIC,<POINTR (F.BLK##+.FXUSW,US$EBC)>,
SL FLAG,<POINTR (F.BLK##+.FXUSW,US$FLG)>,FLG,FLGLOW
;SP INITFILE,NIPFSB,.SWFIL##,,FS.NFS!FS.VRQ
SN LSN,<POINTR (F.BLK##+.FXUSW,US$LSN)>,
SN LSNCONTINUOUS,<POINTR (F.BLK##+.FXUSW,US$LSC)>,
SP LSNINCREMENT,S.XUO6,.SWDEC##,LSI,
SN MOAN,S.MOAN,FS.NFS
SN NONULLS,<POINTR (F.BLK##+.FXUSW,US$NUL)>,
SN OKERROR,S.OKER,FS.NFS
SP PASSWORD,<POINT <^D65-$ASCMX>,S.PASS>,.SWASQ##,,
SN SPACES,<POINTR (F.BLK##+.FXUSW,US$SPA)>,
SN TABS,<POINTR (F.BLK##+.FXUSW,US$TAB)>,
SL TOTALS,S.TOTA,TOT,7777,FS.OBV
SN TRUNCATE,<POINTR (F.BLK##+.FXUSW,US$TRU)>,
SP USERID,<POINT <^D65-<3*$ASCMX>>,S.USER>,.SWUID##,,
;*** SP UACCOUNT,<POINT <^D65-$ASCMX>,S.UACC>,.SWUAC##,,
;*** SP UPASSWORD,<POINT <^D65-$ASCMX>,S.UPAS>,.SWUPA##,,
SP WRAP,S.XUO7,.SWDEC##,,FS.VRQ
>
;FLAGS STORED IN THE .FXUSW WORD
US$ARR==1B0 ;/[NO]ARROW
US$CHO==1B1 ;/[NO]CHOP
US$CSN==1B2 ;/[NO]CSN
US$EBC==1B3 ;/[NO]EBCDIC
US$EBI==1B4 ;INTERNAL FLAG USAGE ONLY, NOT A SWITCH
US$LSN==1B5 ;/[NO]LSN
US$NUL==1B6 ;/[NO]NONULLS
US$SPA==1B7 ;/[NO]SPACES
US$TAB==1B8 ;/[NO]TABS
US$TRU==1B9 ;/[NO]TRUNCATE
US$FLG==7B12 ;/FLAG:(LOWER, UPPER)
US$FLU==1B11 ;/FLAG:UPPER
US$FLL==1B12 ;/FLAG:LOWER
US$CON==1B13 ;/CONCATENATE
US$LSC==1B14 ;/[NO]LSNCONTINUOUS
;THE CHARACTER TRANSLATION MASKS
US$XLI==US$EBI ;INPUT TRANSLATION NEEDED
US$XLO==US$EBC ;OUTPUT TRANSLATION NEEDED
;CHARACTER PROCESSING OF ANY TYPE MASK
US$CHP==US$ARR!US$CHO!US$CSN!US$EBC!US$EBI!US$LSN!US$NUL
US$CHP==US$CHP!US$SPA!US$TAB!US$TRU!US$FLG
;VALUES STORED IN $FXUO? (ORDERING MUST MATCH S.XUO? USAGE IN SWTCHS MACRO)
$FXCRL==$FXUO0 ;/CRLF
;$FXCSN==$FXUO1 ;/CSN
$FXCSC==$FXUO2 ;/CSNCOLUMN
$FXCSI==$FXUO3 ;/CSNINCREMENT
$FXCSW==$FXUO4 ;/CSNWIDTH
;$FXLSN==$FXUO5 ;/LSN
$FXLSI==$FXUO6 ;/LSNINCREMENT
$FXWRA==$FXUO7 ;/WRAP
$FXBCH==$FXUO0 ;BEGINING OF CHARACTER PROCESSING SWITCHES
$FXECH==$FXUO7+1 ;END (+1) OF CHARACTER PROCESSING SWITCHES
;SWITCH MAXIMA AND DEFAULTS
DM CSC,^D500,^D72,^D72 ;/CSNCOLUMN
DM CSI,^D10000,^D1,^D1 ;/CSNINCREMENT
DM CSW,^D16,^D08,^D08 ;/CSNWIDTH
DM LSI,^D10000,^D10,^D10 ;/LSN
;SWITCH KEYWORDS
KEYS (FLG,<LOWER,UPPER>)
DOSCAN(COPSW)
SUBTTL COPY command - SCAN argument blocks
;"COPY" TSCAN PARAMETER BLOCK
COPTS: EXP FXVRSN ;PROTOCOL VERSION WORD
IOWD COPSWL,COPSWN ;IOWD POINTER FOR SWITCH NAMES
XWD COPSWD,COPSWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,COPSWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /NIP/ ;HELP
XWD CLRALL,CLRFIL ;CLEAR ALL,,CLEAR FILE
XWD INX,OUX ;ALLOC INPUT AREA,,ALLOC OUTPUT AREA
XWD MEMSTK,APLSTK ;MEMORIZE STICKY,,APPLY STICKY
XWD CLRSTK,0 ;CLEAR STICKY,,FLAGS
Z ;<FUTURE>,,SWITCH VALUE STORAGE RTN
COPTL==.-COPTS
;"COPY" OSCAN BLOCK
COPOS: EXP FXVRSN ;PROTOCOL VERSION WORD
IOWD COPSWL,COPSWN ;IOWD POINTER FOR SWITCH NAMES
XWD COPSWD,COPSWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,COPSWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /NIP/ ;HELP
XWD COPOSL,COPOSN ;OPTIONS NAME(S)
COPOL==.-COPOS
COPOSN: SIXBIT \COPY\
SIXBIT \NIP\
SIXBIT \NFT\
COPOSL==.-COPOSN
SUBTTL COPY command - I/O CDB initialization vectors
;"COPY" CDB INITIALIZATION VECTORS.
;
;NOTE THAT THE INPUT SIDE DEFERS BUFFER ALLOCATION UNTIL AFTER THE
;OUTPUT SIDE HAS BEEN OPENED AND OUTPUT BUFFERS ALLOCATED. THIS IS
;SO THAT VARIOUS INPUT DEVICES CAN ALLOCATE AND DEALLOCATE BUFFERS
;AND NOT "GROW" MEMORY NEEDLESSLY.
;"COPY" INPUT CDB INITIALIZATION VECTOR
COPIV: EXP 10 ;COUNT OF WORDS FOLLOWING
'NS',,102030 ;VERSION WORD
0 ;"EXTRA" SIZE TO ALLOCATE
0 ;DEFAULT BUFFERING
0 ;MAXIMUM BUFFERING
COPIVC: 0 ;I/O CONTROL
0 ;I/O ERROR CONTROL
IM.SMD!IM.SBO!IM.DQI ;I/O MODE
0 ;(RESERVED)
;"COPY" OUTPUT CDB INITIALIZATION VECTOR
COPOV: EXP 10 ;COUNT OF WORDS FOLLOWING
'NS',,102030 ;VERSION WORD
0 ;"EXTRA" SIZE TO ALLOCATE
0 ;DEFAULT BUFFERING
0 ;MAXIMUM BUFFERING
COPOVC: 0 ;I/O CONTROL
0 ;I/O ERROR CONTROL
0 ;I/O MODE
0 ;(RESERVED)
SUBTTL DEFAULT command
DEF: ERROR DFY,<DEFAULT command not yet implemented>
SUBTTL DELETE command
;DELETE COMMAND
;
; DELETE <INPUT-EXPRESSION>
; DDELET <INPUT-SPECIFICATION>
TTLDDE==TT$BLK!TT$FIL!TT$ERR
TTLDEL==TT$BLK!TT$FIL!TT$ERR
TTMDEL==TT$BLK!TT$FIL!TT$ERR
DDEL: TDZA T1,T1 ;"DAP" ENTRY
DEL: SETO T1, ;NORMAL ENTRY
SETCAM T1,DDCMDF## ;SET COMMAND MODE
JUMPLE CH,ERRNIF## ;EOL HERE IS JUNK
PUSHJ P,CLRTOT## ;CLEAR TOTALS
PUSHJ P,DELC ;READ IN THE REST OF THE COMMAND
JRST DEL70 ;COMMAND ERROR
PUSHJ P,DELD ;HANDLE ANY DEFAULTING
JRST DEL70 ;ERROR
PUSHJ P,DELL ;DO THE FILE DELETE(S)
JFCL ;IGNORE ERROR (SO COMES OUT IN SUMMARY)
SKIPE DDCMDF## ;RESTRICTED TO DAP MODE?
SKIPA T1,[TTLDDE,,TTMDEL] ;YES
MOVE T1,[TTLDEL,,TTMDEL] ;GET TOTALS CONTROL
PUSHJ P,.TOTAL## ;AND ISSUE TOTALS SUMMARY
JFCL ;ERROR (?)
;DO ANY FINAL CLEANUP NEEDED
DEL50: MOVEI T1,CDBLI## ;INPUT CHANNEL CDB
PUSHJ P,.IORLS## ;INDICATE WE ARE DONE WITH IT
JFCL ;DUH???
;NOW FREE UP THE FILE SPEC BLOCKS
DEL60: PUSHJ P,FRESB## ;FREE UP THE FILE SPEC BLOCKS
JRST DEL77 ;???
;ALL DONE WITH "DELETE" COMMAND
JRST .POPJ1## ;RETURN FOR NEXT COMMAND
;DELETE COMMAND-LEVEL ERROR
DEL70: PUSHJ P,FRESB## ;FREE UP ANY FILE SPEC BLOCKS LEFT LYING AROUND
JFCL ;???
DEL77: POPJ P, ;PROPAGATE ERROR
SUBTTL DELETE command - parsing
;HERE TO READ THE DELETE FILE SPECIFICATIONS
DELC: SETZM SIFIR## ;CLEAR OUT THE OLD DATA BASE
PUSHJ P,.REEAT## ;WANT .TSCAN TO SEE CURRENT CHARACTER!
MOVE T1,[DELTL,,DELTS] ;.TSCAN BLOCK
PUSHJ P,.TSCAN## ;READ A COMMAND LINE
PUSHJ P,CLRFIL ;CLEAR FILE ANSWERS BEFORE SWITCH.INI
MOVE T1,[DELOL,,DELOS] ;.OSCAN BLOCK
PUSHJ P,.OSCAN## ;CHECK SWITCH.INI
;ALL FOR NOW
SKIPN DDCMDF## ;DAPPING?
JRST .POPJ1## ;RETURN HAPPILY
;MAKE SURE COMMAND WILL FIT DAP CONSTRAINTS
PUSHJ P,DDCVFY ;CALL DAP COMMAND VERIFIER
POPJ P, ;USER LOSES
JRST .POPJ1## ;RETURN HAPPILY
SUBTTL DELETE command - defaulting
;HERE TO SUPPLY INPUT AND OUTPUT DEFAULTS
DELD: SKIPN P1,SIFIR## ;ADDRESS OF FIRST INPUT SPEC
JRST ERRNIF## ;NONE???
;HANDLE INPUT DEFAULTING
DELD10: MOVE T1,P1 ;ADDRESS OF CURRENT INPUT SPEC
PUSHJ P,DOSDF ;DO ANY GENERAL FILE-SPEC DEFAULTING
SKIPN .FXNAM(P1) ;USER TYPE AN EXPLICIT FILE NAME?
ERROR FRD,<Filename is required in DELETE command>
SKIPN .FXEXT(P1) ;USER TYPE AN EXPLICIT EXTENSION?
HLLOS .FXEXT(P1) ;NO, DELETE SHOULD NOT DEFAULT TO "*"
MOVX T1,FX.PRT ;THE /OKPROT SWITCH BIT
TDNN T1,.FXMOM(P1) ;EXPLICIT /OKPROT/ERPROT?
ANDCAM T1,.FXMOD(P1) ;NO, DEFAULT TO /ERPROT
IORM T1,.FXMOM(P1) ;MAKE SURE NOBODY ELSE UNDEFAULTS US!
MOVX T1,FX.STR ;THE /STRS SWITCH BIT
TDNN T1,.FXMOM(P1) ;EXPLICIT /[NO]STRS?
IORM T1,.FXMOD(P1) ;NO, SET IMPLICIT /STRS
MOVX T1,FX.QRY ;/QUERY MASK
MOVX T2,FX.QRT ;/QUERY:TELL
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T2,.FXCTL(P1) ;NO, DEFAULT TO /QUERY:TELL
MOVX T1,FX.QNY ;THE [N/Y] BIT
TDNN T1,.FXCTM(P1) ;DID USER REQUEST IT?
IORM T1,.FXCTL(P1) ;NO, SO DEFAULT TO [N/Y]
ADDI P1,.FXMAX ;STEP TO NEXT SPEC
CAMG P1,SILAS## ;REACHED LAST ONE YET?
JRST DELD10 ;NOPE, LOOP BACK FOR MORE DEFAULTS
;HANDLE OUTPUT
DELD50: SKIPE P1,SOFIR## ;OUTPUT FILE SPEC BLOCK
JRST ERROFI## ;ILLEGAL OUTPUT FILE
;ALL DONE HERE
JRST .POPJ1## ;DEFAULTS DEFAULTED
SUBTTL DELETE command - main file deletion loop
;LOOP FINDING AND DELETING THE FILE(S)
DELL: MOVEI T1,CDBLI## ;ADDRESS OF INPUT I/O CDB
MOVEI T2,DELIV ;ADDRESS OF CDB INITIALIZATION VECTOR
PUSHJ P,.IOINI## ;INITIALIZE THE CDB
JRST ERRCDI## ;CAN'T INITIALIZE INPUT CDB
MOVE T3,SIFIR## ;FIRST INPUT FILE SPEC
MOVEM T3,.IOFSB(T1) ;SET FIRST ADDRESS IN CDB
MOVE T3,SILAS## ;LAST INPUT FILE SPEC
MOVEM T3,.IOFSL(T1) ;SET LAST INPUT FILE SPEC
SKIPE DDCMDF## ;DAP-MODE?
JRST DELLD ;YES
DELL10: PUSHJ P,.NXTFI## ;GET NEXT INPUT FILE
JRST DELLIE ;GO CHECK OUT FAILURE
MOVE P4,CDBLI+.IOLNW ;INPUT FILE WORD COUNT
;NOW DELETE THE FILE AS REQUESTED
MOVEI T1,CDBLI## ;ADDRESS OF INPUT CDB
PUSHJ P,.IOFDL## ;DELETE THE FILE AS APPROPRIATE
JRST DELLFE ;GO CHECK OUT FAILURE
DELL80: ADDM P4,WORDS## ;COUNT UP THE WORDS TRANSFERRED
ADDI P4,177 ;ROUND UP
LSH P4,-7 ;AND CHOP DOWN TO BLOCKS
ADDM P4,BLOCKS## ;COUNT UP BLOCKS
AOS FILES## ;COUNT UP FILES
JRST DELL10 ;GO BACK FOR NEXT FILE
;INPUT FILE ACCESS ERROR (.NXTFI/.IOPIN)
DELLIE: CAIN M0,$EFIXN ;INPUT EXHAUSTED?
JRST .POPJ1## ;YES, SUCCESSFUL COMPLETION OF COMMAND
PUSHJ P,NERFAE ;HANDLE FILE OPEN ERROR
POPJ P, ;ABORT ON ERROR
JRST DELL10 ;CONTINUE ON ERROR
;FILE DELETE ERROR (.IOFDL)
DELLFE: CAIN M0,$EFRJU ;REJECTED BY USER?
JRST [PUSHJ P,NERFAI ;ABORT I/O
JRST DELL10] ;SKIP INTO NEXT FILE
AOS ERRORS## ;COUNT UP ERRORS
MOVEI T1,CDBLI## ;*** ADDRESS OF INPUT CDB
PUSHJ P,.ERFDL## ;TYPE FILE DELETE ERROR MESSAGE
PUSHJ P,NERFAI ;ABORT THE FILE
PUSHJ P,ONERCK## ;WANT TO ABORT ON ERROR?
POPJ P, ;ABORT ON ERROR
JRST DELL10 ;CONTINUE ON ERROR
;HERE FOR DAP-MODE DELETE
DELLD: XMOVEI T1,CDBLI## ;ADDRESS OF INPUT CDB
XMOVEI T2,DELLDP ;ADDRESS OF FILE "PROCESSOR"
XMOVEI T3,DELLDE ;ADDRESS OF ERROR PROCESSOR
PUSHJ P,.IODDE## ;DO A DAP-MODE DELETE OPERATION
JRST DDCERM ;DAP-MODE COMMAND FAILURE
JRST .POPJ1## ;SUCCESSFUL
DELLDP: MOVE T1,CDBLI+.IOLNW ;GET FILE LENGTH IN -10 WORDS
ADDI T1,177 ;ROUND UP AND
LSH T1,-7 ;TRUNCATE TO BLOCK SIZE
ADDM T1,BLOCKS## ;ACCUMULATE BLOCKS DEALLOCATED
AOS FILES## ;COUNT THE FILES AS THEY GO BY
JRST .POPJ1## ;THAT'S ALL
DELLDE: AOS ERRORS## ;COUNT THE ERRORS AS THEY ACCUMULATE
PJRST ONERCK## ;MAYBE PROCEED, MAYBE ABORT
SUBTTL DELETE command - switch definitions
;"DELETE" SWITCHS
DEFINE SWTCHS,<
;SP INITFILE,NIPFSB,.SWFIL##,,FS.NFS!FS.VRQ
SN MOAN,S.MOAN,FS.NFS
SN OKERROR,S.OKER,FS.NFS
SP PASSWORD,<POINT <^D65-$ASCMX>,S.PASS>,.SWASQ##,,
SL TOTALS,S.TOTA,TOT,7777,FS.OBV
SP USERID,<POINT <^D65-<3*$ASCMX>>,S.USER>,.SWUID##,,
>
DOSCAN(DELSW)
SUBTTL DELETE command - SCAN argument blocks
;"DELETE" TSCAN PARAMETER BLOCK
DELTS: EXP FXVRSN ;PROTOCOL VERSION WORD
IOWD DELSWL,DELSWN ;IOWD POINTER FOR SWITCH NAMES
XWD DELSWD,DELSWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,DELSWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /NIP/ ;HELP
XWD CLRALL,CLRFIL ;CLEAR ALL,,CLEAR FILE
XWD INX,OUX ;ALLOC INPUT AREA,,ALLOC OUTPUT AREA
XWD MEMSTK,APLSTK ;MEMORIZE STICKY,,APPLY STICKY
XWD CLRSTK,0 ;CLEAR STICKY,,FLAGS
Z ;<FUTURE>,,SWITCH VALUE STORAGE RTN
DELTL==.-DELTS
;"DELETE" OSCAN BLOCK
DELOS: EXP FXVRSN ;PROTOCOL VERSION WORD
IOWD DELSWL,DELSWN ;IOWD POINTER FOR SWITCH NAMES
XWD DELSWD,DELSWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,DELSWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /NIP/ ;HELP
XWD DELOSL,DELOSN ;OPTIONS NAME(S)
DELOL==.-DELOS
DELOSN: SIXBIT \DELETE\
SIXBIT \NIP\
SIXBIT \NFT\
DELOSL==.-DELOSN
SUBTTL DELETE command - I/O CDB initialization vector
;"DELETE" INPUT CDB INITIALIZATION VECTOR
DELIV: EXP 10 ;COUNT OF WORDS FOLLOWING
'NS',,102030 ;VERSION WORD
0 ;"EXTRA" SIZE TO ALLOCATE
0 ;DEFAULT BUFFERING
0 ;MAXIMUM BUFFERING
0 ;I/O CONTROL
0 ;I/O ERROR CONTROL
IM.SBO!IM.SMD ;I/O MODE ;[7]
0 ;(RESERVED)
SUBTTL DIRECTORY command
;DIRECTORY COMMAND
;
; DIRECT <LIST-SPECIFICATION> = <INPUT-EXPRESSION>
; DDIREC <LIST-SPECIFICATION> = <INPUT-SPECIFICATION>
TTLDDI==TT$FIL!TT$ERR
TTLDIR==TT$WRD!TT$BLK!TT$FIL!TT$ERR
TTMDIR==TT$FIL!TT$ERR
DDIR: TDZA T1,T1 ;FLAG DAP MODE ENTRY
DIR: SETO T1, ;FLAG NORMAL ENTRY
SETCAM T1,DDCMDF## ;SET DAP FLAG
PUSHJ P,CLRTOT## ;CLEAR TOTALS
PUSHJ P,DIRC ;READ IN THE REST OF THE COMMAND
JRST DIR70 ;COMMAND ERROR
PUSHJ P,DIRD ;HANDLE ANY DEFAULTING
JRST DIR70 ;ERROR
PUSHJ P,DIRL ;LIST THE FILE(S)
JFCL ;IGNORE ERROR (SO COMES OUT IN SUMMARY)
SKIPE DDCMDF## ;RESTRICTED TO DAP-MODE?
SKIPA T1,[TTLDDI,,TTMDIR] ;GET THE TOTALS CONTROL
MOVE T1,[TTLDIR,,TTMDIR] ;GET THE TOTALS CONTROL
PUSHJ P,.TOTAL## ;AND ISSUE TOTALS IF NEEDED
JFCL ;ERROR (?)
;NOW CLEAN UP ANY RANDOM I/O LEFT OVER
;
;INPUT IS RELEASED FIRST IN ORDER TO DE-ALLOCATE MANAGED MEMORY
;IN OPPOSITE ORDER OF ALLOCATION . . .
DIR50: MOVEI T1,CDBLI## ;INPUT CHANNEL CDB
PUSHJ P,.IORLS## ;INDICATE WE ARE DONE WITH IT
JFCL ;DUH???
SKIPN SOFIR## ;GOT AN OUTPUT SPEC?
JRST DIR60 ;NO, JUST DID OUTCHRS, NO CDB PRESENT
MOVEI T1,CDBLO## ;OUTPUT CHANNEL CDB
PUSHJ P,.IOCLO## ;CLOSE OFF THE LISTING FILE
ERROR ECD,<Error CLOSEing directory listing file>
PUSHJ P,.IORLS## ;INDICATE WE ARE DONE WITH IT
JFCL ;DUH???
;NOW FREE UP THE FILE SPEC BLOCKS
DIR60: PUSHJ P,FRESB## ;FREE UP THE FILE SPEC BLOCKS
JRST DIR77 ;???
;ALL DONE WITH DIRECT COMMAND
JRST .POPJ1## ;RETURN FOR NEXT COMMAND
;DIRECT ERROR
DIR70: PUSHJ P,FRESB## ;MAKE SURE FILE SPEC BLOCKS FREED UP
JFCL ;???
DIR77: POPJ P, ;PROPAGATE ERROR
SUBTTL DIRECTORY command - parsing
;HERE TO READ THE DIRECT FILE SPECIFICATIONS
DIRC: SETZM SIFIR## ;CLEAR OUT THE OLD DATA BASE
PUSHJ P,.REEAT## ;WANT .TSCAN TO SEE CURRENT CHARACTER!
MOVE T1,[DIRTL,,DIRTS] ;.TSCAN BLOCK
PUSHJ P,.TSCAN## ;READ A COMMAND LINE
PUSHJ P,CLRFIL ;CLEAR FILE ANSWERS BEFORE SWITCH.INI
MOVE T1,[DIROL,,DIROS] ;.OSCAN BLOCK
PUSHJ P,.OSCAN## ;CHECK SWITCH.INI
;ALL FOR NOW
SKIPN DDCMDF## ;DAPPING?
JRST .POPJ1## ;RETURN HAPPILY
;MAKE SURE DAP WON'T BE OFFENDED
PUSHJ P,DDCVFY ;VERIFY DAPPABLE COMMAND
POPJ P, ;NOPE
JRST .POPJ1## ;RETURN HAPPILY
SUBTTL DIRECTORY command - defaulting
;HERE TO SUPPLY INPUT AND OUTPUT DEFAULTS
DIRD: MOVEI T1,1 ;DEFAULT VALUE FOR /OKERROR
SKIPGE S.OKER## ;USER SUPPLY /[NO]OKERROR?
MOVEM T1,S.OKER## ;NO, DIRECT DEFAULTS TO /OKERRROR
SKIPE P1,SIFIR## ;ADDRESS OF FIRST INPUT SPEC
JRST DIRD10 ;FLESH OUT THE INPUT SPEC AS NEEDED
;HERE WHEN NO INPUT SPECIFIED, DEFAULT TO DSK:[-]*.*
PUSHJ P,CLRFIL## ;CLEAR OUT THE FILE AREA
PUSHJ P,INX## ;AND ALLOCATE AN INPUT FILE
MOVE P1,SIFIR ;NOW GET FIRST INPUT FILE SPEC BLOCK
MOVSI T1,'DSK' ;DEFAULT DEVICE IS DISK
SETO T2, ;FULL NON-WILD MASK
DMOVEM T1,.FXDEV(P1) ;SET DEVICE FIELD SPECIFICATION
XMOVEI T1,[ASCIZ\DSK\] ;DEFAULT DEVICE IS DISK
MOVEM T1,.FSDEV(P1) ;SET DEVICE FIELD SPECIFICATION
;HANDLE INPUT DEFAULTING
DIRD10: MOVE T1,P1 ;ADDRESS OF CURRENT INPUT SPEC
PUSHJ P,DOSDF ;DO ANY GENERAL FILE-SPEC DEFAULTING
SKIPE .FXNAM(P1) ;GOT A FILE NAME?
JRST DIRD17 ;YES
MOVSI T1,'* ' ;FULL WILD NAME
SETZ T2, ;FULL WILD MASK
DMOVEM T1,.FXNAM(P1) ;SUPPLY DEFAULT FILE NAME
XMOVEI T1,[ASCIZ\*\] ;FULL WILD NAME
MOVEM T1,.FSNAM(P1) ;SUPPLY DEFAULT FILE NAME
MOVX T3,FX.WNM ;THE WILDCARDS-IN-NAME FLAG
IORM T3,.FXFLD(P1) ;SET IN FIELDS FLAGS
DIRD17: MOVX T1,FX.UQN ;
TDNN T1,.FXFLD(P1) ;USER-SPECIFIED QUOTED FILE NAME?
SKIPE .FXEXT(P1) ;GOT AN EXTENSION?
JRST DIRD18 ;YES
MOVSI T1,'* ' ;FULL WILD NAME
HLLZM T1,.FXEXT(P1) ;SUPPLY A DEFAULT
XMOVEI T1,[ASCIZ\*\] ;FULL WILD NAME
MOVEM T1,.FSEXT(P1) ;SUPPLY DEFAULT FILE EXTENSION
MOVX T3,FX.WEX ;THE WILDCARDS-IN-EXTENSION FLAG
IORM T3,.FXFLD(P1) ;SET THAT TOO
DIRD18: MOVX T1,FX.PRT ;THE /OKPROT SWITCH BIT
TDNN T1,.FXMOM(P1) ;EXPLICIT /OKPROT/ERPROT?
ANDCAM T1,.FXMOD(P1) ;NO, DEFAULT TO /ERPROT
IORM T1,.FXMOM(P1) ;MAKE SURE NOBODY ELSE UNDEFAULTS US!
MOVX T1,FX.STR ;THE /STRS SWITCH BIT
TDNN T1,.FXMOM(P1) ;EXPLICIT /[NO]STRS?
IORM T1,.FXMOD(P1) ;NO, SET IMPLICIT /STRS
MOVX T1,FX.QRY ;/QUERY MASK
MOVX T2,FX.QRN ;/QUERY:NEVER
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T2,.FXCTL(P1) ;NO, DEFAULT TO /QUERY:NEVER
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T1,.FXCTM(P1) ;NO, MAKE SURE NOONE ELSE UNDEFAULTS US
ADDI P1,.FXMAX ;STEP TO NEXT SPEC
CAMG P1,SILAS## ;REACHED LAST ONE YET?
JRST DIRD10 ;NOPE, LOOP BACK FOR MORE DEFAULTS
;HANDLE OUTPUT DEFAULTING
DIRD50: SKIPE P1,SOFIR## ;OUTPUT FILE SPEC BLOCK
JRST DIRD52 ;USER TYPED ONE IN, GO FILL IT OUT
JRST .POPJ1## ;*** JUST DO OUTCHRS!
;NO OUTPUT FILE SPECIFIED, DEFAULT TO TTY:
PUSHJ P,CLRFIL## ;CLEAR OUT FILE SPECIFICATION
PUSHJ P,OUX## ;ALLOCATE A FILE SPEC BLOCK
MOVE P1,T1 ;WANT ADDRESS IN P1 ON G.P.S
MOVSI T1,'TTY' ;DEFAULT OUTPUT DEVICE
SETO T2, ;NON-WILD MASK
DMOVEM T1,.FXDEV(P1) ;SET DEFAULT DEVICE
XMOVEI T1,[ASCIZ\TTY\] ;DEFAULT OUTPUT DEVICE
MOVEM T1,.FSDEV(P1) ;SET DEFAULT DEVICE
;FLESH OUT THE OUTPUT FILE SPEC
DIRD52: MOVE T1,P1 ;POSITION ADDRESS OF FILE SPEC BLOCK
PUSHJ P,DOSDF ;DO ANY GENERAL FILE-SPEC DEFAULTING
SKIPE .FXNAM(P1) ;OUTPUT FILE NAME GIVEN?
JRST DIRD57 ;YES
MOVE T1,['FILES '] ;DEFAULT LISTING FILE NAME
SETO T2, ;NON-WILD MASK
DMOVEM T1,.FXNAM(P1) ;SET OUTPUT LIST FILE
DIRD57: SKIPE .FXEXT(P1) ;OUTPUT EXTENSION GIVEN?
JRST DIRD58 ;YES
MOVSI T1,'DIR' ;DEFAULT LISTING EXTENSION
HLLOM T1,.FXEXT(P1) ;SET LISTING FILE
XMOVEI T1,[ASCIZ\DIR\] ;DEFAULT LISTING EXTENSION
MOVEM T1,.FSEXT(P1) ;SET LISTING FILE
DIRD58: MOVX T1,FX.PRT ;THE /OKPROT BIT
TDNN T1,.FXMOM(P1) ;DID USER SPECIFY /[NO]ERPROT?
ANDCAM T1,.FXMOD(P1) ;NO, FORCE /ERPROT FOR OUTPUT FILE
TDNN T1,.FXMOM(P1) ;DID USER SPECIFY /[NO]ERPROT?
IORM T1,.FXMOM(P1) ;AND MAKE IT STICKY
MOVX T1,FX.QRY ;/QUERY MASK
MOVX T2,FX.QRN ;/QUERY:NEVER
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T2,.FXCTL(P1) ;NO, DEFAULT TO /QUERY:NEVER
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T1,.FXCTM(P1) ;ENSURE NOONE UNDEFAULTS US
MOVEI T1,1 ;/SCERROR:NEVER
DPB T1,[POINTR .FXCTL(P1),FX.SCE] ;KROCK
;ALL DONE HERE
JRST .POPJ1## ;DEFAULTS DEFAULTED
SUBTTL DIRECTORY command - main file listing loop
;LOOP FINDING AND REPORTING THE FILE(S)
DIRL: MOVEI T1,CDBLI## ;ADDRESS OF INPUT I/O CDB
MOVEI T2,DIRIV ;ADDRESS OF CDB INIT VECTOR
PUSHJ P,.IOINI## ;INITIALIZE THE CDB
JRST ERRCDI## ;CAN'T
MOVE T3,SIFIR## ;FIRST INPUT FILE SPEC BLOCK ADDRESS
MOVEM T3,.IOFSB(T1) ;SET FIRST ADDRESS IN CDB
MOVE T3,SILAS## ;LAST INPUT FILE SPEC BLOCK ADDRESS
MOVEM T3,.IOFSL(T1) ;SET LAST ADDRESS IN CDB
SKIPN SOFIR## ;GOT A LISTING FILE?
JRST DIRL09 ;NO
MOVEI T1,CDBLO## ;ADDRESS OF LISTING I/O CDB
MOVEI T2,DIROV ;ADDRESS OF CDB INIT VECTOR
PUSHJ P,.IOINI## ;INITIALIZE THE CDB
JRST ERRCDO## ;CAN'T?
MOVE T3,SOFIR## ;ADDRESS OF FIRST OUTPUT FILE SPEC BLOCK
MOVEM T3,.IOFSB(T1) ;SET IN CDB
MOVEM T3,.IOFSL(T1) ;ALSO LAST ADDRESS
MOVEI T2,CDBLI## ;KROCK ADDRESS OF SOMETHING
PUSHJ P,.IOPOU## ;OPEN OUTPUT LISTING FILE
ERROR EOD,<Error OPENing directory listing file>
DIRL09: XMOVEI T1,DIRLTC ;ASSUME NO OUTPUT FILE
SKIPE SOFIR## ;DID WE GUESS RIGHT?
XMOVEI T1,DIRLTO ;NO, ADDRESS OF OUR "TYPER"
PUSHJ P,.XTYPO## ;REDIRECT TYPEOUT TO LISTING FILE
SKIPE DDCMDF## ;DAP MODE?
JRST DIRLD ;YEAH
;LOOP FINDING EACH FILE
DIRL10: PUSHJ P,.NXTFL## ;[25] ASK FOR AN INPUT FILE
JRST DIRLIE ;SEE IF DONE
;LIST THE FILE
PUSHJ P,DIRLP ;PROCESS THIS FILE
JFCL ;HUH?
;NOW CLOSE OFF THIS FILE
MOVEI T1,CDBLI## ;ADDRESS OF INPUT CDB
PUSHJ P,.IOCLO## ;CLOSE OFF THE FILE
JFCL ;HUH?
JRST DIRL10 ;BACK FOR MORE FILES
;INPUT FILE ACCESS ERROR (.NXTFI/.IOPIN)
DIRLIE: CAIN M0,$EFIXN ;INPUT EXHAUSTED?
JRST .POPJ1## ;YES, SUCCESSFUL COMPLETION OF COMMAND
PUSHJ P,NERFAE ;HANDLE FILE OPEN ERROR
POPJ P, ;ABORT ON ERROR
JRST DIRL10 ;CONTINUE ON ERROR
;HERE FOR DAP MODE DIRECTORY
DIRLD: MOVEI T1,CDBLI## ;INPUT CDB ADDRESS
XMOVEI T2,DIRLP ;LIST-THE-FILE PROCESSOR
XMOVEI T3,DIRLDE ;ERROR PROCESSOR
PUSHJ P,.IODDI## ;DO A DAP-MODE DIRECTORY LIST
JRST DDCERM ;DAP-MODE COMMAND FAILURE
JRST .POPJ1## ;SUCCESSFUL
DIRLDE: AOS ERRORS## ;NOTE AN ERROR OCCURRED
PJRST ONERCK## ;MAYBE CONTINUE, MAYBE ABORT
;THE LIST-THE-FILE PROCESSOR
DIRLP: MOVEI T1,CDBLI## ;ADDRESS OF INPUT CDB
PUSHJ P,.TOCFN## ;TYPE OUT FILE SPECIFICATION STRING
JFCL ;CAN'T FAIL
PUSHJ P,.TCRLF## ;CAP OFF LISTING
;AND ACCUMULATE TOTALS FOR ANYONE WHO CARES
MOVE T1,CDBLI+.IOLNW ;LENGTH OF FILE
ADDM T1,WORDS## ;ACCUMULATE WORDS
ADDI T1,177 ;ROUND UP AND
LSH T1,-7 ;TRUNCATE TO BLOCKS
ADDM T1,BLOCKS## ;ACCUMULATE BLOCKS
AOS FILES## ;ACCUMULATE FILES
JRST .POPJ1## ;SUCCESSFUL RETURN
;HELPER TO "TYPE" CHARACTERS
DIRLTC: OUTCHR T1 ;THE SIMPLE CASE
POPJ P, ;ALL DONE
DIRLTO: PUSH P,T2 ;SAVE T2
MOVE T2,T1 ;PUT CHARACTER IN T2
MOVEI T1,CDBLO## ;AND THE CDB ADDRESS IN T1
PUSHJ P,@.IOOSR(T1) ;OUTPUT CHARACTER
JFCL ;*** GOTTA DO SOMETHING ABOUT THIS
MOVE T1,T2 ;RESTORE CHARACTER
POP P,T2 ;RESTORE T2
POPJ P, ;RETURN
SUBTTL DIRECTORY command - switch definitions
;"DIRECT" SWITCHS
DEFINE SWTCHS,<
;SP INITFILE,NIPFSB,.SWFIL##,,FS.NFS!FS.VRQ
SN MOAN,S.MOAN,FS.NFS
SN OKERROR,S.OKER,FS.NFS
SP PASSWORD,<POINT <^D65-$ASCMX>,S.PASS>,.SWASQ##,,
SL TOTALS,S.TOTA,TOT,7777,FS.OBV
SP USERID,<POINT <^D65-<3*$ASCMX>>,S.USER>,.SWUID##,,
>
DOSCAN(DIRSW)
SUBTTL DIRECTORY command - SCAN argument blocks
;"DIRECT" TSCAN PARAMETER BLOCK
DIRTS: EXP FXVRSN ;PROTOCOL VERSION WORD
IOWD DIRSWL,DIRSWN ;IOWD POINTER FOR SWITCH NAMES
XWD DIRSWD,DIRSWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,DIRSWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /NIP/ ;HELP
XWD CLRALL,CLRFIL ;CLEAR ALL,,CLEAR FILE
XWD INX,OUX ;ALLOC INPUT AREA,,ALLOC OUTPUT AREA
XWD MEMSTK,APLSTK ;MEMORIZE STICKY,,APPLY STICKY
XWD CLRSTK,0 ;CLEAR STICKY,,FLAGS
Z ;<FUTURE>,,SWITCH VALUE STORAGE RTN
DIRTL==.-DIRTS
;"DIRECT" OSCAN BLOCK
DIROS: EXP FXVRSN ;PROTOCOL VERSION WORD
IOWD DIRSWL,DIRSWN ;IOWD POINTER FOR SWITCH NAMES
XWD DIRSWD,DIRSWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,DIRSWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /NIP/ ;HELP
XWD DIROSL,DIROSN ;OPTIONS NAME(S)
DIROL==.-DIROS
DIROSN: SIXBIT \NDIREC\
SIXBIT \NIP\
SIXBIT \NFT\
DIROSL==.-DIROSN
SUBTTL DIRECTORY command - I/O CDB initialization vectors
;"DIRECT" CDB INITIALIZATION VECTORS.
;
;NOTE THAT THE INPUT SIDE DEFERS BUFFER ALLOCATION UNTIL AFTER THE
;OUTPUT SIDE HAS BEEN OPENED AND OUTPUT BUFFERS ALLOCATED. THIS IS
;SO THAT VARIOUS INPUT DEVICES CAN ALLOCATE AND DEALLOCATE BUFFERS
;AND NOT "GROW" MEMORY NEEDLESSLY.
;"DIRECT" INPUT CDB INITIALIZATION VECTOR
DIRIV: EXP 10 ;COUNT OF WORDS FOLLOWING
'NS',,102030 ;VERSION WORD
0 ;"EXTRA" SIZE TO ALLOCATE
0 ;DEFAULT BUFFERING
0 ;MAXIMUM BUFFERING
0 ;I/O CONTROL
0 ;I/O ERROR CONTROL
IM.SMD!IM.SBO ;I/O MODE
0 ;(RESERVED)
;"DIRECT" OUTPUT CDB INITIALIZATION VECTOR
DIROV: EXP 10 ;COUNT OF WORDS FOLLOWING
'NS',,102030 ;VERSION WORD
0 ;"EXTRA" SIZE TO ALLOCATE
0 ;DEFAULT BUFFERING
0 ;MAXIMUM BUFFERING
.ICASC ;I/O CONTROL (ASCII MODE)
0 ;I/O ERROR CONTROL
0 ;I/O MODE
0 ;(RESERVED)
SUBTTL MOVE command
MOV: ERROR MVY,<MOVE command not yet implemented>
SUBTTL NETWORK command
;NETWORK COMMAND
;
; NETWORK <INPUT-EXPRESSION>
;
;The NETWORK command is used to list network/DAP-related information
;about the specified network nodes.
NET: PUSHJ P,NETC ;READ IN THE NODE LIST
JRST NET70 ;DIED? CLEAN UP
PUSHJ P,NETD ;HANDLE ANY DEFAULTING
JRST NET70 ;NOT SUPPOSED TO HAPPEN!
PUSHJ P,NETL ;LIST THE NETWORK NODES
JFCL ;HO HUM
NET50: SKIPN SOFIR## ;GOT A REAL LISTING FILE?
JRST NET60 ;NO
MOVEI T1,CDBLO## ;ADDRESS OF OUTPUT/LISTING CDB
PUSHJ P,.IOCLO## ;CLOSE OFF LISTING FILE
ERROR ECN,<Error CLOSEing network listing file>,,,NET57
NET57: MOVEI T1,CDBLO## ;ADDRESS OF OUTPUT CDB
PUSHJ P,.IORLS## ;CLEAN UP THE CDB
JFCL
;DEALLOCATE SCAN BLOCKS
NET60: PUSHJ P,FRESB## ;FREE UP AN FILE SPEC BLOCKS
JRST NET77 ;FAILED???
JRST .POPJ1## ;SUCCESSFUL COMPLETION OF NETWORK COMMAND
;HERE ON ERROR
NET70: PUSHJ P,FRESB## ;PITCH ANY ACCUMULATED FILE SPEC BLOCKS
JFCL ;HO HUM
NET77: POPJ P, ;TAKE ERROR RETURN
SUBTTL NETWORK command - parsing
;HERE TO READ THE NODE LIST
NETC: SETZM SIFIR## ;CLEAR OUT THE OLD DATA BASE
PUSHJ P,.REEAT## ;WANT .TSCAN TO SEE CURRENT CHARACTER!
MOVE T1,[NETTL,,NETTS] ;.TSCAN BLOCK
PUSHJ P,.TSCAN## ;READ A COMMAND LINE
PUSHJ P,CLRFIL ;CLEAR FILE ANSWERS BEFORE SWITCH.INI
MOVE T1,[NETOL,,NETOS] ;.OSCAN BLOCK
PUSHJ P,.OSCAN## ;CHECK SWITCH.INI
JRST .POPJ1## ;RETURN HAPPILY
SUBTTL NETWORK command - defaulting
;HERE TO SUPPLY INPUT AND OUTPUT DEFAULTS
NETD: SKIPN P1,SIFIR## ;ADDRESS OF FIRST INPUT SPEC
ERROR NNN,<No nodes specified for NETWORK command>
;HANDLE INPUT DEFAULTING
NETD10: MOVE T1,P1 ;ADDRESS OF CURRENT INPUT SPEC
PUSHJ P,DOSDF ;DO ANY GENERAL FILE-SPEC DEFAULTING
SKIPE .FXNOD(P1) ;GOT AN EXPLICIT NODE?
JRST NETD20 ;YES, NO FAKERY
SKIPE .FXNAM(P1) ;NO, CAN WE FAKE ONE FROM A FILE NAME?
JRST NETD12 ;YES
SKIPE .FXDEV(P1) ;NO NODE, NO NAME, GIVE A DEVICE?
JRST NETD20 ;YES, TRY IT AND SEE WHAT HAPPENS
ERROR NNS,<No node name specified>
NETD12: DMOVE T1,.FXNAM(P1) ;GET NAME SPEC
DMOVEM T1,.FXNOD(P1) ;AND SET AS NODE SPEC
SETZM .FXNAM(P1) ;CLEAR OUT NAME SPEC
SETZM .FXNAM+1(P1) ;AND THE MASK TOO
MOVE T1,.FSNAM(P1) ;GET NAME STRING
MOVEM T1,.FSNOD(P1) ;AND SET AS NODE STRING
SETZM .FSNAM(P1) ;CLEAR OUT NAME STRING
MOVE T1,.FXFLD(P1) ;GET FIELDS FLAGS
TXZ T1,FX.UNM!FX.SNM;CLEAR NAME-TYPED FLAGS
TXNE T1,FX.WNM ;WAS NAME WILD?
TXO T1,FX.WND ;YES, THEN NODE IS WILD
TXO T1,FX.UND ;THE "USER" TYPED A NODE (NO, REALLY, HE DID!)
MOVEM T1,.FXFLD(P1) ;SET FIELDS FLAGS
NETD20: MOVX T1,FX.PRT ;THE /OKPROT SWITCH BIT
TDNN T1,.FXMOM(P1) ;EXPLICIT /OKPROT/ERPROT?
ANDCAM T1,.FXMOD(P1) ;NO, DEFAULT TO /ERPROT
IORM T1,.FXMOM(P1) ;MAKE SURE NOBODY ELSE UNDEFAULTS US!
MOVX T1,FX.QRY ;/QUERY MASK
MOVX T2,FX.QRN ;/QUERY:NEVER
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T2,.FXCTL(P1) ;NO, DEFAULT TO /QUERY:NEVER
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T1,.FXCTM(P1) ;NO, MAKE SURE NOONE ELSE UNDEFAULTS US
ADDI P1,.FXMAX ;STEP TO NEXT SPEC
CAMG P1,SILAS## ;REACHED LAST ONE YET?
JRST NETD10 ;NOPE, LOOP BACK FOR MORE DEFAULTS
;HANDLE OUTPUT DEFAULTING
NETD50: SKIPE P1,SOFIR## ;OUTPUT FILE SPEC BLOCK
JRST NETD52 ;USER TYPED ONE IN, GO FILL IT OUT
JRST .POPJ1## ;*** JUST DO OUTCHRS!
;FLESH OUT THE OUTPUT FILE SPEC
NETD52: MOVE T1,P1 ;POSITION ADDRESS OF FILE SPEC BLOCK
PUSHJ P,DOSDF ;DO ANY GENERAL FILE-SPEC DEFAULTING
SKIPE .FXNAM(P1) ;OUTPUT FILE NAME GIVEN?
JRST NETD57 ;YES
MOVE T1,['NODES '] ;DEFAULT LISTING FILE NAME
SETO T2, ;NON-WILD MASK
DMOVEM T1,.FXNAM(P1) ;SET OUTPUT LIST FILE
NETD57: SKIPE .FXEXT(P1) ;OUTPUT EXTENSION GIVEN?
JRST NETD58 ;YES
MOVSI T1,'NET' ;DEFAULT LISTING EXTENSION
HLLOM T1,.FXEXT(P1) ;SET LISTING FILE
XMOVEI T1,[ASCIZ\NET\] ;DEFAULT LISTING EXTENSION
MOVEM T1,.FSEXT(P1) ;SET LISTING FILE
NETD58: MOVX T1,FX.PRT ;THE /OKPROT BIT
TDNN T1,.FXMOM(P1) ;DID USER SPECIFY /[NO]ERPROT?
ANDCAM T1,.FXMOD(P1) ;NO, FORCE /ERPROT FOR OUTPUT FILE
TDNN T1,.FXMOM(P1) ;DID USER SPECIFY /[NO]ERPROT?
IORM T1,.FXMOM(P1) ;AND MAKE IT STICKY
MOVX T1,FX.QRY ;/QUERY MASK
MOVX T2,FX.QRN ;/QUERY:NEVER
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T2,.FXCTL(P1) ;NO, DEFAULT TO /QUERY:NEVER
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T1,.FXCTM(P1) ;ENSURE NOONE UNDEFAULTS US
MOVEI T1,1 ;/SCERROR:NEVER
DPB T1,[POINTR .FXCTL(P1),FX.SCE] ;KROCK
;ALL DONE HERE
JRST .POPJ1## ;DEFAULTS DEFAULTED
SUBTTL NETWORK command - main file listing loop
;LOOP FINDING AND REPORTING THE NODE(S)
NETL: MOVEI T1,CDBLI## ;ADDRESS OF INPUT I/O CDB
MOVEI T2,NETIV ;ADDRESS OF CDB INIT VECTOR
PUSHJ P,.IOINI## ;INITIALIZE THE CDB
JRST ERRCDI## ;CAN'T
MOVE T3,SIFIR## ;FIRST INPUT FILE SPEC BLOCK ADDRESS
MOVEM T3,.IOFSB(T1) ;SET FIRST ADDRESS IN CDB
MOVE T3,SILAS## ;LAST INPUT FILE SPEC BLOCK ADDRESS
MOVEM T3,.IOFSL(T1) ;SET LAST ADDRESS IN CDB
SKIPN SOFIR## ;GOT A LISTING FILE?
JRST NETL09 ;NO
MOVEI T1,CDBLO## ;ADDRESS OF LISTING I/O CDB
MOVEI T2,NETOV ;ADDRESS OF CDB INIT VECTOR
PUSHJ P,.IOINI## ;INITIALIZE THE CDB
JRST ERRCDO## ;CAN'T?
MOVE T3,SOFIR## ;ADDRESS OF FIRST OUTPUT FILE SPEC BLOCK
MOVEM T3,.IOFSB(T1) ;SET IN CDB
MOVEM T3,.IOFSL(T1) ;ALSO LAST ADDRESS
MOVEI T2,CDBLI## ;KROCK ADDRESS OF SOMETHING
PUSHJ P,.IOPOU## ;OPEN OUTPUT LISTING FILE
ERROR EON,<Error OPENing network listing file>
NETL09: XMOVEI T1,DIRLTC ;ASSUME NO OUTPUT FILE
SKIPE SOFIR## ;DID WE GUESS RIGHT?
XMOVEI T1,DIRLTO ;NO, ADDRESS OF OUR "TYPER"
PUSHJ P,.XTYPO## ;REDIRECT TYPEOUT TO LISTING FILE
SETZM NETNOD ;NO NODES SEEN YET
;LOOP FINDING EACH NODE
NETL10: MOVEI IO,CDBLI## ;RUN IN I/O CONTEXT
PUSHJ P,IOPND0## ;OPEN ONLY A NETWORK/DAP LINK (NO FILE LOOKUP)
JRST NETLIE ;SEE IF DONE
;GO TYPE OUT INFO FOR THIS NODE
MOVE T2,.ION6M(IO) ;GET NODE OPENED
CAMN T2,NETNOD ;SAME AS LAST TIME HERE?
JRST NETL10 ;YEAH, PUNT IT
MOVEM T2,NETNOD ;NEW NODE, REMEMBER IT
PUSHJ P,NETLP ;DO LOTS OF TYPING
JFCL ;HUH? NAH, DIDN'T HAPPEN . . .
AOS .CTFLF## ;TELL .LKWLD TO MIND ITS OWN BUSINESS
JRST NETL10 ;GO GET ANOTHER NODE
;HERE ON END, CLEAN UP THE CDB
NETL30: PUSHJ P,NTZAP0## ;BLAST AWAY THE NETWORK LINK
JFCL ;IGNORE NON-EXISTENT ERRORS
PUSHJ P,.TCRLF## ;BLANK LINE FOR NEATNESS
JRST .POPJ1## ;SUCCESSFUL COMPLETION OF COMMAND
;INPUT FILE ACCESS ERROR (.NXTFI/.IOPIN)
NETLIE: CAIN M0,$EFIXN ;INPUT EXHAUSTED?
JRST NETL30 ;YES, SUCCESSFUL COMPLETION OF COMMAND
PUSHJ P,NERFAE ;HANDLE FILE OPEN ERROR
POPJ P, ;ABORT ON ERROR
JRST NETL10 ;CONTINUE ON ERROR
;THE LIST-THE-NODE PROCESSOR
NETLP: PUSHJ P,.TCRLF## ;START WITH AN INTERVENING BLANK LINE
MOVEI T1,[ASCIZ\Node \] ;TEXT
PUSHJ P,.TSTRG## ;TYPE IT
MOVE T1,.ION6M(IO) ;NODE NAME
PUSHJ P,.TSIXN## ;TYPE IT
MOVE T2,.IOCCF(IO) ;CHANNEL CONTROL FLAGS
MOVEI T1,[ASCIZ\ (Unknown)\] ;NETWORK TYPE
TXNE T2,IO.ANF ;ANF-10 NODE?
MOVEI T1,[ASCIZ\ (ANF-10)\] ;YES
TXNE T2,IO.DCN ;DECNET NODE?
MOVEI T1,[ASCIZ\ (DECnet)\] ;YES
PUSHJ P,.TSTRG## ;TYPE IT OUT
MOVEI T1,[ASCIZ\ running \] ;TEXT TO IDENTIFY
PUSHJ P,.TSTRG## ;THE OPERATING SYSTEM
MOVD1 T1,OST ;GET REMOTE OPERATING SYSTEM TYPE
CAILE T1,$DVOMX ;WITHIN LIMITS?
SETZ T1, ;UNKNOWN (NEW) OPERATING SYSTEM TYPE
MOVE T1,NETOST(T1) ;GET ADDRESS OF TEXT STRING
PUSHJ P,.TSTRG## ;IDENTIFY REMOTE OPERATING SYSTEM
MOVD1 T1,FST ;GET REMOTE FILE SYSTEM
CAIE T1,$DVFT1 ;IF TOPS-10
CAIN T1,$DVFT2 ;OR TOPS-20
JRST NETLP2 ;THEN SKIP FILE SYSTEM JUNK
CAIN T1,$DVOS8 ;IF OS-8
JRST NETLP2 ;THEN SKIP FILE SYSTEM JUNK
MOVEI T1,[ASCIZ\ with \] ;PREFIX TEXT
PUSHJ P,.TSTRG## ;FOR THE FILE SYSTEM
MOVD1 T1,FST ;RETRIEVE FST AGAIN
CAILE T1,$DVFMX ;WITHIN KNOWN BOUNDS?
SETZ T1, ;NO, UNKNOWN FILE SYSTEM TYPE
MOVE T1,NETFST(T1) ;GET TEXT STRING TO
PUSHJ P,.TSTRG## ;IDENTIFY THE REMOTE FILE SYSTEM
NETLP2: PUSHJ P,.TCRLF## ;START UP A NEW LINE
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
MOVEI T1,[ASCIZ\ DAP version \] ;MORE PREFIX TEXT
PUSHJ P,.TSTRG## ;TO USE UP SCREEN SPACE
MOVD1 T1,DVR ;MAJOR VERSION
PUSHJ P,.TDECW## ;TYPE OUT AS DECIMAL
PUSHJ P,.TDOT## ;SEPARATE FROM MINOR VERSION
MOVD1 T1,DVE ;WHICH IS SAVED HERE
PUSHJ P,.TDECW## ;TYPE OUT MINOR ("ECO") LEVEL
PUSHJ P,.TDOT## ;SEPARATE FROM MINOR MINOR VERSION
MOVD1 T1,DVU ;WHICH IS YET A DIFFERENT FIELD
PUSHJ P,.TDECW## ;TYPE OUT "USER" (CUSTOMER) VERSION
PUSHJ P,.TDOT## ;SEPARATE WITH ANOTHER DOT
MOVD1 T1,DVS ;DAP "SOFTWARE" VERSION
PUSHJ P,.TDECW## ;TYPE THAT OUT TOO
PUSHJ P,.TDOT## ;THIS IS GETTING KINDA TEDIOUS . . .
MOVD1 T1,DVT ;DAP "USER SOFTWARE" VERSION
PUSHJ P,.TDECW## ;TYPE THAT OUT
MOVEI T1,[ASCIZ\; Maximum message size is \]
PUSHJ P,.TSTRG## ;MORE NOISE
MOVD1 T1,MSZ ;DAP MESSAGE MAXIMA
JUMPE T1,[MOVEI T1,[ASCIZ\unlimited\]
PUSHJ P,.TSTRG## ;TELL HIM
JRST NETLP3] ;CAP IF OFF
PUSHJ P,.TDECW## ;LIST DECIMAL BYTES
MOVEI T1,[ASCIZ\ bytes\]
PUSHJ P,.TSTRG## ;CAP OFF MESSAGE SIZE
NETLP3: PUSHJ P,.TCRLF## ;CAP OFF LINE
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;NOW LIST THE CONFIGURATION CAPABILITIES
DEFINE NETXN(FLG,TXT),<
TFNE P1,FLG
PUSHJ P,[MOVEI T1,[ASCIZ\ TXT
\]
PJRST .TSTRG##]
> ;END DEFINE NETXN
NETLP5: MOVD P1,CNF ;GENERIC REMOTE CONFIGURATION FLAGS
MOVEI T1,[ASCIZ\ Supports file READ/WRITE access
Supports file DELETE access
\] ;BY DEFINITION
PUSHJ P,.TSTRG## ;START OFF WITH THE OBVIOUS
;MAJOR FUNCTIONALITY
NETXN APN,Supports file APPEND access
NETXN CMF,Supports file SUBMIT/EXECUTE access
NETXN REN,Supports file RENAME access
NETXN DIR,Supports file DIRECTORY-list access
;SEMI-MAJOR FUNCTIONALITY
NETXN SPO,Supports PRINT-on-CLOSE via FOP
NETXN CMS,Supports SUBMIT-on-CLOSE via FOP
NETXN FDE,Supports DELETE-on-CLOSE via FOP
NETXN <<CFA,CFD,CFP,CFN>>,Supports RENAME-on-CLOSE via ACCOMP(CHANGE)
;SEMI-MINOR FUNCTIONS
NETXN CRA,Supports changing main attributes on RENAME access
NETXN CFA,Supports changing main attributes on RENAME-on-CLOSE
NETXN CRD,Supports changing date/time on RENAME access
NETXN CFD,Supports changing date/time on RENAME-on-CLOSE
NETXN CRP,Supports changing protection on RENAME access
NETXN CFP,Supports changing protection on RENAME-on-CLOSE
NETXN CFN,Supports changing name on RENAME-on-CLOSE
;MINOR FUNCTIONS
NETXN FPA,Supports file pre-allocation
NETXN FCK,Supports file data checksumming
NETXN FTR,Supports file transfer recovery
NETXN WLD,Supports file wildcarding
NETXN CGN,Supports GO/NOGO file selection
;FILE ORGANIZATIONS
NETXN SFO,Supports sequential file organization
NETXN RFO,Supports relative file organization
NETXN DFO,Supports direct file organization
NETXN MFO,Supports multi-keyed indexed file organization
;RANDOM ACCESS STUFF
NETXN SFT,Supports sequential file transfer
NETXN SRA,Supports sequential record transfer
NETXN RAR,Supports random-access by relative record number
NETXN RAB,Supports random-access by virtual block number
NETXN RAK,Supports random-access by key
NETXN RAH,Supports random-access by hash value
NETXN RAA,Supports random-access by record file address
;ERRATA
NETXN NAM,Supports name message
NETXN PEA,Supports protection attributes message
NETXN TEA,Supports date/time attributes message
NETXN AEA,Supports allocation attributes message
NETXN KEA,Supports key definition attributes message
NETXN SEA,Supports summary attributes message
NETXN LEA,Supports access control list message
NETXN FXC,Supports extending files with CONTROL(EXTEND)
NETXN SWA,Supports switching of record access mode
NETXN CCP,Supports data compression
NETXN MDS,Supports multiple data streams
NETXN DFC,Supports return of attributes via CONTROL(DISPLAY)
NETXN DFS,Supports default file specification
NETXN WST,Supports warning status message
NETXN MAR,Supports return of modified attributes on file create
NETXN N3D,Supports control of 3-part name messages via DISPLAY
NETXN BLC,Supports BLKCNT field in CONTROL message
NETXN OVO,Supports octal file version only
;ERRATA II
NETXN C25,Supports long (.GT. 255 bytes) messages
NETXN BLR,Supports blocking of messages up to response
NETXN BLU,Supports unlimited blocking of messages
NETXN DSG,Supports message segmentation
NETXN BTC,Supports BITCNT field of data message
NETLP9: JRST .POPJ1## ;THAT'S ALL FOR NOW
;THE OPERATING SYSTEM AND FILE SYSTEM TEXT TABLES
DEFINE X(TXT),<[ASCIZ\TXT\]>
NETOST: X Unknown
X RT-11
X RSTS/E
X RSX-11S
X RSX-11M
X RSX-11D
X IAS
X VAX/VMS
X TOPS-20
X TOPS-10
X RTS-8
X OS-8
X RSX-11M+
X COPOS/11
X P/OS
X VAX/ELAN
X CP/M
X MS-DOS
X ULTRIX-32
X ULTRIX-11
IFN <$DVOMX-<.-NETOST>+1>,<IF1,<
PRINTX ? NETOST table out of sync with protocol maximum>>
NETFST: X Unknown
X RMS-11
X RMS-20
X RMS-32
X FCS-11
X RT-11
X No file system
X TOPS-20
X TOPS-10
X OS-8
X RMS-32S
X CP/M
X MS-DOS
X ULTRIX-32
X ULTRIX-11
IFN <$DVFMX-<.-NETFST>+1>,<IF1,<
PRINTX ? NETFST table out of sync with protocol maximum>>
SUBTTL NETWORK command - switch definitions
;"NETWORK" SWITCHS
DEFINE SWTCHS,<
;SP INITFILE,NIPFSB,.SWFIL##,,FS.NFS!FS.VRQ
SN MOAN,S.MOAN,FS.NFS
SN OKERROR,S.OKER,FS.NFS
SP USERID,<POINT <^D65-<3*$ASCMX>>,S.USER>,.SWUID##,,
>
DOSCAN(NETSW)
SUBTTL NETWORK command - SCAN argument blocks
;"NETWORK" TSCAN PARAMETER BLOCK
NETTS: EXP FXVRSN ;PROTOCOL VERSION WORD
IOWD NETSWL,NETSWN ;IOWD POINTER FOR SWITCH NAMES
XWD NETSWD,NETSWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,NETSWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /NIP/ ;HELP
XWD CLRALL,CLRFIL ;CLEAR ALL,,CLEAR FILE
XWD INX,OUX ;ALLOC INPUT AREA,,ALLOC OUTPUT AREA
XWD MEMSTK,APLSTK ;MEMORIZE STICKY,,APPLY STICKY
XWD CLRSTK,0 ;CLEAR STICKY,,FLAGS
Z ;<FUTURE>,,SWITCH VALUE STORAGE RTN
NETTL==.-NETTS
;"NETWORK" OSCAN BLOCK
NETOS: EXP FXVRSN ;PROTOCOL VERSION WORD
IOWD NETSWL,NETSWN ;IOWD POINTER FOR SWITCH NAMES
XWD NETSWD,NETSWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,NETSWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /NIP/ ;HELP
XWD NETOSL,NETOSN ;OPTIONS NAME(S)
NETOL==.-NETOS
NETOSN: SIXBIT \NIP\
SIXBIT \NFT\
NETOSL==.-NETOSN
SUBTTL NETWORK command - I/O CDB initialization vectors
;"NETWORK" CDB INITIALIZATION VECTORS.
;
;NOTE THAT THE INPUT SIDE DEFERS BUFFER ALLOCATION UNTIL AFTER THE
;OUTPUT SIDE HAS BEEN OPENED AND OUTPUT BUFFERS ALLOCATED. THIS IS
;SO THAT VARIOUS INPUT DEVICES CAN ALLOCATE AND DEALLOCATE BUFFERS
;AND NOT "GROW" MEMORY NEEDLESSLY.
;"NETWORK" INPUT CDB INITIALIZATION VECTOR
NETIV: EXP 10 ;COUNT OF WORDS FOLLOWING
'NS',,102030 ;VERSION WORD
0 ;"EXTRA" SIZE TO ALLOCATE
0 ;DEFAULT BUFFERING
0 ;MAXIMUM BUFFERING
0 ;I/O CONTROL
0 ;I/O ERROR CONTROL
IM.SMD!IM.SBO ;I/O MODE
0 ;(RESERVED)
;"NETWORK" OUTPUT CDB INITIALIZATION VECTOR
NETOV: EXP 10 ;COUNT OF WORDS FOLLOWING
'NS',,102030 ;VERSION WORD
0 ;"EXTRA" SIZE TO ALLOCATE
0 ;DEFAULT BUFFERING
0 ;MAXIMUM BUFFERING
.ICASC ;I/O CONTROL (ASCII MODE)
0 ;I/O ERROR CONTROL
0 ;I/O MODE
0 ;(RESERVED)
SUBTTL PRINT command
;PRINT COMMAND
;
; PRINT <INPUT-EXPRESSION>
;
;The print command is used to "print" the specified files on the
;system lineprinter. It does not actually copy the file, rather it
;"queues" or "spools" the file with the system's line printer spooling
;mechanism.
TTLPRI==TT$FIL!TT$ERR
TTMPRI==TT$BLK!TT$FIL!TT$ERR
PRI: JUMPLE CH,ERRNIF## ;EOL HERE IS JUNK
PUSHJ P,CLRTOT## ;CLEAR TOTALS
PUSHJ P,PRIC ;READ IN THE REST OF THE COMMAND
JRST PRI70 ;COMMAND ERROR
PUSHJ P,PRID ;HANDLE ANY DEFAULTING
JRST PRI70 ;ERROR
PUSHJ P,PRIL ;DO THE FILE SUBMISSION(S)
JFCL ;IGNORE ERROR (SO COMES OUT IN SUMMARY)
MOVE T1,[TTLPRI,,TTMPRI] ;GET TOTALS CONTROL
PUSHJ P,.TOTAL## ;AND ISSUE TOTALS SUMMARY
JFCL ;ERROR (?)
;DO ANY FINAL CLEANUP NEEDED
PRI50: MOVEI T1,CDBLI## ;INPUT CHANNEL CDB
PUSHJ P,.IORLS## ;INDICATE WE ARE DONE WITH IT
JFCL ;DUH???
;NOW FREE UP THE FILE SPEC BLOCKS
PRI60: PUSHJ P,FRESB## ;FREE UP THE FILE SPEC BLOCKS
JRST PRI77 ;???
;ALL DONE WITH "PRINT" COMMAND
JRST .POPJ1## ;RETURN FOR NEXT COMMAND
;PRINT COMMAND-LEVEL ERROR
PRI70: PUSHJ P,FRESB## ;FREE UP ANY FILE SPEC BLOCKS LEFT LYING AROUND
JFCL ;???
PRI77: POPJ P, ;PROPAGATE ERROR
SUBTTL PRINT command - parsing
;HERE TO READ THE PRINT FILE SPECIFICATIONS
PRIC: SETZM SIFIR## ;CLEAR OUT THE OLD DATA BASE
PUSHJ P,.REEAT## ;WANT .TSCAN TO SEE CURRENT CHARACTER!
MOVE T1,[PRITL,,PRITS] ;.TSCAN BLOCK
PUSHJ P,.TSCAN## ;READ A COMMAND LINE
PUSHJ P,CLRFIL ;CLEAR FILE ANSWERS BEFORE SWITCH.INI
MOVE T1,[PRIOL,,PRIOS] ;.OSCAN BLOCK
PUSHJ P,.OSCAN## ;CHECK SWITCH.INI
;ALL FOR NOW
JRST .POPJ1## ;RETURN HAPPILY
SUBTTL PRINT command - defaulting
;HERE TO SUPPLY INPUT AND OUTPUT DEFAULTS
PRID: SKIPN P1,SIFIR## ;ADDRESS OF FIRST INPUT SPEC
JRST ERRNIF## ;NONE???
;HANDLE INPUT DEFAULTING
PRID10: MOVE T1,P1 ;ADDRESS OF CURRENT INPUT SPEC
PUSHJ P,DOSDF ;DO ANY GENERAL FILE-SPEC DEFAULTING
SKIPN .FXNAM(P1) ;USER TYPE AN EXPLICIT FILE NAME?
ERROR FRP,<Filename is required in PRINT command>
PRID18: MOVX T1,FX.PRT ;THE /OKPROT SWITCH BIT
TDNN T1,.FXMOM(P1) ;EXPLICIT /OKPROT/ERPROT?
ANDCAM T1,.FXMOD(P1) ;NO, DEFAULT TO /ERPROT
IORM T1,.FXMOM(P1) ;MAKE SURE NOBODY ELSE UNDEFAULTS US!
MOVX T1,FX.STR ;THE /STRS SWITCH BIT
TDNN T1,.FXMOM(P1) ;EXPLICIT /[NO]STRS?
ANDCAM T1,.FXMOD(P1) ;NO, SET IMPLICIT /NOSTRS
MOVX T1,FX.QRY ;/QUERY MASK
MOVX T2,FX.QRT ;/QUERY:TELL
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T2,.FXCTL(P1) ;NO, DEFAULT TO /QUERY:TELL
; MOVX T1,FX.QNY ;THE [N/Y] BIT
; TDNN T1,.FXCTM(P1) ;DID USER REQUEST IT?
; IORM T1,.FXCTL(P1) ;NO, SO DEFAULT TO [N/Y]
ADDI P1,.FXMAX ;STEP TO NEXT SPEC
CAMG P1,SILAS## ;REACHED LAST ONE YET?
JRST PRID10 ;NOPE, LOOP BACK FOR MORE DEFAULTS
;HANDLE OUTPUT (CURRENTLY ILLEGAL, MAYBE USED IN FUTURE A LA QUEUE)
PRID50: SKIPE P1,SOFIR## ;OUTPUT FILE SPEC BLOCK
JRST ERROFI## ;ILLEGAL OUTPUT FILE
;ALL DONE HERE
JRST .POPJ1## ;DEFAULTS DEFAULTED
SUBTTL PRINT command - main file submission loop
;LOOP FINDING AND PRINTING THE FILE(S)
PRIL: MOVEI T1,CDBLI## ;ADDRESS OF INPUT I/O CDB
MOVEI T2,PRIIV ;ADDRESS OF CDB INITIALIZATION VECTOR
PUSHJ P,.IOINI## ;INITIALIZE THE CDB
JRST ERRCDI## ;CAN'T INITIALIZE INPUT CDB
MOVE T3,SIFIR## ;FIRST INPUT FILE SPEC
MOVEM T3,.IOFSB(T1) ;SET FIRST ADDRESS IN CDB
MOVE T3,SILAS## ;LAST INPUT FILE SPEC
MOVEM T3,.IOFSL(T1) ;SET LAST INPUT FILE SPEC
PRIL10: PUSHJ P,.NXTFI## ;GET NEXT INPUT FILE
JRST PRILIE ;GO CHECK OUT FAILURE
MOVE P4,CDBLI+.IOLNW ;INPUT FILE WORD COUNT
;NOW PRINT THE FILE AS REQUESTED
MOVEI T1,CDBLI## ;ADDRESS OF INPUT CDB
PUSHJ P,.IOFPR## ;PRINT THE FILE AS APPROPRIATE
JRST PRILFE ;GO CHECK OUT FAILURE
PRIL80: ADDM P4,WORDS## ;COUNT UP THE WORDS
ADDI P4,177 ;ROUND UP
LSH P4,-7 ;AND CHOP DOWN TO BLOCKS
ADDM P4,BLOCKS## ;COUNT UP BLOCKS
AOS FILES## ;COUNT UP FILES
JRST PRIL10 ;GO BACK FOR NEXT FILE
;INPUT FILE ACCESS ERROR (.NXTFI/.IOPIN)
PRILIE: CAIN M0,$EFIXN ;INPUT EXHAUSTED?
JRST .POPJ1## ;YES, SUCCESSFUL COMPLETION OF COMMAND
PUSHJ P,NERFAE ;HANDLE FILE OPEN ERROR
POPJ P, ;ABORT ON ERROR
JRST PRIL10 ;CONTINUE ON ERROR
;FILE PRINT ERROR (.IOFPR)
PRILFE: CAIN M0,$EFRJU ;REJECTED BY USER?
JRST [PUSHJ P,NERFAI ;ABORT I/O
JRST PRIL10] ;SKIP INTO NEXT FILE
AOS ERRORS## ;COUNT UP ERRORS
MOVEI T1,CDBLI## ;*** ADDRESS OF INPUT CDB
PUSHJ P,.ERFPR## ;TYPE FILE PRINT ERROR MESSAGE
PUSHJ P,NERFAI ;ABORT THE FILE
PUSHJ P,ONERCK## ;WANT TO ABORT ON ERROR?
POPJ P, ;ABORT ON ERROR
JRST PRIL10 ;CONTINUE ON ERROR
SUBTTL PRINT command - switch definitions
;"PRINT" SWITCHS
DEFINE SWTCHS,<
;SP INITFILE,NIPFSB,.SWFIL##,,FS.NFS!FS.VRQ
SN MOAN,S.MOAN,FS.NFS
SN OKERROR,S.OKER,FS.NFS
SP PASSWORD,<POINT <^D65-$ASCMX>,S.PASS>,.SWASQ##,,
SL TOTALS,S.TOTA,TOT,7777,FS.OBV
SP USERID,<POINT <^D65-<3*$ASCMX>>,S.USER>,.SWUID##,,
>
DOSCAN(PRISW)
SUBTTL PRINT command - SCAN argument blocks
;"PRINT" TSCAN PARAMETER BLOCK
PRITS: EXP FXVRSN ;PROTOCOL VERSION WORD
IOWD PRISWL,PRISWN ;IOWD POINTER FOR SWITCH NAMES
XWD PRISWD,PRISWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,PRISWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /NIP/ ;HELP
XWD CLRALL,CLRFIL ;CLEAR ALL,,CLEAR FILE
XWD INX,OUX ;ALLOC INPUT AREA,,ALLOC OUTPUT AREA
XWD MEMSTK,APLSTK ;MEMORIZE STICKY,,APPLY STICKY
XWD CLRSTK,0 ;CLEAR STICKY,,FLAGS
Z ;<FUTURE>,,SWITCH VALUE STORAGE RTN
PRITL==.-PRITS
;"PRINT" OSCAN BLOCK
PRIOS: EXP FXVRSN ;PROTOCOL VERSION WORD
IOWD PRISWL,PRISWN ;IOWD POINTER FOR SWITCH NAMES
XWD PRISWD,PRISWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,PRISWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /NIP/ ;HELP
XWD PRIOSL,PRIOSN ;OPTIONS NAME(S)
PRIOL==.-PRIOS
PRIOSN: SIXBIT \NPRINT\
SIXBIT \NIP\
SIXBIT \NFT\
PRIOSL==.-PRIOSN
SUBTTL PRINT command - I/O CDB initialization vector(s)
;"PRINT" INPUT CDB INITIALIZATION VECTOR
PRIIV: EXP 10 ;COUNT OF WORDS FOLLOWING
'NS',,102030 ;VERSION WORD
0 ;"EXTRA" SIZE TO ALLOCATE
0 ;DEFAULT BUFFERING
0 ;MAXIMUM BUFFERING
.ICASC ;I/O CONTROL (ASCII MODE)
0 ;I/O ERROR CONTROL
IM.SBO ;I/O MODE
0 ;(RESERVED)
SUBTTL RENAME command
;RENAME COMMAND
;
; RENAME <NEW-SPECIFICATION> = <INPUT-EXPRESSION>
; DRENAM <NEW-SPECIFICATION> = <INPUT-SPECIFICATION>
TTLDRE==TT$FIL!TT$ERR
TTLREN==TT$FIL!TT$ERR
TTMREN==TT$FIL!TT$ERR
DREN: TDZA T1,T1 ;"DAP" MODE ENTRY
REN: SETO T1, ;NORMAL MODE ENTRY
SETCAM T1,DDCMDF## ;SET MODE FLAG
JUMPLE CH,ERRNIF## ;EOL HERE IS JUNK
PUSHJ P,CLRTOT## ;CLEAR TOTALS
PUSHJ P,RENC ;READ IN THE REST OF THE COMMAND
JRST REN70 ;COMMAND ERROR
PUSHJ P,REND ;HANDLE ANY DEFAULTING
JRST REN70 ;ERROR
PUSHJ P,RENL ;DO THE FILE TRANSFER(S)
JFCL ;IGNORE ERROR (SO COMES OUT IN SUMMARY)
SKIPE DDCMDF## ;DAP-MODE?
SKIPA T1,[TTLDRE,,TTMREN] ;YES
MOVE T1,[TTLREN,,TTMREN] ;GET TOTALS CONTROL
PUSHJ P,.TOTAL## ;ISSUE APPROPRIATE TOTALS
JFCL ;ERROR (?)
;DO ANY FINAL CLEANUP NEEDED
REN50: MOVEI T1,CDBLI## ;INPUT CHANNEL CDB
PUSHJ P,.IORLS## ;INDICATE WE ARE DONE WITH IT
JFCL ;DUH???
;NOW FREE UP THE FILE SPEC BLOCKS
REN60: PUSHJ P,FRESB## ;FREE UP THE FILE SPEC BLOCKS
JRST REN77 ;???
;ALL DONE WITH "RENAME" COMMAND
JRST .POPJ1## ;RETURN FOR NEXT COMMAND
;RENAME COMMAND ERRORS
REN70: PUSHJ P,FRESB## ;RETURN ANY FILE SPEC BLOCKS
JFCL ;???
REN77: POPJ P, ;RETURN ERROR
SUBTTL RENAME command - parsing
;HERE TO READ THE RENAME FILE SPECIFICATIONS
RENC: SETZM SIFIR## ;CLEAR OUT THE OLD DATA BASE
PUSHJ P,.REEAT## ;WANT .TSCAN TO SEE CURRENT CHARACTER!
MOVE T1,[RENTL,,RENTS] ;.TSCAN BLOCK
PUSHJ P,.TSCAN## ;READ A COMMAND LINE
PUSHJ P,CLRFIL ;CLEAR FILE ANSWERS BEFORE SWITCH.INI
MOVE T1,[RENOL,,RENOS] ;.OSCAN BLOCK
PUSHJ P,.OSCAN## ;CHECK SWITCH.INI
;ALL FOR NOW
SKIPN DDCMDF## ;DAPPING?
JRST .POPJ1## ;RETURN HAPPILY
;MAKE SURE COMMAND WILL FIT DAP
PUSHJ P,DDCVFY ;CHECK DAP CONSTRAINTS
POPJ P, ;USER LOSES
JRST .POPJ1## ;RETURN HAPPILY
SUBTTL RENAME command - defaulting
;HERE TO SUPPLY INPUT AND OUTPUT DEFAULTS
REND: SKIPN P1,SIFIR## ;ADDRESS OF FIRST INPUT SPEC
JRST ERRNIF## ;NONE???
;HANDLE INPUT DEFAULTING
REND10: MOVE T1,P1 ;ADDRESS OF CURRENT INPUT SPEC
PUSHJ P,DOSDF ;DO ANY GENERAL FILE-SPEC DEFAULTING
SKIPN .FXNAM(P1) ;GOT AN EXPLICIT FILE NAME?
ERROR FRR,<Filename is required in RENAME command>
SKIPN .FXEXT(P1) ;GOT AN EXPLICIT FILE TYPE?
HLLOS .FXEXT(P1) ;NO, THEN SET BLANK EXTENSION
MOVX T1,FX.PRT ;THE /OKPROT SWITCH BIT
TDNN T1,.FXMOM(P1) ;EXPLICIT /OKPROT/ERPROT?
ANDCAM T1,.FXMOD(P1) ;NO, DEFAULT TO /ERPROT
IORM T1,.FXMOM(P1) ;MAKE SURE NOBODY ELSE UNDEFAULTS US!
MOVX T1,FX.STR ;THE /STRS SWITCH BIT
TDNN T1,.FXMOM(P1) ;EXPLICIT /[NO]STRS?
IORM T1,.FXMOD(P1) ;NO, SET IMPLICIT /STRS
MOVX T1,FX.QRY ;/QUERY MASK
MOVX T2,FX.QRT ;/QUERY:TELL
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T2,.FXCTL(P1) ;NO, DEFAULT TO /QUERY:TELL
ADDI P1,.FXMAX ;STEP TO NEXT SPEC
CAMG P1,SILAS## ;REACHED LAST ONE YET?
JRST REND10 ;NOPE, LOOP BACK FOR MORE DEFAULTS
;HANDLE OUTPUT DEFAULTING
REND50: SKIPN P1,SOFIR## ;OUTPUT FILE SPEC BLOCK
JRST ERRNOF## ;NONE???
MOVE T1,P1 ;POSITION ADDRESS OF FILE SPEC BLOCK
PUSHJ P,DOSDF ;DO ANY GENERAL FILE-SPEC DEFAULTING
REPEAT 0,< ;HO HUM
SKIPE .FXNOD(P1) ;RESULTANT OUTPUT NODE GIVEN?
JRST REND52 ;NO
MOVSI T1,'* ' ;FULL WILD NAME
SETZ T2, ;FULL WILD MASK
DMOVEM T1,.FXNOD(P1) ;NO, SUPPLY DEFAULT (TO KEEP SAME INPUT NODE)
XMOVEI T1,[ASCIZ\*\] ;FULL WILD NAME
MOVEM T1,.FSNOD(P1) ;SUPPLY DEFAULT NODE (TO KEEP SAME INPUT NODE)
MOVX T3,FX.WND ;THE WILDCARDS-IN-NODE FLAG
IORM T3,.FXFLD(P1) ;NOTE THAT TOO
REND52: SKIPE .FXDEV(P1) ;RESULTANT DEVICE GIVEN?
JRST REND53 ;YES
MOVSI T1,'* ' ;FULL WILD NAME
SETZ T2, ;FULL WILD MASK
DMOVEM T1,.FXDEV(P1) ;SUPPLY DEFAULT (TO KEEP SAME INPUT DEVICE)
XMOVEI T1,[ASCIZ\*\] ;FULL WILD NAME
MOVEM T1,.FSDEV(P1) ;SUPPLY DEFAULT DEVICE
MOVX T3,FX.WDV ;THE WILDCARDS-IN-DEVICE FLAG
IORM T3,.FXFLD(P1) ;NOTE THAT TOO
REND53: SKIPE .FXDIR(P1) ;EXPLICIT OUTPUT DIRECTORY GIVEN?
JRST REND56 ;YES
MOVSI T3,-.FXLND ;LENGTH OF FILE SPEC DIRECTORY BLOCK
HRRI T3,.FXDIR(P1) ;ADDRESS OF FILE SPEC DIRECTORY BLOCK
MOVE T1,[377777,,377777] ;[*,*]
REND55: DMOVEM T1,(T3) ;STASH IN FILE SPEC BLOCK
MOVSI T1,'* ' ;DEFAULT FULL WILD NAME
ADDI T3,1 ;NEXT FILE SPEC DIRECTORY NAME ENTRY
AOBJN T3,REND55 ;LOOP FOR ENTIRE PATH BLOCK
XMOVEI T1,[ASCIZ\*\] ;FULL WILD NAME
MOVEM T1,.FSDIR(P1) ;SUPPLY DEFAULT DIRECTORY
MOVX T3,FX.WDR ;THE WILDCARDS-IN-DIRECTORY FLAG
IORM T3,.FXFLD(P1) ;NOTE THAT TOO
REND56: SKIPE .FXNAM(P1) ;OUTPUT FILE NAME GIVEN?
JRST REND57 ;YES
MOVSI T1,'* ' ;FULL WILD NAME
SETZ T2, ;FULL WILD MASK
DMOVEM T1,.FXNAM(P1) ;SUPPLY DEFAULT FILE NAME
XMOVEI T1,[ASCIZ\*\] ;FULL WILD NAME
MOVEM T1,.FSNAM(P1) ;SUPPLY DEFAULT FILE NAME
MOVX T3,FX.WNM ;THE WILDCARDS-IN-NAME FLAG
IORM T3,.FXFLD(P1) ;NOTE THAT TOO
REND57: SKIPE .FXEXT(P1) ;OUTPUT EXTENSION GIVEN?
JRST REND58 ;YES
MOVSI T1,'* ' ;FULL WILD NAME
HLLZM T1,.FXEXT(P1) ;NO, DEFAULT TO FULL WILD
XMOVEI T1,[ASCIZ\*\] ;FULL WILD NAME
MOVEM T1,.FSEXT(P1) ;SUPPLY DEFAULT FILE EXTENSION
MOVX T3,FX.WEX ;THE WILDCARDS-IN-EXTENSION FLAG
IORM T3,.FXFLD(P1) ;NOTE THAT TOO
> ;END REPEAT 0
REND58: MOVX T1,FX.PRT ;THE /OKPROT BIT
TDNN T1,.FXMOM(P1) ;DID USER SPECIFY /[NO]ERPROT?
ANDCAM T1,.FXMOD(P1) ;NO, FORCE /ERPROT FOR OUTPUT FILE
TDNN T1,.FXMOM(P1) ;DID USER SPECIFY /[NO]ERPROT?
IORM T1,.FXMOM(P1) ;NO, MAKE IT STICKY
MOVX T1,FX.QRY ;/QUERY MASK
MOVX T2,FX.QRT ;/QUERY:TELL
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T2,.FXCTL(P1) ;NO, DEFAULT TO /QUERY:TELL
;ALL DONE HERE
JRST .POPJ1## ;DEFAULTS DEFAULTED
SUBTTL RENAME command - main file renaming loop
;LOOP FINDING AND RENAME'ING THE FILE(S)
RENL: MOVEI T1,CDBLI## ;ADDRESS OF INPUT I/O CDB
MOVEI T2,RENIV ;ADDRESS OF CDB INITIALIZATION VECTOR
PUSHJ P,.IOINI## ;INITIALIZE THE CDB
JRST ERRCDI## ;CAN'T INITIALIZE INPUT CDB
MOVE T3,SIFIR## ;FIRST INPUT FILE SPEC
MOVEM T3,.IOFSB(T1) ;SET FIRST ADDRESS IN CDB
MOVE T3,SILAS## ;LAST INPUT FILE SPEC
MOVEM T3,.IOFSL(T1) ;SET LAST INPUT FILE SPEC
MOVE T3,SOFIR## ;FIRST OUTPUT FILE SPEC BLOCK
MOVEM T3,.IOFS3(T1) ;SET FIRST OUTPUT FILE SPEC
SKIPE DDCMDF## ;DAP MODE?
JRST RENLD ;YES
RENL10: PUSHJ P,.NXTFI## ;GET NEXT INPUT FILE
JRST RENLIE ;GO CHECK OUT FAILURE
;NOW RENAME THE FILE AS REQUESTED
MOVEI T1,CDBLI## ;ADDRESS OF INPUT CDB
PUSHJ P,.IOFRN## ;RENAME THE FILE AS APPROPRIATE
JRST RENLFE ;GO CHECK OUT FAILURE
RENL80: AOS FILES## ;COUNT UP FILES
JRST RENL10 ;GO BACK FOR NEXT FILE
;INPUT FILE ACCESS ERROR (.NXTFI/.IOPIN)
RENLIE: CAIN M0,$EFIXN ;INPUT EXHAUSTED?
JRST .POPJ1## ;YES, SUCCESSFUL COMPLETION OF COMMAND
PUSHJ P,NERFAE ;HANDLE FILE OPEN ERROR
POPJ P, ;ABORT ON ERROR
JRST RENL10 ;CONTINUE ON ERROR
;FILE RENAME ERROR (.IOFRN)
RENLFE: CAIN M0,$EFRJU ;REJECTED BY USER?
JRST [PUSHJ P,NERFAI ;ABORT I/O
JRST RENL10] ;SKIP INTO NEXT FILE
AOS ERRORS## ;COUNT UP ERRORS
MOVEI T1,CDBLI## ;*** ADDRESS OF INPUT CDB
PUSHJ P,.ERFRN## ;TYPE FILE RENAME ERROR MESSAGE
PUSHJ P,NERFAI ;ABORT THE FILE
PUSHJ P,ONERCK## ;WANT TO ABORT ON ERROR?
POPJ P, ;ABORT ON ERROR
JRST RENL10 ;CONTINUE ON ERROR
;HERE FOR DAP-MODE RENAME
RENLD: XMOVEI T1,CDBLI## ;ADDRESS OF INPUT CDB
XMOVEI T2,RENLDP ;ADDRESS OF FILE "PROCESSOR"
XMOVEI T3,RENLDE ;ADDRESS OF ERROR PROCESSOR
PUSHJ P,.IODRN## ;DO A DAP-MODE RENAME OPERATION
JRST DDCERM ;DAP-MODE COMMAND FAILURE
JRST .POPJ1## ;SUCCESSFUL
RENLDP: AOS FILES## ;COUNT THE FILES AS THEY GO BY
JRST .POPJ1## ;THAT'S ALL
RENLDE: AOS ERRORS## ;COUNT THE ERRORS AS THEY ACCUMULATE
PJRST ONERCK## ;MAYBE PROCEED, MAYBE ABORT
SUBTTL RENAME command - switch definitions
;"RENAME" SWITCHS
DEFINE SWTCHS,<
;SP INITFILE,NIPFSB,.SWFIL##,,FS.NFS!FS.VRQ
SN MOAN,S.MOAN,FS.NFS
SN OKERROR,S.OKER,FS.NFS
SP PASSWORD,<POINT <^D65-$ASCMX>,S.PASS>,.SWASQ##,,
SL TOTALS,S.TOTA,TOT,7777,FS.OBV
SP USERID,<POINT <^D65-<3*$ASCMX>>,S.USER>,.SWUID##,,
>
DOSCAN(RENSW)
SUBTTL RENAME command - SCAN argument blocks
;"RENAME" TSCAN PARAMETER BLOCK
RENTS: EXP FXVRSN ;PROTOCOL VERSION WORD
IOWD RENSWL,RENSWN ;IOWD POINTER FOR SWITCH NAMES
XWD RENSWD,RENSWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,RENSWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /NIP/ ;HELP
XWD CLRALL,CLRFIL ;CLEAR ALL,,CLEAR FILE
XWD INX,OUX ;ALLOC INPUT AREA,,ALLOC OUTPUT AREA
XWD MEMSTK,APLSTK ;MEMORIZE STICKY,,APPLY STICKY
XWD CLRSTK,0 ;CLEAR STICKY,,FLAGS
Z ;<FUTURE>,,SWITCH VALUE STORAGE RTN
RENTL==.-RENTS
;"RENAME" OSCAN BLOCK
RENOS: EXP FXVRSN ;PROTOCOL VERSION WORD
IOWD RENSWL,RENSWN ;IOWD POINTER FOR SWITCH NAMES
XWD RENSWD,RENSWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,RENSWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /NIP/ ;HELP
XWD RENOSL,RENOSN ;OPTIONS NAME(S)
RENOL==.-RENOS
RENOSN: SIXBIT \RENAME\
SIXBIT \NIP\
SIXBIT \NFT\
RENOSL==.-RENOSN
SUBTTL RENAME command - I/O CDB initialization vector(s)
;"RENAME" INPUT CDB INITIALIZATION VECTOR
RENIV: EXP 10 ;COUNT OF WORDS FOLLOWING
'NS',,102030 ;VERSION WORD
0 ;"EXTRA" SIZE TO ALLOCATE
0 ;DEFAULT BUFFERING
0 ;MAXIMUM BUFFERING
0 ;I/O CONTROL
0 ;I/O ERROR CONTROL
IM.SBO!IM.DQI ;I/O MODE
0 ;(RESERVED)
SUBTTL RESET command
;RESET COMMAND
;
; RESET
RES: PUSHJ P,RSEDF ;RESET SET DEFAULTS
JFCL ;FAILED???
JRST .POPJ1## ;SUCCESSFUL RETURN
SUBTTL REVIEW command
REV: ERROR RVY,<REVIEW command not yet implemented>
SUBTTL SET command
;SET COMMAND
;
; SET <SET-COMMAND-SPECIFIC STUFF>
;
; SET DEFAULT [<ACTUAL-SPEC> =] <DEFAULT-SPEC>
SET: JUMPLE CH,SETER0 ;IF <EOL> THEN JUNK SET COMMAND
;FOR NOW (SINCE COMMANDS DON'T NEST), JUST FAKE IT OUT
PUSHJ P,.SIXSC## ;READ SET COMMAND
MOVE T1,[IOWD SETCML,SETCMT] ;LIST OF LEGAL SET COMMANDS
SKIPN T2,NM ;GET USER'S SET COMMAND
JRST SETER0 ;NULL SET COMMAND ILLEGAL
PUSHJ P,.LKNAM## ;IDENTIFY SET COMMAND
JRST SETER1 ;UNKNOWN/ILLEGAL SET COMMAND
SUBI T1,SETCMT ;GET INDEX OF SET COMMAND
PUSHJ P,@SETCMX(T1) ;DISPATCH ON SPECIFIC SET COMMAND
PUSHJ P,.CLEOL## ;FAILED? CLEAR REST OF LINE (IF ANY)
JUMPLE CH,.POPJ1## ;HAPPINESS = <EOL>
WARN GSC,<Garbage at end of SET command, ignored>
PUSHJ P,.CLEOL## ;DIGEST AND EXCRETE THE GARBAGE
JRST .POPJ1## ;TAKE SUCCESSFUL RETURN
;The SET commands
SETCMT: 'DEFAUL' ;SET DEFAULT
'NAME ' ;SET NAME
SETCML==.-SETCMT ;LENGTH OF SET COMMAND TABLE
;And the SET command processors
SETCMX: IFIW SEDF ;SET DEFAULT PROCESSOR
IFIW SENM ;SET NAME PROCESSOR
;SET COMMAND ERRORS
SETER0: ERROR SE0,<Blank/null 'SET' command illegal>
SETER1: CAIL T1,0 ;UNKNOWN OR AMBIGUOUS COMMAND?
ERROR SE1,<Ambiguous SET command ">,SETE01
ERROR SE2,<Unknown/illegal SET command ">,SETE01
SETE01: MOVE T1,NM ;COPY OF BUM COMMAND
PUSHJ P,.TSIXN## ;TYPE IT OUT FOR USER
PUSHJ P,.TDQTE## ;ENCLOSING QUOTE CHARACTER
PJRST .TCRLF## ;CAP OFF ERROR MESSAGE WITH <CR><LF>
SETER3: ERROR SE3,<Non-blank character terminator syntax error>
SETER4: ERROR SE4,<Insufficient memory resources for SET command>
SUBTTL SET DEFAULT command
;SET DEFAULT command
;SET NAME command
;
; SET DEFAULT [<ACTUAL-SPEC> =] <DEFAULT-SPEC>
; SET DEFAULT <NAME> = <DEFAULT-SPEC>
;
;The defaults are stored as a linked list of "<A>=<D>" file specs. If
;the <ACTUAL-SPEC> was not supplied, then the default is the global or
;"master" default.
;
;The names are stored in the same linked-list, only sans <ACTUAL-SPEC>.
$DFNXT==0 ;POINTER TO NEXT LINK IN THE CHAIN
$DFNAM==1 ;NAME (SIXBIT)
$DFAFS==2 ;ADDRESS OF <ACTUAL-SPEC>
$DFDFS==3 ;ADDRESS OF <DEFAULT-SPEC>
$DFLEN==4 ;SIZE OF CHAIN LINK
SEDF: TDZA P1,P1 ;FLAG 'DEFAULT'
SENM: SETO P1, ;FLAG 'NAME'
PUSHJ P,SEDF00 ;GO DO IT!
JRST [MOVE T1,CMDFF## ;OOPS, SOMETHING FALL DOWN GO BOOM!
MOVEM T1,.JBFF ;BACK OUT OF WHATEVER HAPPENED
POPJ P,] ;PROPAGATE ERROR RETURN
JRST .POPJ1## ;SUCCESS
;Here to RESET the SET DEFAULTs and NAMEs
RSEDF: SETZM SDFFIR ;CLEAR START
SETZM SDFLAS ; AND END OF DEFAULTS CHAIN
SETZM SDFMAS ;CLEAR "MASTER" SPEC POINTER
MOVE T1,ORGFF## ;GET THE REAL .JBFF
MOVEM T1,.JBFF ;TELL THE WORLD
MOVEM T1,CMDFF## ;TELL THE GALAXY
MOVEM T1,SAVFF## ;TELL THE WHOLE UNIVERSE
JRST .POPJ1## ;SUCCESSFUL RETURN
;Here to do the actual work of the SET DEFAULT command
SEDF00: JUMPLE CH,SETER0 ;CAN'T END THE LINE YET!
CAIE CH," " ;MUST BE A BLANK HERE
JRST SETER3 ;SET COMMAND SYNTAX ERROR
;First get a[nother] list pointer cell (for lack of a better name)
MOVEI T1,$DFLEN ;SIZE OF A LINK
PUSHJ P,.MMGWD## ;ASK MEMORY MANAGER
JRST SETER4 ;NO FREE CORE, CAN'T DO COMMAND
MOVE P2,T2 ;HANG ONTO THIS LINK FOR AWHILE
SETZM $DFNAM(P2) ;CLEAR THE NAME SPEC
SETZM $DFAFS(P2) ;AND THE <ACTUAL-SPEC> POINTER
;Get the first 'file spec'
SEDF10: PUSHJ P,SEDFS ;PARSE THE FIRST DEFAULT (FILE SPEC)
POPJ P, ;ERROR (PROBABLY SYNTAX), ABORT
JUMPG CH,SEDF20 ;IF MORE COMMING, THEN TWO SPECS
JUMPE P1,SEDF12 ;IF SET DEFAULT THEN THIS IS MASTER
ERROR MNS,<Missing default specification in SET NAME>
SEDF12: SKIPE SDFMAS ;ALREADY SEEN A "MASTER" DEFAULT?
ERROR DMI,<Duplicate "master" defaults>
MOVEM P2,SDFMAS ;THIS WILL BE THE MASTER DEFAULT
JRST SEDF29 ;AND PUT THIS LINK INTO THE CHAIN
;Here for <ACTUAL-SPEC> ! <NAME> = <DEFAULT-SPEC> construction
SEDF20: JUMPE P1,SEDF23 ;PROCESS TWO SPECS IF SET DEFAULT
SKIPN T3,.FXDEV(T2) ;GET DEVICE NAME
SKIPE T3,.FXNAM(T2) ;NONE, TRY FOR SIMPLE NAME
CAIA ;SET THE NAME
ERROR MNM,<Missing 'name' in name specification in SET NAME>
MOVEM T3,$DFNAM(P2) ;SAVE THE NAME
PUSHJ P,.MMFWD## ;RELINQUISH THE NAME FSB
JFCL ;DUH?
CAIN CH,"=" ;MUST BE SEPARATING "="
JRST SEDF24 ;SLURP UP THE <DEFAULT-SPEC>
ERROR MEN,<Missing "=" character in SET NAME>
SEDF23: MOVEM T2,$DFAFS(P2) ;SAVE <ACTUAL-SPEC> FSB ADDRESS
CAIE CH,"=" ;MUST BE SEPARATING "="
ERROR MED,<Missing "=" character in SET DEFAULT>
SEDF24: PUSHJ P,SEDFS ;NOW PARSE THE <DEFAULT-SPEC>
POPJ P, ;ERROR, ABORT
SEDF29: MOVEM T2,$DFDFS(P2) ;SAVE ADDRESS OF <DEFAULT-SPEC>
;Insert this default into the chain of defaults
SEDF40: SKIPN SDFFIR ;IS THIS THE FIRST DEFAULT?
MOVEM P2,SDFFIR ;YES, SO ACTS AS START OF CHAIN
SKIPE SDFLAS ;IF THERE IS ALREADY AN END TO THE CHAIN,
MOVEM P2,@SDFLAS ;LINK OLD LAST TO NEW LAST
MOVEM P2,SDFLAS ;SET THE NEW END OF THE CHAIN
;Make the .JBFF allocations permanent
MOVE T1,.JBFF ;CURRENT .JBFF VALUE
MOVEM T1,CMDFF## ;FAKE OUT THE COMMAND-LEVEL COPY
MOVEM T1,SAVFF## ;AND THE TOP-LEVEL COPY AS WELL
JRST .POPJ1## ;SUCCESSFUL COMPLETION OF THIS COMMAND
;SEDFS - Parse a file spec for the SET DEFAULT command
;Call is:
;
; PUSHJ P,SEDFS
; error return
; normal return
;
;On error return an error message has been issued.
;
;On successful return, the address of the resultant file spec block
;is in T2.
;
;Uses T1, T2, T3, T4.
SEDFS: PUSHJ P,.CLRFL## ;CLEAR THE SCANNER
PUSHJ P,.CLSNS## ;AND THE STICKY DEFAULTS TOO!
PUSHJ P,.FILSP## ;PARSE ONE FILE SPEC
PJRST (T1) ;*** RETURNED ADDRESS, NOT CODE
;*** NOTE THAT THIS WILL ERROR-RETURN VIA
;*** NFTER ROUTINE IN NFT MODULE! BLETCH!
PUSHJ P,.TINBC## ;GET TO NON-BLANK TERMINATOR
CAIN CH,"=" ;AN "=" IS AN OK TERMINATOR
JRST SEDFS3 ;SLURP UP THIS SPEC AND RETURN IT
JUMPLE CH,SEDFS3 ;<EOL> IS VALID TERMINATOR
CAIGE CH,.CHGWD ;'GUIDE-WORD' META-CHARACTER?
ERROR SDC,<Illegal terminator character ">,.+2,CH
ERROR SDG,<Illegal terminator 'GUIDE WORD' ">,.+1,CH
PUSHJ P,.TFCHR## ;TYPE OFFENDING CHARACTER
PJRST .TDQTE## ;CAP OFF WITH ENCLOSING QUOTES
SEDFS3: PUSHJ P,INX## ;ALLOCATE AND SETUP ONE FILE SPEC BLOCK
SETZM SIFIR## ;WE DON'T REALLY USE SIFIR
SETZM SILAS## ;NOR SILAS, SO BLOW THEM AWAY
PUSHJ P,.GTSPC## ;COPY SPEC FROM SCAN'S DATA BASE
EXCH T1,T2 ;NATURALLY, WE WANT THE ADDRESS IN T2!
JRST .POPJ1## ;RETURN WITH FILE SPEC BLOCK
;DOSDF - Here to apply file-spec-defaults, from both SET DEFAULT and SWITCH.INI
DOSDF: PUSHJ P,.SAVE4## ;PROTECT THE PEAS
PUSHJ P,TSAV14## ;AND THE TEAS TOO
PUSHJ P,DNSDF ;LOOK FOR A 'NAME' MATCH
JRST DOSDF3 ;NOPE, JUST TRY DEFAULTS
PUSHJ P,DASDF ;DEFAULT-FILL THE USER'S SPEC
JFCL ;FAILED???
DOSDF3: MOVE T1,-T1(P) ;RESTORE ADDRESS OF USER FSB
PUSHJ P,DMSDF ;GET A MATCHING SPEC FROM SET DEFAULT
JRST DOSDF8 ;NONE, JUST TRY FOR SWITCH.INI
PUSHJ P,DASDF ;APPLY THE DEFAULTS
JFCL ;FAILED???
DOSDF8: MOVE T1,-T1(P) ;RESTORE ADDRESS OF USER FSB
MOVEI T2,.FXMAX ;LENGTH OF A FILE SPEC BLOCK
PJRST DOOSDF## ;APPLY SWITCH.INI DEFAULTS
;Loop through the DEFAULTs looking for a <NAME> that matches
;the current user-typed file spec.
DNSDF: SKIPE .FXDEV(T1) ;<NAME> MATCH ONLY ON DEVICE:
SKIPE .FXNOD(T1) ;SANS ANY NODE-NAME
POPJ P, ;NO <NAME> MATCH FOR THIS SPEC
SKIPN T3,SDFFIR ;BASE ADDRESS OF DEFAULTS CHAIN
POPJ P, ;NONE, NO MATCH HERE THEN
DNSDF1: CAME T3,SDFMAS ;SKIP THE MASTER SPEC ON 'NAME' SEARCH
SKIPN T2,$DFNAM(T3) ;GET <NAME>, IF ANY
JRST DNSDF8 ;NONE, SKIP THIS ONE
DMOVE P1,.FXDEV(T1) ;GET USER'S DEVICE SPEC
CAMN T2,P1 ;DOES THIS <NAME> MATCH USER'S DEVICE?
AOJE P2,DNSDF9 ;YES (BUT ONLY IF NOT-WILDCARDED!)
DNSDF8: SKIPE T3,$DFNXT(T3) ;ADVANCE TO NEXT ENTRY IN THE CHAIN
JRST DNSDF1 ;AND SEE IF IT MATCHES
POPJ P, ;NO MATCH, NO MASTER, DO DEFAULTS HERE
DNSDF9: MOVE T2,$DFDFS(T3) ;ADDRESS OF <DEFAULT-SPEC>
SETZM .FXDEV(T1) ;BLAST THE DEVICE NAME
SETZM .FXDEM(T1) ; AND THE DEVICE MASK
SETZM .FSDEV(T1) ; AND THE DEVICE STRING
MOVX T4,FX.UDV!FX.WDV!FX.SDV ;CLEAR ALL VESTIGES OF THE
ANDCAM T4,.FXFLD(T1) ;DEVICE'S HAVING EVER EXISTED
JRST .POPJ1## ;RETURN POINTING TO DEFAULT SPEC
;Loop through the DEFAULTs looking for an <ACTUAL-SPEC> that matches
;the current user-typed file spec, or a "master" default spec.
DMSDF: SKIPN T3,SDFFIR ;BASE ADDRESS OF DEFAULTS CHAIN
POPJ P, ;NONE, NO MATCH HERE THEN
DMSDF1: CAME T3,SDFMAS ;SAVE THE MASTER SPEC TILL LAST
SKIPN T2,$DFAFS(T3) ;GET <ACTUAL-SPEC>, IF ANY
JRST DMSDF8 ;NONE, SKIP THIS ONE
MOVE P4,.FXFLD(T2) ;GET FIELDS-MASK OF <ACTUAL-SPEC>
TXNN P4,FX.UND!FX.UDV!FX.UDR!FX.UNM!FX.UEX ;GOT ANYTHING WORTHWHILE?
JRST DMSDF8 ;NO, SKIP OVER THIS SPEC
TXNN P4,FX.UND ;GOT A NODE-SPEC TO MATCH?
JRST DMSDF2 ;NO, SKIP NODE FIELD
MOVE P1,.FXNOD(T1) ;USER'S NODE SPEC
XOR P1,.FXNOD(T2) ;CONTRAST WITH <ACTUAL-SPEC>
AND P1,.FXNOM(T2) ;MASK OUT WILDCARD FIELDS
JUMPN P1,DMSDF8 ;IF NOT A MATCH, ADVANCE TO NEXT CANDIDATE
DMSDF2: TXNN P4,FX.UDV ;GOT A DEVICE-SPEC TO MATCH?
JRST DMSDF3 ;NO, SKIP DEVICE FIELD
MOVE P1,.FXDEV(T1) ;USER'S DEVICE SPEC
XOR P1,.FXDEV(T2) ;CONTRAST WITH <ACTUAL-SPEC>
AND P1,.FXDEM(T2) ;MASK OUT WILDCARD FIELDS
JUMPN P1,DMSDF8 ;IF NOT A MATCH, ADVANCE TO NEXT CANDIDATE
DMSDF3: TXNN P4,FX.UDR ;GOT A DIRECTORY-SPEC TO MATCH?
JRST DMSDF6 ;NO, SKIP DIRECTORY FIELD
HRRZI P2,.FXDIR(T1) ;ADDRESS OF USER'S DIRECTORY
MOVSI P3,-.FXLND ;COUNT OF DIRECTORY BI-WORDS
HRRI P3,.FXDIR(T2) ;ADDRESS OF <ACTUAL-SPEC> DIRECTORY
DMSDF4: MOVE P1,0(P2) ;USER'S DIRECTORY SPEC
XOR P1,0(P3) ;CONTRAST WITH <ACTUAL-SPEC>
AND P1,1(P3) ;MASK OUT WILDCARD FIELDS
JUMPN P1,DMSDF8 ;IF NOT A MATCH, ADVANCE TO NEXT CANDIDATE
AOBJP P3,DMSDF6 ;IF LOOKED AT WHOLE DIRECTORY THEN MATCHES
ADDI P2,2 ;ADVANCE USER'S SPEC TO NEXT BI-WORD
SKIPE 1(P3) ;GOT MORE <ACTUAL-SPEC> TO LOOK AT?
AOJA P3,DMSDF4 ;YES, CHECK NEXT SUB-DIRECTORY LEVEL
SKIPE 0(P2) ;NO, IF USER SPEC STILL GOING
JRST DMSDF8 ;THEN SPEC DOESN'T MATCH
;Continued on next page
;Continued from previous page
DMSDF6: TXNN P4,FX.UNM ;GOT A NAME-SPEC TO MATCH?
JRST DMSDF7 ;NO, SKIP NAME FIELD
MOVE P1,.FXNAM(T1) ;USER'S NAME SPEC
XOR P1,.FXNAM(T2) ;CONTRAST WITH <ACTUAL-SPEC>
AND P1,.FXNMM(T2) ;MASK OUT WILDCARD FIELDS
JUMPN P1,DMSDF8 ;IF NOT A MATCH, ADVANCE TO NEXT CANDIDATE
DMSDF7: TXNN P4,FX.UEX ;GOT A EXTENSION/TYPE-SPEC TO MATCH?
JRST DMSDF9 ;NO, THEN THIS SPEC WINS!
HLLZ P1,.FXEXT(T1) ;USER'S EXTENSION SPEC
XOR P1,.FXEXT(T2) ;CONTRAST WITH <ACTUAL-SPEC>
HRLZ P2,.FXEXT(T2) ;<ACTUAL-SPEC> WILDCARD MASK
AND P1,P2 ;MASK OUT WILDCARD FIELDS
JUMPN P1,DMSDF8 ;IF NOT A MATCH, ADVANCE TO NEXT CANDIDATE
JRST DMSDF9 ;THIS <ACTUAL-SPEC> MATCHES, USE IT
DMSDF8: SKIPE T3,$DFNXT(T3) ;ADVANCE TO NEXT ENTRY IN THE CHAIN
JRST DMSDF1 ;AND SEE IF IT MATCHES
SKIPN T3,SDFMAS ;NO MATCHES, GOT A "MASTER" DEFAULT?
POPJ P, ;NO MATCH, NO MASTER, NO DEFAULTS HERE
DMSDF9: MOVE T2,$DFDFS(T3) ;ADDRESS OF <DEFAULT-SPEC>
JRST .POPJ1## ;RETURN POINTING TO DEFAULT SPEC
;Apply the SET DEFAULTs to this user-typed file spec.
;
;T1/User-FSB
;T2/Defl-FSB
DASDF: DMOVE P3,T1 ;P3:=USER SPEC, P4:=DEFAULT SPEC
MOVE P1,.FXFLD(P3) ;FIELDS SEEN SO FAR
MOVE P2,.FXFLD(P4) ;FIELDS PRESENT IN DEFAULT AREA
DASDF1: SKIPN .FXNOD(P3) ;GOT A NODE SPECIFICATION?
TXNN P2,FX.UND ;NO, DEFAULT NODE?
JRST DASDF3 ;NO DEFAULT NODE NAME
DMOVE T3,.FXNOD(P4) ;APPLY NODE--PICK UP DEFAULT
DMOVEM T3,.FXNOD(P3) ;SUPPLY HIS DEFAULT NODE
MOVE T1,.FSNOD(P4) ;ADDRESS OF DEFAULT NODE STRING
MOVEM T1,.FSNOD(P3) ;SET APPLIED DEFAULT NODE STRING
TXO P1,FX.UND ;NOTE A "DEFAULT" NODE NAME
TXNE P2,FX.WND ;NODE WILDCARDS?
TXO P1,FX.WND ;YES, NOTE THOSE TOO
DASDF2: SKIPN .FXDEV(P3) ;GOT A DEVICE SPECIFICATION?
TXNN P2,FX.UDV ;NO, DEFAULT DEVICE?
JRST DASDF3 ;NO DEFAULT DEVICE NAME
DMOVE T3,.FXDEV(P4) ;APPLY DEVICE--PICK UP DEFAULT
DMOVEM T3,.FXDEV(P3) ;SUPPLY HIS DEFAULT DEVICE
MOVE T1,.FSDEV(P4) ;ADDRESS OF DEFAULT DEVICE STRING
MOVEM T1,.FSDEV(P3) ;SET APPLIED DEFAULT DEVICE STRING
TXO P1,FX.UDV ;NOTE A "DEFAULT" DEVICE NAME
TXNE P2,FX.WDV ;DEVICE WILDCARDS?
TXO P1,FX.WDV ;YES, NOTE THOSE TOO
DASDF3: SKIPN .FXDIR(P3) ;GOT A DIRECTORY SPECIFICATION?
TXNN P2,FX.UDR ;NO, DEFAULT DIRECTORY?
JRST DASDF4 ;NO DEFAULT DIRECTORY
MOVSI T4,.FXDIR(P4) ;ADDRESS OF DEFAULT DIRECTORY SPEC
HRRI T4,.FXDIR(P3) ;ADDRESS OF USER-SPEC DIRECTORY FIELD
BLT T4,.FXDIR+<2*.FXLND>-1(P3) ;COPY DEFAULT
MOVE T1,.FSDIR(P4) ;ADDRESS OF DEFAULT DIRECTORY STRING
MOVEM T1,.FSDIR(P3) ;SET APPLIED DEFAULT DIRECTORY STRING
TXO P1,FX.UDR ;NOTE "DEFAULT" DIRECTORY
TXNE P2,FX.WDR ;WILD DIRECTORY?
TXO P1,FX.WDR ;YES, NOTE THOSE TOO
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
DASDF4: SKIPN .FXNAM(P3) ;GOT A FILE NAME SPECIFICATION?
TXNN P2,FX.UNM ;NO, DEFAULT FILE NAME?
JRST DASDF5 ;NO DEFAULT FILE NAME
DMOVE T3,.FXNAM(P4) ;GET NAME
DMOVEM T3,.FXNAM(P3) ; APPLY DEFAULT NAME
MOVE T1,.FSNAM(P4) ;ADDRESS OF DEFAULT NAME STRING
MOVEM T1,.FSNAM(P3) ;SET APPLIED DEFAULT NAME STRING
TXO P1,FX.UNM ;NOTE "DEFAULT" NAME
TXNE P2,FX.WNM ;NAME WILDCARDS?
TXO P1,FX.WNM ;YES, NOTE THOSE TOO
DASDF5: SKIPN .FXEXT(P3) ;GOT A FILE TYPE SPECIFICATION?
TXNN P2,FX.UEX ;NO, DEFAULT EXTENSION?
JRST DASDF6 ;NO DEFAULT EXTENSION
MOVE T3,.FXEXT(P4) ;APPLY EXTENSION
MOVEM T3,.FXEXT(P3) ; ..
MOVE T1,.FSEXT(P4) ;ADDRESS OF DEFAULT EXTENSION STRING
MOVEM T1,.FSEXT(P3) ;SET APPLIED DEFAULT EXTENSION STRING
TXO P1,FX.UEX ;NOTE "DEFAULT" EXTENSION
TXNE P2,FX.WEX ;EXTENSION WILDCARDS?
TXO P1,FX.WEX ;YES, NOTE THOSE TOO
DASDF6: SKIPN .FXGEN(P3) ;GOT A FILE GENERATION SPECIFICATION?
TXNN P2,FX.UGN ;NO, DEFAULT GENERATION?
JRST DASDF7 ;NO DEFAULT GENERATION
MOVE T3,.FXGEN(P4) ;APPLY GENERATION
MOVEM T3,.FXGEN(P3) ; ..
MOVE T1,.FSGEN(P4) ;ADDRESS OF DEFAULT GENERATION STRING
MOVEM T1,.FSGEN(P3) ;SET APPLIED DEFAULT GENERATION STRING
TXO P1,FX.UGN ;NOTE "DEFAULT" GENERATION
TXNE P2,FX.WGN ;GENERATION WILDCARDS?
TXO P1,FX.WGN ;YES, NOTE THOSE TOO
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
DASDF7: MOVEM P1,.FXFLD(P3) ;STASH AWAY FIELD FLAGS
DMOVE T3,.FXCTL(P4) ;APPLY ALL CONTROL MODES
ANDCM T3,.FXCTM(P3) ;LESS THOSE EXPLICITLY TYPED
IORM T3,.FXCTL(P3) ; . . .
IORM T4,.FXCTM(P3) ; . . .
DMOVE T3,.FXMOD(P4) ;APPLY ALL FILE SWITCHES
ANDCM T3,.FXMOM(P3) ;MASK HERE USED TO INDICATE WHICH WERE TYPED
IORM T3,.FXMOD(P3) ; ..
IORM T4,.FXMOM(P3) ; ..
MOVSI T3,.FXBOM-.FXEOM;LENGTH OF SWITCHES
HRRI T3,(P3) ;ADDRESS OF USER SPEC
MOVEI T4,(P4) ;ADDRESS OF DEFAULT SPEC
DASDF8: MOVE T2,.FXBOM(T3) ;GET CURRENT VALUE
CAMN T2,[-1] ;SEE IF SET
MOVE T2,.FXBOM(T4) ;NO--GET THIS DEFAULT SWITCH
MOVEM T2,.FXBOM(T3) ;STORE RESULT
ADDI T4,1 ;ADVANCE DEFAULT POINTER
AOBJN T3,DASDF8 ;LOOP OVER ALL SWITCHES
;Continued on next page
;Continued from previous page
;Now do our own stuff
DASDG: SKIPN .FXUID(P3) ;IF USER TYPED A USERID FIELD,
SKIPN .FXUID(P4) ;OR WE DON'T HAVE A DEFAULT ONE
JRST DASDG3 ;THEN DON'T DEFAULT THE USERID FIELD
MOVSI T3,.FXUID(P4) ;ADDRESS OF DEFAULT USERID FIELD
HRRI T3,.FXUID(P3) ;ADDRESS OF WANTING USERID FIELD
BLT T3,.FXUID+$ASCMX-1(P3) ;DEFAULT THE USERID FIELD
DASDG1: SKIPN .FXUAC(P3) ;IF USER SUPPLIED AN ACCOUNT FIELD
SKIPN .FXUAC(P4) ;OR WE DON'T HAVE A DEFAULT ONE
JRST DASDG2 ;THEN DON'T DEFAULT THE ACCOUNT FIELD
MOVSI T3,.FXUAC(P4) ;ADDRESS OF DEFAULT ACCOUNT FIELD
HRRI T3,.FXUAC(P3) ;ADDRESS OF WANTING ACCOUNT FIELD
BLT T3,.FXUAC+$ASCMX-1(P3) ;DEFAULT THE ACCOUNT FIELD
DASDG2: SKIPN .FXUPW(P3) ;IF USER TYPED A PASSWORD FIELD,
SKIPN .FXUPW(P4) ;OR WE DON'T HAVE A DEFAULT ONE
JRST DASDG3 ;THEN DON'T DEFAULT THE PASSWORD FIELD
MOVSI T3,.FXUPW(P4) ;ADDRESS OF DEFAULT PASSWORD FIELD
HRRI T3,.FXUPW(P3) ;ADDRESS OF WANTING PASSWORD FIELD
BLT T3,.FXUPW+$ASCMX-1(P3) ;DEFAULT THE PASSWORD FIELD
DASDG3: JRST .POPJ1## ;SUCCESSFUL RETURN
SUBTTL SUBMIT command
;SUBMIT COMMAND
;
; SUBMIT <INPUT-EXPRESSION>
; DSUBMI <INPUT-SPECIFICATION>
;
;Note: DAP refers to this function as "execute", and defines "submit" to
; be a copy operation with execute on close. For the purposes of
; user interface on TOPS-10, the terminology is "submit", even
; though the code in the I/O library will use "execute".
TTLDSU==TT$FIL!TT$ERR
TTLSUL==TT$FIL!TT$ERR
TTMSUL==TT$BLK!TT$FIL!TT$ERR
DSBM: TDZA T1,T1 ;"DAP" ENTRY
SBM: SETO T1, ;NORMAL ENTRY
SETCAM T1,DDCMDF## ;SET COMMAND MODE
JUMPLE CH,ERRNIF## ;EOL HERE IS JUNK
PUSHJ P,CLRTOT## ;CLEAR TOTALS
PUSHJ P,SBMC ;READ IN THE REST OF THE COMMAND
JRST SBM70 ;COMMAND ERROR
PUSHJ P,SBMD ;HANDLE ANY DEFAULTING
JRST SBM70 ;ERROR
PUSHJ P,SBML ;DO THE FILE SUBMISSION(S)
JFCL ;IGNORE ERROR (SO COMES OUT IN SUMMARY)
SKIPE DDCMDF## ;RESTRICTED TO DAP MODE?
SKIPA T1,[TTLDSU,,TTMSUL] ;YES
MOVE T1,[TTLSUL,,TTMSUL] ;GET TOTALS CONTROL
PUSHJ P,.TOTAL## ;AND ISSUE TOTALS SUMMARY
JFCL ;ERROR (?)
;DO ANY FINAL CLEANUP NEEDED
SBM50: MOVEI T1,CDBLI## ;INPUT CHANNEL CDB
PUSHJ P,.IORLS## ;INDICATE WE ARE DONE WITH IT
JFCL ;DUH???
;NOW FREE UP THE FILE SPEC BLOCKS
SBM60: PUSHJ P,FRESB## ;FREE UP THE FILE SPEC BLOCKS
JRST SBM77 ;???
;ALL DONE WITH "SUBMIT" COMMAND
JRST .POPJ1## ;RETURN FOR NEXT COMMAND
;SUBMIT COMMAND-LEVEL ERROR
SBM70: PUSHJ P,FRESB## ;FREE UP ANY FILE SPEC BLOCKS LEFT LYING AROUND
JFCL ;???
SBM77: POPJ P, ;PROPAGATE ERROR
SUBTTL SUBMIT command - parsing
;HERE TO READ THE SUBMIT FILE SPECIFICATIONS
SBMC: SETZM SIFIR## ;CLEAR OUT THE OLD DATA BASE
PUSHJ P,.REEAT## ;WANT .TSCAN TO SEE CURRENT CHARACTER!
MOVE T1,[SBMTL,,SBMTS] ;.TSCAN BLOCK
PUSHJ P,.TSCAN## ;READ A COMMAND LINE
PUSHJ P,CLRFIL ;CLEAR FILE ANSWERS BEFORE SWITCH.INI
MOVE T1,[SBMOL,,SBMOS] ;.OSCAN BLOCK
PUSHJ P,.OSCAN## ;CHECK SWITCH.INI
;ALL FOR NOW
SKIPN DDCMDF## ;DAPPING?
JRST .POPJ1## ;RETURN HAPPILY
;MAKE SURE COMMAND WILL FIT DAP CONSTRAINTS
PUSHJ P,DDCVFY ;CALL DAP COMMAND VERIFIER
POPJ P, ;USER LOSES
JRST .POPJ1## ;RETURN HAPPILY
SUBTTL SUBMIT command - defaulting
;HERE TO SUPPLY INPUT AND OUTPUT DEFAULTS
SBMD: SKIPN P1,SIFIR## ;ADDRESS OF FIRST INPUT SPEC
JRST ERRNIF## ;NONE???
;HANDLE INPUT DEFAULTING
SBMD10: MOVE T1,P1 ;ADDRESS OF CURRENT INPUT SPEC
PUSHJ P,DOSDF ;DO ANY GENERAL FILE-SPEC DEFAULTING
SKIPN .FXNAM(P1) ;USER TYPE AN EXPLICIT FILE NAME?
ERROR FRS,<Filename is required in SUBMIT command>
MOVX T1,FX.UQN ;
TDNN T1,.FXFLD(P1) ;USER-SPECIFIED QUOTED FILE NAME?
SKIPE .FXEXT(P1) ;USER TYPE AN EXPLICIT EXTENSION?
JRST SBMD18 ;YES
MOVSI T1,'CTL' ;DEFAULT SUBMIT FILE TYPE
HLLOM T1,.FXEXT(P1) ;NO, SUBMIT DEFAULTS TO .CTL
XMOVEI T1,[ASCIZ\CTL\] ;DEFAULT SUBMIT FILE TYPE
MOVEM T1,.FSEXT(P1) ;SUBMIT DEFAULTS TO .CTL
SBMD18: MOVX T1,FX.PRT ;THE /OKPROT SWITCH BIT
TDNN T1,.FXMOM(P1) ;EXPLICIT /OKPROT/ERPROT?
ANDCAM T1,.FXMOD(P1) ;NO, DEFAULT TO /ERPROT
IORM T1,.FXMOM(P1) ;MAKE SURE NOBODY ELSE UNDEFAULTS US!
MOVX T1,FX.STR ;THE /STRS SWITCH BIT
TDNN T1,.FXMOM(P1) ;EXPLICIT /[NO]STRS?
ANDCAM T1,.FXMOD(P1) ;NO, SET IMPLICIT /NOSTRS
MOVX T1,FX.QRY ;/QUERY MASK
MOVX T2,FX.QRT ;/QUERY:TELL
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T2,.FXCTL(P1) ;NO, DEFAULT TO /QUERY:TELL
; MOVX T1,FX.QNY ;THE [N/Y] BIT
; TDNN T1,.FXCTM(P1) ;DID USER REQUEST IT?
; IORM T1,.FXCTL(P1) ;NO, SO DEFAULT TO [N/Y]
ADDI P1,.FXMAX ;STEP TO NEXT SPEC
CAMG P1,SILAS## ;REACHED LAST ONE YET?
JRST SBMD10 ;NOPE, LOOP BACK FOR MORE DEFAULTS
;HANDLE OUTPUT
SBMD50: SKIPE P1,SOFIR## ;OUTPUT FILE SPEC BLOCK
JRST ERROFI## ;ILLEGAL OUTPUT FILE
;ALL DONE HERE
JRST .POPJ1## ;DEFAULTS DEFAULTED
SUBTTL SUBMIT command - main file submission loop
;LOOP FINDING AND SUBMITTING THE FILE(S)
SBML: MOVEI T1,CDBLI## ;ADDRESS OF INPUT I/O CDB
MOVEI T2,SBMIV ;ADDRESS OF CDB INITIALIZATION VECTOR
PUSHJ P,.IOINI## ;INITIALIZE THE CDB
JRST ERRCDI## ;CAN'T INITIALIZE INPUT CDB
MOVE T3,SIFIR## ;FIRST INPUT FILE SPEC
MOVEM T3,.IOFSB(T1) ;SET FIRST ADDRESS IN CDB
MOVE T3,SILAS## ;LAST INPUT FILE SPEC
MOVEM T3,.IOFSL(T1) ;SET LAST INPUT FILE SPEC
SKIPE DDCMDF## ;DAP-MODE?
JRST SBMLD ;YES
SBML10: PUSHJ P,.NXTFI## ;GET NEXT INPUT FILE
JRST SBMLIE ;GO CHECK OUT FAILURE
MOVE P4,CDBLI+.IOLNW ;INPUT FILE WORD COUNT
;NOW SUBMIT THE FILE AS REQUESTED
MOVEI T1,CDBLI## ;ADDRESS OF INPUT CDB
PUSHJ P,.IOFSU## ;SUBMIT THE FILE AS APPROPRIATE
JRST SBMLFE ;GO CHECK OUT FAILURE
SBML80: ADDM P4,WORDS## ;COUNT UP THE WORDS
ADDI P4,177 ;ROUND UP
LSH P4,-7 ;AND CHOP DOWN TO BLOCKS
ADDM P4,BLOCKS## ;COUNT UP BLOCKS
AOS FILES## ;COUNT UP FILES
JRST SBML10 ;GO BACK FOR NEXT FILE
;INPUT FILE ACCESS ERROR (.NXTFI/.IOPIN)
SBMLIE: CAIN M0,$EFIXN ;INPUT EXHAUSTED?
JRST .POPJ1## ;YES, SUCCESSFUL COMPLETION OF COMMAND
PUSHJ P,NERFAE ;HANDLE FILE OPEN ERROR
POPJ P, ;ABORT ON ERROR
JRST SBML10 ;CONTINUE ON ERROR
;FILE SUBMIT ERROR (.IOFSU)
SBMLFE: CAIN M0,$EFRJU ;REJECTED BY USER?
JRST [PUSHJ P,NERFAI ;ABORT I/O
JRST SBML10] ;SKIP INTO NEXT FILE
AOS ERRORS## ;COUNT UP ERRORS
MOVEI T1,CDBLI## ;*** ADDRESS OF INPUT CDB
PUSHJ P,.ERFSU## ;TYPE FILE SUBMIT ERROR MESSAGE
PUSHJ P,NERFAI ;ABORT THE FILE
PUSHJ P,ONERCK## ;WANT TO ABORT ON ERROR?
POPJ P, ;ABORT ON ERROR
JRST SBML10 ;CONTINUE ON ERROR
;HERE FOR DAP-MODE SUBMIT
SBMLD: XMOVEI T1,CDBLI## ;ADDRESS OF INPUT CDB
XMOVEI T2,SBMLDP ;ADDRESS OF FILE "PROCESSOR"
XMOVEI T3,SBMLDE ;ADDRESS OF ERROR PROCESSOR
PUSHJ P,.IODEX## ;DO A DAP-MODE SUBMIT OPERATION
JRST DDCERM ;DAP-MODE COMMAND FAILURE
JRST .POPJ1## ;SUCCESSFUL
SBMLDP: MOVE T1,CDBLI+.IOLNW ;GET FILE LENGTH IN -10 WORDS
ADDI T1,177 ;ROUND UP AND
LSH T1,-7 ;TRUNCATE TO BLOCK SIZE
ADDM T1,BLOCKS## ;ACCUMULATE BLOCKS
AOS FILES## ;COUNT THE FILES AS THEY GO BY
JRST .POPJ1## ;THAT'S ALL
SBMLDE: AOS ERRORS## ;COUNT THE ERRORS AS THEY ACCUMULATE
PJRST ONERCK## ;MAYBE PROCEED, MAYBE ABORT
SUBTTL SUBMIT command - switch definitions
;"SUBMIT" SWITCHS
DEFINE SWTCHS,<
;SP INITFILE,NIPFSB,.SWFIL##,,FS.NFS!FS.VRQ
SN MOAN,S.MOAN,FS.NFS
SN OKERROR,S.OKER,FS.NFS
SP PASSWORD,<POINT <^D65-$ASCMX>,S.PASS>,.SWASQ##,,
SL TOTALS,S.TOTA,TOT,7777,FS.OBV
SP USERID,<POINT <^D65-<3*$ASCMX>>,S.USER>,.SWUID##,,
>
DOSCAN(SBMSW)
SUBTTL SUBMIT command - SCAN argument blocks
;"SUBMIT" TSCAN PARAMETER BLOCK
SBMTS: EXP FXVRSN ;PROTOCOL VERSION WORD
IOWD SBMSWL,SBMSWN ;IOWD POINTER FOR SWITCH NAMES
XWD SBMSWD,SBMSWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,SBMSWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /NIP/ ;HELP
XWD CLRALL,CLRFIL ;CLEAR ALL,,CLEAR FILE
XWD INX,OUX ;ALLOC INPUT AREA,,ALLOC OUTPUT AREA
XWD MEMSTK,APLSTK ;MEMORIZE STICKY,,APPLY STICKY
XWD CLRSTK,0 ;CLEAR STICKY,,FLAGS
Z ;<FUTURE>,,SWITCH VALUE STORAGE RTN
SBMTL==.-SBMTS
;"SUBMIT" OSCAN BLOCK
SBMOS: EXP FXVRSN ;PROTOCOL VERSION WORD
IOWD SBMSWL,SBMSWN ;IOWD POINTER FOR SWITCH NAMES
XWD SBMSWD,SBMSWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,SBMSWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /NIP/ ;HELP
XWD SBMOSL,SBMOSN ;OPTIONS NAME(S)
SBMOL==.-SBMOS
SBMOSN: SIXBIT \NSUBMI\
SIXBIT \NIP\
SIXBIT \NFT\
SBMOSL==.-SBMOSN
SUBTTL SUBMIT command - I/O CDB initialization vector(s)
;"SUBMIT" INPUT CDB INITIALIZATION VECTOR
SBMIV: EXP 10 ;COUNT OF WORDS FOLLOWING
'NS',,102030 ;VERSION WORD
0 ;"EXTRA" SIZE TO ALLOCATE
0 ;DEFAULT BUFFERING
0 ;MAXIMUM BUFFERING
.ICASC ;I/O CONTROL (ASCII MODE)
0 ;I/O ERROR CONTROL
IM.SBO ;I/O MODE
0 ;(RESERVED)
SUBTTL TYPE command
;TYPE COMMAND
;
; TYPE <OUTPUT-SPECIFICATION> = <INPUT-EXPRESSION>
TTLTYP==0
TTMTYP==0
TYP: SETZM DDCMDF## ;NORMAL COMMAND STUFF
JUMPLE CH,ERRNIF## ;EOL HERE IS JUNK
PUSHJ P,CLRTOT## ;CLEAR TOTALS
PUSHJ P,TYPC ;READ IN THE REST OF THE COMMAND
JRST TYP70 ;COMMAND ERROR
PUSHJ P,TYPD ;HANDLE ANY DEFAULTING
JRST TYP70 ;ERROR
PUSHJ P,.TCRLF## ;PRINT BLANK LINE FOR NEATNESS
PUSHJ P,COPL ;DO THE FILE TRANSFER(S)
; (PROCESS SAME AS "COPY" COMMAND)
JFCL ;IGNORE ERROR (SO COMES OUT IN SUMMARY)
PUSHJ P,.TCRLF## ;ANOTHER NEATNESS
MOVE T1,[TTLTYP,,TTMTYP] ;/TOTALS CONTROL
SKIPLE S.BAUD ;WANT BAUD RATE TOO?
TXO T1,TT$BAU ;YES
PUSHJ P,.TOTAL## ;ISSUE TOTALS SUMMARY
JFCL ;DUH??
;NOW CLEAN UP ANY RANDOM I/O LEFT OVER
;
;INPUT IS RELEASED FIRST IN ORDER TO DE-ALLOCATE MANAGED MEMORY
;IN OPPOSITE ORDER OF ALLOCATION . . .
TYP50: MOVEI T1,CDBLI## ;INPUT CHANNEL CDB
PUSHJ P,.IORLS## ;INDICATE WE ARE DONE WITH IT
JFCL ;DUH???
MOVEI T1,CDBLO## ;OUTPUT CHANNEL CDB
PUSHJ P,.IORLS## ;INDICATE WE ARE DONE WITH IT
JFCL ;DUH???
;NOW FREE UP THE FILE SPEC BLOCKS
TYP60: PUSHJ P,FRESB## ;FREE UP THE FILE SPEC BLOCKS
JRST TYP77 ;???
;ALL DONE WITH TYPE COMMAND
JRST .POPJ1## ;RETURN FOR NEXT COMMAND
;TYPE ERROR
TYP70: PUSHJ P,FRESB## ;MAKE SURE FILE SPEC BLOCKS FREED UP
JFCL ;???
TYP77: POPJ P, ;PROPAGATE ERROR
SUBTTL TYPE command - parsing
;HERE TO READ THE TYPE FILE SPECIFICATIONS
TYPC: SETZM SIFIR## ;CLEAR OUT THE OLD DATA BASE
PUSHJ P,.REEAT## ;WANT .TSCAN TO SEE CURRENT CHARACTER!
MOVE T1,[TYPTL,,TYPTS] ;.TSCAN BLOCK
PUSHJ P,.TSCAN## ;READ A COMMAND LINE
PUSHJ P,CLRFIL ;CLEAR FILE ANSWERS BEFORE SWITCH.INI
MOVE T1,[TYPOL,,TYPOS] ;.OSCAN BLOCK
PUSHJ P,.OSCAN## ;CHECK SWITCH.INI
;ALL FOR NOW
JRST .POPJ1## ;RETURN HAPPILY
SUBTTL TYPE command - defaulting
;HERE TO SUPPLY INPUT AND OUTPUT DEFAULTS
TYPD: SKIPN P1,SIFIR## ;ADDRESS OF FIRST INPUT SPEC
JRST ERRNIF## ;NO INPUT FILE SPECIFIED
;HANDLE INPUT DEFAULTING
TYPD10: MOVE T1,P1 ;ADDRESS OF CURRENT INPUT SPEC
PUSHJ P,DOSDF ;DO ANY GENERAL FILE-SPEC DEFAULTING
SKIPE .FXNAM(P1) ;GOT A FILE NAME?
JRST TYPD17 ;YES
MOVSI T1,'* ' ;FULL WILD NAME
SETZ T2, ;FULL WILD MASK
DMOVEM T1,.FXNAM(P1) ;SUPPLY DEFAULT FILE NAME
XMOVEI T1,[ASCIZ\*\] ;FULL WILD NAME
MOVEM T1,.FSNAM(P1) ;SUPPLY DEFAULT FILE NAME
MOVX T3,FX.WNM ;THE WILDCARDS-IN-NAME FLAG
IORM T3,.FXFLD(P1) ;SET IN FIELDS FLAGS
TYPD17: MOVX T1,FX.UQN ;
TDNN T1,.FXFLD(P1) ;USER-SPECIFIED QUOTED FILE NAME?
SKIPE .FXEXT(P1) ;GOT AN EXTENSION?
JRST TYPD18 ;YES
MOVSI T1,'* ' ;FULL WILD NAME
HLLZM T1,.FXEXT(P1) ;NO, SUPPLY A DEFAULT
XMOVEI T1,[ASCIZ\*\] ;FULL WILD NAME
MOVEM T1,.FSEXT(P1) ;SUPPLY DEFAULT FILE EXTENSION
MOVX T3,FX.WEX ;THE WILDCARDS-IN-EXTENSION FLAG
IORM T3,.FXFLD(P1) ;SET THAT TOO
TYPD18: MOVX T1,FX.PRT ;THE /OKPROT SWITCH BIT
TDNN T1,.FXMOM(P1) ;EXPLICIT /OKPROT/ERPROT?
ANDCAM T1,.FXMOD(P1) ;NO, DEFAULT TO /ERPROT
; CONSIDER "26_NUL:=ACCT.SYS[1,4]"
IORM T1,.FXMOM(P1) ;MAKE SURE NOBODY ELSE UNDEFAULTS US!
MOVX T1,FX.STR ;THE /STRS SWITCH BIT
TDNN T1,.FXMOM(P1) ;EXPLICIT /[NO]STRS?
ANDCAM T1,.FXMOD(P1) ;NO, SET IMPLICIT /NOSTRS
MOVX T1,FX.QRY ;/QUERY MASK
MOVX T2,FX.QRN ;/QUERY:NEVER
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T2,.FXCTL(P1) ;NO, DEFAULT TO /QUERY:NEVER
MOVX T1,FX.MCY!FX.MEY!FX.DAM!FX.IOM ;I/O MODE SPECIFIERS
MOVX T2,.IOASL ;/DATAMODE:ASCII
TDNE T1,.FXCTM(P1) ;I/O MODE OF SOME SORT SPECIFIED?
JRST TYPD23 ;YES, USE VALUE AS SPECIFIED
DPB T2,[POINTR .FXCTL(P1),FX.DAM] ;NO, DEFAULT TO /DATAMODE:ASCII
DPB T2,[POINTR .FXCTM(P1),FX.DAM] ;FLAG THE MASK TOO
TYPD23: ADDI P1,.FXMAX ;STEP TO NEXT SPEC
CAMG P1,SILAS## ;REACHED LAST ONE YET?
JRST TYPD10 ;NOPE, LOOP BACK FOR MORE DEFAULTS
;HANDLE OUTPUT DEFAULTING
TYPD50: SKIPE P1,SOFIR## ;OUTPUT FILE SPEC BLOCK
JRST TYPD52 ;USER TYPED ONE IN, GO FILL IT OUT
;NO OUTPUT FILE SPECIFIED, DEFAULT TO TTY:[]*.*/BYTESIZE:7
PUSHJ P,CLRFIL## ;CLEAR OUT FILE SPECIFICATION
PUSHJ P,OUX## ;ALLOCATE A FILE SPEC BLOCK
MOVE P1,T1 ;WANT ADDRESS IN P1 ON G.P.S
MOVSI T1,'TTY' ;DEFAULT OUTPUT DEVICE
SETO T2, ;NON-WILD MASK
DMOVEM T1,.FXDEV(P1) ;SET DEFAULT DEVICE
XMOVEI T1,[ASCIZ\TTY\] ;DEFAULT OUTPUT DEVICE
MOVEM T1,.FSDEV(P1) ;SUPPLY DEFAULT OUTPUT DEVICE
MOVEI T1,^D07 ;ASCII CHARACTERS ARE 7-BITS BY DEFAULT
MOVEM T1,.FXBSZ(P1) ;SO FAKE A /BYTESIZE:7 COMMAND
; /ASCII WILL BE DEFAULTED BELOW . . .
;FLESH OUT THE OUTPUT FILE SPEC
TYPD52: MOVE T1,P1 ;POSITION ADDRESS OF FILE SPEC BLOCK
PUSHJ P,DOSDF ;DO ANY GENERAL FILE-SPEC DEFAULTING
SKIPE .FXNAM(P1) ;OUTPUT FILE NAME GIVEN?
JRST TYPD57 ;YES
MOVSI T1,'* ' ;FULL WILD NAME
SETZ T2, ;FULL WILD MASK
DMOVEM T1,.FXNAM(P1) ;NO, DEFAULT FULL WILD
XMOVEI T1,[ASCIZ\*\] ;FULL WILD NAME
MOVEM T1,.FSNAM(P1) ;SUPPLY DEFAULT FILE NAME
MOVX T3,FX.WNM ;THE WILDCARDS-IN-NAME FLAG
IORM T3,.FXFLD(P1) ;NOTE THAT TOO
TYPD57: MOVX T1,FX.UQN ;
TDNN T1,.FXFLD(P1) ;USER-SPECIFIED QUOTED FILE NAME?
SKIPE .FXEXT(P1) ;OUTPUT EXTENSION GIVEN?
JRST TYPD58 ;YES
MOVSI T1,'* ' ;FULL WILD NAME
HLLZM T1,.FXEXT(P1) ;NO, DEFAULT TO FULL WILD
XMOVEI T1,[ASCIZ\*\] ;FULL WILD NAME
MOVEM T1,.FSEXT(P1) ;SUPPLY DEFAULT FILE EXTENSION
MOVX T3,FX.WEX ;THE WILDCARDS-IN-EXTENSION FLAG
IORM T3,.FXFLD(P1) ;NOTE THAT TOO
TYPD58: MOVX T1,FX.PRT ;THE /OKPROT BIT
TDNN T1,.FXMOM(P1) ;DID USER SPECIFY /[NO]ERPROT?
ANDCAM T1,.FXMOD(P1) ;NO, FORCE /ERPROT FOR OUTPUT FILE
TDNN T1,.FXMOM(P1) ;DID USER SPECIFY /[NO]ERPROT?
IORM T1,.FXMOM(P1) ;AND MAKE IT STICKY
MOVX T1,FX.QRY ;/QUERY MASK
MOVX T2,FX.QRN ;/QUERY:NEVER
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T2,.FXCTL(P1) ;NO, DEFAULT TO /QUERY:NEVER
MOVX T1,FX.MCY!FX.MEY!FX.DAM!FX.IOM ;I/O MODE SPECIFIERS
MOVX T2,.IOASL ;/DATAMODE:ASCII
TDNE T1,.FXCTM(P1) ;I/O MODE OF SOME SORT SPECIFIED?
JRST TYPD63 ;YES, USE VALUE AS SPECIFIED
DPB T2,[POINTR .FXCTL(P1),FX.DAM] ;NO, DEFAULT TO /DATAMODE:ASCII
DPB T2,[POINTR .FXCTM(P1),FX.DAM] ;MARK THE MASK TOO
TYPD63:
;ALL DONE HERE
JRST .POPJ1## ;DEFAULTS DEFAULTED
SUBTTL TYPE command - SCAN argument blocks
;"TYPE" TSCAN PARAMETER BLOCK
TYPTS: EXP FXVRSN ;PROTOCOL VERSION WORD
IOWD COPSWL,COPSWN ;IOWD POINTER FOR SWITCH NAMES
XWD COPSWD,COPSWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,COPSWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /NIP/ ;HELP
XWD CLRALL,CLRFIL ;CLEAR ALL,,CLEAR FILE
XWD INX,OUX ;ALLOC INPUT AREA,,ALLOC OUTPUT AREA
XWD MEMSTK,APLSTK ;MEMORIZE STICKY,,APPLY STICKY
XWD CLRSTK,0 ;CLEAR STICKY,,FLAGS
Z ;<FUTURE>,,SWITCH VALUE STORAGE RTN
TYPTL==.-TYPTS
;"TYPE" OSCAN BLOCK
TYPOS: EXP FXVRSN ;PROTOCOL VERSION WORD
IOWD COPSWL,COPSWN ;IOWD POINTER FOR SWITCH NAMES
XWD COPSWD,COPSWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,COPSWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /NIP/ ;HELP
XWD TYPOSL,TYPOSN ;OPTIONS NAME(S)
TYPOL==.-TYPOS
TYPOSN: SIXBIT \TYPE\
SIXBIT \NIP\
SIXBIT \NFT\
TYPOSL==.-TYPOSN
SUBTTL Copy file attributes
;CIOX -- COPY INPUT FILE ATTRIBUTES TO OUTPUT FILE
;Call is:
;
; PUSHJ P,CIOX
; error return
; normal return
;
;CIOX copies the input file attributes (data type, byte size, etc) to
;the output file.
;
;On normal return the output CDB is ready for .NXTFO/.IOPOU to create
;the output file.
;
;*** What I really need is a "/X" switch to govern the creation of a
;*** logically "new" file versus an exact "copy" of an old file . . .
CIOX: MOVE P3,.IOFSB(CI) ;ADDRESS OF INPUT FILE SPEC BLOCK
MOVE P4,.IOFSB(CO) ;ADDRESS OF OUTPUT FILE SPEC BLOCK
DMOVE T1,.FXUSW(P3) ;GET INPUT SWITCHES
DMOVE T3,.FXUSW(P4) ;AND OUTPUT SWITCHES
TDZ T1,T4 ;OUTPUT OVERRIDES INPUT
IOR T3,T1 ;MERGE INPUT AND OUTPUT SWITCHES
MOVE T1,COPOVC ;INITIAL OUTPUT I/O CONTROL FLAGS
TXNE T3,US$LSN ;WANT OUTPUT LINE SEQUENCE NUMBERS
TXO T1,IC.LSN ;YES, MUST INFORM NETWORK LEVEL BEFORE THE
; FILE IS OPENED (UNLIKE LOCAL FILES)
LDB T2,[POINTR .IOIOC(CI),IC.MOD] ;FETCH CURRENT INPUT MODE
DPB T2,[POINTR T1,IC.MOD] ;SELECT DEFAULT OUTPUT MODE
LDB T2,[POINTR .IOIOC(CI),IC.RFM] ;FETCH INPUT RECORD FORMAT
CAIN T2,.ICRF3 ;*** /RECFORMAT:36?
MOVEI T2,.ICRFU ;*** THEN PROBABLY WANT TOPS-10 FILE HERE
DPB T2,[POINTR T1,IC.RFM] ;SELECT DEFAULT OUTPUT RECORD FORMAT
MOVEM T1,.IOIOC(CO) ;SET OUTPUT I/O CONTROL
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;DEFAULT OUTPUT FIELDS FROM CORRESPONDING INPUT FIELDS
CIOX10: SETZM .IOBSZ(CO) ;INITIALLY NO OUTPUT BYTE SIZE
SETZM .IOFSZ(CO) ;NOR FRAME SIZE
HRLZ T1,.IOBSZ(CI) ;GET INPUT FILE DATA BYTE SIZE
HRR T1,.IOFSZ(CI) ;AND INPUT FILE FRAME BYTE SIZE
MOVEM T1,.IODBS(CO) ;AND SET OUTPUT FILE DEFAULT BYTE/FRAME SIZE
MOVE T1,.IORSZ(CI) ;GET INPUT FILE RECORD SIZE
MOVEM T1,.IORSZ(CO) ;AND SET OUTPUT FILE RECORD SIZE
;RDH MOVE T1,.IOBLS(CI) ;GET INPUT FILE BLOCK SIZE
;RDH MOVEM T1,.IOBLS(CO) ;AND SET OUTPUT FILE BLOCK SIZE
MOVE T1,.IOLNB(CI) ;GET INPUT FILE DATA LENGTH (BYTES)
MOVEM T1,.IOLNB(CO) ;AND SET CORRESPONDING OUTPUT FILE PARAMETER
MOVE T1,.IOLNW(CI) ;GET INPUT FILE DATA LENGTH (-10 WORDS)
MOVEM T1,.IOLNW(CO) ;AND SET CORRESPONDING OUTPUT FILE PARAMETER
;RDH MOVE T1,.IOALB(CI) ;GET INPUT FILE ALLOCATION (BYTES)
;RDH MOVEM T1,.IOALB(CO) ;AND SET CORRESPONDING OUTPUT FILE PARAMETER
;RDH MOVE T1,.IOALW(CI) ;GET INPUT FILE ALLOCATION (-10 WORDS)
;RDH MOVEM T1,.IOALW(CO) ;AND SET CORRESPONDING OUTPUT FILE PARAMETER
MOVE T1,.IOCDT(CI) ;GET INPUT FILE LOGICAL CREATION DATE/TIME
MOVEM T1,.IOCDT(CO) ;AND SET CORRESPONDING OUTPUT FILE PARAMETER
MOVE T1,.IOUDT(CI) ;GET INPUT FILE LAST UPDATE DATE/TIME
MOVEM T1,.IOUDT(CO) ;AND SET CORRESPONDING OUTPUT FILE PARAMETER
MOVE T1,.IOEDT(CI) ;GET INPUT FILE EXPIRATION DATE/TIME
MOVEM T1,.IOEDT(CO) ;AND SET CORRESPONDING OUTPUT FILE PARAMETER
;RDH MOVE T1,.IOBDT(CI) ;GET INPUT FILE BACKUP DATE/TIME
;RDH MOVEM T1,.IOBDT(CO) ;AND SET CORRESPONDING OUTPUT FILE PARAMETER
SETZM .IOBDT(CO) ;*** WHAT DO I REALLY WANT TO DO HERE?
MOVE T1,.IOADT(CI) ;GET INPUT FILE LAST READ DATE/TIME
MOVEM T1,.IOADT(CO) ;AND SET CORRESPONDING OUTPUT FILE PARAMETER
;RDH MOVE T1,.IOPDT(CI) ;GET INPUT FILE PHYSICAL MEDIA DATE/TIME
;RDH MOVEM T1,.IOPDT(CO) ;AND SET CORRESPONDING OUTPUT FILE PARAMETER
SETZM .IOPDT(CO) ;*** WHAT DO I REALLY WANT TO DO HERE?
MOVE T1,.IOPRT(CI) ;GET INPUT FILE PROTECTION
MOVEM T1,.IOPRT(CO) ;AND SET CORRESPONDING OUTPUT FILE PARAMETER
;ALL DONE HERE
JRST .POPJ1## ;SUCCESSFUL RETURN
SUBTTL Copy processor (COPY, TYPE, etc. commands)
;COPY -- COPY ONE FILE DATA STREAM
;Call is:
;
; PUSHJ P,COPY
; error return
; normal return
;
;COPY will copy input data into the output file until EOF is reached,
;or a fatal error occurs.
;
;The caller must have OPENed the input and output file streams prior
;to calling COPY (although if multiple files are being concatenated then
;COPY will do the subsequent input OPEN calls itself). When EOF is reached
;(i.e., the copy operation is completed) the output file is CLOSEd.
;
;Various levels of processing are utilized depending on the type of copy
;operation being performed. For example, a straight [local] disk-to-disk
;"/X" copy can be done without even having to actually copy the data
;internally, whereas converting tabs to spaces necessitates a fair number
;of cpu cycles for every character copied.
;
;AC P4 is incremented by the number of "bytes" copied, all other "P" acs
;and the "T" acs are trashed.
COPY: XMOVEI T1,COPY70 ;THE RETURN ADDRESS
PUSH P,T1 ;FAKE A "PUSHJ P," DISPATCH
XMOVEI CI,CDBLI## ;***
XMOVEI CO,CDBLO## ;***
;RECORD-FORMATTED I/O MUST BE HANDLED DIFFERENTLY
LDB T1,[POINTR .IOIOC(CI),IC.RFM] ;INPUT RECORD FORMAT
CAIE T1,.ICRFU ;IF UNDEFINED (I.E., NO) RECORD FORMAT
CAIN T1,.ICRF3 ;OR 36PACK'ING (WHICH WE SEE AS BYTES)
CAIA ;THEN NOT "RECORD-STRUCTURED I/O"
JRST COR ;RECORD-STRUCTURED I/O, USE RECORD PROCESSOR
LDB T1,[POINTR .IOIOC(CO),IC.RFM] ;OUTPUT RECORD FORMAT
CAIE T1,.ICRFU ;IF UNDEFINED RECORD FORMAT
CAIN T1,.ICRF3 ;OR 36PACK'ED PDP-10 WORDS
CAIA ;THEN DON'T NEED THE RECORD PROCESSOR
JRST COR ;NO, RECORD-STRUCTURED I/O PROCESSOR
;CHECK FOR ANY FORCED CHARACTER-MODE PROCESSING
MOVE T1,CI ;THE INPUT CDB
PUSHJ P,TSCHP ;FORCED CHARACTER PROCESSING?
JRST COA ;YES, CHAR PROC LOOP
MOVE T1,CO ;THE OUTPUT CDB
PUSHJ P,TSCHP ;FORCED CHARACTER PROCESSING?
JRST COA ;YES, CHAR PROC LOOP
;USER DID NOT FORCE CHARACTER PROCESSING. IF EITHER SIDE IS A REMOTE
;(NETWORK-BASED) FILE THEN BYTE-AT-A-TIME TRANSFER MUST BE USED.
MOVE P1,.IOCCF(CI) ;INPUT CDB CHANNEL CONTROL FLAGS
MOVE P2,.IOCCF(CO) ;OUTPUT CDB CHANNEL CONTROL FLAGS
TXNN P1,IO.NET ;IF EITHER THE INPUT
TXNE P2,IO.NET ; OR THE OUTPUT IS REMOTE
JRST COPY40 ;THEN BYTE-AT-A-TIME MUST BE USED
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;BOTH THE INPUT AND THE OUTPUT FILES ARE LOCAL FILES - DO SPECIAL CASE
;CHECKING TO TRY FOR THE FASTEST TRANSFER METHOD DEPENDING ON THE TYPE
;OF DEVICE/FILE BEING TRANSFERRED.
;*** NEED TO CHECK FOR /CONCATENATE
COPY20: LDB T1,[POINTR .I1DTY(CI),TY.DEV] ;INPUT DEVICE TYPE
LDB T2,[POINTR .I1DTY(CO),TY.DEV] ;OUTPUT DEVICE TYPE
;TRY FOR DISK-TO-DISK
CAIN T1,.TYDSK ;IF BOTH INPUT
CAIE T2,.TYDSK ; AND OUTPUT ARE DISK
CAIA ;(NO)
JRST COD ;DO FAST DISK-TO-DISK COPY
;TRY FOR MAGTAPE-TO-MAGTAPE
CAIN T1,.TYMTA ;IF BOTH INPUT
CAIE T1,.TYMTA ; AND OUTPUT ARE MAGTAPE
CAIA ;(NO)
JRST COM ;DO FAST TAPE-TO-TAPE COPY
;TRY FOR DISK/TAPE-TO-DISK/TAPE
CAIE T1,.TYDSK ;IF INPUT IS EITHER A DISK
CAIN T1,.TYMTA ; OR A MAGTAPE
CAIA ;(YES)
JRST COPY26 ;(NO)
CAIE T2,.TYDSK ;AND OUTPUT IS EITHER A DISK
CAIN T1,.TYMTA ;OR A MAGTAPE
JRST COQ ;THEN DO QUICK BUFFERED COPY
;RANDOM COPY, DO IT A BYTE AT A TIME
COPY26: JRST COB ;RELATIVELY FAST BYTE-AT-A-TIME COPY
;HERE WITH EITHER THE INPUT OR THE OUTPUT FILE REMOTE, THEREBY FORCING
;BYTE-AT-A-TIME COPY
COPY40: LDB T1,[POINTR .IOIOC(CI),IC.MOD] ;INPUT FILE DATA MODE
LDB T2,[POINTR .IOIOC(CO),IC.MOD] ;OUTPUT FILE DATA MODE
;SEE IF CHARACTER PROCESSING IS IMPLICITLY REQUIRED
CAIE T1,.ICASC ;IF EITHER THE INPUT FILE
CAIN T2,.ICASC ; OR THE OUTPT FILE IS ASCII (7-BIT)
JRST COA ;THEN CHARACTER PROCESSING REQUIRED
; (NEEDED TO HANDLE REMOTE LSN'S)
CAIE T1,.ICAS8 ;IF EITHER THE INPUT FILE
CAIN T2,.ICAS8 ; OR THE OUTPUT FILE IS ASCII (8-BIT)
JRST COA ;THEN CHARACTER PROCESSING REQUIRED
;DATA IS NOT ASCII, TREAT AS BINARY, JUST COPY IT BYTE-AT-A-TIME
JRST COB ;STRAIGHT BYTE-AT-A-TIME COPY
;HERE AT END OF COPY OPERATION, EITHER DUE TO ERROR OR TO SUCCESSFUL
;COMPLETION (DEFINED AS A "SKIP RETURN" TO THE "PUSHJ" FAKED ABOVE)
COPY70: TDZA P1,P1 ;FLAG ERROR RETURN
MOVEI P1,1 ;FLAG SUCCESSFUL (SO FAR) RETURN
;NOW FIRST CLOSE THE INPUT FILE (NOTE THAT IF A FILE DATA STREAM CHECKSUM
;ERROR WAS TO OCCUR IT WOULD HAVE BEEN DETECTED IN THE INPUT I/O PRO-
;CESSOR)
MOVE T1,CI ;ADDRESS OF THE INPUT CDB
PUSHJ P,.IOCLO## ;CLOSE THE INPUT FILE
JFCL ;FAILED??? WELL, WE WERE DONE WITH IT ANYWAY
JUMPE P1,COPY77 ;ON ERROR ABORT THE OUTPUT FILE
;SUCCESSFUL RETURN, CLOSE OUTPUT FILE
MOVE T1,CO ;ADDRESS OF OUTPUT CDB
PUSHJ P,.IOCLO## ;CLOSE THE OUTPUT FILE
CAIA ;ERROR
JRST COPY79 ;SUCCESSFUL, TIME TO RETURN TO CALLER
PUSHJ P,NERCL ;HANDLE THE CLOSE-TIME FILE ERROR
JRST COPY77 ;ABORT THE OUTPUT FILE
MOVE T1,CO ;CHECKSUM ERROR BUT PROCEDE ANYWAY
MOVX T2,IO.NCK ;THE NO-CHECKSUM-ON-CLOSE FLAG
IORM T2,.IOCCF(T1) ;TELL CLOSE TO IGNORE THE CHECKSUM
PUSHJ P,.IOCLO## ;TRY TO CLOSE IT AGAIN
JRST COPY76 ;FAILED AGAIN, GIVE UP AND ABORT THE FILE
JRST COPY79 ;SUCCESSFUL, RETURN AS APPROPRIATE
;ABORT THE OUTPUT FILE
COPY76: SETZ P1, ;FLAG ERROR
COPY77: MOVE T1,CO ;ADDRESS OF OUTPUT CDB
PUSHJ P,.IOABO## ;ABORT THE OUTPUT FILE
JFCL ;THIS JUST ISN'T GONNA WORK
COPY79: ADDM P1,(P) ;SKIP IF SUCCESSFUL, ELSE ERROR
POPJ P, ;RETURN AS APPROPRIATE
;TSCHP - TEST HELPER FOR COPY PROCESSOR
TSCHP: MOVE T2,.IOFSB(T1) ;ADDRESS OF FILE SPEC BLOCK
MOVE T3,.FXUSW(T2) ;"USER" SWITCHES
TXNE T3,US$CHP ;ANY CHARACTER-PROCESSING SWITCHES?
POPJ P, ;YES, CHARACTER PROCESSOR REQUIRED
;NOW CHECK THE FULL-WORD SWITCHES
SETO T3, ;THE "NO-VALUE" VALUE
MOVEI T4,$FXECH-$FXBCH;LENGTH OF SWITCHES
TSCHP2: CAME T3,$FXBCH(T2) ;SWITCH SPECIFIED?
POPJ P, ;YES, CHARACTER PROCESSOR REQUIRED
SOJLE T4,.POPJ1## ;DONE IF ALL SWITCHES CHECKED
AOJA T2,TSCHP2 ;CHECK REST OF SWITCHES
SUBTTL Copy processor - ASCII character processing
;COA -- ASCII CHARACTER PROCESSOR
COA: MOVE P1,.IOFSB(CI) ;INPUT FILE SPEC BLOCK
MOVE P2,.IOFSB(CO) ;OUTPUT FILE SPEC BLOCK
;INITIALIZE LOOP VARIABLES
COA000: SETZM ASCCSN ;INITIALIZE CSN COUNTER
SETZM ASCLSN ;INITIALIZE LSN COUNTER
MOVEI T1,10 ;DEFAULT TAB SIZE
MOVEM T1,S.TINC ;SET TAB "INCREMENT"
;SETUP THE SPACE-COMPRESSOR/CHOPPER BUFFER
REPEAT 0,< ;***
MOVE T1,.FXRSZ(P1) ;THE INPUT /RECSIZ VALUE (IF ANY)
CAMGE T1,.FXRSZ(P2) ;CONTRAST WITH THE OUTPUT /RECSIZ (IF ANY)
MOVE T1,.FXRSZ(T2) ;OUTPUT IS BIGGER, USE IT INSTEAD
CAIG T1,$SZRSZ ;BIGGER THAN OUR MINIMUM?
MOVEI T1,$SZRSZ ;NO, USE OUR MINIMUM THEN
ADDI T1,4 ;SIZE IS BYTES, ROUND UP AND
IDIVI T1,5 ;CONVERT TO 36-BIT WORDS
ASH T1,1 ;NEED TWO BUFFERS
PUSHJ P,.MMGWD## ;GET A CHUNK OF MEMORY
STOPCD <MMGWD failed in COA>
ASH T1,-1 ;CONVERT BACK TO INDIVIDUAL BUFFER SIZE
MOVE T3,T1 ;HOLD A COPY FOR A MOMENT
IMULI T1,5 ;T1:=CHARACTERS PER BUFFER
SUBI T1,4 ;READJUSTED
HRLI T2,(POINT 7,) ;T1/T2:=COUNTER/POINTER
DMOVEM T1,ASCICP ;SET PROTOTYPE INPUT COUNTER/POINTER
ADD T2,T3 ;POINT TO OTHER "BUFFER"
DMOVEM T1,ASCOCP ;SET PROTOTYPE OUTPUT COUNTER/POINTER
> ;END REPEAT 0 ;***
;*** DUE TO THE LIMITATIONS OF THE CURRENT MEMORY MANGLER, WE MUST
;*** RESTRICT OURSELF TO A CONSTANT COMPRESSION BUFFER
DMOVE T1,[EXP <$SZRSZ-1>,<POINT 7,ASCICB>] ;***
DMOVEM T1,ASCICP ;*** SET PROTOTYPE INPUT COUNTER/POINTER
DMOVE T1,[EXP <$SZRSZ-1>,<POINT 7,ASCOCB>] ;***
DMOVEM T1,ASCOCP ;*** SET PROTOTYPE OUTPUT COUNTER/POINTER
;CONTINUED ON NEXT PAGE
;CONTINUED ON NEXT PAGE
;DO THE WORK
COA010: PUSHJ P,COAIF ;SETUP PROCESSING PARAMETERS, ETC.
STOPCD ;CAN'T HAPPEN
MOVE P1,T2 ;POSITION SWITCH MASK
PUSHJ P,COASC ;DO THE COPY
TDZA P1,P1 ;FLAG ERROR
MOVEI P1,1 ;FLAG SUCCESS
;DE-ALLOCATE THE SPACE COMPRESSION BUFFER
REPEAT 0,< ;***
MOVE T1,ASCICP ;BYTES ALLOCATED FOR INPUT
IDIVI T1,5 ;WORDS ALLOCATED FOR INPUT
ASH T1,1 ;WORDS ALLOCATED TOTAL
HRRZ T2,ASCICP+1 ;ADDRESS OF THE TWO BUFFERS
PUSHJ P,.MMFWD## ;RELINQUISH THE BUFFERS
STOPCD <MMFWD failed in COA010>
> ;END REPEAT 0 ;***
;ALL DONE, RETURN TO COPY PROCESSOR TO CLOSE THE FILES
COA079: ADDM P1,0(P) ;SET RETURN AS APPROPRIATE
POPJ P, ;RETURN SUCCESS/FAILURE
SUBTTL Copy processor - ASCII character loop
;HERE TO PROCESS AN ASCII DATA STREAM, HANDLING SPACE/TAB CONVERSION, ETC.
;
;AN ISSUE AS YET UNRESOLVED - WHAT TO DO WITH /CSN'ED LINES LONGER THAN
;/CSNCOLUMN - TRUNCATE THEM, OR FREE-CRLF THEM?
COASC: SETZ P3, ;START WITH COLUMN POSITION 0
;LOOP READING INPUT CHARACTERS
COASC1: JSP CX,COAIC ;GET NEXT INPUT CHARACTER
PUSHJ P,NERIN ; I/O ERROR
JRST COASE ; END-OF-FILE
JRST COALU ; LINE-SEQUENCE-NUMBER
; ASCII CHARACTER
;NORMAL ASCII CHARACTER, DISPATCH ON CHARACTER UNLESS AT BOL
COASC5: ANDI T2,377 ;STRIP OFF GARBAGE FROM CHARACTER
JUMPG P3,@ASCDSP(T2) ;IF AT BEGINING OF LINE,
SKIPG T3,S.LSN ;AT BEGINING OF LINE, WANT LINE SEQ NO.S?
JRST @ASCDSP(T2) ;NO, JUST OUTPUT THE CHARACTER
;WANT LINE SEQUENCE NUMBERS GENERATED
COASL0: CAIE T2,.CHCRT ;A <CR>?
JRST COASL5 ;NO, LOOK FOR <FF>
JSP CX,COAIC ;PEEK AT CHARACTER PAST <CR>
PUSHJ P,NERIN ; I/O ERROR
JRST COASL1 ; END-OF-FILE
JRST COASL8 ; LINE-SEQUENCE-NUMBER (CAN'T HAPPEN)
CAIN T2,.CHFFD ; ASCII CHARACTER - A <CR><FF> PAIR?
JRST COASL5 ;YES, JUST ISSUE A "PAGE-MARK"
HRROM T2,ASCHAR ;NO, SAVE PEEKED CHARACTER FOR NEXT TIME
COASL1: MOVEI T2,.CHCRT ;RETRIEVE OUR <CR>
JRST COALS ;AND TREAT AS RANDOM BLANK LINE
COASL5: CAIE T2,.CHFFD ;A <FF> CHARACTER?
JRST COALS ;NO, JUST FIRE UP A NEW LINE
MOVE T1,CO ;ADDRESS OF OUTPUT CDB
MOVEI T2,.FULSN ;FUNCTION: WRITE LSN
SETO T3, ;-1 = WRITE PAGE MARK
PUSHJ P,.IOFUN## ;ISSUE REQUEST
PUSHJ P,NERLS ;ERROR?
TXNE P1,US$LSC ;/LSNCONTINUOUS?
TDZA P3,P3 ;YES, DON'T RESET THE LSN COUNTER
SETZB P3,ASCLSN ;START UP A FRESH PAGE
JRST COASC1 ;BACK FOR MORE CHARACTERS
;HERE ON INPUT LSN AFTER <CR> (CAN'T HAPPEN)
COASL8: STOPCD <Returned LSN in COASL>
;HERE TO GENERATE NEW LINE SEQUENCE NUMBERS
COALS: MOVEM T2,ASCHAL ;RE-READ THIS CHARACTER LATER
COALS1: ADDB T3,ASCLSN ;INCREMENT LSN COUNTER
COALS3: MOVEI T2,.FULSN ;FUNCTION: WRITE LINE SEQUENCE NUMBER
MOVE T1,CO ;SELECT OUTPUT CHANNEL
PUSHJ P,.IOFUN## ;CALL I/O FUNCTION PROCESSOR
PUSHJ P,NERLS ;I/O ERROR WRITING LSN
SKIPGE ASCLSN ;WAS THAT A LSN OR A PAGE MARK?
TDZA P3,P3 ;A SOS PAGE MARK, SO STILL AT COLUMN 0
MOVE P3,S.TINC ;WE ARE NOW POSITIONED TO THE FIRST TAB STOP
SETZ T2, ;FLAG 0
EXCH T2,ASCHAL ;RETRIEVE SAVED CHARACTER, IF ANY
JUMPN T2,@ASCDSP(T2) ;NOW GO PROCESS CHARACTER
JRST COASC1 ;GO READ ANOTHER CHARACTER
;HERE WHEN LINE SEQUENCE NUMBER ENCOUNTERED IN THE INPUT FILE
COALU: MOVEM T2,ASCLSN ;SET LSN
SETOM S.LSN ;DO NOT GENERATE LSN
JUMPE P3,COALU3 ;HAD BETTER BE AT BOL
WARN LML,<Line Sequence Number in middle of line, starting new line>
PUSHJ P,COANL ;START A NEW LINE
POPJ P, ;DIED
COALU3: MOVE T3,ASCLSN ;RETRIEVE INPUT LSN
JRST COALS3 ;AND SEND IT ON ITS WAY
;HERE ON INPUT EOF
COASE: CAIE M0,$EIEOF ;VALID EOF ON INPUT?
POPJ P, ;NO, MUST BE CONCATENATION ERROR
COASE1: SKIPN ASCSTP ;[14] GOT ANY OUTPUT BUFFERED UP?
JRST COASE3 ;NO
PUSHJ P,COAOA7 ;YES, FLUSH IT OUT
POPJ P, ;OH WELL, ALMOST MADE IT
COASE3: JRST .POPJ1## ;ALL DONE!
;HERE ON BACKSPACE
COABS: SOJGE P3,COAQC ;SPACE BACKWARDS, OUTPUT CHARACTER
SETZ P3, ;OOPS - PEG AT THE LEFT MARGIN
JRST COAQC ;AND OUTPUT THE BACKSPACE
;HERE ON HORIZONTAL TAB
COAHT: CAML P3,S.WRAP ;TIME FOR AN WORD-WRAP-CRLF?
JRST COAHW ;YES
CAMGE P3,S.CRLF ;NO, HOW ABOUT FREE CRLF?
JRST COAHT1 ;NO, JUST PROCESS THIS TAB
PUSHJ P,COANL ;NEED FREE CRLF, START UP A NEW LINE
POPJ P, ;DIED
COAHT1: MOVE T3,P3 ;CURRENT POSITION WITHIN LINE
IDIV T3,S.TINC ;T3:=TAB STOP; T4:=CHARS IN NEXT PARTIAL STOP
MOVN T4,T4 ;DON'T HAVE SUB-FROM-M
ADD T4,S.TINC ;T4:=POSITIONS LEFT IN CURRENT PARTIAL TAB
ADD P3,T4 ;ADVANCE POSITION COUNTER
CAML P3,S.WRAP ;TIME YET FOR WORD-WRAP-CRLF?
JRST COAHU1 ;YES
CAML P3,S.CRLF ;NO, HOW ABOUT FREE CRLF?
JRST COAHU2 ;YES
TXNN P1,US$SPA ;/SPACES?
JRST COAQC ;NO, OUTPUT TAB AS IS
;/SPACES, FILL OUT THE TAB WITH SPACES
MOVEI T2," " ;A SPACE CHARACTER
COAHT4: PUSHJ P,COAOC ;OUTPUT ONE ASCII SPACE CHARACTER
PUSHJ P,NEROU ;I/O ERROR
SOJG T4,COAHT4 ;LOOP FOR REST OF TAB STOP
JRST COASC1 ;BACK FOR NEXT ASCII INPUT CHARACTER
;HERE WHEN THIS TAB WOULD BREAK THE WORD-WRAP-CRLF BOUNDRY
COAHU1: SUB P3,S.WRAP ;P3:=EXCESSIVE SPACE
CAIA ;HANDLE NEW LINE
;HERE WHEN THIS TAB WOULD BREAK THE FREE-CRLF BOUNDRY
COAHU2: SUB P3,S.CRLF ;P3:=EXCESSIVE SPACE
SUB T4,P3 ;T4:=SPACE TO CRLF BOUNDRY
TXNN P1,US$SPA ;/SPACES?
TDZA T4,T4 ;NO, OUTPUT TAB DIRECTLY
MOVEI T2," " ;YES, NEED TO FILL TRAILING TAB WITH SPACES
COAHU4: PUSHJ P,COAOC ;OUTPUT SPACE OR TAB AS APPROPRIATE
PUSHJ P,NEROU ;I/O ERROR
SOJG T4,COAHU4 ;LOOP FOR ENTIRE SPACE REQUIREMENT
;FALL INTO COAHW TO GENERATE NEW LINE
;SPACE/TAB OVERFLOWED AUTO-CRLF, CONVERT TO NEW LINE
COAHW: PUSHJ P,COANL ;START UP A NEW LINE
POPJ P, ;DIED
MOVE T2,S.CRLF ;GET FREE-CRLF BOUNDRY
CAMGE T2,S.WRAP ;HERE FOR WORD-WRAP- OR FREE-CRLF?
JRST COASC1 ;FREE-CRLF, PROCESS NEXT CHARACTER
;WORD-WRAP-CRLF, COMPRESS OUT SPACES
;NOW EAT ANY FOLLOWING SPACES/TABS
COAHW3: JSP CX,COAIC ;NEXT INPUT CHARACTER
PUSHJ P,NERIN ; I/O ERROR
JRST COASE ; END-OF-FILE
JRST COALU ; LINE-SEQUENCE-NUMBER
CAIE T2," " ; ASCII CHARACTER - A SPACE?
CAIN T2,.CHTAB ;OR A TAB?
JRST COAHW3 ;YES, EAT IT UP
JRST COASC5 ;NO, VALID CHARACTER, GO PROCESS IT
;HERE ON <LF>
COALF: JRST COAQC ;JUST OUTPUT IT
;HERE ON <VT>
COAVT: JRST COAQC ;JUST OUTPUT IT
;HERE ON <FF>
COAFF: JRST COAQC ;JUST OUTPUT IT
;HERE ON CARRIAGE-RETURN
COACR: SKIPG S.CSN ;WANT CARD SEQUENCE NUMBERS?
JRST COACR2 ;NO
PUSHJ P,COACS ;YES, OUTPUT THE CSN
POPJ P, ;DIED
COACR2: JSP CX,COAIC ;READ THE NEXT INPUT CHARACTER
PUSHJ P,NERIN ; I/O ERROR
JRST COACS9 ; END OF FILE
JRST COACS7 ; LINE SEQUENCE NUMBER
CAIN T2,.CHFFD ; ASCII CHARACTER - A <FF>?
JRST COACS0 ;YES, CONVERT INTO "PAGE MARK"
COACR3: HRROM T2,ASCHAR ;SAVE CHARACTER TO BE RE-EATEN
MOVEI T2,.CHCRT ;OUR <CR>
PUSHJ P,COAOC ;OUTPUT THE <CR>
PUSHJ P,NEROU ;I/O ERROR
HRRZ T2,ASCHAR ;RETRIEVE THE INPUT CHARACTER
SETZB P3,ASCHAR ;NOW ON COLUMN 0
CAIE T2,.CHLFD ;A <CR><LF>?
CAIN T2,.CHFFD ;OR <CR><FF>?
JRST COAQC ;YES, OUTPUT THE <LF> DIRECTLY
SKIPG S.LSN ;<CR><RANDOM> - GENERATING LSN'S?
JRST COASC5 ;NO, DISPATCH ON THE CHARACTER
HRROM T2,ASCHAR ;YES, SAVE FIRST OVER-PRINTED CHARACTER
MOVEI T2,.CHTAB ;A TAB CHARACTER TO OVER-SKIP THE LSN
MOVE P3,S.TINC ;AND IT'S RESULTANT COLUMN POSITION
JRST COAQC ;OUTPUT TAB, RE-READ OVER-PRINTED CHARACTER
;HERE ON <CR><FF> - SPECIAL LSN HANDLING NEEDED
COACS0: SKIPG S.LSN ;GENERATING LSNS?
JRST COACR3 ;NO, NOTHING SPECIAL THEN
JUMPE P3,COACS3 ;JUST ISSUE PAGE MARK IF A FREE <FF>
MOVEI T2,.CHCRT ;A <CR>
PUSHJ P,COAOC ;ISSUE <CR>
PUSHJ P,NEROU ;I/O ERROR
MOVEI T2,.CHLFD ;A <LF>
PUSHJ P,COAOC ;ISSUE <CR><LF> TO CAP OFF CURRENT LINE
PUSHJ P,NEROU ;I/O ERROR
COACS3: SETO T3, ;A "PAGE MARK" LSN
MOVEI T2,.FULSN ;FUNCTION: WRITE LINE SEQUENCE NUMBER
MOVE T1,CO ;FOR THE OUTPUT FILE STREAM
PUSHJ P,.IOFUN## ;ISSUE THE PAGE MARK
PUSHJ P,NERLS ;ERROR WRITING LSN
TXNE P1,US$LSC ;/LSNCONTINUOUS?
TDZA P3,P3 ;YES, DON'T RESET THE LSN COUNTER
SETZB P3,ASCLSN ;NOW AT LEFT MARGIN AGAIN ON A NEW PAGE
JRST COASC1 ;GO FOR NEXT CHARACTER
;HERE ON <CR><LSN>
COACS7: SKIPLE S.LSN ;GENERATING (RE-SEQUENCING)?
MOVEM T2,ASCLSN ;SAVE THE LSN
MOVEI T2,.CHCRT ;OUR <CR>
PUSHJ P,COAOC ;OUTPUT THE <CR>
PUSHJ P,NEROU ;I/O ERROR
MOVEI T2,.CHLFD ;A <LF>
PUSHJ P,COAOC ;CONVERT TO <CR><LF><LSN>
PUSHJ P,NEROU ;I/O ERROR
SETZ P3, ;WE ARE NOW AT THE LEFT MARGIN AGAIN
SKIPLE T3,S.LSN ;WHOSE LSN TO BELIEVE?
JRST COALS1 ;GENERATE NEW ONE
JRST COALU3 ;PROCESS RECEIVED ONE
;HERE ON <CR><EOF>
COACS9: MOVEI T2,.CHCRT ;OUR <CR>
PUSHJ P,COAOC ;OUTPUT THE <CR>
PUSHJ P,NEROU ;I/O ERROR
SETZ P3, ;WE ARE NOW AT THE LEFT MARGIN AGAIN
JRST COASE1 ;[14] GO PROCESS <EOF>
;HERE ON SPACE CHARACTER
COASP: CAML P3,S.WRAP ;TIME TO WORD-WRAP YET?
JRST COAHW ;YES, WRAP TO A NEW LINE
TXNN P1,US$TAB ;/TABS?
JRST COAPC ;NO, NORMAL PRINTING CHARACTER
MOVE T3,P3 ;YES, GET CURRENT COLUMN COUNTER
IDIV T3,S.TINC ;REDUCE TO TAB, POSITION WITH TAB
SUB T4,S.TINC ;T4:=-<COUNT TILL NEXT TAB>
HRLZ T4,T4 ;MAKE INTO AOBJN POINTER
JRST COASP5 ;ENTER SPACE COMPRESSION LOOP
;LOOP BUILDING UP SPACES UNTIL THE NEXT TAB STOP IS HIT
COASP2: JSP CX,COAIC ;NEXT INPUT CHARACTER
PUSHJ P,NERIN ; I/O ERROR
JRST COASR0 ; END-OF-FILE
JRST COASR1 ; LINE-SEQUENCE-NUMBER
CAIN T2,.CHTAB ; ASCII CHARACTER - HIT A TAB?
JRST [HLRO T3,T4 ;YES, GET SPACE LEFT TILL TAB
SUB P3,T3 ;ADD IT INTO COLUMN POSITION
JRST COASP7] ;OUTPUT TAB, CHECKING FREE-CRLF/ETC.
CAIE T2," " ;ANOTHER SPACE?
JRST COASQ ;NO, END OF EMBEDDED SPACES
COASP5: MOVE T3,P3 ;COLUMN POSITION LESS SPACES
ADDI T3,1(T4) ;ACCOUNT FOR SPACES SO FAR
CAMGE T3,S.WRAP ;WOULD THIS EXCEED WORD-WRAP-CRLF BOUNDRY?
CAML T3,S.CRLF ; OR FREE-CRLF BOUNDRY?
JRST COASW ;YES TO ONE OF THE ABOVE
AOBJN T4,COASP2 ;LOOP TILL TAB STOP REACHED
COASP7: ADDI P3,(T4) ;ACCOUNT FOR SPACE(S) COMPRESSED OUT
MOVEI T2,.CHTAB ;SELECT ASCII TAB CHARACTER
CAMGE P3,S.WRAP ;HAVE WE NOW EXCEEDED WORD-WRAP-CRLF BOUNDRY?
CAML P3,S.CRLF ;OR THE FREE-CRLF BOUNDRY?
JRST COASW ;YES, NEED A NEW LINE
JRST COAQC ;NO, ALL SET, OUTPUT ONE TAB
;HERE WHEN EITHER WORD-WRAP-CRLF OR FREE-CRLF BOUNDRY EXCEEDED
COASW: CAIN T2,.CHTAB ;GET UP TO A TAB BOUNDRY?
JRST [PUSHJ P,COAOC ;YES, OUTPUT THE TAB CHARACTER
PUSHJ P,NEROU ;I/O ERROR
JRST COASW2] ;START UP A NEW LINE
PUSHJ P,COASS ;FLUSH OUT ACCUMULATED SPACES
POPJ P, ;DIED
COASW2: PUSHJ P,COANL ;START UP A NEW LINE
POPJ P, ;DIED
MOVE T3,S.CRLF ;GET THE FREE-CRLF BOUNDRY
CAMGE T3,S.WRAP ;WAS THIS A WORD-WRAP-CRLF OR A FREE-CRLF
JRST COASC1 ;FREE-CRLF, KEEP COMPRESSING SPACES
JRST COAHW3 ;WORD-WRAP-CRLF, EAT FOLLOWING SPACES
;HERE ON EOF WHILE COMPRESSING SPACES
COASR0: PUSHJ P,COASS ;DUMP OUT SPACES SO FAR
POPJ P, ;DIED
JRST COASE ;END OF FILE PROCESSING
;HERE ON LSN WHILE COMPRESSING SPACES
COASR1: PUSHJ P,COASS ;DUMP OUT SPACES SO FAR
POPJ P, ;DIED
JRST COALU ;PROCESS RECEIVED LSN
;HERE ON NON-SPACE FOLLOWING ONE OR MORE SPACE CHARACTERS
COASQ: PUSHJ P,COASS ;DUMP OUT SPACES SO FAR
POPJ P, ;DIED
JRST COASC5 ;PROCESS THIS NON-SPACE CHARACTER
;HELPER TO DUMP OUT ACCUMULATED SPACES
COASS: PUSHJ P,TSAV12## ;SAVE THE INPUT CHARACTER IN T2
ANDI T4,-1 ;REDUCE TO COUNT OF SPACES EATEN
ADD P3,T4 ;ACCOUNT FOR HORIZONTAL POSITION
MOVEI T2," " ;SELECT ASCII SPACE CHARACTER
COASS3: PUSHJ P,COAOC ;OUTPUT ONE ASCII CHARACTER
PUSHJ P,NEROU ;I/O ERROR
SOJG T4,COASS3 ;LOOP FOR ALL EMBEDDED SPACES
JRST .POPJ1## ;SUCCESSFULLY FLUSHED OUT THE SPACES
;HERE ON RANDOM CONTROL CHARACTER
COACC: TXNN P1,US$ARR ;/ARROW?
JRST COAQC ;NO, JUST OUTPUT THE CHARACTER STRAIGHT
IORI T2,100 ;YES, CONVERT TO PRINTING GRAPHIC EQUIVILENT
CAIE T2,177 ;A RUBOUT?
CAIN T2,377 ;OR A RUBOUT?
MOVEI T2,"?" ;YES, DISPLAY RUBOUT AS "^?"
MOVEI T3,"^" ;THE "FLAG" CHARACTER
JRST COAFL0 ;GO PRINT "FLAGGED" CHARACTER
;HERE ON LOWER-CASE ALPHAMERICS
COALC: TXNN P1,US$FLL ;/FLAG:LOWER?
JRST COAPC ;NO, NORMAL PRINTING CHARACTER
JRST COAFL ;YES, FLAG LOWER CASE CHARACTER
;HERE ON UPPER-CASE ALPHAMERICS
COAUC: TXNN P1,US$FLU ;/FLAG:UPPER?
JRST COAPC ;NO, NORMAL PRINTING CHARACTER
; JRST COAFL ;YES, FLAG UPPER CASE CHARACTER
;HERE TO FLAG THE CHARACTER IN T2
COAFL: MOVEI T3,"'" ;THE "FLAG" CHARACTER
COAFL0: HRROM T2,ASCHAR ;SAVE THE FLAGGED CHARACTER
CAMGE P3,S.CRLF ;WILL THE FLAG CHARACTER FIT ON THE LINE?
JRST COAFL3 ;YES, NO PROBLEMS
PUSHJ P,COANL ;NO, START UP A NEW LINE
POPJ P, ;DIED
COAFL3: MOVE T2,T3 ;POSITION FLAG CHARACTER
PUSHJ P,COAOC ;OUTPUT ASCII CHARACTER
PUSHJ P,NEROU ;I/O ERROR
COAFL7: SETZ T2, ;CLEAR FLAG
EXCH T2,ASCHAR ;RETRIEVE FLAGGED CHARACTER
AOJA P3,COAPC ;GO FINISH OFF PRINTING CHARACTER
;HERE ON "NORMAL PRINTING ASCII GRAPHIC" CHARACTER
COAPC: CAMGE P3,S.CRLF ;EXCEEDED FREE-CRLF BOUNDRY?
AOJA P3,COAQC ;NO, OUTPUT THIS CHARACTER
PUSHJ P,COANL ;YES, START A NEW LINE
POPJ P, ;DIED
AOJA P3,COAQC ;OUTPUT PRINTING ASCII CHARACTER IN T2
;HERE TO OUTPUT ONE ASCII CHARACTER
COAQC: PUSHJ P,COAOC ;OUTPUT THE CHARACTER
PUSHJ P,NEROU ;I/O ERROR
JRST COASC1 ;LOOP BACK FOR NEXT INPUT CHARACTER
;COAIC - RETURN NEXT INPUT ASCII CHARACTER
;Call is:
;
; JSP CX,COAIC
; I/O-Error return
; End-of-File return
; Line-Sequence-Number return
; Normal return
;
;On normal return T2 has the next ASCII character.
COAIC: SKIPE T2,ASCHAR ;GOT A SAVED ASCII CHARACTER?
JRST [ANDI T2,177 ;YES, REDUCE TO JUST CHARACTER
SETZM ASCHAR ;NOTE WE HAVE READ THE SAVED CHARACTER
JRST 3(CX)] ;RETURN WITH SAVED CHARACTER
SKIPLE ASCSTI ;GOT A SAVED ASCII STRING?
JRST [ILDB T2,ASCSTJ ;FETCH NEXT SAVED CHARACTER
SOSLE ASCSTI ;COUNT DOWN VALID BYTE COUNT
JRST 3(CX) ;RETURN WITH SAVED CHARACTER
MOVE M0,ASCSTK ;GET SAVED EXCEPTION CONDITION
JUMPE M0,.+1 ;JUST RESUME INPUT IF NONE
JRST COAICE] ;TAKE VARIED EXCEPTION RETURN
PUSHJ P,COAIB ;READ NEXT INPUT DATA BYTE
JRST COAICE ;TAKE EXCEPTION RETURN
TXNN P1,US$TRU ;WANT TRAILING SPACES/TABS TRUNCATED?
JRST 3(CX) ;NO, JUST RETURN CHARACTER DIRECTLY
CAIE T2,.CHTAB ;A TAB?
CAIN T2," " ;OR A SPACE?
JRST COAIC3 ;YES, COMPRESS THEM A BIT
JRST 3(CX) ;NO, RETURN STRAIGHT
;HERE TO SCAN AHEAD TO SEE IF TRAILING BLANKS (AND DELETE THEM IF SO)
COAIC3: PUSHJ P,COAIS ;DO SPACE/TAB LOOKAHEAD
JRST COAIC ;RETURN APPROPRIATE CHARACTER
;HERE TO "EXCEPTION" RETURN AS APPROPRIATE BY CODE IN M0
COAICE: CAIN M0,$EIEOF ;END OF FILE?
JRST 1(CX) ;YES
CAIE M0,$EILSN ;NO, HOW ABOUT A LINE SEQUENCE NUMBER?
JRST 0(CX) ;MUST BE AN I/O ERROR
JUMPN T2,2(CX) ;RETURN VALID LSN
JRST COAIC ;A NULL LSN, JUST IGNORE THE EXCEPTION
; THIS HAPPENS IF LSA (DAP) IS SET BUT THE
; REMOTE FILE IS NOT LSN'ED - FAL "PADS"
; WITH A " 00000" SEQUENCE.
;HERE TO HANDLE THE TRAILING SPACE/TAB TRUNCATION FOR COAIC
COAIS: PUSHJ P,TSAV14## ;WANT TO PROTECT THE CALLERS ACS
DMOVE T3,ASCICP ;GET THE PROTOTYPE INPUT COUNTER/POINTER
JRST COAIS5 ;ENTER THE LOOP
;LOOP ACCUMULATING SPACES AND/OR TABS
COAIS4: PUSHJ P,COAIB ;GET ANOTHER BYTE
JRST [MOVEM M0,ASCSTK ;REMEMBER EXCEPTION STATUS
JRST COAIS7] ;RETURN STRING OF SPACES/TABS
COAIS5: CAIN T2,.CHCRT ;IF A <CR>
JRST [MOVEM T2,ASCHAR ;THEN ALL SET, FLAG TO RETURN <CR>
POPJ P,] ;RETURN, HAVING EATEN THE BLANKS
IDPB T2,T4 ;STASH AWAY THIS BYTE
CAIE T2,.CHTAB ;IF A TAB
CAIN T2," " ; OR A SPACE
SOJG T3,COAIS4 ;JUST ACCUMULATE IT
CAIG T3,0 ;OVER-FLOW?
JRST [PUSHJ P,COATES ;YES, ISSUE WARNING MESSAGE
AOJA T3,.+1] ;KEEP T3 CONSISTENT
SETZM ASCSTK ;NOTE FINISHED CLEANLY
COAIS7: SUB T3,ASCICP ;T3:=NEGATIVE COUNT OF CHARACTERS SAVED
SUBI T3,2 ;OFFSET BY ONE FOR LOOP EXIT
MOVNM T3,ASCSTI ;SET INPUT SAVED COUNT
MOVE T4,ASCICP+1 ;GET THE SPACE POINTER
MOVEM T4,ASCSTJ ;SET THE SAVED STRING POINTER
POPJ P, ;START RETURNING SAVED STRING
;COAIB - READ NEXT INPUT BYTE
COAIB: MOVE T1,CI ;ADDRESS OF INPUT CDB
TXNN P1,US$XLI ;ANY SORT OF INPUT TRANSLATION?
PJRST @.IOISR(T1) ;NO, QUICK AND FAST CASE
PUSHJ P,@.IOISR(T1) ;READ NEXT INPUT DATA BYTE
JRST COAIE ;FAILED - SEE WHY
TXNE P1,US$EBI ;IS INPUT EBCDIC-ENCODED?
HRRZ T2,ASCEBC(T2) ;YES, TRANSLATE (AS BEST WE CAN) INTO USASCII
AOS (P) ;SUCCESSFUL
POPJ P, ; RETURN
;CAN'T READ NEXT INPUT DATA BYTE, SEE WHY
COAIE: CAIN M0,$EILSN ;LINE SEQUENCE NUMBER?
JRST [MOVEM T2,ASCLSN ;YES, STASH IT AWAY
POPJ P,] ;AND TAKE EXCEPTION RETURN
CAIE M0,$EIEOF ;END OF FILE?
POPJ P, ;ERROR FOR NOW
TXNN P1,US$CON ;/CONCATENATE?
POPJ P, ;RETURN VALID EOF
COAIE1: PUSHJ P,.NXTFC## ;YES, GO OPEN NEXT CONCATENATED INPUT FILE
JRST COAIE3 ;SEE WHY CAN'T GET NEXT INPUT FILE
PUSHJ P,COAIF ;HANDLE SWITCH-PROCESSING SETUP
POPJ P, ;DUH?
;*** AT THIS POINT SOMETHING SPECIAL NEEDS TO BE DONE ABOUT THE
;*** END OF A CONCATENATED INPUT SET, AS IN:
;*** COPY *.* = *.MAC, *.BAK/CONCATENATE, *.REL
MOVE P1,T2 ;SET NEW FLAGS WORD
JRST COAIB ;BACK TO READ MORE DATA
COAIE3: CAIN M0,$EFIXN ;ALL OUT OF INPUT FILES?
JRST [MOVEI M0,$EIEOF ;YES, TIME FOR "END-OF-FILE" RETURN
POPJ P,] ;TAKE EXCEPTION RETURN
PUSHJ P,NERFAE ;HANDLE FILE ACCESS ERROR
POPJ P, ;ABORT ON ERROR
JRST COAIE1 ;CONTINUE ON ERROR
;COAIF - SETUP ASCII CONTROL-PROCESSING BASED ON OUTPUT AND INPUT SWITCHES
;
;Returns US$--- switch processing flags in T2.
COAIF: PUSHJ P,.SAVE4## ;NEED SOME ACS HERE
MOVE P3,.IOFSB(CI) ;ADDRESS OF INPUT FILE SPEC BLOCK
MOVE P4,.IOFSB(CO) ;ADDRESS OF OUTPUT FILE SPEC BLOCK
DMOVE P1,.FXUSW(P4) ;OUTPUT "USER" (FILE) SWITCHES
DMOVE T3,.FXUSW(P3) ;INPUT "USER" SWITCHES
TDZ T3,P2 ;OUTPUT SWITCHES TAKE PRECEDENCE OVER INPUT
TXZE T3,US$EBC ;/EBCDIC ON INPUT?
TXO T3,US$EBI ;YES, REPOSITION INPUT SIDE
IOR P1,T3 ;MERGE OUTPUT WITH INPUT SWITCHES
IOR P2,T4 ;MERGE SWITCH MASK TOO
;NOW SET UP DEFAULTS/ETC.
MOVE T4,.IOIOC(CI) ;GET I/O CONTROL
;SETUP CARD SEQUENCE NUMBER PROCESSING, IF NEEDED
TXNN P2,US$CSN ;ANY FLAVOR OF /[NO]CSN
MOVNI T1,1 ;NO, NO CSN PROCESSING
MOVEI T1,0 ;YES, SOME SORT OF CSN SPECIFIED
TXNE P1,US$CSN ;WAS /CSN SPECIFIED?
MOVEI T1,1 ;YES, GENERATING CSNS
MOVEM T1,S.CSN ;SET /CSN PROCESSING
JUMPLE T1,COAIF4 ;IF /CSN,
TXNE P2,US$SPA ;AND NO /[NO]SPACE
TXO P1,US$SPA ;THEN DEFAULT /SPACE ON /CSN
SKIPGE T1,$FXCSC(P4) ;GET OUTPUT /CSNCOLUMN, IF ANY
MOVE T1,$FXCSC(P3) ;OTHERWISE USE INPUT /CSNCOLUMN
CAIG T1,0 ;GOT A COLUMN?
MOVEI T1,AD.CSC ;NO, USE STANDARD CARD SEQUENCE COLUMN
MOVEM T1,S.CSNC ;SET CARD SEQUENCE NUMBER COLUMN
SKIPGE T1,$FXCSI(P4) ;GET OUTPUT /CSNINCREMENT, IF ANY
MOVE T1,$FXCSI(P3) ;OTHERWISE USE INPUT /CSNINCREMENT
CAIG T1,0 ;GOT AN INCREMENT?
MOVEI T1,AD.CSI ;NO, USE STANDARD CARD SEQUENCE INCREMENT
MOVEM T1,S.CSN ;SET CARD SEQUENCE NUMBER INCREMENT
; .GT. 0 IS FLAG /CSN PROCESSING
SKIPGE T1,$FXCSW(P4) ;GET OUTPUT /CSNWIDTH, IF ANY
MOVE T1,$FXCSW(P3) ;OTHERWISE USE INPUT /CSNWIDTH
CAIG T1,0 ;GOT A WIDTH?
MOVEI T1,AD.CSW ;NO, USE STANDARD CARD SEQUENCE WIDTH
MOVEM T1,S.CSNW ;SET CARD SEQUENCE NUMBER WIDTH
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;SETUP LINE SEQUENCE NUMBER PROCESSING, IF NEEDED
COAIF4: TXNN P2,US$LSN ;WAS ANY FLAVOR OF /[NO]LSN SPECIFIED?
JRST [SKIPGE T1,$FXLSI(P4) ;NO, GET OUTPUT /LSNINCREMENT, IF ANY
MOVE T1,$FXLSI(P3) ;OTHERWISE USE INPUT /LSNINCREMENT
MOVEM T1,S.LSN ;SET /LSN PROCESSING (IF ANY)
TXZ T4,IC.LSN ;DISCARD ANY INPUT LSN(S)
JRST COAIF5] ;THAT'S IT FOR LSN PROCESSING
TXNN P1,US$LSN ;WAS IT /LSN OR /NOLSN?
JRST [TXZ T4,IC.LSN ;DISCARD ANY INPUT LSN(S)
SETOM S.LSN ;DO NOT GENERATE OUTPUT LSNS
JRST COAIF5] ;AND THAT IT THAT
SKIPGE T1,$FXLSI(P4) ;GET OUTPUT /LSNINCREMENT, IF ANY
MOVE T1,$FXLSI(P3) ;OTHERWISE USE INPUT /LSNINCREMENT
CAIG T1,0 ;WAS A GOOD INCREMENT GIVEN?
MOVEI T1,AD.LSI ;NO, USE ABSENT DEFAULT
MOVEM T1,S.LSN ;SET /LSN PROCESSING
DMOVE T1,.FXUSW(P3) ;SPECIAL CHECK FOR INPUT SWITCH
TXNN T1,US$LSN ;DID USER SPECIFY /LSN
TXNN T2,US$LSN ;DID USER SPECIFY /NOLSN?
CAIA ;EITHER NO /[NO]LSN OR /LSN
TXZ T4,IC.LSN ;/NOLSN, SUPPRESS ANY INPUT LSN
;SETUP FREE-CRLF PROCESSING, IF NEEDED
COAIF5: SKIPGE T1,$FXCRL(P4) ;GET OUTPUT /CRLF, IF ANY
MOVE T1,$FXCRL(P3) ;OTHERWISE USE INPUT /CRLF
CAIG T1,0 ;WANT FREE-CRLF PROCESSING?
HRLOI T1,377777 ;NO, SET BOUNDRY AT INFINITY
SKIPLE S.CSN ;/CSN IN EFFECT?
MOVE T1,S.CSNC ;YES, THEN BREAK LINE AT CSN COLUMN
MOVEM T1,S.CRLF ;SET FREE-CRLF BOUNDRY
;SETUP AUTO-CRLF PROCESSING, IF NEEDED
SKIPGE T1,$FXWRA(P4) ;GET OUTPUT /WRAP, IF ANY
SKIPG T1,$FXWRA(P3) ;OTHERWISE USE INPUT /WRAP
JUMPLE T1,COAIF7 ;IF /WRAP
TXNN P2,US$TRU ;AND NO /[NO]TRUNCATE
TXO P1,US$TRU ;THEN DEFAULT /TRUNCATE ON /WRAP
COAIF7: CAIG T1,0 ;WANT WORD-WRAP-CRLF PROCESSING?
HRLOI T1,377777 ;NO, SET BOUNDRY AT INFINITY
MOVEM T1,S.WRAP ;SET WORD-WRAP-CRLF BOUNDRY
CAMLE T1,S.CRLF ;WORD-WRAP-CRLF SET LESS THAN FREE-CRLF?
TLNE T1,377777 ;NO, ERROR UNLESS INFINITY
JRST COAIF8 ;YES, ALL SET
WARN CLW,</CRLF boundry set before /WRAP, ignoring /WRAP>
HRLOI T1,377777 ;POSITIVE INFINITY
MOVEM T1,S.WRAP ;DEFEAT /WRAP PROCESSING
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;SETUP NULL PROCESSING AS NEEDED
COAIF8: TXNE P1,US$NUL ;WANT NULLS?
TXOA T4,IC.NLC ;YES, FLAG NULLS LEGAL CHARACTERS
TXZ T4,IC.NLC ;NO, CHUCK NULLS
MOVEM T4,.IOIOC(CI) ;SET I/O CONTROL PROCESSING
MOVE T2,P1 ;RETURN IN T2 DUE TO .SAVE4
JRST .POPJ1## ;PROCESSING VARIABLES ALL SET
;COANL - WRITE EOL/BOL (READ <CR><LF>)
COANL: PUSHJ P,TSAV14## ;NEED TO PROTECT ALL THE ACS HERE
SKIPG S.CSN ;WANT CARD SEQUENCE NUMBERS?
JRST COANL2 ;NO
PUSHJ P,COACS ;YES, OUTPUT THE CSN
POPJ P, ;DIED
COANL2: MOVEI T2,.CHCRT ;A CARRIAGE RETURN CHARACTER
PUSHJ P,COAOC ;OUTPUT ONE CHARACTER
PUSHJ P,NEROU ;I/O ERROR
MOVEI T2,.CHLFD ;THE TRAILING LINE-FEED CHARACTER
PUSHJ P,COAOC ;OUTPUT ONE MORE CHARACTER
PUSHJ P,NEROU ;I/O ERROR
SETZ P3, ;NOW AT BEGINING OF LINE
SKIPG T3,S.LSN ;GENERATING LINE SEQUENCE NUMBERS?
JRST .POPJ1## ;NO, JUST RETURN
ADDB T3,ASCLSN ;YES, GET NEXT LSN
MOVEI T2,.FULSN ;FUNCTION: LINE SEQ NO
MOVE T1,CI ;ADDRESS OF INPUT CDB
PUSHJ P,.IOFUN## ;WRITE NEW LINE SEQUENCE NUMBER
POPJ P, ;DIED
MOVE P3,S.TINC ;WE ARE NOW AT THE FIRST TAB STOP
JRST .POPJ1## ;NOW RETURN
;COACS - WRITE OUT CARD SEQUENCE NUMBER
COACS: PUSHJ P,TSAV14## ;SAVE THE T'S
MOVE T4,S.CSNC ;CSN COLUMN
SUB T4,P3 ;T4:=SPACES TO GO
JUMPLE T4,COACS5 ;JUST ISSUE CSN IF ALREADY THERE
TXNN P1,US$TAB ;USER REALLY WANT TABS?
TDZA T3,T3 ;NO, USE SPACES
JRST [MOVE T1,P3 ;CURRENT POSITION
IDIV T1,S.TINC ;T1:=CURRENT TAB COLUMN
MOVE T3,S.CSNC ;DESIRED POSITION
IDIV T3,S.TINC ;T3:=DESIRED TAB COLUMN
;T4:=EXTRA SPACES NEEDED FOR CSN
SUB T3,T1 ;T3:=EXTRA TABS NEEDED FOR CSN
JRST .+1] ;ISSUE SPACING REQUEST
PUSHJ P,COACT2 ;ISSUE TAB/SPACES AS NEEDED
POPJ P, ;DIED
;AT START OF CARD SEQUENCE NUMBER FIELD, ISSUE NEXT NUMBER
COACS5: MOVE T2,S.CSN ;CSCNINCREMENT VALUE
ADDB T2,ASCCSN ;CALCULATE NEXT NUMBER TO ISSUE
MOVE T4,S.CSNW ;PICK UP WIDTH OF CSN FIELD
COACS6: IDIVI T2,^D10 ;GENERATE ANOTHER DECADE
PUSH P,T3 ;SAVE LATEST DIGIT
SOJLE T4,COACS8 ;LOOP FOR FULL "EIGHT" DIGITS
PUSHJ P,COACS6 ;GO FOR ANOTHER DECADE
JRST [POP P,T2 ;DIED, ADJUST STACK
POPJ P,] ;PROPAGATE DEATH
COACS8: POP P,T2 ;RETRIEVE NEXT DIGIT
ADDI T2,"0" ;ASCIIZE THE DIGIT
PUSHJ P,COAOC ;OUTPUT THIS CHARACTER
PUSHJ P,NEROU ;I/O ERROR
JRST .POPJ1## ;SUCCESSFUL RETURN
;HELPER TO COACS TO ISSUE TABS/SPACES AS NEEDED
COACT0: MOVEI T2,.CHTAB ;A TAB CHARACTER
PUSHJ P,COAOC ;OUTPUT ONE CHARACTER
PUSHJ P,NEROU ;I/O ERROR
COACT2: SOJG T3,COACT0 ;LOOP FOR ALL NEEDED TABS
JUMPN T4,COASS ;ISSUE (T4) SPACES
JRST .POPJ1## ;NO SPACES NEEDED
;COAOC - WRITE NEXT OUTPUT CHARACTER
;Call is:
;
; PUSHJ P,COAOC
; I/O error return
; Normal return
COAOC: TXNE P1,US$TRU ;/TRUNCATE?
JRST COAOA ;YES, NEED TO CHECK THINGS OUT
;COAOB - WRITE NEXT OUTPUT DATA BYTE
;Call is:
;
; PUSHJ P,COAOB
; I/O error return
; Normal return
COAOB: TXNE P1,US$EBC ;WANT TO EBCDIC-ENCODE THE OUTPUT?
HLRZ T2,ASCEBC(T2) ;YES, TRANSLATE (AS BEST WE CAN) INTO EBCDIC
MOVE T1,CO ;ADDRESS OF OUTPUT CDB
PUSHJ P,@.IOOSR(T1) ;WRITE OUT THE CHARACTER
JRST COAOB3 ;I/O ERROR, SEE IF NEED TO ABORT
AOJA P4,.POPJ1## ;7 MORE BITS WRITTEN OUT
;HERE ON OUTPUT ERROR, SEE IF SHOULD ABORT
COAOB3: POPJ P, ;ABORT FOR NOW
;HERE TO HANDLE COAOC'S /TRUNCATED OUTPUT
COAOA: SKIPE ASCSTP ;ALREADY STARTED AN OUTPUT STRING?
JRST COAOA3 ;YES, APPEND THIS CHARACTER
CAIE T2,.CHTAB ;NO, IS THIS A TAB?
CAIN T2," " ; OR A SPACE?
CAIA ;YES, NEED TO START UP AN OUTPUT STRING
PJRST COAOB ;NO, JUST OUTPUT THIS BYTE
;HERE ON FIRST SPACE/TAB, NEED TO START UP AN OUTPUT STRING
PUSHJ P,TSAV14## ;SAVE ALL ACS
DMOVE T3,ASCOCP ;FETCH PROTOTYPE OUTPUT COUNTER/POINTER
DMOVEM T3,ASCSTO ;SET NEW OUTPUT COUNTER/POINTER
;NOW ACCUMLATE THE SPACES AND/OR TABS UNTIL SOMETHING EXCITING COMES ALONG
COAOA3: CAIN T2,.CHCRT ;A <CR>?
JRST [SETZM ASCSTP ;YES, FLUSH SAVED SPACES/TABS
PJRST COAOB] ;AND WRITE THE DATA BYTE DIRECTLY
IDPB T2,ASCSTP ;STASH AWAY THIS CHARACTER
SOSG ASCSTO ;AND ACCOUNT FOR IT
JRST COAOA6 ;OVERFLOWED-DUMP THE STRING OUT
CAIE T2,.CHTAB ;ON ANOTHER TAB?
CAIN T2," " ;OR ANOTHER SPACE?
JRST .POPJ1## ;YES, JUST HOLD ONTO IT FOR NOW
JRST COAOA7 ;NO, FLUSH OUT SAVED CHARACTERS
;NON-SPACE CHARACTER, NEED TO RETRIEVE THE SAVED BLANKS AND OUTPUT 'EM
COAOA6: PUSHJ P,COATES ;ISSUE TOO MANY SPACES MESSAGE
COAOA7: PUSHJ P,TSAV14## ;SAVE THE ACS
DMOVE T3,ASCOCP ;PROTOTYPE OUTPUT COUNTER/POINTER
SUB T3,ASCSTO ;T3:=COUNT OF BYTES SAVED
COAOA8: ILDB T2,T4 ;NEXT SAVED OUTPUT CHARACTER
PUSHJ P,COAOB ;OUTPUT IT
POPJ P, ;DIED
SOJG T3,COAOA8 ;LOOP FOR ALL SAVED CHARACTERS
SETZM ASCSTP ;CLEAR SAVED-CHARACTERS FLAG
JRST .POPJ1## ;RETURN SUCCESSFULLY
COATES: WARN TES,<Too many embedded spaces for space compressor, ignored>
POPJ P, ;SIMPLY RETURN
SUBTTL Copy processor - ASCII character dispatch table
ASCDSP: IFIW COACC ; 000 = 000 = 00 NUL Null
IFIW COACC ; 001 = 001 = 01 SOH Control-A
IFIW COACC ; 002 = 002 = 02 STX Control-B
IFIW COACC ; 003 = 003 = 03 ETX Control-C
IFIW COACC ; 004 = 004 = 04 EOT Control-D
IFIW COACC ; 005 = 005 = 05 ENQ Control-E
IFIW COACC ; 006 = 006 = 06 ACK Control-F
IFIW COACC ; 007 = 007 = 07 BEL Control-G
IFIW COABS ; 010 = 008 = 08 BS Control-H Backspace
IFIW COAHT ; 011 = 009 = 09 HT Control-I Horizontal-Tab
IFIW COALF ; 012 = 010 = 0A LF Control-J Line-Feed
IFIW COAVT ; 013 = 011 = 0B VT Control-K Vertical-Tab
IFIW COAFF ; 014 = 012 = 0C FF Control-L Form-Feed
IFIW COACR ; 015 = 013 = 0D CR Control-M Carriage-Return
IFIW COACC ; 016 = 014 = 0E SO Control-N
IFIW COACC ; 017 = 015 = 0F SI Control-O
IFIW COACC ; 020 = 016 = 10 DLE Control-P
IFIW COACC ; 021 = 017 = 11 DC1 Control-Q XON
IFIW COACC ; 022 = 018 = 12 DC2 Control-R
IFIW COACC ; 023 = 019 = 13 DC3 Control-S XOFF
IFIW COACC ; 024 = 020 = 14 DC4 Control-T
IFIW COACC ; 025 = 021 = 15 NAK Control-U
IFIW COACC ; 026 = 022 = 16 SYN Control-V
IFIW COACC ; 027 = 023 = 17 ETB Control-W
IFIW COACC ; 030 = 024 = 18 CAN Control-X
IFIW COACC ; 031 = 025 = 19 EM Control-Y
IFIW COACC ; 032 = 026 = 1A SUB Control-Z
IFIW COACC ; 033 = 027 = 1B ESC Control-[ Escape
IFIW COACC ; 034 = 028 = 1C FS Control-\
IFIW COACC ; 035 = 029 = 1D GS Control-]
IFIW COACC ; 036 = 030 = 1E RS Control-^
IFIW COACC ; 037 = 031 = 1F US Control-_
;CONTINUED ON NEXT PAGE
;ASCII CHARACTER DISPATCH TABLE (CONTINUED)
IFIW COASP ; 040 = 032 = 20 Space
IFIW COAPC ; 041 = 033 = 21 !
IFIW COAPC ; 042 = 034 = 22 "
IFIW COAPC ; 043 = 035 = 23 #
IFIW COAPC ; 044 = 036 = 24 $
IFIW COAPC ; 045 = 037 = 25 %
IFIW COAPC ; 046 = 038 = 26 &
IFIW COAPC ; 047 = 039 = 27 '
IFIW COAPC ; 050 = 040 = 28 (
IFIW COAPC ; 051 = 041 = 29 )
IFIW COAPC ; 052 = 042 = 2A *
IFIW COAPC ; 053 = 043 = 2B +
IFIW COAPC ; 054 = 044 = 2C ,
IFIW COAPC ; 055 = 045 = 2D -
IFIW COAPC ; 056 = 046 = 2E .
IFIW COAPC ; 057 = 047 = 2F /
IFIW COAPC ; 060 = 048 = 30
IFIW COAPC ; 061 = 049 = 31 1
IFIW COAPC ; 062 = 050 = 32 2
IFIW COAPC ; 063 = 051 = 33 3
IFIW COAPC ; 064 = 052 = 34 4
IFIW COAPC ; 065 = 053 = 35 5
IFIW COAPC ; 066 = 054 = 36 6
IFIW COAPC ; 067 = 055 = 37 7
IFIW COAPC ; 070 = 056 = 38 8
IFIW COAPC ; 071 = 057 = 39 9
IFIW COAPC ; 072 = 058 = 3A :
IFIW COAPC ; 073 = 059 = 3B ;
IFIW COAPC ; 074 = 060 = 3C <
IFIW COAPC ; 075 = 061 = 3D =
IFIW COAPC ; 076 = 062 = 3E >
IFIW COAPC ; 077 = 063 = 3F ?
;CONTINUED ON NEXT PAGE
;ASCII DISPATCH TABLE (CONTINUED)
IFIW COAPC ; 100 = 064 = 40 @
IFIW COAUC ; 101 = 065 = 41 A
IFIW COAUC ; 102 = 066 = 42 B
IFIW COAUC ; 103 = 067 = 43 C
IFIW COAUC ; 104 = 068 = 44 D
IFIW COAUC ; 105 = 069 = 45 E
IFIW COAUC ; 106 = 070 = 46 F
IFIW COAUC ; 107 = 071 = 47 G
IFIW COAUC ; 110 = 072 = 48 H
IFIW COAUC ; 111 = 073 = 49 I
IFIW COAUC ; 112 = 074 = 4A J
IFIW COAUC ; 113 = 075 = 4B K
IFIW COAUC ; 114 = 076 = 4C L
IFIW COAUC ; 115 = 077 = 4D M
IFIW COAUC ; 116 = 078 = 4E N
IFIW COAUC ; 117 = 079 = 4F O
IFIW COAUC ; 120 = 080 = 50 P
IFIW COAUC ; 121 = 081 = 51 Q
IFIW COAUC ; 122 = 082 = 52 R
IFIW COAUC ; 123 = 083 = 53 S
IFIW COAUC ; 124 = 084 = 54 T
IFIW COAUC ; 125 = 085 = 55 U
IFIW COAUC ; 126 = 086 = 56 V
IFIW COAUC ; 127 = 087 = 57 W
IFIW COAUC ; 130 = 088 = 58 X
IFIW COAUC ; 131 = 089 = 59 Y
IFIW COAUC ; 132 = 090 = 5A Z
IFIW COAPC ; 133 = 091 = 5B [
IFIW COAPC ; 134 = 092 = 5C \
IFIW COAPC ; 135 = 093 = 5D ]
IFIW COAPC ; 136 = 094 = 5E ^
IFIW COAPC ; 137 = 095 = 5F _
;CONTINUED ON NEXT PAGE
;ASCII DISPATCH TABLE (CONTINUED)
IFIW COAPC ; 140 = 096 = 60 `
IFIW COALC ; 141 = 097 = 61 a
IFIW COALC ; 142 = 098 = 62 b
IFIW COALC ; 143 = 099 = 63 c
IFIW COALC ; 144 = 100 = 64 d
IFIW COALC ; 145 = 101 = 65 e
IFIW COALC ; 146 = 102 = 66 f
IFIW COALC ; 147 = 103 = 67 g
IFIW COALC ; 150 = 104 = 68 h
IFIW COALC ; 151 = 105 = 69 i
IFIW COALC ; 152 = 106 = 6A j
IFIW COALC ; 153 = 107 = 6B k
IFIW COALC ; 154 = 108 = 6C l
IFIW COALC ; 155 = 109 = 6D m
IFIW COALC ; 156 = 110 = 6E n
IFIW COALC ; 157 = 111 = 6F o
IFIW COALC ; 160 = 112 = 70 p
IFIW COALC ; 161 = 113 = 71 q
IFIW COALC ; 162 = 114 = 72 r
IFIW COALC ; 163 = 115 = 73 s
IFIW COALC ; 164 = 116 = 74 t
IFIW COALC ; 165 = 117 = 75 u
IFIW COALC ; 166 = 118 = 76 v
IFIW COALC ; 167 = 119 = 77 w
IFIW COALC ; 170 = 120 = 78 x
IFIW COALC ; 171 = 121 = 79 y
IFIW COALC ; 172 = 122 = 7A z
IFIW COAPC ; 173 = 123 = 7B {
IFIW COAPC ; 174 = 124 = 7C |
IFIW COAPC ; 175 = 125 = 7D }
IFIW COAPC ; 176 = 126 = 7E ~
IFIW COACC ; 177 = 127 = 7F DEL Control-? Delete
;CONTINUED ON NEXT PAGE
;ASCII DISPATCH TABLE (CONTINUED)
;
;THE "UPPER HALF" IS FOR NOW A DUPLICATE OF THE "LOWER HALF":
IFIW COACC ; 200 = 128 = 80 NUL Null
IFIW COACC ; 201 = 129 = 81 SOH Control-A
IFIW COACC ; 202 = 130 = 82 STX Control-B
IFIW COACC ; 203 = 131 = 83 ETX Control-C
IFIW COACC ; 204 = 132 = 84 EOT Control-D
IFIW COACC ; 205 = 133 = 85 ENQ Control-E
IFIW COACC ; 206 = 134 = 86 ACK Control-F
IFIW COACC ; 207 = 135 = 87 BEL Control-G
IFIW COABS ; 210 = 136 = 88 BS Control-H Backspace
IFIW COAHT ; 211 = 137 = 89 HT Control-I Horizontal-Tab
IFIW COALF ; 212 = 138 = 8A LF Control-J Line-Feed
IFIW COAVT ; 213 = 139 = 8B VT Control-K Vertical-Tab
IFIW COAFF ; 214 = 140 = 8C FF Control-L Form-Feed
IFIW COACR ; 215 = 141 = 8D CR Control-M Carriage-Return
IFIW COACC ; 216 = 142 = 8E SO Control-N
IFIW COACC ; 217 = 143 = 8F SI Control-O
IFIW COACC ; 220 = 144 = 90 DLE Control-P
IFIW COACC ; 221 = 145 = 91 DC1 Control-Q XON
IFIW COACC ; 222 = 146 = 92 DC2 Control-R
IFIW COACC ; 223 = 147 = 93 DC3 Control-S XOFF
IFIW COACC ; 224 = 148 = 94 DC4 Control-T
IFIW COACC ; 225 = 149 = 95 NAK Control-U
IFIW COACC ; 226 = 150 = 96 SYN Control-V
IFIW COACC ; 227 = 151 = 97 ETB Control-W
IFIW COACC ; 230 = 152 = 98 CAN Control-X
IFIW COACC ; 231 = 153 = 99 EM Control-Y
IFIW COACC ; 232 = 154 = 9A SUB Control-Z
IFIW COACC ; 233 = 155 = 9B ESC Control-[ Escape
IFIW COACC ; 234 = 156 = 9C FS Control-\
IFIW COACC ; 235 = 157 = 9D GS Control-]
IFIW COACC ; 236 = 158 = 9E RS Control-^
IFIW COACC ; 237 = 159 = 9F US Control-_
;CONTINUED ON NEXT PAGE
;ASCII CHARACTER DISPATCH TABLE (CONTINUED)
IFIW COASP ; 240 = 160 = A0 Space
IFIW COAPC ; 241 = 161 = A1 !
IFIW COAPC ; 242 = 162 = A2 "
IFIW COAPC ; 243 = 163 = A3 #
IFIW COAPC ; 244 = 164 = A4 $
IFIW COAPC ; 245 = 165 = A5 %
IFIW COAPC ; 246 = 166 = A6 &
IFIW COAPC ; 247 = 167 = A7 '
IFIW COAPC ; 250 = 168 = A8 (
IFIW COAPC ; 251 = 169 = A9 )
IFIW COAPC ; 252 = 170 = AA *
IFIW COAPC ; 253 = 171 = AB +
IFIW COAPC ; 254 = 172 = AC ,
IFIW COAPC ; 255 = 173 = AD -
IFIW COAPC ; 256 = 174 = AE .
IFIW COAPC ; 257 = 175 = AF /
IFIW COAPC ; 260 = 176 = B0
IFIW COAPC ; 261 = 177 = B1 1
IFIW COAPC ; 262 = 178 = B2 2
IFIW COAPC ; 263 = 179 = B3 3
IFIW COAPC ; 264 = 180 = B4 4
IFIW COAPC ; 265 = 181 = B5 5
IFIW COAPC ; 266 = 182 = B6 6
IFIW COAPC ; 267 = 183 = B7 7
IFIW COAPC ; 270 = 184 = B8 8
IFIW COAPC ; 271 = 185 = B9 9
IFIW COAPC ; 272 = 186 = BA :
IFIW COAPC ; 273 = 187 = BB ;
IFIW COAPC ; 274 = 188 = BC <
IFIW COAPC ; 275 = 189 = BD =
IFIW COAPC ; 276 = 190 = BE >
IFIW COAPC ; 277 = 191 = BF ?
;CONTINUED ON NEXT PAGE
;ASCII DISPATCH TABLE (CONTINUED)
IFIW COAPC ; 300 = 192 = C0 @
IFIW COAUC ; 301 = 193 = C1 A
IFIW COAUC ; 302 = 194 = C2 B
IFIW COAUC ; 303 = 195 = C3 C
IFIW COAUC ; 304 = 196 = C4 D
IFIW COAUC ; 305 = 197 = C5 E
IFIW COAUC ; 306 = 198 = C6 F
IFIW COAUC ; 307 = 199 = C7 G
IFIW COAUC ; 310 = 200 = C8 H
IFIW COAUC ; 311 = 201 = C9 I
IFIW COAUC ; 312 = 202 = CA J
IFIW COAUC ; 313 = 203 = CB K
IFIW COAUC ; 314 = 204 = CC L
IFIW COAUC ; 315 = 205 = CD M
IFIW COAUC ; 316 = 206 = CE N
IFIW COAUC ; 317 = 207 = CF O
IFIW COAUC ; 320 = 208 = D0 P
IFIW COAUC ; 321 = 209 = D1 Q
IFIW COAUC ; 322 = 210 = D2 R
IFIW COAUC ; 323 = 211 = D3 S
IFIW COAUC ; 324 = 212 = D4 T
IFIW COAUC ; 325 = 213 = D5 U
IFIW COAUC ; 326 = 214 = D6 V
IFIW COAUC ; 327 = 215 = D7 W
IFIW COAUC ; 330 = 216 = D8 X
IFIW COAUC ; 331 = 217 = D9 Y
IFIW COAUC ; 332 = 218 = DA Z
IFIW COAPC ; 333 = 219 = DB [
IFIW COAPC ; 334 = 220 = DC \
IFIW COAPC ; 335 = 221 = DD ]
IFIW COAPC ; 336 = 222 = DE ^
IFIW COAPC ; 337 = 223 = DF _
;CONTINUED ON NEXT PAGE
;ASCII DISPATCH TABLE (CONTINUED)
IFIW COAPC ; 340 = 224 = E0 `
IFIW COALC ; 341 = 225 = E1 a
IFIW COALC ; 342 = 226 = E2 b
IFIW COALC ; 343 = 227 = E3 c
IFIW COALC ; 344 = 228 = E4 d
IFIW COALC ; 345 = 229 = E5 e
IFIW COALC ; 346 = 230 = E6 f
IFIW COALC ; 347 = 231 = E7 g
IFIW COALC ; 350 = 232 = E8 h
IFIW COALC ; 351 = 233 = E9 i
IFIW COALC ; 352 = 234 = EA j
IFIW COALC ; 353 = 235 = EB k
IFIW COALC ; 354 = 236 = EC l
IFIW COALC ; 355 = 237 = ED m
IFIW COALC ; 356 = 238 = EE n
IFIW COALC ; 357 = 239 = EF o
IFIW COALC ; 360 = 240 = F0 p
IFIW COALC ; 361 = 241 = F1 q
IFIW COALC ; 362 = 242 = F2 r
IFIW COALC ; 363 = 243 = F3 s
IFIW COALC ; 364 = 244 = F4 t
IFIW COALC ; 365 = 245 = F5 u
IFIW COALC ; 366 = 246 = F6 v
IFIW COALC ; 367 = 247 = F7 w
IFIW COALC ; 370 = 248 = F8 x
IFIW COALC ; 371 = 249 = F9 y
IFIW COALC ; 372 = 250 = FA z
IFIW COAPC ; 373 = 251 = FB {
IFIW COAPC ; 374 = 252 = FC |
IFIW COAPC ; 375 = 253 = FD }
IFIW COAPC ; 376 = 254 = FE ~
IFIW COACC ; 377 = 255 = FF DEL Control-? Delete
SUBTTL Copy processor - ASCII <=> EBCDIC translation table
;INDEX VIA CHARACTER:
;
; LH = EBCDIC <== ASCII
; RH = EBCDIC ==> ASCII
;
;THIS TABLE IS TAKEN FROM THE VERSION 10 COBOL/LIBOL MANUAL "DEC-10-LCPRA-B-DN1"
ASCEBC: XWD 000, .CHNUL ; 000 = 000 = 00
XWD 001, "\" ; 001 = 001 = 01
XWD 002, "\" ; 002 = 002 = 02
XWD 003, "\" ; 003 = 003 = 03
XWD 067, .CHDC4 ; 004 = 004 = 04
XWD 055, .CHTAB ; 005 = 005 = 05
XWD 056, .CHCNN ; 006 = 006 = 06
XWD 057, .CHDEL ; 007 = 007 = 07
XWD 026, "\" ; 010 = 008 = 08
XWD 005, "\" ; 011 = 009 = 09
XWD 045, "\" ; 012 = 010 = 0A
XWD 013, "\" ; 013 = 011 = 0B
XWD 014, "\" ; 014 = 012 = 0C
XWD 025, "\" ; 015 = 013 = 0D
XWD 006, "\" ; 016 = 014 = 0E
XWD 066, "\" ; 017 = 015 = 0F
XWD 044, "\" ; 020 = 016 = 10
XWD 024, "\" ; 021 = 017 = 11
XWD 064, "\" ; 022 = 018 = 12
XWD 065, .CHCBS ; 023 = 019 = 13
XWD 004, .CHDC1 ; 024 = 020 = 14
XWD 075, .CHCRT ; 025 = 021 = 15
XWD 027, .CHCNH ; 026 = 022 = 16
XWD 046, .CHCNV ; 027 = 023 = 17
XWD 052, "\" ; 030 = 024 = 18
XWD 031, .CHCNY ; 031 = 025 = 19
XWD 032, "\" ; 032 = 026 = 1A
XWD 047, "\" ; 033 = 027 = 1B
XWD 023, "\" ; 034 = 028 = 1C
XWD 041, "\" ; 035 = 029 = 1D
XWD 040, "\" ; 036 = 030 = 1E
XWD 042, "\" ; 037 = 031 = 1F
;CONTINUED ON NEXT PAGE
;ASCII <=> EBCDIC TRANSLATION TABLE (CONTINUED)
XWD 100, .CHCCF ; 040 = 032 = 20
XWD 132, .CHCRB ; 041 = 033 = 21
XWD 177, .CHCUN ; 042 = 034 = 22
XWD 173, "\" ; 043 = 035 = 23
XWD 133, .CHDLE ; 044 = 036 = 24
XWD 154, .CHLFD ; 045 = 037 = 25
XWD 120, .CHCNW ; 046 = 038 = 26
XWD 175, .CHESC ; 047 = 039 = 27
XWD 115, "\" ; 050 = 040 = 28
XWD 135, "\" ; 051 = 041 = 29
XWD 134, .CHCNX ; 052 = 042 = 2A
XWD 116, "\" ; 053 = 043 = 2B
XWD 153, "\" ; 054 = 044 = 2C
XWD 140, .CHCNE ; 055 = 045 = 2D
XWD 113, .CHCNF ; 056 = 046 = 2E
XWD 141, .CHBEL ; 057 = 047 = 2F
XWD 360, "\" ; 060 = 048 = 30
XWD 361, "\" ; 061 = 049 = 31
XWD 362, "\" ; 062 = 050 = 32
XWD 263, "\" ; 063 = 051 = 33
XWD 364, .CHDC2 ; 064 = 052 = 34
XWD 365, .CHDC3 ; 065 = 053 = 35
XWD 366, .CHCNO ; 066 = 054 = 36
XWD 367, .CHCND ; 067 = 055 = 37
XWD 370, "\" ; 070 = 056 = 38
XWD 371, "\" ; 071 = 057 = 39
XWD 172, "\" ; 072 = 058 = 3A
XWD 136, "\" ; 073 = 059 = 3B
XWD 114, "\" ; 074 = 060 = 3C
XWD 176, .CHCNU ; 075 = 061 = 3D
XWD 156, "\" ; 076 = 062 = 3E
XWD 157, "\" ; 077 = 063 = 3F
;CONTINUED ON NEXT PAGE
;ASCII <=> EBCDIC TRANSLATION TABLE (CONTINUED)
XWD 174, " " ; 100 = 064 = 40
XWD 301, "\" ; 101 = 065 = 41
XWD 302, "\" ; 102 = 066 = 42
XWD 303, "\" ; 103 = 067 = 43
XWD 304, "\" ; 104 = 068 = 44
XWD 305, "\" ; 105 = 069 = 45
XWD 306, "\" ; 106 = 070 = 46
XWD 307, "\" ; 107 = 071 = 47
XWD 310, "\" ; 110 = 072 = 48
XWD 311, "\" ; 111 = 073 = 49
XWD 321, "\" ; 112 = 074 = 4A
XWD 322, "." ; 113 = 075 = 4B
XWD 323, "<" ; 114 = 076 = 4C
XWD 324, "(" ; 115 = 077 = 4D
XWD 325, "+" ; 116 = 078 = 4E
XWD 326, "|" ; 117 = 079 = 4F
XWD 327, "&" ; 120 = 080 = 50
XWD 330, "\" ; 121 = 081 = 51
XWD 331, "\" ; 122 = 082 = 52
XWD 342, "\" ; 123 = 083 = 53
XWD 343, "\" ; 124 = 084 = 54
XWD 344, "\" ; 125 = 085 = 55
XWD 345, "\" ; 126 = 086 = 56
XWD 346, "\" ; 127 = 087 = 57
XWD 347, "\" ; 130 = 088 = 58
XWD 350, "\" ; 131 = 089 = 59
XWD 351, "!" ; 132 = 090 = 5A
XWD 340, "$" ; 133 = 091 = 5B
XWD 155, "*" ; 134 = 092 = 5C
XWD 320, ")" ; 135 = 093 = 5D
XWD 117, ";" ; 136 = 094 = 5E
XWD 155, "\" ; 137 = 095 = 5F
;CONTINUED ON NEXT PAGE
;ASCII <=> EBCDIC TRANSLATION TABLE (CONTINUED)
XWD 174, "-" ; 140 = 096 = 60
XWD 201, "/" ; 141 = 097 = 61
XWD 202, "\" ; 142 = 098 = 62
XWD 203, "\" ; 143 = 099 = 63
XWD 204, "\" ; 144 = 100 = 64
XWD 205, "\" ; 145 = 101 = 65
XWD 206, "\" ; 146 = 102 = 66
XWD 207, "\" ; 147 = 103 = 67
XWD 210, "\" ; 150 = 104 = 68
XWD 211, "\" ; 151 = 105 = 69
XWD 221, "\" ; 152 = 106 = 6A
XWD 222, "," ; 153 = 107 = 6B
XWD 223, "%" ; 154 = 108 = 6C
XWD 224, "_" ; 155 = 109 = 6D
XWD 225, ">" ; 156 = 110 = 6E
XWD 226, "?" ; 157 = 111 = 6F
XWD 227, "\" ; 160 = 112 = 70
XWD 230, "\" ; 161 = 113 = 71
XWD 231, "\" ; 162 = 114 = 72
XWD 242, "\" ; 163 = 115 = 73
XWD 243, "\" ; 164 = 116 = 74
XWD 244, "\" ; 165 = 117 = 75
XWD 245, "\" ; 166 = 118 = 76
XWD 246, "\" ; 167 = 119 = 77
XWD 247, "\" ; 170 = 120 = 78
XWD 250, "\" ; 171 = 121 = 79
XWD 251, ":" ; 172 = 122 = 7A
XWD 300, "#" ; 173 = 123 = 7B
XWD 117, "@" ; 174 = 124 = 7C
XWD 260, "'" ; 175 = 125 = 7D
XWD 155, "=" ; 176 = 126 = 7E
XWD 007, """" ; 177 = 127 = 7F
;CONTINUED ON NEXT PAGE
;ASCII <=> EBCDIC TRANSLATION TABLE (CONTINUED)
XWD 000, "\" ; 200 = 128 = 80
XWD 001, "a" ; 201 = 129 = 81
XWD 002, "b" ; 202 = 130 = 82
XWD 003, "c" ; 203 = 131 = 83
XWD 067, "d" ; 204 = 132 = 84
XWD 055, "e" ; 205 = 133 = 85
XWD 056, "f" ; 206 = 134 = 86
XWD 057, "g" ; 207 = 135 = 87
XWD 026, "h" ; 210 = 136 = 88
XWD 005, "i" ; 211 = 137 = 89
XWD 045, "\" ; 212 = 138 = 8A
XWD 013, "\" ; 213 = 139 = 8B
XWD 014, "\" ; 214 = 140 = 8C
XWD 025, "\" ; 215 = 141 = 8D
XWD 006, "\" ; 216 = 142 = 8E
XWD 066, "\" ; 217 = 143 = 8F
XWD 044, "\" ; 220 = 144 = 90
XWD 024, "j" ; 221 = 145 = 91
XWD 064, "k" ; 222 = 146 = 92
XWD 065, "l" ; 223 = 147 = 93
XWD 004, "m" ; 224 = 148 = 94
XWD 075, "n" ; 225 = 149 = 95
XWD 027, "o" ; 226 = 150 = 96
XWD 046, "p" ; 227 = 151 = 97
XWD 052, "q" ; 230 = 152 = 98
XWD 031, "r" ; 231 = 153 = 99
XWD 032, "\" ; 232 = 154 = 9A
XWD 047, "\" ; 233 = 155 = 9B
XWD 023, "\" ; 234 = 156 = 9C
XWD 041, "\" ; 235 = 157 = 9D
XWD 040, "\" ; 236 = 158 = 9E
XWD 042, "\" ; 237 = 159 = 9F
;CONTINUED ON NEXT PAGE
;ASCII <=> EBCDIC TRANSLATION TABLE (CONTINUED)
XWD 100, "\" ; 240 = 160 = A0
XWD 132, "\" ; 241 = 161 = A1
XWD 177, "s" ; 242 = 162 = A2
XWD 173, "t" ; 243 = 163 = A3
XWD 133, "u" ; 244 = 164 = A4
XWD 154, "v" ; 245 = 165 = A5
XWD 120, "w" ; 246 = 166 = A6
XWD 175, "x" ; 247 = 167 = A7
XWD 115, "y" ; 250 = 168 = A8
XWD 135, "z" ; 251 = 169 = A9
XWD 134, "\" ; 252 = 170 = AA
XWD 116, "\" ; 253 = 171 = AB
XWD 153, "\" ; 254 = 172 = AC
XWD 140, "\" ; 255 = 173 = AD
XWD 113, "\" ; 256 = 174 = AE
XWD 141, "\" ; 257 = 175 = AF
XWD 360, "}" ; 260 = 176 = B0
XWD 361, "\" ; 261 = 177 = B1
XWD 362, "\" ; 262 = 178 = B2
XWD 363, "\" ; 263 = 179 = B3
XWD 364, "\" ; 264 = 180 = B4
XWD 465, "\" ; 265 = 181 = B5
XWD 366, "\" ; 266 = 182 = B6
XWD 367, "\" ; 267 = 183 = B7
XWD 370, "\" ; 270 = 184 = B8
XWD 371, "\" ; 271 = 185 = B9
XWD 172, "\" ; 272 = 186 = BA
XWD 136, "\" ; 273 = 187 = BB
XWD 114, "\" ; 274 = 188 = BC
XWD 176, "\" ; 275 = 189 = BD
XWD 156, "\" ; 276 = 190 = BE
XWD 157, "\" ; 277 = 191 = BF
;CONTINUED ON NEXT PAGE
;ASCII <=> EBCDIC TRANSLATION TABLE (CONTINUED)
XWD 174, "{" ; 300 = 192 = C0
XWD 301, "A" ; 301 = 193 = C1
XWD 302, "B" ; 302 = 194 = C2
XWD 303, "C" ; 303 = 195 = C3
XWD 304, "D" ; 304 = 196 = C4
XWD 305, "E" ; 305 = 197 = C5
XWD 306, "F" ; 306 = 198 = C6
XWD 307, "G" ; 307 = 199 = C7
XWD 310, "H" ; 310 = 200 = C8
XWD 311, "I" ; 311 = 201 = C9
XWD 321, "\" ; 312 = 202 = CA
XWD 322, "\" ; 313 = 203 = CB
XWD 323, "\" ; 314 = 204 = CC
XWD 324, "\" ; 315 = 205 = CD
XWD 324, "\" ; 316 = 206 = CE
XWD 326, "\" ; 317 = 207 = CF
XWD 327, "]" ; 320 = 208 = D0
XWD 330, "J" ; 321 = 209 = D1
XWD 331, "K" ; 322 = 210 = D2
XWD 342, "L" ; 323 = 211 = D3
XWD 343, "M" ; 324 = 212 = D4
XWD 344, "N" ; 325 = 213 = D5
XWD 345, "O" ; 326 = 214 = D6
XWD 346, "P" ; 327 = 215 = D7
XWD 347, "Q" ; 330 = 216 = D8
XWD 350, "R" ; 331 = 217 = D9
XWD 351, "\" ; 332 = 218 = DA
XWD 340, "\" ; 333 = 219 = DB
XWD 155, "\" ; 334 = 220 = DC
XWD 320, "\" ; 335 = 221 = DD
XWD 117, "\" ; 336 = 222 = DE
XWD 155, "\" ; 337 = 223 = DF
;CONTINUED ON NEXT PAGE
;ASCII <=> EBCDIC TRANSLATION TABLE (CONTINUED)
XWD 174, "[" ; 340 = 224 = E0
XWD 201, "\" ; 341 = 225 = E1
XWD 202, "S" ; 342 = 226 = E2
XWD 203, "T" ; 343 = 227 = E3
XWD 204, "U" ; 344 = 228 = E4
XWD 205, "V" ; 345 = 229 = E5
XWD 206, "W" ; 346 = 230 = E6
XWD 207, "X" ; 347 = 231 = E7
XWD 210, "Y" ; 350 = 232 = E8
XWD 211, "Z" ; 351 = 233 = E9
XWD 221, "\" ; 352 = 234 = EA
XWD 222, "\" ; 353 = 235 = EB
XWD 223, "\" ; 354 = 236 = EC
XWD 224, "\" ; 355 = 237 = ED
XWD 225, "\" ; 356 = 238 = EE
XWD 226, "\" ; 357 = 239 = EF
XWD 227, "0" ; 360 = 240 = F0
XWD 230, "1" ; 361 = 241 = F1
XWD 231, "2" ; 362 = 242 = F2
XWD 242, "3" ; 363 = 243 = F3
XWD 243, "4" ; 364 = 244 = F4
XWD 244, "5" ; 365 = 245 = F5
XWD 245, "6" ; 366 = 246 = F6
XWD 246, "7" ; 367 = 247 = F7
XWD 247, "8" ; 370 = 248 = F8
XWD 250, "9" ; 371 = 249 = F9
XWD 251, "\" ; 372 = 250 = FA
XWD 300, "\" ; 373 = 251 = FB
XWD 117, "\" ; 374 = 252 = FC
XWD 260, "\" ; 375 = 253 = FD
XWD 155, "\" ; 376 = 254 = FE
XWD 007, "\" ; 377 = 255 = FF
SUBTTL Copy processor - "Byte-At-A-Time" processing
COB: PUSHJ P,COBIF ;SETUP PROCESSING PARAMETERS, ETC.
STOPCD ;CAN'T HAPPEN
MOVE P1,T2 ;POSITION SWITCH MASK
PUSHJ P,COBYT ;DO THE GRUNDGE
POPJ P, ;PROPAGATE FAILURE
JRST .POPJ1## ;SUCCESSFUL
;COBYT - BYTE-AT-A-TIME PROCESSOR LOOP
COBYT: MOVE T1,CI ;ADDRESS OF INPUT CDB
PUSHJ P,@.IOISR(T1) ;GET NEXT INPUT DATA BYTE
JRST COBIE ;CHECK OUT EXCEPTION RETURN
;HERE WITH NEXT VALID DATA BYTE
COBYT5: MOVE T1,CO ;ADDRESS OF OUTPUT CDB
PUSHJ P,@.IOOSR(T1) ;CALL OUTPUT SERVICE ROUTINE
PUSHJ P,NEROU ;I/O ERROR
AOJA P4,COBYT ;COUNT BYTES SUCCESSFULLY OUTPUT
;CAN'T READ INPUT DATA, SEE WHY
COBIE: CAIE M0,$EIEOF ;END OF FILE?
JRST COBIE7 ;NO, I/O ERROR
TXNN P1,US$CON ;YES, CONCATENATING INPUT FILES?
JRST COBYE ;NO, RETURN END OF FILE
COBIE1: PUSHJ P,.NXTFC## ;YES, GO OPEN NEXT CONCATENATED INPUT FILE
JRST COBIE3 ;SEE ABOUT FAILURE
JRST COBYT ;GO GET FIRST DATA BYTE OF NEXT FILE
COBIE3: CAIN M0,$EFIXN ;INPUT STREAM EXHAUSTED?
JRST [MOVEI M0,$EIEOF ;YES, TIME FOR "END-OF-FILE" RETURN
JRST COBYE] ;RETURN END OF FILE
PUSHJ P,NERFAE ;HANDLE FILE ACCESS ERROR
JRST COBYE ;ABORT ON ERROR (TAKE EOF RETURN)
JRST COBIE1 ;CONTINUE ON ERROR
;ISSUE I/O ERROR MESSAGE
JRST COBYT ;I/O ERROR RETRY
COBIE7: PUSHJ P,NERIN ;ISSUE INPUT I/O ERROR MESSAGE
JRST COBYT5 ;I/O ERROR IGNORE/CONTINUE
;HERE ON INPUT EOF
COBYE: CAIN M0,$EIEOF ;EOF CODE?
AOS (P) ;YES, SUCCESSFUL COPY
POPJ P, ;RETURN AS INDICATED
;COBIF - SETUP BINARY CONTROL-PROCESSING BASED ON OUTPUT AND INPUT SWITCHES
;
;Returns US$--- switch processing flags in T2.
COBIF: PUSHJ P,.SAVE4## ;NEED SOME ACS HERE
MOVE P3,.IOFSB(CI) ;ADDRESS OF INPUT FILE SPEC BLOCK
MOVE P4,.IOFSB(CO) ;ADDRESS OF OUTPUT FILE SPEC BLOCK
DMOVE P1,.FXUSW(P4) ;OUTPUT "USER" (FILE) SWITCHES
DMOVE T3,.FXUSW(P3) ;INPUT "USER" SWITCHES
TDZ T3,P2 ;OUTPUT SWITCHES TAKE PRECEDENCE OVER INPUT
TXZE T3,US$EBC ;/EBCDIC ON INPUT?
TXO T3,US$EBI ;YES, REPOSITION INPUT SIDE
IOR P1,T3 ;MERGE OUTPUT WITH INPUT SWITCHES
IOR P2,T4 ;MERGE SWITCH MASK TOO
;NOW SET UP DEFAULTS/ETC.
MOVE T2,P1 ;RETURN IN T2 DUE TO .SAVE4
MOVX P1,IC.LSN ;I/O CONTROL LSN FLAG
ANDCAM P1,.IOIOC(CI) ;DISCARD INPUT LSN'S, IF ANY ENCOUNTERED
JRST .POPJ1## ;SUCCESSFUL RETURN
SUBTTL Copy processor - fast disk-to-disk processing
COD: JRST COB ;HOHUM
SUBTTL Copy processor - fast tape-to-tape processing
COM: JRST COB ;HOHUM
SUBTTL Copy processor - quick buffered-mode processing
COQ: JRST COB ;HOHUM
SUBTTL Copy processor - record-formatted I/O processor
COR: PUSHJ P,COBIF ;SETUP PROCESSING PARAMETERS, ETC.
STOPCD ;CAN'T HAPPEN
MOVE P1,T2 ;POSITION SWITCH MASK
MOVE T1,.IORSZ(CI) ;GET INPUT RECORD SIZE
CAMGE T1,.IORSZ(CO) ;IS OUTPUT BIGGER?
MOVE T1,.IORSZ(CO) ;YES, USE OUTPUT RECORD SIZE THEN
CAIG T1,0 ;GOT A RECORD SIZE?
MOVEI T1,1234 ;NO, HALLUCINATE ONE THEN
MOVEM T1,RSIBT3 ;SAVE FOR ISR CALLS
ADDI T1,3 ;*** 8-BIT BYTES
LSH T1,-2 ;*** 8-BIT BYTES
PUSHJ P,.MMGWD## ;ALLOCATE A RECORD-BUFFER
POPJ P, ;NO MEMORY
DMOVEM T1,RSIBFA ;SAVE THE PAIR
HRLI T2,(POINT 8,) ;CONCOCT A RECORD-BUFFER BYTE POINTER
MOVEM T2,RSIBT4 ;SAVE FOR ISR CALLS
SETZ T1, ;CLEAN SLATE
COR003: LDB T2,[POINTR .IOIOC(CI),IC.RFM] ;INPUT RECORD FORMAT (IF ANY)
CAIE T2,.ICRFU ;IF NO RECORD FORMAT
CAIN T2,.ICRF3 ;OR 36PACK'ED PDP-10 WORDS
JRST COR004 ;THEN INPUT NOT "RECORD-STRUCTURED" I/O
IORI T1,1 ;NOTE INPUT RECORD FORMATTED
MOVX T2,IC.RSI ;SELECT RECORD-STRUCTURED-I/O
IORM T2,.IOIOC(CI) ;AND SET IN CDB FOR .IOIIN
COR004: LDB T2,[POINTR .IOIOC(CO),IC.RFM] ;OUTPUT RECORD FORMAT (IF ANY)
CAIE T2,.ICRFU ;IF NO RECORD FORMAT
CAIN T2,.ICRF3 ;OF 36PACK'ED PDP-10 WORDS
JRST COR005 ;THEN OUTPUT NOT "RECORD-STRUCTURED" I/O
IORI T1,2 ;NOTE OUTPUT RECORD FORMATTED
MOVX T2,IC.RSI ;SELECT RECORD-STRUCTURED-I/O
IORM T2,.IOIOC(CO) ;AND SET IN THE CDB FOR .IOOIN
COR005: PUSHJ P,@[IFIW CORXX ;NO RECORD-STRUCTURE?
IFIW CORIX ;INPUT-ONLY
IFIW COROX ;OUTPUT-ONLY
IFIW CORSI](T1) ;INPUT AND OUTPUT RECORD-FORMATTED
TDZA P1,P1 ;FLAG FILE COPY FAILED
MOVEI P1,1 ;FLAG FILE COPY SUCCEEDED
DMOVE T1,RSIBFA ;GET RECORD BUFFER
PUSHJ P,.MMFWD## ;AND FREE UP THE MEMORY
JFCL ;???
SETZM RSIBFA ;NOTE NO MORE RECORD BUFFER ALLOCATION
ADDM P1,0(P) ;INDICATE APPROPRIATE RETURN
POPJ P, ;AND TAKE IT
;NO RECORD-STRUCTURE????
CORXX: STOPCD
COROX: ERROR CRO,<Can't create record-structured output from non-record-structured input>
;CORIX - INPUT RECORD-FORMATTED, OUTPUT BYTE-ORIENTED
CORIX: MOVE T1,CI ;ADDRESS OF INPUT CDB
SETO T2, ;IGNORE RECORD "ADDRESS"
DMOVE T3,RSIBT3 ;T3 GETS RECORD COUNT, T4 RECORD POINTER
PUSHJ P,@.IOISR(T1) ;GET NEXT INPUT RECORD
JRST CORIE ;CHECK OUT EXCEPTION RETURN
;HERE WITH NEXT VALID DATA RECORD, LOOP OUTPUTTING INDIVIDUAL BYTES
CORIX5: MOVE T1,CO ;ADDRESS OF OUTPUT CDB
JUMPE T3,CORIX ;IGNORE NULL RECORDS
CORIX6: ILDB T2,T4 ;NEXT DATA BYTE
PUSHJ P,@.IOOSR(T1) ;CALL OUTPUT SERVICE ROUTINE
PUSHJ P,NEROU ;I/O ERROR
ADDI P4,1 ;COUNT BYTES SUCCESSFULLY OUTPUT
SOJG T3,CORIX6 ;[20] LOOP FOR ALL BYTES WITHIN RECORD
JRST CORIX ;LOOP FOR ALL RECORDS WITHIN FILE
;CAN'T READ INPUT DATA, SEE WHY
CORIE: CAIE M0,$EIEOF ;END OF FILE?
JRST CORIE7 ;NO, I/O ERROR
TXNN P1,US$CON ;YES, CONCATENATING INPUT FILES?
JRST CORIE9 ;NO, RETURN END OF FILE
CORIE1: PUSHJ P,.NXTFC## ;YES, GO OPEN NEXT CONCATENATED INPUT FILE
JRST CORIE3 ;SEE ABOUT FAILURE
JRST CORIX ;GO GET FIRST DATA RECORD OF NEXT FILE
CORIE3: CAIN M0,$EFIXN ;INPUT STREAM EXHAUSTED?
JRST [MOVEI M0,$EIEOF ;YES, TIME FOR "END-OF-FILE" RETURN
JRST CORIE9] ;RETURN END OF FILE
PUSHJ P,NERFAE ;HANDLE FILE ACCESS ERROR
JRST CORIE9 ;ABORT ON ERROR (TAKE EOF RETURN)
JRST CORIE1 ;CONTINUE ON ERROR
;ISSUE I/O ERROR MESSAGE
JRST CORIX ;I/O ERROR RETRY
CORIE7: PUSHJ P,NERIN ;ISSUE INPUT I/O ERROR MESSAGE
JRST CORIX ;I/O ERROR IGNORE/CONTINUE
;HERE ON INPUT EOF
CORIE9: CAIN M0,$EIEOF ;EOF CODE?
AOS (P) ;YES, SUCCESSFUL COPY
POPJ P, ;RETURN AS INDICATED
;CORSI - RECORD-AT-A-TIME PROCESSOR LOOP
CORSI: MOVE T1,CI ;ADDRESS OF INPUT CDB
SETO T2, ;IGNORE RECORD "ADDRESS"
DMOVE T3,RSIBT3 ;T3 GETS RECORD COUNT, T4 RECORD POINTER
PUSHJ P,@.IOISR(T1) ;GET NEXT INPUT RECORD
JRST CORSE ;CHECK OUT EXCEPTION RETURN
;HERE WITH NEXT VALID DATA RECORD
CORSI5: MOVE T1,CO ;ADDRESS OF OUTPUT CDB
MOVE P3,T3 ;COUNT OF BYTES CONTAINED WITHIN RECORD
PUSHJ P,@.IOOSR(T1) ;CALL OUTPUT SERVICE ROUTINE
PUSHJ P,NEROU ;I/O ERROR
ADD P4,P3 ;COUNT BYTES SUCCESSFULLY OUTPUT
JRST CORSI ;LOOP BACK FOR REST OF FILE
;CAN'T READ INPUT DATA, SEE WHY
CORSE: CAIE M0,$EIEOF ;END OF FILE?
JRST CORSE7 ;NO, I/O ERROR
TXNN P1,US$CON ;YES, CONCATENATING INPUT FILES?
JRST CORSE9 ;NO, RETURN END OF FILE
CORSE1: PUSHJ P,.NXTFC## ;YES, GO OPEN NEXT CONCATENATED INPUT FILE
JRST CORSE3 ;SEE ABOUT FAILURE
JRST CORSI ;GO GET FIRST DATA RECORD OF NEXT FILE
CORSE3: CAIN M0,$EFIXN ;INPUT STREAM EXHAUSTED?
JRST [MOVEI M0,$EIEOF ;YES, TIME FOR "END-OF-FILE" RETURN
JRST CORSE9] ;RETURN END OF FILE
PUSHJ P,NERFAE ;HANDLE FILE ACCESS ERROR
JRST CORSE9 ;ABORT ON ERROR (TAKE EOF RETURN)
JRST CORSE1 ;CONTINUE ON ERROR
;ISSUE I/O ERROR MESSAGE
JRST CORSI ;I/O ERROR RETRY
CORSE7: PUSHJ P,NERIN ;ISSUE INPUT I/O ERROR MESSAGE
JRST CORSI5 ;I/O ERROR IGNORE/CONTINUE
;HERE ON INPUT EOF
CORSE9: CAIN M0,$EIEOF ;EOF CODE?
AOS (P) ;YES, SUCCESSFUL COPY
POPJ P, ;RETURN AS INDICATED
SUBTTL Error routines - File access level
;NERFAE -- TYPE FILE ACCESS ERROR MESSAGE
NERFAE: AOS ERRORS## ;COUNT UP ERRORS
MOVEI T1,CDBLI## ;*** ADDRESS OF INPUT CDB
PUSHJ P,.ERPIN## ;TYPE OUT FILE ACCESS ERROR MESSAGE
PJRST ONERCK## ;WANT TO ABORT COMMAND ON ERROR?
;NERFAB -- ABORT INPUT AND OUTPUT FILES
NERFAB: MOVEI T1,CDBLO## ;FOR THE TIME BEING,
PUSHJ P,.IOABO## ;SO DOES THE OUTPUT FILE
JFCL ;HO HUM
NERFAI: MOVEI T1,CDBLI## ;IN ANY EVENT, THE INPUT FILE
PUSHJ P,.IOABO## ;GETS ABORTED
JFCL ;HO HUM
POPJ P, ;NON-SKIP ALWAYS
SUBTTL Error routines - File I/O level
;NERIN -- ERROR IN INPUT FILE
;
;IF NOT A FATAL I/O ERROR THE CALLER WILL BE RE-EXECUTED
NERIN: PUSHJ P,NEMIN ;ISSUE MESSAGE
JRST NERAB ;ABORT TRANSFER
JRST NERCC ;CONTINUE TRANSFER
;DO THE WORK OF NERIN
NEMIN: AOS ERRORS## ;COUNT UP I/O ERRORS
PUSHJ P,.ERISR## ;ISSUE INPUT SERVICE ERROR MESSAGE
PJRST NEMAC ;SEE IF ABORT OR CONTINUE
;NEROU -- ERROR IN OUTPUT FILE
;
;IF NOT A FATAL I/O ERROR THE CALLER WILL BE RE-EXECUTED
NEROU: PUSHJ P,NEMOU ;ISSUE MESSAGE
JRST NERAB ;ABORT TRANSFER
JRST NERCC ;CONTINUE TRANSFER
;DO THE WORK OF NEROU
NEMOU: AOS ERRORS## ;COUNT UP I/O ERRORS
PUSHJ P,.EROSR## ;ISSUE OUTPUT SERVICE ERROR MESSAGE
PJRST NEMAC ;SEE IF ABORT OR CONTINUE
;NERLS -- ERROR WRITING LSN TO OUTPUT FILE
;
;IF NOT A FATAL I/O ERROR THE CALLER WILL BE RE-EXECUTED
NERLS: PUSHJ P,NEMLS ;ISSUE MESSAGE
JRST NERAB ;ABORT TRANSFER
POPJ P, ;CONTINUED TRANSFER
;DO THE WORK OF NERLS
NEMLS: AOS ERRORS## ;COUNT UP ERRORS
PUSHJ P,.EROSR## ;ISSUE OUTPUT SERVICE ERROR MESSAGE
PJRST NEMAC ;SEE IF CONTINUE OR ABORT
;NERCL - ERROR CLOSING OUTPUT FILE
NERCL: PUSHJ P,NEMCL ;ISSUE MESSAGE
POPJ P, ;ABORT RETURN
JRST .POPJ1## ;SUCCESSFUL RETURN
;DO THE WORK OF NERCL
NEMCL: AOS ERRORS## ;COUNT UP ERRORS
CAIN M0,$EICKE ;REMOTE CHECKSUM FAILURE?
JRST NEMCK ;YES, DIFFERENT
PUSHJ P,ONERCK## ;NO, I/O ERROR, WANT TO ABORT?
ERROR OCF,<Error CLOSEing output file>
WARN OCW,<Error CLOSEing output file>
JRST .POPJ1##
;HERE ON REMOTE-DETECTED CHECKSUM ERROR
NEMCK: PUSHJ P,.EROSR## ;ISSUE OUTPUT ERROR MESSAGE
JRST .POPJ1## ;DO THE CLOSE SANS CHECKSUM
;HELPERS TO NERIN/NEROU
;NEMAC - SEE IF ABORT OR CONTINUE ON ERROR
NEMAC: POPJ P, ;ABORT (CONTINUE NOT YET WRITTEN)
;NEIEC - DO I/O ERROR RECOVERY SO CAN CONTINUE
NEIEC: MOVE T1,-T1(P) ;RETRIEVE SAFE COPY OF CDB ADDRESS
MOVE T2,.IOCCF(T1) ;COPY OF CHANNEL CONTROL
TXNN T2,IO.OPN ;STILL GOT A FILE OPEN?
ERROR IEA,<File aborted, can't continue, aborting>
MOVEI T2,.FUIEC ;FUNCTION: I/O ERROR CONTINUATION
PUSHJ P,.IOFUN## ;TRY TO CONTINUE
ERROR IEC,<I/O error-continuation attempt failed, aborting>
JRST .POPJ1## ;CONTINUE THE TRANSFER
;HERE TO TAKE I/O ABORT RETURN
NERAB: POP P,0(P) ;KILL OUR CALLER
POPJ P, ;AND TAKE HIS ERROR RETURN
;HERE TO TAKE I/O CONTINUE RETURN
NERCC: SOS 0(P) ;BACKUP CALLER'S PC
POPJ P, ;RE-EXECUTE CALLER'S I/O CALL
SUBTTL DDCVFY helper for "D" class commands
;DDCVFY IS USED BY THE "D" CLASS COMMANDS ("DDELETE, DDIRECTORY, ETC.)
;TO VERIFY THAT THE COMMAND REQUESTED CAN BE READILY ASSIMILATED BY
;GOOD OLE CRUFTY DAP
DDCVFY: MOVE T1,SIFIR## ;GET FIRST INPUT SPEC
CAME T1,SILAS## ;EXACTLY ONE SPEC SUPPLIED?
JRST DDCVE1 ;NOPE
SKIPN T2,.FXNOD(T1) ;DOES THE SINGULAR INPUT SPEC HAVE A NODE?
JRST DDCVE2 ;NOPE
;RDH CAMN T2,.MYNOD## ;YES, DOES IT POINT TO A REMOTE NODE?
;RDH JRST DDCVE3 ;NOPE
JRST .POPJ1## ;LOOKS LIKE IT MIGHT WORK
DDCVE1: ERROR DD1,<Only 1 file specification allowed>
DDCVE2: ERROR DD2,<No node specified>
DDCVE3: ERROR DD3,<Specified node is local host>
;DAP-MODE EXECUTION ERRORS
DDCERM: CAIN M0,$EFRNR ;NO REMOTE RENAME SUPPORT?
ERROR RNR,<Remote does not support "RENAME" operation>
CAIN M0,$EFRND ;NO REMOTE DELETE?
ERROR RND,<Remote does not support "DELETE" operation>
CAIN M0,$EFRNX ;NO REMOTE EXECUTE?
ERROR RNX,<Remote does not support "EXECUTE" operation>
CAIN M0,$EFRNL ;NO REMOTE DIRECTORY LIST?
ERROR RNL,<Remote does not support directory list operation>
CAIN M0,$EFRNW ;NO REMOTE WILDCARDS?
ERROR RNW,<Remote does not support wildcard operations>
CAIN M0,$EFRNG ;NO GO/NOGO SUPPORT?
ERROR RNG,<Remote does not support "NO/GONO" option>
CAIN M0,$EFRNC ;NO REMOTE FILE CONSTRAINT?
ERROR RNC,<Remote does not support file constraint switches>
CAIN M0,$EFRNS ;REMOTE NO SUPPORT?
ERROR RNS,<Remote does not support requested functionality>
ERROR DCF,<DAP-mode command failed, code >,.TOCTW##,M0
SUBTTL Variables - Miscellaneous
XLIST ;THE LITERALS
LIT ;THE LITERALS
LIST ;EVERYTHING AFTER THE LITERALS
RELOC 0 ;"VARIABLES" GO INTO THE LOW SEG
TOTBSZ: BLOCK 1 ;SAVED BYTESIZE FOR TOTALS CALCULATION
;NIPFSB: BLOCK .FXMAX ;FILE SPEC BLOCK FOR /INITFILE
SUBTTL Variables - NETWORK command
NETNOD: BLOCK 1 ;SCRATCH LAST NODE NAME USED
NETFSB: BLOCK .FXMAX ;SCRATCH FILE SPEC BLOCK FOR NETWORK COMMAND
SUBTTL Variables - SET DEFAULT command
SDFFIR: BLOCK 1 ;FIRST DEFAULT SPEC
SDFLAS: BLOCK 1 ;LAST DEFAULT SPEC IN CHAIN
SDFMAS: BLOCK 1 ;MASTER DEFAULT SPEC
SUBTTL Variables - Copy processor, ASCII mode
;ASCII copy loop data
S.CSN: BLOCK 1 ;.GT. 0 THEN DOING CARD SEQUENCE NUMBERS
S.CSNC: BLOCK 1 ;CARD SEQUENCE NUMBER COLUMN
S.CSNW: BLOCK 1 ;CARD SEQUENCE NUMBER WIDTH
S.LSN: BLOCK 1 ;.GT. 0 THEN DOING LINE SEQUENCE NUMBERS
S.CRLF: BLOCK 1 ;FREE-CRLF BOUNDRY
S.TINC: BLOCK 1 ;TAB SIZE INCREMENT
S.WRAP: BLOCK 1 ;WORD-WRAP-CRLF BOUNDRY
ASCHAL: BLOCK 1 ;ASCII CHARACTER SAVED BY COALS
ASCHAR: BLOCK 1 ;ASCII CHARACTER TO BE SEEN NEXT
ASCCSN: BLOCK 1 ;CARD SEQUENCE NUMBER
ASCLSN: BLOCK 1 ;LINE SEQUENCE NUMBER
ASCICP: BLOCK 2 ;PROTOTYPE INPUT SAVED COUNTER/POINTER PAIR
ASCOCP: BLOCK 2 ;PROTOTYPE OUTPUT SAVED COUNTER/POINTER PAIR
ASCSTI: BLOCK 1 ;INPUT SAVED BYTE COUNT
ASCSTJ: BLOCK 1 ;INPUT SAVED BYTE POINTER
ASCSTK: BLOCK 1 ;INPUT SAVED STATUS
ASCSTO: BLOCK 1 ;OUTPUT SAVED BYTE COUNT
ASCSTP: BLOCK 1 ;OUTPUT SAVED BYTE POINTER
ASCICB: BLOCK <$SZRSZ+4>/5 ;*** INPUT SPACE COMPRESSION BUFFER
ASCOCB: BLOCK <$SZRSZ+4>/5 ;*** OUTPUT SPACE COMPRESSION BUFFER
SUBTTL Variables - Copy processor, binary/record-structured mode
RSIBFA: BLOCK 2 ;LENGTH, ADDRESS OF RECORD BUFFER
RSIBT3: BLOCK 1 ;BYTE COUNT (T3) FOR ISR
RSIBT4: BLOCK 1 ;BYTE POINTER (T4) FOR ISR
END