Rocksolid Light

Welcome to RetroBBS

mail  files  register  newsreader  groups  login

Message-ID:  

Machines have less problems. I'd like to be a machine. -- Andy Warhol

computers / comp.sys.unisys / Re: Program from Unisys Advanced DMSII Class to list dataset fields

SubjectAuthor
* Program from Unisys Advanced DMSII Class to list dataset fieldsTom Schaefer
`* Re: Program from Unisys Advanced DMSII Class to list dataset fieldsTKosfeld
 `* Re: Program from Unisys Advanced DMSII Class to list dataset fieldsAndrew
  `- Re: Program from Unisys Advanced DMSII Class to list dataset fieldsTKosfeld

1
Program from Unisys Advanced DMSII Class to list dataset fields

<ec6cb015-819b-4e57-8080-01981c4e634en@googlegroups.com>

  copy mid

https://www.rocksolidbbs.com/computers/article-flat.php?id=128&group=comp.sys.unisys#128

  copy link   Newsgroups: comp.sys.unisys
X-Received: by 2002:a7b:c404:0:b0:39c:4389:5834 with SMTP id k4-20020a7bc404000000b0039c43895834mr21941704wmi.70.1655488386726;
Fri, 17 Jun 2022 10:53:06 -0700 (PDT)
X-Received: by 2002:a05:6902:1146:b0:660:9278:80fa with SMTP id
p6-20020a056902114600b00660927880famr11990051ybu.172.1655488386264; Fri, 17
Jun 2022 10:53:06 -0700 (PDT)
Path: i2pn2.org!i2pn.org!aioe.org!news.uzoreto.com!2.eu.feeder.erje.net!feeder.erje.net!proxad.net!feeder1-2.proxad.net!209.85.128.87.MISMATCH!news-out.google.com!nntp.google.com!postnews.google.com!google-groups.googlegroups.com!not-for-mail
Newsgroups: comp.sys.unisys
Date: Fri, 17 Jun 2022 10:53:05 -0700 (PDT)
Injection-Info: google-groups.googlegroups.com; posting-host=47.201.174.91; posting-account=wMZzVQoAAAC5LtCt9val9ojroYZHH5ZL
NNTP-Posting-Host: 47.201.174.91
User-Agent: G2/1.0
MIME-Version: 1.0
Message-ID: <ec6cb015-819b-4e57-8080-01981c4e634en@googlegroups.com>
Subject: Program from Unisys Advanced DMSII Class to list dataset fields
From: thomasmschaefer@gmail.com (Tom Schaefer)
Injection-Date: Fri, 17 Jun 2022 17:53:06 +0000
Content-Type: text/plain; charset="UTF-8"
 by: Tom Schaefer - Fri, 17 Jun 2022 17:53 UTC

A colleague asked me if I knew anybody that might have this program so I said I would ask.

He is looking for a program (I presume it was an example) to list all the fields in a dataset by reading the Description file.

Does anyone have access to those notes? I suspect things may have changed, but if anyone has it, they would be here.

Regards,

Tom Schaefer

Re: Program from Unisys Advanced DMSII Class to list dataset fields

<t8iljt$1f6s$1@gioia.aioe.org>

  copy mid

https://www.rocksolidbbs.com/computers/article-flat.php?id=129&group=comp.sys.unisys#129

  copy link   Newsgroups: comp.sys.unisys
Path: i2pn2.org!i2pn.org!aioe.org!VCF1Gz3n/7BhQwkxszmR1Q.user.46.165.242.75.POSTED!not-for-mail
From: tkosfeld@gmx.net (TKosfeld)
Newsgroups: comp.sys.unisys
Subject: Re: Program from Unisys Advanced DMSII Class to list dataset fields
Date: Fri, 17 Jun 2022 16:45:00 -0300
Organization: Aioe.org NNTP Server
Message-ID: <t8iljt$1f6s$1@gioia.aioe.org>
References: <ec6cb015-819b-4e57-8080-01981c4e634en@googlegroups.com>
Mime-Version: 1.0
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 7bit
Injection-Info: gioia.aioe.org; logging-data="48348"; posting-host="VCF1Gz3n/7BhQwkxszmR1Q.user.gioia.aioe.org"; mail-complaints-to="abuse@aioe.org";
User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:91.0) Gecko/20100101
Thunderbird/91.10.0
X-Antivirus-Status: Clean
X-Notice: Filtered by postfilter v. 0.9.2
Content-Language: en-US
X-Antivirus: Avast (VPS 220617-4, 6/17/2022), Outbound message
 by: TKosfeld - Fri, 17 Jun 2022 19:45 UTC

On 6/17/2022 2:53 PM, Tom Schaefer wrote:
> A colleague asked me if I knew anybody that might have this program so I said I would ask.
>
> He is looking for a program (I presume it was an example) to list all the fields in a dataset by reading the Description file.
>
> Does anyone have access to those notes? I suspect things may have changed, but if anyone has it, they would be here.
>
> Regards,
>
> Tom Schaefer

BEGIN
DEFINE P =POINTER#
,B =BOOLEAN#
%
,NAMEIN(PX,LX) =PX+1 FOR MIN(LX,REAL(PX,1))
," " FOR LX-REAL(PX,1)#
,PRECISION(X) =((FIRSTONE(SCALERIGHTF(X,12))-1).[8:7]+1)#
%
,INIT_BUFO(X) =BEGIN
REPLACE PO:=P(BUFO) BY " " FOR 108;
REPLACE PO:PO BY X FOR 2 DIGITS
," ";
END#
,WRITE_BUFO =WRITE(INFO_FILE,18,BUFO)#
%
,BLOCKF =[47:16]# % BLOCK FIELD OF NODE
,LISTF =[31:16]# % LIST FIELD OF NODE
,PROPF =[15:16]# % PROP FIELD OF NODE
%
,DBLISTEND[N] =DBDESC[(N).LISTF]#
,LISTEND[N] =DESC [(N).LISTF]#
,LISTEND2[N] =DESC2 [(N).LISTF]#
%
,DBPROP[N,F] =DBDESC[(N).PROPF + F]#
,PROP[N,F] =DESC [(N).PROPF + F]#
,PROP2[N,F] =DESC2 [(N).PROPF + F]#
,PROP3[N,F] =DESC3 [(N).PROPF + F]#
%
,DBLISTELEMENT[N,I]
=DBDESC[(N).LISTF + I]#
,LISTELEMENT[N,I] =DESC [(N).LISTF + I]#
,LISTELEMENT2[N,I]=DESC2 [(N).LISTF + I]#
,LISTELEMENT3[N,I]=DESC3 [(N).LISTF + I]#
%
,NAMEOFFSET =2# % OFFSET TO THE NAME OF RESTART DS
;
FILE INFO_FILE
(KIND =PACK
,MAXRECSIZE=18
,BLOCKSIZE =540
,FRAMESIZE =48
,NEWFILE =TRUE
,FILEUSE =OUT
)
;
REAL DBNODE % DATA BASE NODE
,DSSTRUCTURE % STR. NODE OF DATASET
,LDBSTRUCTURE % NODE OF LDB
,SETLIST % NODE TO LIST OF SETS
;
BOOLEAN LDBB % LOGICAL DB IN SPEC.
,LDBSETSB % SET ID'S ARE IN LDB
;
ARRAY REFERENCE DBDESC[0] % DBNODE BUFFER
;
ARRAY BUFO[0:17]
,FLD_NAME_IX[0:1023]
;
EBCDIC ARRAY RDSNAME[0:17] % RESTART DATA SET
,FLD_NAMES[0:9999]
,LDBRDSNAME[0:17] % RESTART DATA SET ON LDB LIST
;
POINTER PO
,PFN
;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
PROCEDURE OVERLAYERR;
FORWARD;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
$INCLUDE PROPERTIES = "DATABASE/59189/PROPERTIES" 20000000-26999999
$INCLUDE PROPERTIES = "DATABASE/59189/PROPERTIES" 28000000-29999999
$INCLUDE PROPERTIES = "DATABASE/59189/PROPERTIES" 33800000-33999999
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
PROCEDURE OVERLAYERR;
BEGIN
DISPLAY("FATAL ERROR");
END OF OVERLAYERR;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
PROCEDURE GET_INFO_DB;
BEGIN
REAL LN
,LEN
,LDBTOP
,LDBNODE
;
EBCDIC ARRAY WK[0:255]
;
POINTER PWK
;
ARRAY REFERENCE DESC[0]
,DESC2[0]
;
%
DASOPEN;
%
INIT_BUFO(01);
REPLACE PWK:=WK BY DASDL.TITLE;
IF PWK="*"
THEN REPLACE PO:PO BY "*"
," " FOR 17
ELSE BEGIN
PWK:=*+1;
REPLACE PO:PO BY PWK:PWK FOR LEN:17 UNTIL=")"
," " FOR LEN+1;
END;
PWK:=*+1;
IF PWK="DESCRIPTION/"
THEN PWK:=*+12;
REPLACE PO:PO BY PWK:PWK FOR LEN:17 WHILE IN ALPHA
," " FOR LEN+1;
IF PWK=" ON "
THEN REPLACE PO:PO BY PWK+4 FOR LEN:17 WHILE IN ALPHA
," " FOR LEN+1
ELSE REPLACE PO:PO BY "DISK"
," " FOR 14;
REPLACE PWK:=WK BY DASDL.HOSTNAME;
REPLACE PO:PO BY PWK FOR LEN:17 WHILE IN ALPHA
," " FOR LEN+1;
WRITE_BUFO;
%
READPROP(0,DESC);
DBNODE:=DESC[DBNODELOC];
LOCKPROP(DBNODE.BLOCKF,DBDESC);
%
IF LDBB % SET UP LOGICAL DB
THEN BEGIN
LDBNODE := DBDESC[DBPROP[DBNODE,LOGICALDATABASENODE]];
READPROP(LDBNODE.BLOCKF,DESC);
LDBTOP := LISTEND[LDBNODE];
LN := 0;
WHILE LN := * + 1 <= LDBTOP
DO BEGIN
LDBSTRUCTURE := LISTELEMENT[LDBNODE,LN];
IF LDBSTRUCTURE.LISTF NEQ 4"0000"
THEN BEGIN
READPROP(LDBSTRUCTURE.BLOCKF,DESC2);
% P(PROP2[LDBSTRUCTURE,WORDONE])
END;
END;
END;
END GET_INFO_DB;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
PROCEDURE GET_INFO_DATASET_ITEMS(DSSTRUCTURE,RDS);
VALUE DSSTRUCTURE,RDS;
REAL DSSTRUCTURE;
BOOLEAN RDS;
BEGIN
REAL I
,J
,T
,IT
,LV
,ITEM
,ITEMNODE
,ITEMTOP
,DEPENDITEM
;
ARRAY REFERENCE DESC[0]
;
POINTER PN
;
%
PFN:=FLD_NAMES;
REPLACE FLD_NAME_IX BY 0 FOR SIZE(FLD_NAME_IX) WORDS;
%
READPROP(DSSTRUCTURE.BLOCKF, DESC);
ITEMNODE := DESC[PROP[DSSTRUCTURE,DATAITEMNODE]];
READPROP(ITEMNODE.BLOCKF, DESC);
ITEMTOP := LISTEND[ITEMNODE];
IT := 0;
WHILE IT := * + 1 <= ITEMTOP
DO BEGIN
ITEM := LISTELEMENT[ITEMNODE,IT];
T := PROP[ITEM,TYPEF];
IF T >= TYP
THEN BEGIN
INIT_BUFO(03);
PN:=P(PROP[ITEM,WORDONE]);
REPLACE PO:PO BY PROP[ITEM,ITEMNUM] FOR 3 DIGITS
," "
,PROP[ITEM,LEVELF] FOR 2 DIGITS
," ";
CASE T
OF BEGIN
GRP: REPLACE PO:PO BY "GRP ";
BOLN: REPLACE PO:PO BY "BOLN"
FLD: REPLACE PO:PO BY "FLD ";
ALPH: REPLACE PO:PO BY "ALPH";
DECI: REPLACE PO:PO BY "DECI"
DECF: REPLACE PO:PO BY "DECF";
BINI: REPLACE PO:PO BY "BINI"
BINF: REPLACE PO:PO BY "BINF";
BFLT: IF RDS
THEN BEGIN
REPLACE PO:PO BY "XXXX";
PROP[ITEM,DECLAREDLENGTH]:=6;
PROP[ITEM,SIGNF]:=0;
END
ELSE IF PROP[ITEM,RSNFLD]=1
THEN REPLACE PO:PO BY "RSN "
ELSE REPLACE PO:PO BY "BFLT"
ELSE: REPLACE PO:PO BY T FOR 4 DIGITS
END;
REPLACE PO:PO BY " "
,PROP[ITEM,DECLAREDLENGTH] FOR 5 DIGITS
," "
,PROP[ITEM,SCALEFACTOR] FOR 2 DIGITS
," "
,PROP[ITEM,SIGNF] FOR 1 DIGITS
," "
,PROP[ITEM,TOTALSZ] FOR 5 DIGITS
," "
,PROP[ITEM,REQUIREDF] FOR 1 DIGITS
," "
,PROP[ITEM,NUMSUBSCRIPTS] FOR 3 DIGITS
," ";
IF PROP[ITEM,VFTYPE]^=0
THEN REPLACE PO:PO BY PROP[ITEM,VFTYPE] FOR 2 DIGITS
," "
ELSE REPLACE PO:PO BY " ";
IF B(PROP[ITEM,OCCURSF])
THEN REPLACE PO:PO BY PROP[ITEM,OCCURSMAX] FOR 5 DIGITS
," "
ELSE REPLACE PO:PO BY " ";
% IF PROP[ITEM,OCCURSTYPE] = OCCDEPENDING
% THEN BEGIN
% A[DEPENDSC] := 1;
% DEPENDITEM := LISTELEMENT[ITEMNODE,PROP[ITEM,
% OCCURSVARIABLE]];
% REPLACE PTEMP BY P(PROP[DEPENDITEM,WORDONE]) FOR
% (REAL(P(PROP[DEPENDITEM,WORDONE]),1)+1);
% END
% ELSE A[DEPENDSC] := 0;
REPLACE PO BY NAMEIN(PN,30);
WRITE_BUFO;
%
FLD_NAME_IX[PROP[ITEM,ITEMNUM]]:=OFFSET(PFN);
REPLACE PFN:PFN BY PN FOR REAL(PN,1)+1;
END;
END;
END GET_INFO_DATASET_ITEMS;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
PROCEDURE GET_INFO_SET;
BEGIN
REAL I
,IX
,OP
,WL
,LEN
,SEQ
,STR
,LSTR
,KITEM
,SETTOP
,KNODE
,KDNODE
,KEYTOP
;
BOOLEAN WB
;
ARRAY REFERENCE DESC [0]
,DESC2[0]
,DESC3[0]
,TEXT [0]
;
POINTER PN
,PW
;
%
READPROP(SETLIST.BLOCKF, DESC);
SETTOP := IF SETLIST IS 0 THEN 0 ELSE LISTEND[SETLIST];
I := 0;
WHILE I := * + 1 <=SETTOP
DO BEGIN
IF LDBSETSB
THEN BEGIN
LSTR := LISTELEMENT[SETLIST,I];
READPROP(LSTR.BLOCKF,DESC2);
STR := DBLISTELEMENT[DBNODE,PROP2[LSTR,STRUCTURENUM]];
END
ELSE BEGIN
LSTR := DBLISTELEMENT[DBNODE,LISTELEMENT[SETLIST,I]];
READPROP(LSTR.BLOCKF, DESC2);
READPROPTEXT(LSTR.BLOCKF,DESC2,TEXT);
STR := LSTR;
END;
PN:=P(PROP2[LSTR,WORDONE]);
INIT_BUFO(04);
REPLACE PO:PO BY NAMEIN(PN,17)
," "
,PROP2[LSTR,DUPSALLOWED] FOR 1 DIGITS
," "
,PROP2[LSTR,DUPSFIRST] FOR 1 DIGITS
," "
,PROP2[LSTR,DUPSLAST] FOR 1 DIGITS
," "
,PROP2[LSTR,KEYCHANGEALLOW] FOR 1 DIGITS
," "
,PROP2[LSTR,SUBSETF] FOR 1 DIGITS
," "
,PROP2[LSTR,WHERELIST] FOR 4 DIGITS
," "
,PROP2[LSTR,WHERELISTSZ] FOR 3 DIGITS
," "
,PROP2[LSTR,KEYCOUNT] FOR 2 DIGITS
," "
,PROP2[LSTR,KEYDATACOUNT] FOR 2 DIGITS
," "
,PROP2[LSTR,SUBTYPEF] FOR 2 DIGITS;
WRITE_BUFO;
IF WL:=PROP2[LSTR,WHERELIST]^=0
THEN BEGIN
INIT_BUFO(08);
REPLACE PO:PO BY SEQ:=1 FOR 4 DIGITS
," "
," ";
IX:=0;
PW:=P(DESC2[WL]);
WHILE OP:=REAL(PW,2) ISNT 4"000A"
DO BEGIN
PW:=*+2;
CASE OP.[15:04]
OF BEGIN
00: %
CASE OP.[11:12]
OF BEGIN
15: REPLACE PO:PO BY "( ";
16: REPLACE PO:PO BY " )";
11: REPLACE PO:PO BY " LT ";
32: REPLACE PO:PO BY " LE ";
22: REPLACE PO:PO BY " EQ ";
33: REPLACE PO:PO BY " NE ";
34: REPLACE PO:PO BY " GE ";
21: REPLACE PO:PO BY " GT ";
31: BEGIN
WRITE_BUFO;
INIT_BUFO(08);
REPLACE PO:PO BY (SEQ:=*+1) FOR 4 DIGITS
," ";
REPLACE PO:PO BY "O ";
END;
30: BEGIN
WRITE_BUFO;
INIT_BUFO(08);
REPLACE PO:PO BY (SEQ:=*+1) FOR 4 DIGITS
," ";
REPLACE PO:PO BY "E ";
END;
24: REPLACE PO:PO BY " NOT ";
10: REPLACE PO:PO BY " LB";
ELSE:
REPLACE PO:PO BY OP.[11:12] FOR * DIGITS;
END; % Case
01: %
PN:=FLD_NAMES[FLD_NAME_IX[OP.[11:12]]];
IF OFFSET(PO)>40
THEN REPLACE PO:PO BY "C ";
REPLACE PO:PO BY PN+1 FOR REAL(PN,1)
," " FOR 40-REAL(PN,1);
PW:=*+2;
02: %
PW:=*+2;
03: %
;
04: %
;
09: %
IF OP.[11:12]=1
THEN REPLACE PO:PO BY "TRUE"
ELSE REPLACE PO:PO BY "FALSE";
10: %
LEN:=OP.[11:12];
REPLACE PO:PO BY "K '"
,PW FOR LEN
,"'"
," " FOR 38-LEN;
IF LEN MOD 2 = 1
THEN LEN:=*+1;
PW:=*+LEN;
11: %
PW:=*+2;
LEN:=OP.[11:12];
REPLACE PO:PO BY "K "
,PW FOR LEN
," " FOR 40-LEN;
IF LEN MOD 2 = 1
THEN LEN:=*+1;
PW:=*+LEN;
12: %
;
ELSE: %
;
END; % Case
IF READLOCK(FALSE,WB)
THEN BEGIN
WRITE_BUFO;
INIT_BUFO(08);
REPLACE PO:PO BY (SEQ:=*+1) FOR 4 DIGITS
," ";
END;
END; % While
WRITE_BUFO;
END;
%
KNODE:=DESC2[PROP2[LSTR,KEYNODE]];
KDNODE:=DESC2[PROP2[LSTR,KEYDATANODE]];
IF KNODE.BLOCKF^=0
THEN BEGIN
READPROP(KNODE.BLOCKF,DESC3);
KEYTOP:=LISTEND[KNODE];
IX:=0;
WHILE IX:=*+1 <= KEYTOP
DO BEGIN
KITEM:=LISTELEMENT3[KNODE,IX];
INIT_BUFO(05);
REPLACE PO:PO BY IX FOR 3 DIGITS
," "
,KITEM.[11:12] FOR 3 DIGITS
," "
,KITEM.[39:12] FOR 5 DIGITS
," "
,KITEM.[27:16] FOR 5 DIGITS
," "
,KITEM.[46:01] FOR 1 DIGITS
," "
,KITEM.[45:06] FOR 2 DIGITS;
WRITE_BUFO;
END;
END;
%
IF KDNODE.BLOCKF^=0
THEN BEGIN
READPROP(KDNODE.BLOCKF,DESC3);
KEYTOP:=LISTEND[KDNODE];
IX:=0;
WHILE IX:=*+1 <= KEYTOP
DO BEGIN
KITEM:=LISTELEMENT3[KDNODE,IX];
INIT_BUFO(06);
REPLACE PO:PO BY IX FOR 3 DIGITS
," "
,KITEM.[11:12] FOR 3 DIGITS
," "
,KITEM.[39:12] FOR 5 DIGITS
," "
,KITEM.[27:16] FOR 5 DIGITS
," "
,KITEM.[46:01] FOR 1 DIGITS
," "
,KITEM.[45:06] FOR 2 DIGITS;
WRITE_BUFO;
END;
END;
END;
END GET_INFO_SET;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
PROCEDURE GET_INFO_DATASET;
BEGIN
REAL I
,LN
,SN
,LTOP
,SETS
,DBTOP
;
ARRAY REFERENCE DESC[0]
,DESC2[0]
,TEXT[0]
;
POINTER PN
;
IF LDBB
THEN BEGIN
READPROP(LDBSTRUCTURE.BLOCKF,DESC2);
LTOP := LISTEND2[LDBSTRUCTURE];
I := 0;
WHILE I := * + 1 <= LTOP
DO BEGIN
DSSTRUCTURE := LISTELEMENT2[LDBSTRUCTURE,I];
READPROP(DSSTRUCTURE.BLOCKF,DESC );
% P(PROP[DSSTRUCTURE,WORDONE])
END;
SETS := PROP[DSSTRUCTURE,SETSF];
LDBSETSB := SETS = SETSLIST;
SETLIST := IF LDBSETSB THEN DSSTRUCTURE ELSE 0;
DSSTRUCTURE := % SET UP TO POINT AT ACTUAL DB PROPS
DBLISTELEMENT[DBNODE,PROP[DSSTRUCTURE,STRUCTURENUM]];
READPROP(DSSTRUCTURE.BLOCKF,DESC);
IF SETS = SETSALL OR SETS = SETSEMPTY
THEN SETLIST := DSSTRUCTURE;
END
ELSE BEGIN % NOT SPECIFIED LDB
DBTOP := DBLISTEND[DBNODE];
SN := 0;
WHILE SN := * + 1 <= DBTOP
DO BEGIN
DSSTRUCTURE := DBLISTELEMENT[DBNODE,SN];
READPROP(DSSTRUCTURE.BLOCKF, DESC);
READPROPTEXT(DSSTRUCTURE.BLOCKF,DESC,TEXT);
I := PROP[DSSTRUCTURE,TYPEF];
INIT_BUFO(02);
PN:=P(PROP[DSSTRUCTURE,WORDONE]);
REPLACE PO:PO BY NAMEIN(PN,17)
," ";
PN:=P(TEXT[PROP[DSSTRUCTURE,DESCTEXT]]);
REPLACE PO:PO BY NAMEIN(PN,40)
," "
,PROP[DSSTRUCTURE,SUBTYPEF] FOR 2 DIGITS
," "
," " % BDOTIMIZ
," "
,PROP[DSSTRUCTURE,ITEMNUM] FOR 5 DIGITS;
%
SETLIST := DSSTRUCTURE;
%
IF PROP[DSSTRUCTURE,TYPEF] = DATASET
THEN BEGIN
WRITE_BUFO;
GET_INFO_DATASET_ITEMS(DSSTRUCTURE
,PROP[DSSTRUCTURE,RESTARTDATASETF]=1);
GET_INFO_SET;
END;
END;
END;
END GET_INFO_DATASET;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
PROCEDURE GET_INFO_RDS;
BEGIN
REAL I
,RDSSN,STR,LTOP
;
POINTER Q
;
ARRAY REFERENCE DESC[0]
,DESC2[0]
;
REPLACE RDSNAME BY " " FOR 18;
REPLACE LDBRDSNAME BY " " FOR 18;
RDSSN := DBPROP[DBNODE,RESTARTDATASETSN];
STR := DBLISTELEMENT[DBNODE,RDSSN];
READPROP(STR.BLOCKF,DESC);
REPLACE RDSNAME BY Q:= P(PROP[STR,WORDONE]) FOR (REAL(Q,1)+1);
IF LDBB
THEN BEGIN
READPROP(LDBSTRUCTURE.BLOCKF, DESC);
LTOP := LISTEND[LDBSTRUCTURE];
I := 0;
WHILE I := * + 1 <= LTOP
DO BEGIN
STR := LISTELEMENT[LDBSTRUCTURE,I];
READPROP(STR.BLOCKF, DESC2);
IF PROP2[STR,STRUCTURENUM] = RDSSN
THEN BEGIN
REPLACE LDBRDSNAME BY
Q := P(PROP2[STR,NAMEOFFSET]) FOR
(REAL(Q,1)+1);
IF RDSNAME NEQ LDBRDSNAME FOR 18
THEN REPLACE RDSNAME BY LDBRDSNAME FOR 18;
END;
END;
END;
END GET_INFO_RDS;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%% OUTER BLOCK %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
OPEN(INFO_FILE);
%
GET_INFO_DB;
GET_INFO_DATASET;
%
CLOSE(INFO_FILE,CRUNCH);
%
END.


Click here to read the complete article
Re: Program from Unisys Advanced DMSII Class to list dataset fields

<t8iomd$j7o$2@gioia.aioe.org>

  copy mid

https://www.rocksolidbbs.com/computers/article-flat.php?id=130&group=comp.sys.unisys#130

  copy link   Newsgroups: comp.sys.unisys
Path: i2pn2.org!i2pn.org!aioe.org!iNGj/luDezKLilfl3oxwcA.user.46.165.242.75.POSTED!not-for-mail
From: Doug@hyperspace.vogon.gov (Andrew)
Newsgroups: comp.sys.unisys
Subject: Re: Program from Unisys Advanced DMSII Class to list dataset fields
Date: Fri, 17 Jun 2022 22:37:33 +0200
Organization: Aioe.org NNTP Server
Message-ID: <t8iomd$j7o$2@gioia.aioe.org>
References: <ec6cb015-819b-4e57-8080-01981c4e634en@googlegroups.com>
<t8iljt$1f6s$1@gioia.aioe.org>
Mime-Version: 1.0
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 8bit
Injection-Info: gioia.aioe.org; logging-data="19704"; posting-host="iNGj/luDezKLilfl3oxwcA.user.gioia.aioe.org"; mail-complaints-to="abuse@aioe.org";
User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101
Firefox/68.0 SeaMonkey/2.53.10.2
X-Notice: Filtered by postfilter v. 0.9.2
 by: Andrew - Fri, 17 Jun 2022 20:37 UTC

TKosfeld wrote:
> On 6/17/2022 2:53 PM, Tom Schaefer wrote:
>> A colleague asked me if I knew anybody that might have this program so
>> I said I would ask.
>>
>> He is looking for a program (I presume it was an example) to list all
>> the fields in a dataset by reading the Description file.
>>
>> Does anyone have access to those notes? I suspect things may have
>> changed, but if anyone has it, they would be here.
>>
>> Regards,
>>
>> Tom Schaefer
>
>    BEGIN
>    DEFINE P                =POINTER#
>          ,B                =BOOLEAN#
>          %
>          ,NAMEIN(PX,LX)    =PX+1 FOR MIN(LX,REAL(PX,1))
>                             ," " FOR LX-REAL(PX,1)#
>          ,PRECISION(X)     =((FIRSTONE(SCALERIGHTF(X,12))-1).[8:7]+1)#
>          %
>          ,INIT_BUFO(X)     =BEGIN
>                             REPLACE PO:=P(BUFO) BY " " FOR 108;
>                             REPLACE PO:PO BY X FOR 2 DIGITS
>                                             ," ";
>                             END#
>          ,WRITE_BUFO       =WRITE(INFO_FILE,18,BUFO)#
>          %
>          ,BLOCKF           =[47:16]#      % BLOCK FIELD OF NODE
>          ,LISTF            =[31:16]#      % LIST FIELD OF NODE
>          ,PROPF            =[15:16]#      % PROP FIELD OF NODE
>          %
>          ,DBLISTEND[N]     =DBDESC[(N).LISTF]#
>          ,LISTEND[N]       =DESC  [(N).LISTF]#
>          ,LISTEND2[N]      =DESC2 [(N).LISTF]#
>          %
>          ,DBPROP[N,F]      =DBDESC[(N).PROPF + F]#
>          ,PROP[N,F]        =DESC  [(N).PROPF + F]#
>          ,PROP2[N,F]       =DESC2 [(N).PROPF + F]#
>          ,PROP3[N,F]       =DESC3 [(N).PROPF + F]#
>          %
>          ,DBLISTELEMENT[N,I]
>                            =DBDESC[(N).LISTF + I]#
>          ,LISTELEMENT[N,I] =DESC  [(N).LISTF + I]#
>          ,LISTELEMENT2[N,I]=DESC2 [(N).LISTF + I]#
>          ,LISTELEMENT3[N,I]=DESC3 [(N).LISTF + I]#
>          %
>          ,NAMEOFFSET       =2#  % OFFSET TO THE NAME OF RESTART DS
>          ;
>    FILE INFO_FILE
>           (KIND      =PACK
>           ,MAXRECSIZE=18
>           ,BLOCKSIZE =540
>           ,FRAMESIZE =48
>           ,NEWFILE   =TRUE
>           ,FILEUSE   =OUT
>           )
>        ;
>    REAL DBNODE                    % DATA BASE NODE
>        ,DSSTRUCTURE               % STR. NODE OF DATASET
>        ,LDBSTRUCTURE              % NODE OF LDB
>        ,SETLIST                   % NODE TO LIST OF SETS
>        ;
>    BOOLEAN LDBB                   % LOGICAL DB IN SPEC.
>           ,LDBSETSB               % SET ID'S ARE IN LDB
>           ;
>    ARRAY REFERENCE DBDESC[0]      % DBNODE BUFFER
>                   ;
>    ARRAY BUFO[0:17]
>         ,FLD_NAME_IX[0:1023]
>         ;
>    EBCDIC ARRAY RDSNAME[0:17]     % RESTART DATA SET
>                ,FLD_NAMES[0:9999]
>                ,LDBRDSNAME[0:17]  % RESTART DATA SET ON LDB LIST
>                ;
>    POINTER PO
>           ,PFN
>           ;
>    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>    PROCEDURE OVERLAYERR;
>    FORWARD;
>    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>  $INCLUDE PROPERTIES = "DATABASE/59189/PROPERTIES" 20000000-26999999
>  $INCLUDE PROPERTIES = "DATABASE/59189/PROPERTIES" 28000000-29999999
>  $INCLUDE PROPERTIES = "DATABASE/59189/PROPERTIES" 33800000-33999999
>    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>    PROCEDURE OVERLAYERR;
>    BEGIN
>    DISPLAY("FATAL ERROR");
>    END OF OVERLAYERR;
>    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>    PROCEDURE GET_INFO_DB;
>    BEGIN
>    REAL LN
>        ,LEN
>        ,LDBTOP
>        ,LDBNODE
>        ;
>    EBCDIC ARRAY WK[0:255]
>                ;
>    POINTER PWK
>           ;
>    ARRAY REFERENCE DESC[0]
>                   ,DESC2[0]
>                   ;
>    %
>    DASOPEN;
>    %
>    INIT_BUFO(01);
>    REPLACE PWK:=WK BY DASDL.TITLE;
>    IF PWK="*"
>    THEN REPLACE PO:PO BY "*"
>                         ," " FOR 17
>    ELSE BEGIN
>         PWK:=*+1;
>         REPLACE PO:PO BY PWK:PWK FOR LEN:17 UNTIL=")"
>                         ," " FOR LEN+1;
>         END;
>    PWK:=*+1;
>    IF PWK="DESCRIPTION/"
>    THEN PWK:=*+12;
>    REPLACE PO:PO BY PWK:PWK FOR LEN:17 WHILE IN ALPHA
>                    ," " FOR LEN+1;
>    IF PWK=" ON "
>    THEN REPLACE PO:PO BY PWK+4 FOR LEN:17 WHILE IN ALPHA
>                         ," " FOR LEN+1
>    ELSE REPLACE PO:PO BY "DISK"
>                         ," " FOR 14;
>    REPLACE PWK:=WK BY DASDL.HOSTNAME;
>    REPLACE PO:PO BY PWK FOR LEN:17 WHILE IN ALPHA
>                    ," " FOR LEN+1;
>    WRITE_BUFO;
>    %
>    READPROP(0,DESC);
>    DBNODE:=DESC[DBNODELOC];
>    LOCKPROP(DBNODE.BLOCKF,DBDESC);
>    %
>    IF LDBB            % SET UP LOGICAL DB
>    THEN BEGIN
>         LDBNODE := DBDESC[DBPROP[DBNODE,LOGICALDATABASENODE]];
>         READPROP(LDBNODE.BLOCKF,DESC);
>         LDBTOP := LISTEND[LDBNODE];
>         LN := 0;
>         WHILE  LN := * + 1 <= LDBTOP
>         DO BEGIN
>            LDBSTRUCTURE := LISTELEMENT[LDBNODE,LN];
>            IF LDBSTRUCTURE.LISTF NEQ 4"0000"
>            THEN BEGIN
>                 READPROP(LDBSTRUCTURE.BLOCKF,DESC2);
>                 % P(PROP2[LDBSTRUCTURE,WORDONE])
>                 END;
>            END;
>         END;
>    END GET_INFO_DB;
>    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>    PROCEDURE GET_INFO_DATASET_ITEMS(DSSTRUCTURE,RDS);
>    VALUE   DSSTRUCTURE,RDS;
>    REAL    DSSTRUCTURE;
>    BOOLEAN RDS;
>    BEGIN
>    REAL I
>        ,J
>        ,T
>        ,IT
>        ,LV
>        ,ITEM
>        ,ITEMNODE
>        ,ITEMTOP
>        ,DEPENDITEM
>        ;
>    ARRAY REFERENCE DESC[0]
>                   ;
>    POINTER PN
>           ;
>    %
>    PFN:=FLD_NAMES;
>    REPLACE FLD_NAME_IX BY 0 FOR SIZE(FLD_NAME_IX) WORDS;
>    %
>    READPROP(DSSTRUCTURE.BLOCKF, DESC);
>    ITEMNODE := DESC[PROP[DSSTRUCTURE,DATAITEMNODE]];
>    READPROP(ITEMNODE.BLOCKF, DESC);
>    ITEMTOP := LISTEND[ITEMNODE];
>    IT := 0;
>    WHILE IT := * + 1 <= ITEMTOP
>    DO BEGIN
>       ITEM := LISTELEMENT[ITEMNODE,IT];
>       T := PROP[ITEM,TYPEF];
>       IF T >= TYP
>       THEN BEGIN
>            INIT_BUFO(03);
>            PN:=P(PROP[ITEM,WORDONE]);
>            REPLACE PO:PO BY PROP[ITEM,ITEMNUM] FOR 3 DIGITS
>                            ," "
>                            ,PROP[ITEM,LEVELF] FOR 2 DIGITS
>                            ," ";
>            CASE T
>            OF BEGIN
>                GRP: REPLACE PO:PO BY "GRP ";
>               BOLN: REPLACE PO:PO BY "BOLN"
>                FLD: REPLACE PO:PO BY "FLD ";
>               ALPH: REPLACE PO:PO BY "ALPH";
>               DECI: REPLACE PO:PO BY "DECI"
>               DECF: REPLACE PO:PO BY "DECF";
>               BINI: REPLACE PO:PO BY "BINI"
>               BINF: REPLACE PO:PO BY "BINF";
>               BFLT: IF RDS
>                     THEN BEGIN
>                          REPLACE PO:PO BY "XXXX";
>                          PROP[ITEM,DECLAREDLENGTH]:=6;
>                          PROP[ITEM,SIGNF]:=0;
>                          END
>                     ELSE IF PROP[ITEM,RSNFLD]=1
>                          THEN REPLACE PO:PO BY "RSN "
>                          ELSE REPLACE PO:PO BY "BFLT"
>               ELSE: REPLACE PO:PO BY T FOR 4 DIGITS
>               END;
>            REPLACE PO:PO BY " "
>                            ,PROP[ITEM,DECLAREDLENGTH] FOR 5 DIGITS
>                            ," "
>                            ,PROP[ITEM,SCALEFACTOR] FOR 2 DIGITS
>                            ," "
>                            ,PROP[ITEM,SIGNF] FOR 1 DIGITS
>                            ," "
>                            ,PROP[ITEM,TOTALSZ] FOR 5 DIGITS
>                            ," "
>                            ,PROP[ITEM,REQUIREDF] FOR 1 DIGITS
>                            ," "
>                            ,PROP[ITEM,NUMSUBSCRIPTS] FOR 3 DIGITS
>                            ," ";
>            IF PROP[ITEM,VFTYPE]^=0
>            THEN REPLACE PO:PO BY PROP[ITEM,VFTYPE] FOR 2 DIGITS
>                                 ," "
>            ELSE REPLACE PO:PO BY "   ";
>            IF B(PROP[ITEM,OCCURSF])
>            THEN REPLACE PO:PO BY PROP[ITEM,OCCURSMAX] FOR 5 DIGITS
>                                 ," "
>            ELSE REPLACE PO:PO BY "      ";
>  %         IF PROP[ITEM,OCCURSTYPE] = OCCDEPENDING
>  %         THEN BEGIN
>  %              A[DEPENDSC] := 1;
>  %              DEPENDITEM := LISTELEMENT[ITEMNODE,PROP[ITEM,
>  %                OCCURSVARIABLE]];
>  %              REPLACE PTEMP BY P(PROP[DEPENDITEM,WORDONE]) FOR
>  %                (REAL(P(PROP[DEPENDITEM,WORDONE]),1)+1);
>  %              END
>  %         ELSE A[DEPENDSC] := 0;
>            REPLACE PO BY NAMEIN(PN,30);
>            WRITE_BUFO;
>            %
>            FLD_NAME_IX[PROP[ITEM,ITEMNUM]]:=OFFSET(PFN);
>            REPLACE PFN:PFN BY PN FOR REAL(PN,1)+1;
>            END;
>       END;
>    END GET_INFO_DATASET_ITEMS;
>    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>    PROCEDURE GET_INFO_SET;
>    BEGIN
>    REAL I
>        ,IX
>        ,OP
>        ,WL
>        ,LEN
>        ,SEQ
>        ,STR
>        ,LSTR
>        ,KITEM
>        ,SETTOP
>        ,KNODE
>        ,KDNODE
>        ,KEYTOP
>        ;
>    BOOLEAN WB
>           ;
>    ARRAY REFERENCE DESC [0]
>                   ,DESC2[0]
>                   ,DESC3[0]
>                   ,TEXT [0]
>                   ;
>    POINTER PN
>           ,PW
>           ;
>    %
>    READPROP(SETLIST.BLOCKF, DESC);
>    SETTOP := IF SETLIST IS 0 THEN 0 ELSE LISTEND[SETLIST];
>    I := 0;
>    WHILE I := * + 1 <=SETTOP
>    DO BEGIN
>       IF LDBSETSB
>       THEN BEGIN
>            LSTR := LISTELEMENT[SETLIST,I];
>            READPROP(LSTR.BLOCKF,DESC2);
>            STR := DBLISTELEMENT[DBNODE,PROP2[LSTR,STRUCTURENUM]];
>            END
>       ELSE BEGIN
>            LSTR := DBLISTELEMENT[DBNODE,LISTELEMENT[SETLIST,I]];
>            READPROP(LSTR.BLOCKF, DESC2);
>            READPROPTEXT(LSTR.BLOCKF,DESC2,TEXT);
>            STR := LSTR;
>            END;
>       PN:=P(PROP2[LSTR,WORDONE]);
>       INIT_BUFO(04);
>       REPLACE PO:PO BY NAMEIN(PN,17)
>                       ,"  "
>                       ,PROP2[LSTR,DUPSALLOWED] FOR 1 DIGITS
>                       ," "
>                       ,PROP2[LSTR,DUPSFIRST] FOR 1 DIGITS
>                       ," "
>                       ,PROP2[LSTR,DUPSLAST] FOR 1 DIGITS
>                       ," "
>                       ,PROP2[LSTR,KEYCHANGEALLOW] FOR 1 DIGITS
>                       ," "
>                       ,PROP2[LSTR,SUBSETF] FOR 1 DIGITS
>                       ," "
>                       ,PROP2[LSTR,WHERELIST] FOR 4 DIGITS
>                       ," "
>                       ,PROP2[LSTR,WHERELISTSZ] FOR 3 DIGITS
>                       ," "
>                       ,PROP2[LSTR,KEYCOUNT] FOR 2 DIGITS
>                       ," "
>                       ,PROP2[LSTR,KEYDATACOUNT] FOR 2 DIGITS
>                       ," "
>                       ,PROP2[LSTR,SUBTYPEF] FOR 2 DIGITS;
>       WRITE_BUFO;
>       IF WL:=PROP2[LSTR,WHERELIST]^=0
>       THEN BEGIN
>            INIT_BUFO(08);
>            REPLACE PO:PO BY SEQ:=1 FOR 4 DIGITS
>                            ," "
>                            ,"  ";
>            IX:=0;
>            PW:=P(DESC2[WL]);
>            WHILE OP:=REAL(PW,2) ISNT 4"000A"
>            DO BEGIN
>               PW:=*+2;
>               CASE OP.[15:04]
>               OF BEGIN
>                  00: %
>                      CASE OP.[11:12]
>                      OF BEGIN
>                         15: REPLACE PO:PO BY "(  ";
>                         16: REPLACE PO:PO BY " )";
>                         11: REPLACE PO:PO BY " LT ";
>                         32: REPLACE PO:PO BY " LE ";
>                         22: REPLACE PO:PO BY " EQ ";
>                         33: REPLACE PO:PO BY " NE ";
>                         34: REPLACE PO:PO BY " GE ";
>                         21: REPLACE PO:PO BY " GT ";
>                         31: BEGIN
>                             WRITE_BUFO;
>                             INIT_BUFO(08);
>                             REPLACE PO:PO BY (SEQ:=*+1) FOR 4 DIGITS
>                                             ," ";
>                             REPLACE PO:PO BY "O ";
>                             END;
>                         30: BEGIN
>                             WRITE_BUFO;
>                             INIT_BUFO(08);
>                             REPLACE PO:PO BY (SEQ:=*+1) FOR 4 DIGITS
>                                             ," ";
>                             REPLACE PO:PO BY "E ";
>                             END;
>                         24: REPLACE PO:PO BY " NOT ";
>                         10: REPLACE PO:PO BY " LB";
>                         ELSE:
>                             REPLACE PO:PO BY OP.[11:12] FOR * DIGITS;
>                         END; % Case
>                  01: %
>                      PN:=FLD_NAMES[FLD_NAME_IX[OP.[11:12]]];
>                      IF OFFSET(PO)>40
>                      THEN REPLACE PO:PO BY "C ";
>                      REPLACE PO:PO BY PN+1 FOR REAL(PN,1)
>                                      ," " FOR 40-REAL(PN,1);
>                      PW:=*+2;
>                  02: %
>                      PW:=*+2;
>                  03: %
>                      ;
>                  04: %
>                      ;
>                  09: %
>                      IF OP.[11:12]=1
>                      THEN REPLACE PO:PO BY "TRUE"
>                      ELSE REPLACE PO:PO BY "FALSE";
>                  10: %
>                      LEN:=OP.[11:12];
>                      REPLACE PO:PO BY "K '"
>                                      ,PW FOR LEN
>                                      ,"'"
>                                      ," " FOR 38-LEN;
>                      IF LEN MOD 2 = 1
>                      THEN LEN:=*+1;
>                      PW:=*+LEN;
>                  11: %
>                      PW:=*+2;
>                      LEN:=OP.[11:12];
>                      REPLACE PO:PO BY "K "
>                                      ,PW FOR LEN
>                                      ," " FOR 40-LEN;
>                      IF LEN MOD 2 = 1
>                      THEN LEN:=*+1;
>                      PW:=*+LEN;
>                  12: %
>                      ;
>                  ELSE: %
>                      ;
>                  END; % Case
>               IF READLOCK(FALSE,WB)
>               THEN BEGIN
>                    WRITE_BUFO;
>                    INIT_BUFO(08);
>                    REPLACE PO:PO BY (SEQ:=*+1) FOR 4 DIGITS
>                                    ," ";
>                    END;
>               END; % While
>            WRITE_BUFO;
>            END;
>       %
>       KNODE:=DESC2[PROP2[LSTR,KEYNODE]];
>       KDNODE:=DESC2[PROP2[LSTR,KEYDATANODE]];
>       IF KNODE.BLOCKF^=0
>       THEN BEGIN
>            READPROP(KNODE.BLOCKF,DESC3);
>            KEYTOP:=LISTEND[KNODE];
>            IX:=0;
>            WHILE IX:=*+1 <= KEYTOP
>            DO BEGIN
>               KITEM:=LISTELEMENT3[KNODE,IX];
>               INIT_BUFO(05);
>               REPLACE PO:PO BY IX FOR 3 DIGITS
>                               ," "
>                               ,KITEM.[11:12] FOR 3 DIGITS
>                               ," "
>                               ,KITEM.[39:12] FOR 5 DIGITS
>                               ," "
>                               ,KITEM.[27:16] FOR 5 DIGITS
>                               ," "
>                               ,KITEM.[46:01] FOR 1 DIGITS
>                               ," "
>                               ,KITEM.[45:06] FOR 2 DIGITS;
>               WRITE_BUFO;
>               END;
>            END;
>       %
>       IF KDNODE.BLOCKF^=0
>       THEN BEGIN
>            READPROP(KDNODE.BLOCKF,DESC3);
>            KEYTOP:=LISTEND[KDNODE];
>            IX:=0;
>            WHILE IX:=*+1 <= KEYTOP
>            DO BEGIN
>               KITEM:=LISTELEMENT3[KDNODE,IX];
>               INIT_BUFO(06);
>               REPLACE PO:PO BY IX FOR 3 DIGITS
>                               ," "
>                               ,KITEM.[11:12] FOR 3 DIGITS
>                               ," "
>                               ,KITEM.[39:12] FOR 5 DIGITS
>                               ," "
>                               ,KITEM.[27:16] FOR 5 DIGITS
>                               ," "
>                               ,KITEM.[46:01] FOR 1 DIGITS
>                               ," "
>                               ,KITEM.[45:06] FOR 2 DIGITS;
>               WRITE_BUFO;
>               END;
>            END;
>       END;
>    END GET_INFO_SET;
>    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>    PROCEDURE GET_INFO_DATASET;
>    BEGIN
>    REAL I
>        ,LN
>        ,SN
>        ,LTOP
>        ,SETS
>        ,DBTOP
>        ;
>    ARRAY REFERENCE DESC[0]
>                   ,DESC2[0]
>                   ,TEXT[0]
>                   ;
>    POINTER PN
>           ;
>    IF LDBB
>    THEN BEGIN
>         READPROP(LDBSTRUCTURE.BLOCKF,DESC2);
>         LTOP := LISTEND2[LDBSTRUCTURE];
>         I := 0;
>         WHILE I := * + 1 <= LTOP
>         DO BEGIN
>            DSSTRUCTURE := LISTELEMENT2[LDBSTRUCTURE,I];
>            READPROP(DSSTRUCTURE.BLOCKF,DESC );
>            % P(PROP[DSSTRUCTURE,WORDONE])
>            END;
>         SETS := PROP[DSSTRUCTURE,SETSF];
>         LDBSETSB := SETS = SETSLIST;
>         SETLIST := IF LDBSETSB THEN DSSTRUCTURE ELSE 0;
>         DSSTRUCTURE :=            % SET UP TO POINT AT ACTUAL DB PROPS
>           DBLISTELEMENT[DBNODE,PROP[DSSTRUCTURE,STRUCTURENUM]];
>         READPROP(DSSTRUCTURE.BLOCKF,DESC);
>         IF SETS = SETSALL OR SETS = SETSEMPTY
>         THEN SETLIST := DSSTRUCTURE;
>         END
>    ELSE BEGIN               % NOT SPECIFIED LDB
>         DBTOP := DBLISTEND[DBNODE];
>         SN := 0;
>         WHILE SN := * + 1 <= DBTOP
>         DO BEGIN
>            DSSTRUCTURE := DBLISTELEMENT[DBNODE,SN];
>            READPROP(DSSTRUCTURE.BLOCKF, DESC);
>            READPROPTEXT(DSSTRUCTURE.BLOCKF,DESC,TEXT);
>            I := PROP[DSSTRUCTURE,TYPEF];
>            INIT_BUFO(02);
>            PN:=P(PROP[DSSTRUCTURE,WORDONE]);
>            REPLACE PO:PO BY NAMEIN(PN,17)
>                            ," ";
>            PN:=P(TEXT[PROP[DSSTRUCTURE,DESCTEXT]]);
>            REPLACE PO:PO BY NAMEIN(PN,40)
>                            ," "
>                            ,PROP[DSSTRUCTURE,SUBTYPEF] FOR 2 DIGITS
>                            ," "
>                            ," "  % BDOTIMIZ
>                            ," "
>                            ,PROP[DSSTRUCTURE,ITEMNUM] FOR 5 DIGITS;
>            %
>            SETLIST := DSSTRUCTURE;
>            %
>            IF PROP[DSSTRUCTURE,TYPEF] = DATASET
>            THEN BEGIN
>                 WRITE_BUFO;
>                 GET_INFO_DATASET_ITEMS(DSSTRUCTURE
>                         ,PROP[DSSTRUCTURE,RESTARTDATASETF]=1);
>                 GET_INFO_SET;
>                 END;
>            END;
>         END;
>    END GET_INFO_DATASET;
>    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>    PROCEDURE GET_INFO_RDS;
>    BEGIN
>    REAL I
>        ,RDSSN,STR,LTOP
>        ;
>    POINTER Q
>           ;
>    ARRAY REFERENCE DESC[0]
>                   ,DESC2[0]
>                   ;
>    REPLACE RDSNAME BY " " FOR 18;
>    REPLACE LDBRDSNAME BY " " FOR 18;
>    RDSSN := DBPROP[DBNODE,RESTARTDATASETSN];
>    STR := DBLISTELEMENT[DBNODE,RDSSN];
>    READPROP(STR.BLOCKF,DESC);
>    REPLACE RDSNAME BY Q:= P(PROP[STR,WORDONE]) FOR (REAL(Q,1)+1);
>    IF LDBB
>    THEN BEGIN
>         READPROP(LDBSTRUCTURE.BLOCKF, DESC);
>         LTOP := LISTEND[LDBSTRUCTURE];
>         I := 0;
>         WHILE I := * + 1 <= LTOP
>         DO BEGIN
>            STR := LISTELEMENT[LDBSTRUCTURE,I];
>            READPROP(STR.BLOCKF, DESC2);
>            IF PROP2[STR,STRUCTURENUM] = RDSSN
>            THEN BEGIN
>                  REPLACE LDBRDSNAME BY
>                   Q := P(PROP2[STR,NAMEOFFSET]) FOR
>                        (REAL(Q,1)+1);
>                 IF RDSNAME NEQ LDBRDSNAME FOR 18
>                 THEN REPLACE RDSNAME BY LDBRDSNAME FOR 18;
>                 END;
>            END;
>         END;
>    END GET_INFO_RDS;
>    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>    %%%%%%%%%%%%%%%%%%%%% OUTER BLOCK %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>    %
>    OPEN(INFO_FILE);
>    %
>    GET_INFO_DB;
>    GET_INFO_DATASET;
>    %
>    CLOSE(INFO_FILE,CRUNCH);
>    %
>    END.
>
>


Click here to read the complete article
Re: Program from Unisys Advanced DMSII Class to list dataset fields

<t8irl4$1le1$1@gioia.aioe.org>

  copy mid

https://www.rocksolidbbs.com/computers/article-flat.php?id=131&group=comp.sys.unisys#131

  copy link   Newsgroups: comp.sys.unisys
Path: i2pn2.org!i2pn.org!aioe.org!VCF1Gz3n/7BhQwkxszmR1Q.user.46.165.242.75.POSTED!not-for-mail
From: tkosfeld@gmx.net (TKosfeld)
Newsgroups: comp.sys.unisys
Subject: Re: Program from Unisys Advanced DMSII Class to list dataset fields
Date: Fri, 17 Jun 2022 18:28:03 -0300
Organization: Aioe.org NNTP Server
Message-ID: <t8irl4$1le1$1@gioia.aioe.org>
References: <ec6cb015-819b-4e57-8080-01981c4e634en@googlegroups.com>
<t8iljt$1f6s$1@gioia.aioe.org> <t8iomd$j7o$2@gioia.aioe.org>
Mime-Version: 1.0
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 8bit
Injection-Info: gioia.aioe.org; logging-data="54721"; posting-host="VCF1Gz3n/7BhQwkxszmR1Q.user.gioia.aioe.org"; mail-complaints-to="abuse@aioe.org";
User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:91.0) Gecko/20100101
Thunderbird/91.10.0
X-Antivirus-Status: Clean
X-Antivirus: Avast (VPS 220617-4, 6/17/2022), Outbound message
Content-Language: en-US
X-Notice: Filtered by postfilter v. 0.9.2
 by: TKosfeld - Fri, 17 Jun 2022 21:28 UTC

On 6/17/2022 5:37 PM, Andrew wrote:
> TKosfeld wrote:
>> On 6/17/2022 2:53 PM, Tom Schaefer wrote:
>>> A colleague asked me if I knew anybody that might have this program
>>> so I said I would ask.
>>>
>>> He is looking for a program (I presume it was an example) to list all
>>> the fields in a dataset by reading the Description file.
>>>
>>> Does anyone have access to those notes? I suspect things may have
>>> changed, but if anyone has it, they would be here.
>>>
>>> Regards,
>>>
>>> Tom Schaefer
>>
>>     BEGIN
>>     DEFINE P                =POINTER#
>>           ,B                =BOOLEAN#
>>           %
>>           ,NAMEIN(PX,LX)    =PX+1 FOR MIN(LX,REAL(PX,1))
>>                              ," " FOR LX-REAL(PX,1)#
>>           ,PRECISION(X)     =((FIRSTONE(SCALERIGHTF(X,12))-1).[8:7]+1)#
>>           %
>>           ,INIT_BUFO(X)     =BEGIN
>>                              REPLACE PO:=P(BUFO) BY " " FOR 108;
>>                              REPLACE PO:PO BY X FOR 2 DIGITS
>>                                              ," ";
>>                              END#
>>           ,WRITE_BUFO       =WRITE(INFO_FILE,18,BUFO)#
>>           %
>>           ,BLOCKF           =[47:16]#      % BLOCK FIELD OF NODE
>>           ,LISTF            =[31:16]#      % LIST FIELD OF NODE
>>           ,PROPF            =[15:16]#      % PROP FIELD OF NODE
>>           %
>>           ,DBLISTEND[N]     =DBDESC[(N).LISTF]#
>>           ,LISTEND[N]       =DESC  [(N).LISTF]#
>>           ,LISTEND2[N]      =DESC2 [(N).LISTF]#
>>           %
>>           ,DBPROP[N,F]      =DBDESC[(N).PROPF + F]#
>>           ,PROP[N,F]        =DESC  [(N).PROPF + F]#
>>           ,PROP2[N,F]       =DESC2 [(N).PROPF + F]#
>>           ,PROP3[N,F]       =DESC3 [(N).PROPF + F]#
>>           %
>>           ,DBLISTELEMENT[N,I]
>>                             =DBDESC[(N).LISTF + I]#
>>           ,LISTELEMENT[N,I] =DESC  [(N).LISTF + I]#
>>           ,LISTELEMENT2[N,I]=DESC2 [(N).LISTF + I]#
>>           ,LISTELEMENT3[N,I]=DESC3 [(N).LISTF + I]#
>>           %
>>           ,NAMEOFFSET       =2#  % OFFSET TO THE NAME OF RESTART DS
>>           ;
>>     FILE INFO_FILE
>>            (KIND      =PACK
>>            ,MAXRECSIZE=18
>>            ,BLOCKSIZE =540
>>            ,FRAMESIZE =48
>>            ,NEWFILE   =TRUE
>>            ,FILEUSE   =OUT
>>            )
>>         ;
>>     REAL DBNODE                    % DATA BASE NODE
>>         ,DSSTRUCTURE               % STR. NODE OF DATASET
>>         ,LDBSTRUCTURE              % NODE OF LDB
>>         ,SETLIST                   % NODE TO LIST OF SETS
>>         ;
>>     BOOLEAN LDBB                   % LOGICAL DB IN SPEC.
>>            ,LDBSETSB               % SET ID'S ARE IN LDB
>>            ;
>>     ARRAY REFERENCE DBDESC[0]      % DBNODE BUFFER
>>                    ;
>>     ARRAY BUFO[0:17]
>>          ,FLD_NAME_IX[0:1023]
>>          ;
>>     EBCDIC ARRAY RDSNAME[0:17]     % RESTART DATA SET
>>                 ,FLD_NAMES[0:9999]
>>                 ,LDBRDSNAME[0:17]  % RESTART DATA SET ON LDB LIST
>>                 ;
>>     POINTER PO
>>            ,PFN
>>            ;
>>     %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>>     PROCEDURE OVERLAYERR;
>>     FORWARD;
>>     %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>>   $INCLUDE PROPERTIES = "DATABASE/59189/PROPERTIES" 20000000-26999999
>>   $INCLUDE PROPERTIES = "DATABASE/59189/PROPERTIES" 28000000-29999999
>>   $INCLUDE PROPERTIES = "DATABASE/59189/PROPERTIES" 33800000-33999999
>>     %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>>     PROCEDURE OVERLAYERR;
>>     BEGIN
>>     DISPLAY("FATAL ERROR");
>>     END OF OVERLAYERR;
>>     %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>>     PROCEDURE GET_INFO_DB;
>>     BEGIN
>>     REAL LN
>>         ,LEN
>>         ,LDBTOP
>>         ,LDBNODE
>>         ;
>>     EBCDIC ARRAY WK[0:255]
>>                 ;
>>     POINTER PWK
>>            ;
>>     ARRAY REFERENCE DESC[0]
>>                    ,DESC2[0]
>>                    ;
>>     %
>>     DASOPEN;
>>     %
>>     INIT_BUFO(01);
>>     REPLACE PWK:=WK BY DASDL.TITLE;
>>     IF PWK="*"
>>     THEN REPLACE PO:PO BY "*"
>>                          ," " FOR 17
>>     ELSE BEGIN
>>          PWK:=*+1;
>>          REPLACE PO:PO BY PWK:PWK FOR LEN:17 UNTIL=")"
>>                          ," " FOR LEN+1;
>>          END;
>>     PWK:=*+1;
>>     IF PWK="DESCRIPTION/"
>>     THEN PWK:=*+12;
>>     REPLACE PO:PO BY PWK:PWK FOR LEN:17 WHILE IN ALPHA
>>                     ," " FOR LEN+1;
>>     IF PWK=" ON "
>>     THEN REPLACE PO:PO BY PWK+4 FOR LEN:17 WHILE IN ALPHA
>>                          ," " FOR LEN+1
>>     ELSE REPLACE PO:PO BY "DISK"
>>                          ," " FOR 14;
>>     REPLACE PWK:=WK BY DASDL.HOSTNAME;
>>     REPLACE PO:PO BY PWK FOR LEN:17 WHILE IN ALPHA
>>                     ," " FOR LEN+1;
>>     WRITE_BUFO;
>>     %
>>     READPROP(0,DESC);
>>     DBNODE:=DESC[DBNODELOC];
>>     LOCKPROP(DBNODE.BLOCKF,DBDESC);
>>     %
>>     IF LDBB            % SET UP LOGICAL DB
>>     THEN BEGIN
>>          LDBNODE := DBDESC[DBPROP[DBNODE,LOGICALDATABASENODE]];
>>          READPROP(LDBNODE.BLOCKF,DESC);
>>          LDBTOP := LISTEND[LDBNODE];
>>          LN := 0;
>>          WHILE  LN := * + 1 <= LDBTOP
>>          DO BEGIN
>>             LDBSTRUCTURE := LISTELEMENT[LDBNODE,LN];
>>             IF LDBSTRUCTURE.LISTF NEQ 4"0000"
>>             THEN BEGIN
>>                  READPROP(LDBSTRUCTURE.BLOCKF,DESC2);
>>                  % P(PROP2[LDBSTRUCTURE,WORDONE])
>>                  END;
>>             END;
>>          END;
>>     END GET_INFO_DB;
>>     %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>>     PROCEDURE GET_INFO_DATASET_ITEMS(DSSTRUCTURE,RDS);
>>     VALUE   DSSTRUCTURE,RDS;
>>     REAL    DSSTRUCTURE;
>>     BOOLEAN RDS;
>>     BEGIN
>>     REAL I
>>         ,J
>>         ,T
>>         ,IT
>>         ,LV
>>         ,ITEM
>>         ,ITEMNODE
>>         ,ITEMTOP
>>         ,DEPENDITEM
>>         ;
>>     ARRAY REFERENCE DESC[0]
>>                    ;
>>     POINTER PN
>>            ;
>>     %
>>     PFN:=FLD_NAMES;
>>     REPLACE FLD_NAME_IX BY 0 FOR SIZE(FLD_NAME_IX) WORDS;
>>     %
>>     READPROP(DSSTRUCTURE.BLOCKF, DESC);
>>     ITEMNODE := DESC[PROP[DSSTRUCTURE,DATAITEMNODE]];
>>     READPROP(ITEMNODE.BLOCKF, DESC);
>>     ITEMTOP := LISTEND[ITEMNODE];
>>     IT := 0;
>>     WHILE IT := * + 1 <= ITEMTOP
>>     DO BEGIN
>>        ITEM := LISTELEMENT[ITEMNODE,IT];
>>        T := PROP[ITEM,TYPEF];
>>        IF T >= TYP
>>        THEN BEGIN
>>             INIT_BUFO(03);
>>             PN:=P(PROP[ITEM,WORDONE]);
>>             REPLACE PO:PO BY PROP[ITEM,ITEMNUM] FOR 3 DIGITS
>>                             ," "
>>                             ,PROP[ITEM,LEVELF] FOR 2 DIGITS
>>                             ," ";
>>             CASE T
>>             OF BEGIN
>>                 GRP: REPLACE PO:PO BY "GRP ";
>>                BOLN: REPLACE PO:PO BY "BOLN"
>>                 FLD: REPLACE PO:PO BY "FLD ";
>>                ALPH: REPLACE PO:PO BY "ALPH";
>>                DECI: REPLACE PO:PO BY "DECI"
>>                DECF: REPLACE PO:PO BY "DECF";
>>                BINI: REPLACE PO:PO BY "BINI"
>>                BINF: REPLACE PO:PO BY "BINF";
>>                BFLT: IF RDS
>>                      THEN BEGIN
>>                           REPLACE PO:PO BY "XXXX";
>>                           PROP[ITEM,DECLAREDLENGTH]:=6;
>>                           PROP[ITEM,SIGNF]:=0;
>>                           END
>>                      ELSE IF PROP[ITEM,RSNFLD]=1
>>                           THEN REPLACE PO:PO BY "RSN "
>>                           ELSE REPLACE PO:PO BY "BFLT"
>>                ELSE: REPLACE PO:PO BY T FOR 4 DIGITS
>>                END;
>>             REPLACE PO:PO BY " "
>>                             ,PROP[ITEM,DECLAREDLENGTH] FOR 5 DIGITS
>>                             ," "
>>                             ,PROP[ITEM,SCALEFACTOR] FOR 2 DIGITS
>>                             ," "
>>                             ,PROP[ITEM,SIGNF] FOR 1 DIGITS
>>                             ," "
>>                             ,PROP[ITEM,TOTALSZ] FOR 5 DIGITS
>>                             ," "
>>                             ,PROP[ITEM,REQUIREDF] FOR 1 DIGITS
>>                             ," "
>>                             ,PROP[ITEM,NUMSUBSCRIPTS] FOR 3 DIGITS
>>                             ," ";
>>             IF PROP[ITEM,VFTYPE]^=0
>>             THEN REPLACE PO:PO BY PROP[ITEM,VFTYPE] FOR 2 DIGITS
>>                                  ," "
>>             ELSE REPLACE PO:PO BY "   ";
>>             IF B(PROP[ITEM,OCCURSF])
>>             THEN REPLACE PO:PO BY PROP[ITEM,OCCURSMAX] FOR 5 DIGITS
>>                                  ," "
>>             ELSE REPLACE PO:PO BY "      ";
>>   %         IF PROP[ITEM,OCCURSTYPE] = OCCDEPENDING
>>   %         THEN BEGIN
>>   %              A[DEPENDSC] := 1;
>>   %              DEPENDITEM := LISTELEMENT[ITEMNODE,PROP[ITEM,
>>   %                OCCURSVARIABLE]];
>>   %              REPLACE PTEMP BY P(PROP[DEPENDITEM,WORDONE]) FOR
>>   %                (REAL(P(PROP[DEPENDITEM,WORDONE]),1)+1);
>>   %              END
>>   %         ELSE A[DEPENDSC] := 0;
>>             REPLACE PO BY NAMEIN(PN,30);
>>             WRITE_BUFO;
>>             %
>>             FLD_NAME_IX[PROP[ITEM,ITEMNUM]]:=OFFSET(PFN);
>>             REPLACE PFN:PFN BY PN FOR REAL(PN,1)+1;
>>             END;
>>        END;
>>     END GET_INFO_DATASET_ITEMS;
>>     %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>>     PROCEDURE GET_INFO_SET;
>>     BEGIN
>>     REAL I
>>         ,IX
>>         ,OP
>>         ,WL
>>         ,LEN
>>         ,SEQ
>>         ,STR
>>         ,LSTR
>>         ,KITEM
>>         ,SETTOP
>>         ,KNODE
>>         ,KDNODE
>>         ,KEYTOP
>>         ;
>>     BOOLEAN WB
>>            ;
>>     ARRAY REFERENCE DESC [0]
>>                    ,DESC2[0]
>>                    ,DESC3[0]
>>                    ,TEXT [0]
>>                    ;
>>     POINTER PN
>>            ,PW
>>            ;
>>     %
>>     READPROP(SETLIST.BLOCKF, DESC);
>>     SETTOP := IF SETLIST IS 0 THEN 0 ELSE LISTEND[SETLIST];
>>     I := 0;
>>     WHILE I := * + 1 <=SETTOP
>>     DO BEGIN
>>        IF LDBSETSB
>>        THEN BEGIN
>>             LSTR := LISTELEMENT[SETLIST,I];
>>             READPROP(LSTR.BLOCKF,DESC2);
>>             STR := DBLISTELEMENT[DBNODE,PROP2[LSTR,STRUCTURENUM]];
>>             END
>>        ELSE BEGIN
>>             LSTR := DBLISTELEMENT[DBNODE,LISTELEMENT[SETLIST,I]];
>>             READPROP(LSTR.BLOCKF, DESC2);
>>             READPROPTEXT(LSTR.BLOCKF,DESC2,TEXT);
>>             STR := LSTR;
>>             END;
>>        PN:=P(PROP2[LSTR,WORDONE]);
>>        INIT_BUFO(04);
>>        REPLACE PO:PO BY NAMEIN(PN,17)
>>                        ,"  "
>>                        ,PROP2[LSTR,DUPSALLOWED] FOR 1 DIGITS
>>                        ," "
>>                        ,PROP2[LSTR,DUPSFIRST] FOR 1 DIGITS
>>                        ," "
>>                        ,PROP2[LSTR,DUPSLAST] FOR 1 DIGITS
>>                        ," "
>>                        ,PROP2[LSTR,KEYCHANGEALLOW] FOR 1 DIGITS
>>                        ," "
>>                        ,PROP2[LSTR,SUBSETF] FOR 1 DIGITS
>>                        ," "
>>                        ,PROP2[LSTR,WHERELIST] FOR 4 DIGITS
>>                        ," "
>>                        ,PROP2[LSTR,WHERELISTSZ] FOR 3 DIGITS
>>                        ," "
>>                        ,PROP2[LSTR,KEYCOUNT] FOR 2 DIGITS
>>                        ," "
>>                        ,PROP2[LSTR,KEYDATACOUNT] FOR 2 DIGITS
>>                        ," "
>>                        ,PROP2[LSTR,SUBTYPEF] FOR 2 DIGITS;
>>        WRITE_BUFO;
>>        IF WL:=PROP2[LSTR,WHERELIST]^=0
>>        THEN BEGIN
>>             INIT_BUFO(08);
>>             REPLACE PO:PO BY SEQ:=1 FOR 4 DIGITS
>>                             ," "
>>                             ,"  ";
>>             IX:=0;
>>             PW:=P(DESC2[WL]);
>>             WHILE OP:=REAL(PW,2) ISNT 4"000A"
>>             DO BEGIN
>>                PW:=*+2;
>>                CASE OP.[15:04]
>>                OF BEGIN
>>                   00: %
>>                       CASE OP.[11:12]
>>                       OF BEGIN
>>                          15: REPLACE PO:PO BY "(  ";
>>                          16: REPLACE PO:PO BY " )";
>>                          11: REPLACE PO:PO BY " LT ";
>>                          32: REPLACE PO:PO BY " LE ";
>>                          22: REPLACE PO:PO BY " EQ ";
>>                          33: REPLACE PO:PO BY " NE ";
>>                          34: REPLACE PO:PO BY " GE ";
>>                          21: REPLACE PO:PO BY " GT ";
>>                          31: BEGIN
>>                              WRITE_BUFO;
>>                              INIT_BUFO(08);
>>                              REPLACE PO:PO BY (SEQ:=*+1) FOR 4 DIGITS
>>                                              ," ";
>>                              REPLACE PO:PO BY "O ";
>>                              END;
>>                          30: BEGIN
>>                              WRITE_BUFO;
>>                              INIT_BUFO(08);
>>                              REPLACE PO:PO BY (SEQ:=*+1) FOR 4 DIGITS
>>                                              ," ";
>>                              REPLACE PO:PO BY "E ";
>>                              END;
>>                          24: REPLACE PO:PO BY " NOT ";
>>                          10: REPLACE PO:PO BY " LB";
>>                          ELSE:
>>                              REPLACE PO:PO BY OP.[11:12] FOR * DIGITS;
>>                          END; % Case
>>                   01: %
>>                       PN:=FLD_NAMES[FLD_NAME_IX[OP.[11:12]]];
>>                       IF OFFSET(PO)>40
>>                       THEN REPLACE PO:PO BY "C ";
>>                       REPLACE PO:PO BY PN+1 FOR REAL(PN,1)
>>                                       ," " FOR 40-REAL(PN,1);
>>                       PW:=*+2;
>>                   02: %
>>                       PW:=*+2;
>>                   03: %
>>                       ;
>>                   04: %
>>                       ;
>>                   09: %
>>                       IF OP.[11:12]=1
>>                       THEN REPLACE PO:PO BY "TRUE"
>>                       ELSE REPLACE PO:PO BY "FALSE";
>>                   10: %
>>                       LEN:=OP.[11:12];
>>                       REPLACE PO:PO BY "K '"
>>                                       ,PW FOR LEN
>>                                       ,"'"
>>                                       ," " FOR 38-LEN;
>>                       IF LEN MOD 2 = 1
>>                       THEN LEN:=*+1;
>>                       PW:=*+LEN;
>>                   11: %
>>                       PW:=*+2;
>>                       LEN:=OP.[11:12];
>>                       REPLACE PO:PO BY "K "
>>                                       ,PW FOR LEN
>>                                       ," " FOR 40-LEN;
>>                       IF LEN MOD 2 = 1
>>                       THEN LEN:=*+1;
>>                       PW:=*+LEN;
>>                   12: %
>>                       ;
>>                   ELSE: %
>>                       ;
>>                   END; % Case
>>                IF READLOCK(FALSE,WB)
>>                THEN BEGIN
>>                     WRITE_BUFO;
>>                     INIT_BUFO(08);
>>                     REPLACE PO:PO BY (SEQ:=*+1) FOR 4 DIGITS
>>                                     ," ";
>>                     END;
>>                END; % While
>>             WRITE_BUFO;
>>             END;
>>        %
>>        KNODE:=DESC2[PROP2[LSTR,KEYNODE]];
>>        KDNODE:=DESC2[PROP2[LSTR,KEYDATANODE]];
>>        IF KNODE.BLOCKF^=0
>>        THEN BEGIN
>>             READPROP(KNODE.BLOCKF,DESC3);
>>             KEYTOP:=LISTEND[KNODE];
>>             IX:=0;
>>             WHILE IX:=*+1 <= KEYTOP
>>             DO BEGIN
>>                KITEM:=LISTELEMENT3[KNODE,IX];
>>                INIT_BUFO(05);
>>                REPLACE PO:PO BY IX FOR 3 DIGITS
>>                                ," "
>>                                ,KITEM.[11:12] FOR 3 DIGITS
>>                                ," "
>>                                ,KITEM.[39:12] FOR 5 DIGITS
>>                                ," "
>>                                ,KITEM.[27:16] FOR 5 DIGITS
>>                                ," "
>>                                ,KITEM.[46:01] FOR 1 DIGITS
>>                                ," "
>>                                ,KITEM.[45:06] FOR 2 DIGITS;
>>                WRITE_BUFO;
>>                END;
>>             END;
>>        %
>>        IF KDNODE.BLOCKF^=0
>>        THEN BEGIN
>>             READPROP(KDNODE.BLOCKF,DESC3);
>>             KEYTOP:=LISTEND[KDNODE];
>>             IX:=0;
>>             WHILE IX:=*+1 <= KEYTOP
>>             DO BEGIN
>>                KITEM:=LISTELEMENT3[KDNODE,IX];
>>                INIT_BUFO(06);
>>                REPLACE PO:PO BY IX FOR 3 DIGITS
>>                                ," "
>>                                ,KITEM.[11:12] FOR 3 DIGITS
>>                                ," "
>>                                ,KITEM.[39:12] FOR 5 DIGITS
>>                                ," "
>>                                ,KITEM.[27:16] FOR 5 DIGITS
>>                                ," "
>>                                ,KITEM.[46:01] FOR 1 DIGITS
>>                                ," "
>>                                ,KITEM.[45:06] FOR 2 DIGITS;
>>                WRITE_BUFO;
>>                END;
>>             END;
>>        END;
>>     END GET_INFO_SET;
>>     %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>>     PROCEDURE GET_INFO_DATASET;
>>     BEGIN
>>     REAL I
>>         ,LN
>>         ,SN
>>         ,LTOP
>>         ,SETS
>>         ,DBTOP
>>         ;
>>     ARRAY REFERENCE DESC[0]
>>                    ,DESC2[0]
>>                    ,TEXT[0]
>>                    ;
>>     POINTER PN
>>            ;
>>     IF LDBB
>>     THEN BEGIN
>>          READPROP(LDBSTRUCTURE.BLOCKF,DESC2);
>>          LTOP := LISTEND2[LDBSTRUCTURE];
>>          I := 0;
>>          WHILE I := * + 1 <= LTOP
>>          DO BEGIN
>>             DSSTRUCTURE := LISTELEMENT2[LDBSTRUCTURE,I];
>>             READPROP(DSSTRUCTURE.BLOCKF,DESC );
>>             % P(PROP[DSSTRUCTURE,WORDONE])
>>             END;
>>          SETS := PROP[DSSTRUCTURE,SETSF];
>>          LDBSETSB := SETS = SETSLIST;
>>          SETLIST := IF LDBSETSB THEN DSSTRUCTURE ELSE 0;
>>          DSSTRUCTURE :=            % SET UP TO POINT AT ACTUAL DB PROPS
>>            DBLISTELEMENT[DBNODE,PROP[DSSTRUCTURE,STRUCTURENUM]];
>>          READPROP(DSSTRUCTURE.BLOCKF,DESC);
>>          IF SETS = SETSALL OR SETS = SETSEMPTY
>>          THEN SETLIST := DSSTRUCTURE;
>>          END
>>     ELSE BEGIN               % NOT SPECIFIED LDB
>>          DBTOP := DBLISTEND[DBNODE];
>>          SN := 0;
>>          WHILE SN := * + 1 <= DBTOP
>>          DO BEGIN
>>             DSSTRUCTURE := DBLISTELEMENT[DBNODE,SN];
>>             READPROP(DSSTRUCTURE.BLOCKF, DESC);
>>             READPROPTEXT(DSSTRUCTURE.BLOCKF,DESC,TEXT);
>>             I := PROP[DSSTRUCTURE,TYPEF];
>>             INIT_BUFO(02);
>>             PN:=P(PROP[DSSTRUCTURE,WORDONE]);
>>             REPLACE PO:PO BY NAMEIN(PN,17)
>>                             ," ";
>>             PN:=P(TEXT[PROP[DSSTRUCTURE,DESCTEXT]]);
>>             REPLACE PO:PO BY NAMEIN(PN,40)
>>                             ," "
>>                             ,PROP[DSSTRUCTURE,SUBTYPEF] FOR 2 DIGITS
>>                             ," "
>>                             ," "  % BDOTIMIZ
>>                             ," "
>>                             ,PROP[DSSTRUCTURE,ITEMNUM] FOR 5 DIGITS;
>>             %
>>             SETLIST := DSSTRUCTURE;
>>             %
>>             IF PROP[DSSTRUCTURE,TYPEF] = DATASET
>>             THEN BEGIN
>>                  WRITE_BUFO;
>>                  GET_INFO_DATASET_ITEMS(DSSTRUCTURE
>>                          ,PROP[DSSTRUCTURE,RESTARTDATASETF]=1);
>>                  GET_INFO_SET;
>>                  END;
>>             END;
>>          END;
>>     END GET_INFO_DATASET;
>>     %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>>     PROCEDURE GET_INFO_RDS;
>>     BEGIN
>>     REAL I
>>         ,RDSSN,STR,LTOP
>>         ;
>>     POINTER Q
>>            ;
>>     ARRAY REFERENCE DESC[0]
>>                    ,DESC2[0]
>>                    ;
>>     REPLACE RDSNAME BY " " FOR 18;
>>     REPLACE LDBRDSNAME BY " " FOR 18;
>>     RDSSN := DBPROP[DBNODE,RESTARTDATASETSN];
>>     STR := DBLISTELEMENT[DBNODE,RDSSN];
>>     READPROP(STR.BLOCKF,DESC);
>>     REPLACE RDSNAME BY Q:= P(PROP[STR,WORDONE]) FOR (REAL(Q,1)+1);
>>     IF LDBB
>>     THEN BEGIN
>>          READPROP(LDBSTRUCTURE.BLOCKF, DESC);
>>          LTOP := LISTEND[LDBSTRUCTURE];
>>          I := 0;
>>          WHILE I := * + 1 <= LTOP
>>          DO BEGIN
>>             STR := LISTELEMENT[LDBSTRUCTURE,I];
>>             READPROP(STR.BLOCKF, DESC2);
>>             IF PROP2[STR,STRUCTURENUM] = RDSSN
>>             THEN BEGIN
>>                   REPLACE LDBRDSNAME BY
>>                    Q := P(PROP2[STR,NAMEOFFSET]) FOR
>>                         (REAL(Q,1)+1);
>>                  IF RDSNAME NEQ LDBRDSNAME FOR 18
>>                  THEN REPLACE RDSNAME BY LDBRDSNAME FOR 18;
>>                  END;
>>             END;
>>          END;
>>     END GET_INFO_RDS;
>>     %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>>     %%%%%%%%%%%%%%%%%%%%% OUTER BLOCK %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>>     %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>>     %
>>     OPEN(INFO_FILE);
>>     %
>>     GET_INFO_DB;
>>     GET_INFO_DATASET;
>>     %
>>     CLOSE(INFO_FILE,CRUNCH);
>>     %
>>     END.
>>
>>
>
> Your .sig says: This email has been checked for viruses by Avast
> antivirus software.
> https://www.avast.com/antivirus
> For that to make sense, your Avast should have verified that source code.
>
Who knows, maybe avast has a algol compiler build in.


Click here to read the complete article
1
server_pubkey.txt

rocksolid light 0.9.81
clearnet tor