Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/23/wildsi.mac
There is 1 other file named wildsi.mac in the archive. Click here to see a list.
00100 COMMENT % wildsix, SIMULA specification;
00200 OPTIONS(/E:QUICK,wildsix);
00300 INTEGER PROCEDURE wildsix(id,mask,k); NAME mask;
00400 INTEGER mask, k; TEXT id;
00500 COMMENT Convert at most k (k <= 6) characters from id to sixbit,
00600 taking special notice of "wild cards" as follows:
00700 If a '?' is found, the corresponding position in mask (byte size 6)
00800 will be made = 8R77. If an asterisk ('*') is found, the rest of
00900 the characters up to number k (1<=k<=6) will be treated as '?'.
01000 ;
01100
01200
01300 !%;! MACRO-10 code !%;!
01400
01500 TITLE wildsix
01600 ENTRY wildsix
01700 SUBTTL SIMULA utility, Lars Enderin June 1978
01800
01900 ;!*** Copyright 1978 by the Swedish Defence Research Institute. ***
02000 ;!*** Copying is allowed. ***
02100
02200
02300 sall
02400 search simmac,simmcr,simrpa
02500 macinit
02600
02700 ;! Local definitions ;!
02800
02900 id==<result==XWAC1>
03000 mask==id+2
03100 k==mask+2
03200 i==id+1
03300 wild==mask+1
03400
03500
03600 wildsix: PROC
03700 IF ;! Non-standard ac's
03800 CAIN XTAC,XWAC1
03900 GOTO FALSE
04000 THEN ;! Put parameters there
04100 EXCH XWAC1,(XTAC)
04200 EXCH XWAC2,1(XTAC)
04300 EXCH XWAC3,2(XTAC)
04400 EXCH XWAC4,3(XTAC)
04500 EXCH XWAC5,4(XTAC)
04600 FI
04700 JUMPE id,L9
04800 JUMPLE k,L9
04900 CAIL k,6
05000 LI k,6
05100 IFONA ZFLVTD(mask)
05200 RTSERR 100 ;! Assignment to expression
05300 ADDI mask,(mask+1)
05400 HRLI mask,(POINT 6,)
05500 LI wild,77
05600 LF ,ZTVSP(,id)
05700 IF JUMPE FALSE
05800 THEN IDIVI 5
05900 ADD [POINT 7,2
06000 POINT 7,2,6
06100 POINT 7,2,13
06200 POINT 7,2,20
06300 POINT 7,2,27](X1)
06400 ST X1
06500 ELSE
06600 L X1,[POINT 7,2]
06700 FI
06800 ADDI X1,(id)
06900 L XIAC,[POINT 6,result]
07000 LF i,ZTVLNG(,result)
07100 CAILE i,(k)
07200 LI i,(k)
07300 SUBI k,(i)
07400 SETZB result,(mask)
07500 LOOP
07600 ILDB X1
07700 SUBI 40
07800 CAIL 100
07900 SUBI 40
08000 SKIPGE
08100 SETZ
08200 IF ;! *
08300 CAIE '*'
08400 GOTO FALSE
08500 THEN ;! Make rest '?'s
08600 LI '?'
08700 ADDI i,(k)
08800 LOOP
08900 IDPB XIAC
09000 IDPB wild,mask
09100 AS
09200 SOJG i,TRUE
09300 SA
09400 ELSE
09450 IDPB XIAC
09500 IBP mask
09600 CAIN '?'
09700 DPB wild,mask
09900 FI
10000 AS
10100 SOJG i,TRUE
10200 SA
10300
10400 L9():! IF CAIN XTAC,XWAC1
10500 GOTO FALSE
10600 THEN EXCH XWAC5,4(XTAC)
10700 EXCH XWAC4,3(XTAC)
10800 EXCH XWAC3,2(XTAC)
10900 EXCH XWAC2,1(XTAC)
11000 EXCH XWAC1,(XTAC)
11100 FI
11200 RET
11300 EPROC
11400 LIT
11500 END;