Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/23/unpack.mac
There are 2 other files named unpack.mac in the archive. Click here to see a list.
COMMENT * SIMULA specification;
OPTIONS(/E:CODE,NOCHECK,unpent);
BOOLEAN PROCEDURE unpack;
!*;! MACRO-10 code !*;!
TITLE unpack
SUBTTL SIMULA utility, UNPACK procedure
;!*** Copyright 1975 by the Swedish Defence Research Institute. ***
;!*** Copying is allowed. ***
;!Author: Stephan Oldgren, ENEA, Sept 1975
;!Modified by: Lars Enderin, FOA, Jan 1976
;!Version: 1
;!Purpose: external procedure to unpack data in a SIMULA program
;!Contents: PULPV load packed variable
;! PUUC unpack CHARACTER
;! PUUI unpack INTEGER and BOOLEAN
;! PUUL unpack LONG REAL
;! PUUR unpack REAL
;! PUUT unpack TEXT
;! MAINPROGRAM procedure control
SEARCH SIMMAC,SIMMCR,SIMRPA
ENTRY UNPENT
;! Offsets in procedure block
result==ZBI%S ;! Function value
PAREA== result+1 ;! Parameter (ZFL) for packed area
PBYP== PAREA+2 ;! ZFL for number of bits to bypass in packed area
UAREA== PBYP+2 ;! ZFL for unpacked area (array or variable)
ISIZE== UAREA+2 ;! ZFL for item size (bits)
;! Ac assignments
XIND= 3 ;! Offset of current UAREA relative to first UAREA (0,2,4 etc)
XPADR= 4 ;! Address (dynamic) of packed area
XPMAX= 5 ;! Max offset relative to XPADR or max XPADR value
XPOFF= 6 ;! Current bit offset within packed area
XPBYP= 7 ;! Number of bits to bypass in current packed word
XUTYP= XPBYP ;! Type of unpacked area
XUADR= 10 ;! Address (dynamic) of unpacked area (UAREA)
XUMAX= 11 ;! Max offset or address in UAREA
XUNBY= XUMAX ;! Number of bytes left in unpacked area
XSIZ= 12 ;! Bit size of packed item
XUBYT= 1 ;! Number of bytes to skip in unpacked text
XA= 0 ;! Work ac
XB= XUBYT ;! - " -
XC= 2 ;! - " -
XD= XPBYP ;! - " -
XE= 13 ;! - " -
XF= 14 ;! - " -
XAREA= 16 ;! Used to save XUADR, XUMAX in PUUT
XG= XAREA ;! Work ac, also JSP ac for NEXT and ERROREXIT (simplifies debug)
;! CONSTANTS DEFINITIONS
QWL= ^D36 ;!word length
QHWL= QWL/2 ;!half word length
QQWL= QWL/4 ;!quarter word length
QDWL= QWL*2 ;!double word length
QBYA= 7 ;!byte length ASCII
QBYS= 6 ;!byte length SIXBIT
QNBA= 5 ;!number of bytes in one word ASCII
OPDEF ERROREXIT [JSP XG,NOGOOD]
OPDEF NEXT [JSP XG,NEXT]
OPDEF LOADPACKED [PUSHJ XPDP,PULPV]
SALL
MACINIT
;! ERROR MESSAGES
ERUM1::! ASCIZ/Parameter missing in UNPACK/
SUBTTL PULPV
;!Purpose: load a packed variable from area to unpack data from
;!Entry: PULPV
;!Input arguments: XPADR block instance to area to unpack
;! data from
;! XPMAX max offset to area to unpack data from
;! XPOFF start offset to area to unpack data from
;! XSIZ size of packed field
;!Normal exit: Skip RETURN
;!Error exit: RETURN
;!Output arguments: XPOFF (see above) now points at first bit
;! after the now unpacked variable
;! XA packed variable left adjusted
;!Call format: LOADPACKED (EXEC PULPV)
;!Used subroutines: none
PULPV: PROC
SAVE <XC>
N==1 ;! Number of ac's saved
;!error return if overflow in area to unpack data from
L XC,XPOFF
ADD XC,XSIZ
CAMLE XC,XPMAX
GOTO L9
;!make a word offset of the bit offset
IDIVI XPOFF,QWL
;!now XPOFF contains offset in words and
;!XPOFF+1=XPBYP contains number of bits to be bypassed
;!at the beginning of area to unpack data from
;!compute address to area to unpack from and store it in XPOFF
ADD XPOFF,XPADR
;!make bit mask with zeroes in place for packed variable and
;!ones in the rest of a word
SETZ XF,
SETO XE,
MOVN XSIZ,XSIZ
ROTC XE,(XSIZ)
MOVN XSIZ,XSIZ
SETO XF,
MOVN XPBYP,XPBYP
ROTC XE,(XPBYP)
MOVN XPBYP,XPBYP
;!read first word of area to unpack data from and use the bit mask
;!to remove unwanted parts of the vord
L XA,(XPOFF)
ANDCM XA,XE
L XC,XPBYP
ADD XC,XSIZ
IF ;! The packed variable straddles a word boundary
CAIG XC,QWL
GOTO FALSE
THEN ;!increment offset and
;!read the next word of area to unpack data from
;!use the bit mask to remove unwanted parts,left justify
;!the variable and compute new number of bits to be bypassed
ADDI XPOFF,1
L XB,(XPOFF)
ANDCM XB,XF
ROTC XA,(XPBYP)
SUBI XPBYP,QWL
ELSE ;! left justify variable and
;!compute new number of bits to be bypassed
ROT XA,(XPBYP)
FI
ADD XPBYP,XSIZ
;!reset bit offset
SUB XPOFF,XPADR
IMULI XPOFF,QWL
ADD XPOFF,XPBYP
AOS -N(XPDP) ;! Ok, skip return
L9():!
RETURN
EPROC
SUBTTL PUUC
;!Purpose: unpack routine for variable of type character
;! unpacking is done by returning previously
;! deleted bits as zeroes
;!Entry: PUUC
;!Input arguments: XPADR block instance to area to unpack
;! data from
;! XPMAX max offset to area to unpack data from
;! XPOFF start offset to area to unpack data from
;! XUADR address of unpacked area
;! XUMAX max address of unpacked area
;! XSIZ size of packed field
;!Normal exit: NEXT
;!Error exit: ERROREXIT
;!Output arguments: XPOFF (see above) now points at first bit after
;! the now unpacked variable
;!CALL FORMAT: EXEC PUUC
;!Used subroutine: PULPV
PUUC: PROC
;!compute number of previously deleted bits, negated
LI XC,(XSIZ)
SUBI XC,QWL
;!unpack every element of the variable
WHILE
CAMLE XUADR,XUMAX
GOTO FALSE
DO
;!load element of packed variable
;!error return if error in pulpv
;!shift right and move in zeroes in
;!place of the previously deleted bits
;!store the unpacked variable
LOADPACKED
ERROREXIT
LSH XA,(XC)
ST XA,(XUADR)
ADDI XUADR,1
OD
NEXT
EPROC
SUBTTL PUUI
;!Purpose: unpack routine for variable of type integer
;! or boolean
;!Entry: PUUI
;!Input arguments: XPADR block instance to area to unpack
;! data from
;! XPMAX max offset to area to unpack data from
;! XPOFF start offset to area to unpack data from
;! XUADR address of unpacked area
;! XUMAX max address of unpacked area
;! XSIZ size of packed field
;!Normal exit: NEXT
;!Error exit: ERROREXIT
;!Output arguments: XPOFF (see above) now points at first bit after
;! the now unpacked variable
;!Call format: EXEC PUUI
;!Used subroutine: PULPV
PUUI: PROC
;!compute number of previously deleted bits and negate
LI XC,(XSIZ)
SUBI XC,QWL
;!unpack every element of the variable
WHILE
CAMLE XUADR,XUMAX
GOTO FALSE
DO
;!load element of packed variable
;!error return if error in PULPV
;!copy the sign bit into the previously
;!deleted bits,and store the variable
LOADPACKED
ERROREXIT
ASH XA,(XC)
ST XA,(XUADR)
ADDI XUADR,1
OD
NEXT
EPROC
SUBTTL PUUL
;!Purpose: unpack routine for variable of type long real
;! unpacking is done by filling up with zeroes at
;! the end of each element after the packed part
;!Entry: PUUL
;!Input arguments: XPADR block instance to area to unpack
;! data from
;! XPMAX max offset to area to unpack data from
;! XPOFF start offset to area to unpack data from
;! XUADR address of unpacked area
;! XUMAX max address of unpacked area
;! XSIZ size of packed field
;!Normal exit: NEXT
;!Error exit: ERROREXIT
;!Output arguments: XPOFF (see above) now points at first bit after
;! the now unpacked variable
;!Call format: EXEC PUUL
;!Used subroutine: PULPV
PUUL: PROC
IF ;! Packed field fits in one word
CAILE XSIZ,QWL
GOTO FALSE
THEN ;!unpack first word of every element
;!and zero the second word
WHILE ;! There is more to unpack
CAMLE XUADR,XUMAX
GOTO FALSE
DO ;!load element of packed variable, store the
;!first word into area to unpack into
;!increment address to unpacked variable and
;!zero the second word of the variable
;!error return if anything wrong in pulpv or
;!if second word is missing
LOADPACKED
ERROREXIT
ST XA,(XUADR)
ADDI XUADR,2
CAILE XUADR,1(XUMAX)
ERROREXIT
SETZM -1(XUADR)
OD
ELSE ;!load one word of the packed element,
;!and store it
;!then load the rest of the packed element and store it
;!while there are elements in the variable
L XC,XSIZ
SUBI XC,QWL
WHILE
CAMLE XUADR,XUMAX
GOTO FALSE
DO
;!save size of packed variable, set size to word
;!length,load one word of element and store it
;!error return if something wrong in PULPV
LI XSIZ,QWL
LOADPACKED
ERROREXIT
ST XA,(XUADR)
;!increment address,error return if second word
;!of element is missing
ADDI XUADR,2
CAILE XUADR,1(XUMAX)
ERROREXIT
;!set size to size of packed element minus
;!word length,then load the rest of the packed
;!element and store it in unpacked area
L XSIZ,XC
LOADPACKED
ERROREXIT
ST XA,-1(XUADR)
OD
FI
NEXT
EPROC
SUBTTL PUUR
;!Purpose: unpack routine for variable of type real
;! unpacking is done by filling up with zeroes at
;! the end of each element after the packed part
;!Entry: PUUR
;!Input arguments: XPADR block instance to area to unpack
;! data from
;! XPMAX max offset to area to unpack data from
;! XPOFF start offset to area to unpack data from
;! XUADR address of unpacked area
;! XUMAX max address of unpacked area
;! XSIZ size of packed field
;!Normal exit: NEXT
;!Error exit: ERROREXIT
;!Output arguments: XPOFF (see above) now points at first bit after
;! the now unpacked variable
;!Call format: EXEC PUUR
;!Used subroutine: PULPV
PUUR: PROC
WHILE ;! More remains to be unpacked
CAMLE XUADR,XUMAX
GOTO FALSE
DO ;!load element of packed variable and just store it into
;!area to unpack into
;!error return if something wrong in PULPV
;!increment address of unpacked variable
LOADPACKED
ERROREXIT
ST XA,(XUADR)
ADDI XUADR,1
OD
NEXT
EPROC
SUBTTL PUUT
;!Purpose: unpack routine for variable of type text
;! unpacking is done by converting characters from
;! SIXBIT to ASCII
;!Entry: PUUT
;!Input arguments: XPADR block instance to area to unpack
;! data from
;! XPMAX max offset to area to unpack data from
;! XPOFF start offset to area to unpack data from
;! XUADR address of text specification
;! XUMAX max address of text specification
;! XSIZ size of packed field
;!Normal exit: NEXT
;!Error exit: ERROREXIT
;!Output arguments: XPOFF (see above) now points at first bit after
;! the now unpacked variable
;!Call format: EXEC PUUT
;!Used subroutine: PULPV
PUUT: PROC
WHILE
CAMLE XUADR,XUMAX
GOTO FALSE
DO
;!save address
L XAREA,XUADR
HRL XAREA,XUMAX
LD XUADR,(XUADR)
JUMPE XUADR,NOGOOD ;! If NOTEXT
HLRZ XA,XUADR
HLLI XUADR,
HLRZ XUNBY,XUNBY
;!compute start address
IDIVI XA,QNBA
ADDI XA,2
ADD XUADR,XA
;!Note that XB=XUBYT now contains number of bytes to be
;!bypassed before start of text in the word(XUADR)
;!construct byte pointer to byte where unpacked text should be stored
L XC,[POINT QBYA,(XUADR)]
IF JUMPLE XUBYT,FALSE
THEN
LOOP
IBP XC
AS SOJG XUBYT,TRUE
SA
FI
IF ;! Bytes remain in text variable
JUMPLE XUNBY,FALSE
THEN
LOOP ;!load one sixbit character,error return if
;!something wrong in PULPV ,convert to ASCII and
;!store byte in unpacked area
LOADPACKED
ERROREXIT
IF
CAIE XSIZ,6
GOTO FALSE
THEN
ROT XA,QBYS
ADDI XA,40
ELSE
ROT XA,QBYA
FI
IDPB XA,XC
AS SOJG XUNBY,TRUE
SA
FI
;!reinitialize address to text specification and increment it to
;!point at the next text element if any
HRRI XUADR,2(XAREA)
HLR XUMAX,XAREA
OD
NEXT
EPROC
SUBTTL MAINPROGRAM
;!Purpose: to unpack a number of variables defined by a
;! SIMULA program from another variable
;! also defined by the SIMULA program
;!Entry: UNPENT
;!Used subroutines: PUUC unpack character
;! PUUI unpack integer and boolean
;! PUUL unpack long real
;! PUUR unpack real
;! PUUT unpack text
UNPENT:;! Execution starts here for UNPACK routine
SETOM result(XCB) ;! Assume true result as a start
SETZ XIND,
IF ;! ISIZE was not given
SKIPE ISIZE(XCB)
GOTO FALSE
THEN ;! Error, not enough parameters
OUTSTR ERUM1
RTSERR QDSCON,214
ERROREXIT
FI
SETZB XE,XB
;!read parameters for area to unpack data from and number of bits
;!to be bypassed at the beginning of that area
;!ie the first two parameters
BEGIN
;!error exit if area to unpack data from is a constant or an
;!expression
LF XA,ZFLDTP(XCB,PAREA)
CAIL XA,QDTCON
ERROREXIT
;!check type of area
;!error exit if not REAL,LONG REAL,INTEGER,BOOLEAN
;!** GETTYPE XD,PAREA
LF XD,ZFLATP(XCB,PAREA)
CAIG XD,QBOOLEAN
CAIN XD,QCHARACTER
ERROREXIT
;!check kind of area,error exit if not ARRAY or SIMPLE
;!** GETKIND XE,PAREA
LF XE,ZFLAKD(XCB,PAREA)
IF ;! NOT array
CAIN XE,QARRAY
GOTO FALSE
THEN ;! Must be simple variable
CAIE XE,QSIMPLE
ERROREXIT
;!treat simple variable
;!load dynamic address and compute max bit offset and bit offset
;!to first bit in variable
;!** GETADD PAREA,<XPADR-XWAC1>
IF ;! No thunk
SKIPL PAREA(XCB)
GOTO FALSE
THEN ;! Get address the easy way
LF XPADR,ZFLZBI(XCB,PAREA)
HRL XPADR,PAREA+1(XCB)
ELSE ;! Use PHFA
LI XPADR,(XCB)
HRLI XPADR,PAREA
EXEC PHFA
XWD XPADR-XWAC1,[0]
FI
HLRZ XPMAX,XPADR
CAIN XD,QLREAL
ADDI XPMAX,1
IMULI XPMAX,QWL
ADDI XPMAX,QWL
HLRZ XPOFF,XPADR
IMULI XPOFF,QWL
HLLI XPADR,
ELSE ;!treat array variables
;!load dynamic address and compute number of bits in array
;!** GETAADD PAREA,3
IF ;! No thunk
SKIPL PAREA(XCB)
GOTO FALSE
THEN ;! Get address the easy way
LF XPADR,ZFLZBI(XCB,PAREA)
ADD XPADR,PAREA+1(XCB)
L XPADR,(XPADR)
ELSE ;! Use PHFM
LI XPADR,(XCB)
HRLI XPADR,PAREA
EXEC PHFM
XWD XPADR-XWAC1,[0]
FI
LF XPMAX,ZARLEN(XPADR)
IMULI XPMAX,QWL
;!compute offset to first element
LF XPOFF,ZARSUB(XPADR)
IMULI XPOFF,3*QWL
ADDI XPOFF,3*QWL
FI
;!read parameter for number of bits to be bypassed
;!at the beginning of area to unpack data from
;!error exit if not simple integer
;!** GETTYPE XC,PBYP
LF XA,ZFLAKD(XCB,PBYP)
LF XC,ZFLATP(XCB,PBYP)
CAIN XA,QSIMPLE
CAIE XC,QINTEGER
NOGOODEXIT
;!** GETVAL PBYP,6,<XPADR>
IF ;! No thunk
SKIPL PBYP(XCB)
GOTO FALSE
THEN ;! Simple value access
LF XPBYP,ZFLZBI(XCB,PBYP)
ADD XPBYP,PBYP+1(XCB)
L XPBYP,(XPBYP)
ELSE ;! Do it the hard way
LI XPBYP,(XCB)
HRLI XPBYP,PBYP
EXEC PHFV
XWD XPBYP-XWAC1,[1B<XPADR-XWAC1>]
FI
;!error exit if negative value
JUMPL XPBYP,NOGOOD
;!add number of bits to bypass to offset
ADD XPOFF,XPBYP
;!
;!now the contents of the registers are as follows
;! XPADR block instance of area to unpack from
;! XPMAX max bit offset
;! XPOFF bit offset to first bit in area to unpack from
;!
ENDD
GETNXT: ;!read parameters for area to unpack into and size of packed variable
;!ie the next two parameters
;!XIND contains index to parameter table
BEGIN
;!check type of area,
;!error exit if not REAL,LONG REAL,INTEGER,BOOLEAN,
;!CHARACTER or TEXT
;!** GETTYPE XUTYP,UAREA,XIND
LI XUADR,UAREA(XIND)
ADDI XUADR,(XCB)
LF XUTYP,ZFLATP(XUADR)
CAILE XUTYP,QTEXT
ERROREXIT
;!check kind of area,error exit if not ARRAY or SIMPLE
;!** GETKIND XE,UAREA,XIND
LF XE,ZFLAKD(XUADR)
IF ;! Not array
CAIN XE,QARRAY
GOTO FALSE
THEN ;! Must be simple
CAIE XE,QSIMPLE
ERROREXIT
;!treat simple variable
;! Get dynamic address and compute max offset
;!** GETADD UAREA(XIND),7,<XPADR>
IF ;! No thunk
SKIPL (XUADR)
GOTO FALSE
THEN ;! Get dynamic address
HRL XUADR,1(XUADR)
HRR XUADR,(XUADR)
ELSE ;! Use PHFA or PHFT
HRLI XUADR,UAREA(XIND)
HRRI XUADR,(XCB)
LI XB,PHFA
CAIN XUTYP,QTEXT
LI XB,PHFT
EXEC 0(XB)
XWD XUADR-XWAC1,[1B<XPADR-XWAC1>]
FI
HLRZ XUMAX,XUADR
CAIE XUTYP,QTEXT
CAIN XUTYP,QLREAL
ADDI XUMAX,1
ELSE ;!treat array variables
;!load dynamic address and compute max offset and start offset
;!** GETAADD UAREA(XIND),7,<XPADR>
IF ;! No thunk
SKIPL (XUADR)
GOTO FALSE
THEN ;! Simple computation of array address
LF XB,ZFLZBI(XUADR)
ADD XB,1(XUADR)
L XUADR,(XB)
ELSE ;! Use PHFM
LI XUADR,(XCB)
HRLI XUADR,UAREA(XIND)
EXEC PHFM
XWD XUADR-XWAC1,[1B<XPADR-XWAC1>]
FI
LF XUMAX,ZARLEN(XUADR)
SUBI XUMAX,1
LF XE,ZARSUB(XUADR)
IMULI XE,3
ADDI XE,3
HRL XUADR,XE
FI
;!read argument for size of packed variable
;!error exit if not of type integer and of kind simple or
;!if size greater than double word length for long real variables or
;! greater than word length for other variables
;!** GETTYPE XE,ISIZE,XIND
LI XSIZ,ISIZE(XIND)
ADDI XSIZ,(XCB)
LF XB,ZFLAKD(XSIZ)
LF XE,ZFLATP(XSIZ)
CAIN XE,QINTEGER
CAIE XB,QSIMPLE
ERROREXIT
;!** GETVAL ISIZE(XIND),11,<XPADR,XUADR>
IF ;! No thunk
SKIPL (XSIZ)
GOTO FALSE
THEN ;! Simple evaluation
LF XB,ZFLZBI(XSIZ)
ADD XB,1(XSIZ)
L XSIZ,(XB)
ELSE ;! Use PHFV
LI XSIZ,(XCB)
HRLI XSIZ,ISIZE(XIND)
EXEC PHFV
XWD XSIZ-XWAC1,[1B<XPADR-XWAC1>+1B<XUADR-XWAC1>]
FI
;!error exit if size is as follows:
;!type of var greater than less than
;!INTEGER WORD LENGTH 2
;!REAL - " - 10
;!CHARACTER - " - 7
;!BOOLEAN - " - 1
;!LONG REAL DOUBLE WORD LENGTH 10
;!TEXT 7 6
L XB,SIZTAB-1(XUTYP)
HLRZ XB
CAIL XSIZ,(XB)
CAMGE XSIZ
ERROREXIT
;!change dynamic address to real address and max offset to max address
HLRZ XE,XUADR
HLLI XUADR,
ADD XUMAX,XUADR
ADD XUADR,XE
;!now the contents of the ac's are as follows
;! XUTYP type of area to unpack
;! XUADR address of first word of area to unpack
;! or if text, address to first text specification
;! XUMAX max address of area to unpack (not if text)
;! or if text, max address of text specifications
;! XSIZ size of packed variable
;!
ENDD
;!select correct subroutine for each type of variable
XCT ROUTAB-1(XUTYP)
NEXT: ;!Check for more arguments
ADDI XIND,2*2 ;! Step to next UAREA, ISIZE pair
LI XB,(XCB)
ADDI XB,(XIND)
SKIPN UAREA(XB)
GOTO FINISH
IF ;! There is room for both UAREA and ISIZE parameters
Q==2*<<^D31/2>*2-4>
CAILE XIND,Q
GOTO FALSE
THEN ;! Handle next pair if ISIZE is given
SKIPE ISIZE(XB)
GOTO GETNXT
FI
;! *** ERROR, wrong number of parameters *** ;!
OUTSTR ERUM1
RTSERR QDSCON,214
NOGOOD: SETZM result(XCB)
GOTO FINISH
FINISH=CSEP
SIZTAB: XWD QWL,2 ;! INTEGER
XWD QWL,10 ;! REAL
XWD 2*QWL,10 ;! LONG REAL
XWD QWL,7 ;! CHARACTER
XWD QWL,1 ;! BOOLEAN
XWD 7,6 ;! TEXT
ROUTAB: BRANCH PUUI
BRANCH PUUR
BRANCH PUUL
BRANCH PUUI
BRANCH PUUI
BRANCH PUUT
LIT
END;