Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/24/filest.mac
There are 2 other files named filest.mac in the archive. Click here to see a list.
COMMENT * SIMULA specification;
OPTIONS(/E:QUICK,ZYLILL);
PROCEDURE illegal;
COMMENT Dummy procedure, should not be called from SIMULA.
;
!*;! MACRO-10 code !*;!
SUBTTL FILEST, File definition string
;!*** Copyright 1977 by the Swedish Defence Research Institute. ***
;!*** Copying is allowed. ***
Comment \
Purpose:To form a string from a file lookup/enter block
Input: If X2 is a lookup blk ptr, X0 has sixbit device name.
X1: Destination designator for specification string -
either byte pointer or address of subroutine for
handling one character.
X2: File designator - either REF(file) or pointer to
LOOKUP/ENTER block (may be extended format)
X3: Zero or format control flags (see below)
X4: XWD -n,pointer to work area of n words (for PATH. blk etc)
Output: File specification, one character at a time, in X1.
Each byte is transmitted to the destination via a
subroutine pointed to by XOB in this procedure.
The string format is:
dev:file.ext[path]<prot> (TOPS-10)
str:<directory>file.ext.,Pnnnnnn (TOPS-20)
Protection is only output on demand.
Null fields are not output.
\
TITLE filest, file to string translation
SUBTTL SIMULA utility, Lars Enderin FOA June 1977
SEARCH UUOSYM,SIMMAC,SIMMCR,SIMRPA
SALL
MACINIT
ENTRY .FILST
XOB==X5 ;!Contains instruction to handle one byte in X1.
P==XPDP ;!Push-down pointer
OPDEF OUTOCT [XEC .OUTOC]
OPDEF SIXASC [XEC .SIXAS]
OPDEF FILEST [XEC .FILST]
OPDEF OUTBYTE [XCT XOB]
OPDEF OUTPPN [XEC .OUTPP]
DEFINE OUTC(C)<
LI X1,C
OUTBYTE>
DEFINE DELIM(C)<
LI X1,C
TRNE X7,1
OUTBYTE>
;!Format control bits in X3 (X7):
;!-------------------------
RADIX 10
DEFINE Z(F,M,N)<DF ZJS'F,0,M,N>
DEFINE X(F)<
IRP F,<
N==N+3
Z F,3,\N
>>
DEFINE Y(F)<
IRP F,<N==N+1
Z F,1,\N
>>
DEFINE OUTCHK(f,def)<
STACK def
LF X1,ZJS'f(,X7)
XEC .OUTCK
UNSTK (P)
>
N==-1
X<DEV,DIR,NAM,TYP,GEN,PRO,ACT>
N==20
Y<TMP,SIZ,CRD,LWR,LRD>
N==31
Y<PSD,TBR,TBP,PAF>
RADIX 8
.JSNOF==0
.JSAOF==1
.JSSSD==2
.FILST: PROC
SAVE <X0,X1,X2,X3,X4,X5,X6,X7>
N==1+7
N0==1
N1==N0+1 ;!X1 offset from -N(P)
LOWADR
q==2B<%ZJSDEV>+2B<%ZJSDIR>+1B<%ZJSNAM>+1B<%ZJSTYP>+1B<%ZJSGEN>
q==q+1B<%ZJSTMP>+1B<%ZJSPAF>
SKIPN X7,X3
L X7,[Q] ;!Default
TOPS10,<
IF ;! There is a work area supplied
JUMPE X4,FALSE
THEN ;! Set up path block
HLRZ X1,X4
SETZM (X4)
Q==1+11
IF ;! Big enough
CAIGE X1,Q
GOTO FALSE
THEN ;! Set it up
HRLI (X4)
HRRI 1(X4)
BLT Q-1(X4)
MOVSI Q
HRRI Q(X4)
ST (X4)
SUBI X1,Q
HRLZM X1,1(X4)
FI FI
>
L1():! L X6,X1+N0-N(P)
IF ;!X1 was a string ptr
TLNN X6,-1
GOTO FALSE
THEN
L XOB,[IDPB X1,X6]
ELSE ;!Should be routine address
LI XOB,(X6)
HRLI XOB,(XEC)
FI
IF ;!X2 could be a file ref
LF X1,ZDNTYP(X2)
CAIE X1,QZCL
GOTO FALSE
THEN ;!Check for file prototype
LF X1,ZBIZPR(X2)
LF X1,ZCPGCI(X1)
CAIE X1,QIOFI
GOTO L9
LF ,ZFIDVN(X2) ;!Device
ST N0-N(P)
LF ,ZFICHN(X2) ;!Channel more useful than device
LF X1,ZFIFIL(X2)
IF ;!Pointer to extended lookup/enter blk
TLNE X1,-1
GOTO FALSE
THEN ;!Make X2 point to file name there, flag this
HRROI X2,4(X1)
ELSE ;!Point to ZFIFIL
ADDI X2,OFFSET(ZFIFIL)
FI
ELSE ;!Adjust pointer if extended lookup block
L X1,(X2)
TLNN X1,-1
HRROI X2,.RBNAM(X2)
L N0-N(P)
FI
STACK X2
N==N+1
TOPS10,<
IF ;!There is a work area
SKIPE X4,X4+N0-N(P)
SKIPN (X4)
GOTO FALSE
THEN ;!Check for ersatz device
LI X1,1(X4)
ST (X1)
HRLI X1,11
IF ;!Ersatz
PATH. X1,
GOTO FALSE
L X3,.PTSWT(X1)
TRNN X3,PT.IPP
GOTO FALSE
THEN ;!No SFD please
SETZM .PTPPN+1(X1)
L (X1)
FI
TLNN -1
L (X1)
FI
TLNN -1
L N0-N(P)
IF ;!Output of DEV: is requested
OUTCHK DEV,<['DSK ']>
JUMPE X1,FALSE
THEN ;!DEV:
IF ;!Extended lookup block
JUMPGE X2,FALSE
THEN ;!Find logical device name, then file structure
L X1,.RBDEV-.RBNAM(X2)
JUMPE X1,FALSE
ST X1,5(P)
LI X1,5(P)
HRLI X1,.DCSNM+1
DSKCHR X1,
GOTO FALSE
L .DCSNM+5(P) ;!File structure name
ELSE ;!Get device name
L N0-N(P)
DEVNAM
CAI
FI
SIXASCII
DELIM ":"
FI
>;!TOPS10
TOPS20,<
;!Output dev: or dev:<directory>
L X1,3(X2)
SKIPG X2
L X1,-1(X2)
IF ;!No ppn
JUMPN X1,FALSE
THEN ;!Just output dev: as is
IF
OUTCHK DEV,<['DSK']>
JUMPE X1,FALSE
THEN
SIXASCII
DELIM ":"
FI
ELSE ;!Construct dev:<directory>
L X2,X1
STACK XOB
LI XOB,[IDPB X4
RET]
HRLI XOB,(XEC)
L X4,[POINT 7,5(P)]
SIXASCII
OUTC 0
HRROI X1,YOCTXT(XLOW) ;!Destination string
HRROI X3,5(P) ;!DEV
PPNST%
ERJMP [UNSTK XOB
UNSTK X2
BRANCH L9()]
SKIPA X3,[POINT 7,YOCTXT(XLOW)]
LOOP
OUTBYTE
ILDB X1,X3
AS
JUMPN X1,TRUE
SA
FI
UNSTK XOB
>;!TOPS20
UNSTK X2
N==N-1
IF ;!Filename wanted
TLNN X7,(7B<%ZJSNAM>)
GOTO FALSE
THEN ;!Output it
L (X2)
SIXASCII
DELIM "."
FI
IF ;!Extension wanted
TLNN X7,(7B<%ZJSTYP>)
GOTO FALSE
THEN
HLLZ 1(X2)
SIXASCII
FI
TOPS10,<
L X3,3(X2) ;!PPN or SFD ptr
SKIPG X2
L X3,-1(X2)
L X1,X3
IF ;!No3defined path
JUMPN X3,FALSE
THEN ;!Use device path
IF ;!Path available
SKIPE X4,X4+N0-N(P)
SKIPN (X4)
GOTO FALSE
THEN ;!Use it
LI X3,1(X4)
FI FI
IF ;!Directory suppressed
TLNE X7,(7B<%ZJSDIR>)
GOTO FALSE
THEN SETZ X3,
ELSE
IF ;!Not always output
TLNE X7,(<.JSAOF>B<%ZJSDIR>)
GOTO FALSE
THEN ;!Check for default path
IF ;!Path space available
SKIPE X4,X4+N0-N(P)
SKIPN X1,(X4)
GOTO FALSE
THEN
HLRZ X1
IF ;!Big enough
CAIGE 11
GOTO FALSE
THEN ;!Get default path
LI X1,1(X1)
HRLI X1,11
SETOM (X1)
IF ;!Path is found
PATH. X1,
GOTO FALSE
THEN
IF ;!PPN only
TLNN X3,-1
GOTO FALSE
THEN ;!Check ppn+first SFD
SKIPN .PTPPN+1(X1)
CAME X3,.PTPPN(X1)
GOTO L7 ;!Unequal
GOTO L6 ;!Equal
FI
LI X4,(X3)
HLRZ (X4)
CAIN QZYS
ADDI X4,2
HRLI X1,-6
LOOP
L .PTPPN(X1)
CAME .PTPPN(X4)
GOTO FALSE
JUMPE L6
AS
ADDI X4,1
AOBJN X1,TRUE
L6():! SETZB X1,X3
SA
L7():!
FI FI FI FI FI
IF ;!Path not suppressed
JUMPE X3,FALSE
THEN ;!Output [path]
DELIM "["
IF ;!Not SFD
TLNN X3,-1
GOTO FALSE
THEN ;!Just p,pn
L X3
OUTPPN
ELSE ;!Full path with SFD's
HLRZ (X3) ;!If not a ZYS blk ptr,
CAIE QZYS
SUBI X3,2 ;!Fake overhead
L 4(X3)
OUTPPN
LOOP
L 5(X3)
JUMPE FALSE
OUTC <",">
SIXASCII
AS
AOJA X3,TRUE
SA
FI
DELIM "]"
FI
>;!TOPS10
L X1,[12,,16]
GETTAB X1, ;!Default prot
MOVSI X1,(055B8) ;!Assume 055 on failure
ROT X1,9
LDB [POINT 9,2(X2),8]
IF ;!Protection should be output
JUMPE FALSE
OUTCHK PRO,X1
JUMPE X1,FALSE
THEN ;!Output prot
TOPS10,<
DELIM "<"
OUTOCT
DELIM ">"
>;!TOPS10
TOPS20,<
DELIM ";!"
DELIM "P"
SETZ X1,
LOOP
LI X2,7
AND X2,X0
OR X1,[EXP 77,77,66,56,56,52,12,02](X2)
ROT X1,-6
LSH X0,-3
AS
TLNN X1,77
GOTO TRUE
SA
HLRZ X1
IF
OUTCHK PRO,<[775200]> ;!??
JUMPE X1,FALSE
THEN
STACK
LSH -9
OUTOCT
UNSTK
OUTOCT
FI
>;!TOPS20
FI
L9():! RETURN
EPROC
SUBTTL OUTOCT
;!Input: X0 9-bit number
;! XOB bytehandler instruction (OUTBYTE)
;!Output:ASCII octal digits via X1 to bytehandler
.OUTOC: PROC
JUMPE L9
HRLO
LSH 9
LOOP
LI X1,"0"_-3
ROTC 3
OUTBYTE
AS
TRNE -1 ;!All digits exhausted
GOTO TRUE
SA
L9():! RETURN
EPROC
SUBTTL OUTPPN
;!Input: X0=ppn
;!Output:nnnnnn,nnnnnn (octal digits) via outbyte
.OUTPP: PROC
SAVE X0
N==1
HLRZ 1-N(P)
XEC .OUTP
OUTC <",">
HRRZ 1-N(P)
XEC .OUTP
RETURN
EPROC
.OUTP: ;!Octal number in ascii with zero suppression
IF ;!ZERO
JUMPN FALSE
THEN ;!Just one 0 output
OUTC "0"
ELSE ;!Suppress initial zeros
HRLO ;!Flag in right half
WHILE
TLNE (7B2)
GOTO FALSE
DO
LSH 3
OD
LOOP
LI X1,"0"_-3
ROTC 3
OUTBYTE
AS
TRNE -1
GOTO TRUE
SA
FI
RET
SUBTTL OUTCHK
;!Check if field should be output: X1=value of control field, X0 is current
;!value of field, defaultfield is default value.
;!X1 = 0 if no output should be done.
;!Field value in X0 on return.
.OUTCK: PROC defaultfield
CAIN X1,.JSNOF
GOTO L9
SKIPN
L defaultfield
CAIE X1,.JSAOF
CAME defaultfield
SKIPA X1,[-1]
L9():! SETZ X1,
RET
EPROC
SUBTTL SIXASC
;!Input: SIXBIT word in X0.
;!Output:ASCII characters in X1, to outbyte
.SIXAS::PROC
JUMPE L9
LOOP
SETZ X1,
ROTC 6
ADDI X1," "
OUTBYTE
AS
JUMPN TRUE
SA
L9():! RETURN
EPROC
LIT
END;