|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 17548 (0x448c)
Notes: pts_type(SC)
Names: »DECVRT.SC«
└─⟦48601905a⟧ Bits:30009668 Philips computer tape "600121"
└─⟦this⟧ »S:DE/DECVRT.SC«
└─⟦d2a299635⟧ Bits:30009698 Philips computer tape "600415"
└─⟦this⟧ »S:DE/DECVRT.SC«
IDENT DECVRT REL 10.0 80-04-11 80-04-10/JAER * * THIS PROGRAM-MODUL CONTAINS ENTRIES TO THE DIFFERENT * CONVERTIONS THAT OCCURS IN THE FORMAT GENERATION * DDUM DEDDIV PDIV * ENTRY CONNUM CONVERT STRG=>BIN * ENTRY BINCON CONVERT BIN=>STRG * EJECT * * CONVERT VARIABLE NUMBER (INDEX) TO BINARY * * INPUT PARAMETERS (FORMAL): WSTRG = WORKSTRING VAL/GEN/ACC * CHNUM = NUMBER OF INPUT CHARACTERS * WIND = INDEX TO CORRESPONDING CHAR- * * INPUT PARAMETERS : * VALSTR = VAL/GEN/ACC---CHARACTERSTRIN * DEBIN4 = POINTER INPUTBUFFER WSTRG * DEBIN5 = NUMB OF DELETED CHARACTERS * * WORKITEMS : DEBIN2 = LENGTH OF LITERAL STRING * DEBIN3 = CONVERTED VAR.-NR. BINARY * BIN15 = LENGTH OF VALSTR (31) * BIN16 = MATCHING-POINTER 'VALSTR' * DEINPUT = WORK BUFFER * WORK(W5) = SAVED (-POSITION * WORK(W6) = SAVED )-POSITION * WORK(W7) = SAVED (...)-LENGTH * * OUTPUT PARAMETERS : CHNUM = EFFEKTIV VAL-/GEN-/ACC-LENTH * WSTRG = VAL-/GEN-/ACC-STRING CONVERT * * DEBIN4 = POINTER WSTRG ADJUSTED * FBIN2 = HIGHEST FIELD REF. NO. (FORW ************************************************************************ EJECT CONNUM PROC WSTRG,CHNUM(),WIND MOVE BIN15,=W'31' LOAD LENGTH OF VALSTR CBE WIND,W4,CN00 JUMP IF DUPL DLETE WSTRG,DEBIN4,W3 DELETE '#X:' SUB CHNUM(WIND),W3 ADJUST FOR FUNCTION TEXT ADD DEBIN5,W3 ADD NUMB OF DLETED CHARACTERS EJECT CN00 MOVE BIN16,W0 MATCHINDEX:=0 MOVE STR6A,='0' ZEROIZE WORKITEM MATCH VALSTR,BIN16,BIN15,WSTRG,DEBIN4,W1 CBE BIN16,W23,CNCL JUMP IF LITERAL ADD DEBIN4,W1 NEXT POS CBE BIN16,W0,CNCM JUMP IF 'M' IB BIN16,CNC0,CNC0,CNC0,CNC0, 1-4 C CNC3,CNC2,CNC0,CNCA,CNC2, 5-9 C CNC1,CNC3,CNC2,CNC2,CNC0, 10-14 C CNC0,CNC0,CNC0,CNC0,CNC0, 15-19 C CNC0,CNC0,CNC0,CNCL,CNC0, 20-24 C CNCG,CNCM,CNCM,CNC0,CNC0, 25-29 C CNCR 30 B CNC0 CNCM M=MESSAGE SPLIT,R/N=CONDFRM CH MOVE DEBIN3,DEBIN4 LOAD ACTUAL POSITION MATCH WSTRG,DEBIN3,W1,VALSTR,W23,W1 M'...' BNOK CNC2 M99 B CNCL EJECT * * CNC0 NO CONVERTION * CNC0 CBNE DEBIN4,CHNUM(WIND),CN00 GO ON IF NOT END OF FUNC B CNOK END OF FUNC FOUND * * CNC1 CONVERT 1 BYTE TO BINARY * CNC1 MOVE DEBIN3,W5 STARTPOS WORKITEM PERF CONV,WSTRG,W1 CONVERT TO BINARY SUB CHNUM(WIND),DEBIN3 ADJUST END POSITION B CNC0 CHECK END-OF-LINE EJECT * * CNC2 CONVERTION OF 2 BYTES TO BINARY * -M,-L,-A,-S,-T,-C * CNC2 MOVE DEBIN3,W4 STARTPOS WORKITEM PERF CONV,WSTRG,W2 CONVERT TO BINARY SUB CHNUM(WIND),DEBIN3 ADJUST END POSITION CBNE BIN16,W12,CNC0 JUMP IF NOT 'T' CBE DEBIN4,CHNUM(WIND),CNOK JUMP IF END OF LINE FOUND MOVE DEBIN3,DEBIN4 LOAD WORKPOINTER MATCH WSTRG,DEBIN3,W1,VALSTR,W18,W1 NEXT POS : ? BNOK CN00 ADD DEBIN4,W1 NEXT POS MOVE DEBIN3,W4 STARTPOS WORKITEM PERF CONV,WSTRG,W2 CONVERT TO BINARY SUB CHNUM(WIND),DEBIN3 ADJUST END POSITION B CNC0 CHECK END-OF-LINE EJECT * * CNC3 CONVERTION OF 3 BYTES TO BINARY -D,-F,-G * CNC3 CBNE BIN16,W5,CNC3A JUMP IF NOT = 5(D) CBE WIND,W4,CNC0 JUMP IF D=DATUM(DUPL) CNC3A MOVE DEBIN3,W3 STARTPOS WORKITEM PERF CONV,WSTRG,W3 CONVERT TO BINARY SUB CHNUM(WIND),DEBIN3 ADJUST END POSITION CBNG DEBIN2,WORK(W6),CNC3B JUMP IF L HIGHST FIELD REF. MOVE WORK(W6),DEBIN2 SAVE HIGHEST FIELD REF. NO. CNC3B B CNC0 CHECK END-OF-LINE EJECT * * CNCL CONVERT TO LITERAL * CNCL MOVE DEBIN2,CHNUM(WIND) SAVE ENDPOS ADD DEBIN4,W1 NEXT POS SUB DEBIN2,DEBIN4 NUMB OF CHRS TO MATCH MOVE DEBIN3,DEBIN4 STARTPOS IN MATCH MATCH WSTRG,DEBIN3,DEBIN2,VALSTR,W23,W1 MATCH NEXT' SUB DEBIN3,DEBIN4 =NUMB OF LIT-CHARS MOVE DEBIN2,W128 1ST BIT = 1 ADD DEBIN2,DEBIN3 +LENGTH OF LITERAL SUB DEBIN4,W1 ADJUST FOR OVERWRITE POSITION XCOPY WSTRG,DEBIN4,W1,DEBIN2,W1 'L'='80'+LENGTH ADD DEBIN4,DEBIN3 ADJUST NEXT POS ADD DEBIN4,W1 NEXT POS DLETE WSTRG,DEBIN4,W1 DELETE 2ND ' SUB CHNUM(WIND),W1 ADJUST LENGTH FOR DELETED CHAR ADD DEBIN5,W1 NUMB OF DELETED CHARCTERS B CNC0 GO ON * * CNCA CONVERT FOR CONDITIONAL ACCUMULATION * CNCA 'A'-FOUND MOVE DEBIN3,DEBIN4 SAVE CURR POS MATCH WSTRG,DEBIN3,W1,VALSTR,W29,W1 (-? BNOK CNC2 JUMP IF USUAL ACCUMULATOR B CNCX JUMP IF COND ACCUMULATION * * CNCG CONVERT FOR CONDITIONAL GENERATION * CNCG 'G'-FOUND CBNE WIND,W2,CNC3 JUMP IF NOT GEN CNCX SUB DEBIN4,W1 ADJUST FOR CONVERTION XCOPY WSTRG,DEBIN4,W1,VALSTR,W0 G/A=>M ADD DEBIN4,W1 NEXT POS MOVE WORK(W8),DEBIN4 SAVE (-POS MOVE DEBIN2,CHNUM(WIND) SAVE ENDPOS SUB DEBIN2,DEBIN4 NUMB OF CHARS TO MATCH MOVE DEBIN3,DEBIN4 STARTPOS IN MATCH MOVE BIN16,=W'30' MATCH WSTRG,DEBIN3,DEBIN2,VALSTR,BIN16,W1 MOVE WORK(W9),DEBIN3 SAVE)-POS ADD DEBIN4,W1 NEXT POS SUB DEBIN3,DEBIN4 =NUMB OF LIT CHARS MOVE WORK(W7),DEBIN3 SAVE (...)-LENGTH B CNC0 GO ON EJECT * * CNCR RIGHT PARENTHESIS FOUND * CNCR SUB DEBIN4,W1 ADJUST FOR DEL )-CHAR SUB WORK(W9),DEBIN4 =DIFFERENCE SUB WORK(W7),WORK(W9) =REAL LENGTH ADD WORK(W7),W128 1ST BIT = 1 XCOPY WSTRG,WORK(W8),W1,WORK(W7),W1 (...)-LENGTH DLETE WSTRG,DEBIN4,W1 DELETE )-CHARS SUB CHNUM(WIND),W1 ADJUST ENDPOS ADD DEBIN5,W1 ADJUST NUMB OF DEL CHARS B CNC0 GO ON EJECT CNOK MOVE BIN15,CHNUM(WIND) STORE ENDPOSITION SUB BIN15,DEBIN1 SUBTRACT STARTPOSITION MOVE CHNUM(WIND),BIN15 GIVING NUMB OF CHARS RET PEND EJECT * * CONVERTS NUMERIC STRINGCHARACTERS TO BINARY * * INPUT VARIABLES : NUMB(F) = NUMBER OF CHARACTERS TO CONVERT * DEBIN3 = STARTPOS IN WORKITEM FOR 'XCOPY' * WSTRG = ACTUAL WORKSTRING VAL/GEN OR ACC * * WORK ITEMS : DEBIN2 = CONVERTED NUMERIC VALUE BINARY * BCD13A = CONVERTED NUMERIC VALUE BCD * STR6A = NUMERIC VALUE STRG * * OUTPUT VARIABLES : DEBIN4 = POINTER ADJUSTED * DEBIN5 = NUMB OF DELETED CHARS * WSTRG = WORKBUFFER WITH CONVERTED CHARACTER * DEBIN3 = NUMB OF DELETED CHARS * DEBIN2 = CONVERTED NUMERIC VALUE BINARY * ************************************************************************ CONV PROC WSTRG,NUMB XCOPY STR6A,DEBIN3,NUMB,WSTRG,DEBIN4 COPY STRGNUM MOVE BCD13A,STR6A LOAD STR=>BCD MOVE DEBIN2,BCD13A LOAD BCD=>BIN XCOPY WSTRG,DEBIN4,W1,DEBIN2,W1 LOAD VARNR BINARY MOVE DEBIN3,NUMB STORE NUMB CONVRTD CHARACTERS SUB DEBIN3,W1 ADD DEBIN4,W1 NEXT POS DLETE WSTRG,DEBIN4,DEBIN3 DELETE ALPHA CHARACTERS ADD DEBIN5,DEBIN3 NEXT POS RET PEND EJECT * * THIS ROUTINE CONVERTS BINARY NUMERICALS TO * ALPHANUMERIC STRING CHARACTERS * * FORMAL PARAMETER : WSTRG = JOBSPC (VALIDATION STRING) * = DUPL (DUPLICATION STRING) * OPT = 1 = VALIDITION * = 2 = GENERATION * = 3 = ACCUMULATION * = 4 = DUPLICATION * * INPUT VARIABLES : BIN15 = LENGTH OF FUNC-CODE * DEBIN3 = POINTER TO WSTRG * FBIN1 = NUMBER OF CONVERTED CHARACTERS * * USED VARIABLES : BIN16 = MATCHINGPOINTER * DEBIN1 = WORK * DEBIN2 = LENGTH OF MATCHSTRING (VALSTR = 29) * DEBIN4 = BINARY NUMERICALS * FBIN1 = CHECK END OF OF FUNC-CODE * WORK(W7)= LENGTH/ENDPOS COND. GEN/ACC * * OUTPUT VARIABLES : WSTRG = CONVERTED * BIN15 = ADJUSTED ACCORDING TO CONVERTED * CHARACTERS * CURSEC= ADJUSTED WITH INPUT VALUE OF BIN15 * ************************************************************************ * EJECT BINCON PROC WSTRG,OPT XCOPY WSTRG,DEBIN3,BIN15,BPOOL(PINDCB),CURSEC STORE WORKSTRING MOVE DEBIN2,=W'31' LOAD LENGTH OF VALSTR ADD CURSEC,BIN15 ADJUST FOR CHARS CBE OPT,W4,BN00 JUMP IF DUPL ADD BIN15,W3 ADJUST FOR FUNC.TEXT CLEAR BOOL4 F=NO CONDITIONAL GEN/ACC BN00 MOVE BIN16,W0 MATCHINGPOINTER :=0 MOVE DEBIN4,W0 BINARY NUMERICALS:=0 MATCH VALSTR,BIN16,DEBIN2,WSTRG,DEBIN3,W1 MATCH CHARACTER CBE BIN16,W0,BNME JUMP IF MESSAGE IB BIN16,BNC0,BNC0,BNC0,BNC0, 1-4 C BNC3,BNC2,BNC0,BNC2,BNC2, 5-9 C BNC1,BNC3,BNC2,BNC2,BNC0, 10-14 C BNC0,BNC0,BNC0,BNC0,BNC0, 15-19 C BNC0,BNC0,BNC0,BNCR,BNC0, 20-24 C BNC3,BNME,BNME,BNC0 25-28 EJECT * * CHECK IF LITERAL * XCOPY DEBIN4,W1,W1,WSTRG,DEBIN3 GET BYTE CBG DEBIN4,W128,BNCL JUMP IF LITERAL B BNCR RETUR * * CHECK MESSAGE TYPE AND CONDITIONAL GEN/ACC * BNME IB OPT,BNMS,BNMG,BNMA BNMS ADD DEBIN3,W1 NEXT POS ADD FBIN1,W1 ADJUST NUMB OF CONVERTED XCOPY DEBIN4,W1,W1,WSTRG,DEBIN3 GET MESSAGE TYPE CBG DEBIN4,W128,BNCL JUMP IF M'.....' SUB DEBIN3,W1 ADJUST FOR 2CHAR-CONVERTION SUB FBIN1,W1 ADJUST NUMB OF CONVERTED B BNC2 M99 EJECT * * CONVERT 1 CHARACTER * BNC1 PERF CONBIN,WSTRG,W1 CONVERT BIN=>STRG * * CONVERT NO CHARCTER * BNC0 ADD DEBIN3,W1 NEXT POS ADD FBIN1,W1 ADJUST NUMB OF CONVERTED TBF BOOL4,BNCA JUMP IF NO COND GEN/ACC CBNE WORK(W7),DEBIN3,BNCA JUMP IF ENDPOS OF COND MOVE DEBIN1,=W'30' INSRT WSTRG,DEBIN3,W1,VALSTR,DEBIN1 INSERT ) ADD DEBIN3,W1 NEXT POS ADD FBIN1,W1 ADJUST NUMBER OF CONVERTED ADD BIN15,W1 ADJUST LENGTH CLEAR BOOL4 F=NO COND GEN/ACC BNCA CBE BIN15,FBIN1,BNCR JUMP IF END-OF-STRING B BN00 GO ON EJECT * * CONVERT 2 CHARACTERS * BNC2 PERF CONBIN,WSTRG,W2 CONVERT BIN=>STRG CBNE BIN16,W12,BNC0 JUMP IF NOT 'T' ADD DEBIN3,W1 NEXT POS ADD FBIN1,W1 ADJUST NUMB OF CONVERTED CBE BIN15,FBIN1,BNCR JUMP IF END-OF STRING MOVE DEBIN1,DEBIN3 MATCH WSTRG,DEBIN1,W1,VALSTR,W18,W1 NEXT POS : BNOK BN00 GO MATCH CHARACTER PERF CONBIN,WSTRG,W2 CONVERT BIN=>STRG B BNC0 * * CONVERT 3 CHARACTERS * BNC3 CBNE BIN16,W5,BNC3A JUMP IF NOT (D) CBE BIN15,W1,BNC0 JUMP IF 1 CH =D=DATUM BNC3A PERF CONBIN,WSTRG,W3 CONVERT BIN=>STRG B BNC0 EJECT * * CONVERT LITERAL (INSERT '....') * BNCL SUB DEBIN4,W128 GET LENGTH OF LITERAL XCOPY WSTRG,DEBIN3,W1,VALSTR,W23 INSERT 1ST ' ADD DEBIN3,DEBIN4 ADJUST BUFPOS WITH LENGTH ADD DEBIN3,W1 NEXT POS ADD FBIN1,DEBIN4 ADJUST CHARC CONVERTED ADD FBIN1,W1 ADJUST NUMB OF CONVERTED INSRT WSTRG,DEBIN3,W1,VALSTR,W23 INSERT 2ND ' ADD BIN15,W1 ADJUST LENGTH TBF BOOL4,BNC0 GO ON IF NO COND GEN ACC ADD WORK(W7),W1 ADJUST ENDPOS FOR COND GEN/ACC B BNC0 EJECT BNMG COND GEN FOUND MOVE DEBIN1,W25 B BNMC BNMA COND ACC FOUND MOVE DEBIN1,W8 BNMC XCOPY WSTRG,DEBIN3,W1,VALSTR,DEBIN1 CONVERT M=>G/A ADD DEBIN3,W1 NEXT POS ADD FBIN1,W1 ADJUST NUMB OF CONV MOVE WORK(W7),W0 (...)-LENGTH:=0 XCOPY WORK(W7),W1,W1,WSTRG,DEBIN3 SUB WORK(W7),W128 GET LENGTH 0F (...)-STRING XCOPY WSTRG,DEBIN3,W1,VALSTR,W29 =>(-CHARACTER ADD WORK(W7),DEBIN3 ENDPOS (...)-STRING ADD WORK(W7),W1 ADJUST DITO SET BOOL4 T=CONDITIONAL GEN/ACC FOUND B BNC0 GO ON BNCR RET PEND EJECT * * CONVERT BINARY NUMERICALS ,FROM ACTUAL POINT IN BUFFER * TO ALPHANUMERIC CHARACTER STRING. AND COPIES IT INTO * THE SAME POSITION IN BUFFER * * USED VARIABLES : DEBIN1 = NUMBER OF ALPHANUMERIC STRG-CHARCTERS * ************************************************************************ CONBIN PROC WSTRG,FIND ADD DEBIN3,W1 NEXT POS XCOPY DEBIN4,W1,W1,WSTRG,DEBIN3 COPY BINNUM MOVE BCD13A,DEBIN4 LOAD BIN=>BCD MOVE DEBIN1,W0 ZEROISE EDSUB STR6A,DEBIN1,FCONV(FIND) CONV BCD=>STRG DLETE WSTRG,DEBIN3,W1 DELETE BINNUM POSITION INSRT WSTRG,DEBIN3,DEBIN1,STR6A,W0 INSERT STRG-CHARACTERS SUB DEBIN1,W1 ADJUST ADD BIN15,DEBIN1 ADJUST LENGTH ADD DEBIN3,DEBIN1 ADJUST BUFPOS ADD FBIN1,DEBIN1 ADJUST NUMB OF CONVERTED ADD FBIN1,W1 ADJUST NUMB OF CONVERTED TBF BOOL4,CONRET GO ON IF NO COND GEN ACC ADD WORK(W7),DEBIN1 ADJUST ENDPOS OF (...) CONRET RET PEND EJECT FCONV FTABLE CONV1,CONV2,CONV3 CONV1 FRMT FMEL '9',BCD13A FMEND CONV2 FRMT FMEL '99',BCD13A FMEND CONV3 FRMT FMEL '999',BCD13A FMEND END