|
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: 7868 (0x1ebc)
Notes: pts_type(SC)
Names: »REMSUB.SC«
└─⟦26dca8ec8⟧ Bits:30009711 Philips computer tape "RÅKON-DIVFMT"
└─⟦this⟧ »REMIT2/REMSUB.SC«
IDENT REMSUB 820804 NJ DDUM KMD08 PDIV ENTRY FMOD ENTRY FSOLVE ENTRY NEWLIN ENTRY WCHECK ENTRY PRTADJ EXT VARRD EXT GENWRF EXT SPCLRA EXT WAITF EXT ABORT EXT IDXGET EXT TRGETF EXT TRINS EXT SPLIN8 EXT WCHUPD EXT WSTRCH EXT LEVRD EXT LEVIN EXT VARWRT INCLUDE EQUATE EJECT FMOD PROC T,S * THE PROCEDURE MODIFIES A STRING, CONTAINING * FORMAT CONTROL CHARACTERS. * A TEXT TO BE REPLACED HAS TO BE SPECIFIED AS * FOLLOWS: * FTEXT X'<LENGTH> (LENGTH I HEX NOTATION) * THE PROCEDURE WILL DELETE THE UNUSABLE LENGTH (01) * AND INSERT DATA FROM THE SPECIFIED STRING, WITH * THE LENGTH THAT WAS SPECIFIED IN THE FORMAT AS DATA * THE INSERTED DATA WILL NOW LOOK LIKE A FTEXT * SET LENGTH = EDITBUF-1DVS. 731 MOVE GSWBIN6,=W'731' MOVE GSWBIN7,T TEXTNR MOVE GSWBIN8,CBIN0 MOVE GSWSTR1,=X'C301' IDENT FOR FTEXT FMOD10 MATCH EDITBUF,GSWBIN8,GSWBIN6,GSWSTR1,CBIN0,CBIN1 BNOK FMOD95 ADD GSWBIN8,CBIN1 LENGTH (01 OR NN) MOVE GSWBIN6,=W'731' SUB GSWBIN6,GSWBIN8 COMPUTE NEW LENGTH FOR MATCH SUB GSWBIN7,CBIN1 BNZ FMOD10 REPEAT UNTIL FOUND XCOPY GSWBIN7,CBIN1,CBIN1,EDITBUF,GSWBIN8 CBNE GSWBIN7,CBIN1,FMOD95 DLETE EDITBUF,GSWBIN8,CBIN1 AND DELETE IT XCOPY GSWBIN7,CBIN1,CBIN1,EDITBUF,GSWBIN8 ADD GSWBIN8,CBIN1 INSRT EDITBUF,GSWBIN8,GSWBIN7,S,CBIN0 INSERT ITEM CMP CBIN0,CBIN0 B FMOD99 FMOD95 CMP CBIN0,CBIN1 FMOD99 RET PEND EJECT FSOLVE PROC * THE PROCEDURE SOLVES UNEDITED TEXT FROM * BUNDTCHECK AND BUNDTGIRO. * UNSOLVED TEXTS ARE IDENTIFIED BY X'C301XX' MOVE GSWBIN7,=W'731' MOVE SPINPUT,=' ' MOVE GSWSTR2,=X'C301' MOVE GSWBIN8,CBIN0 FSOLV10 MATCH EDITBUF,GSWBIN8,GSWBIN7,GSWSTR2,CBIN0,CBIN2 BNOK FSOLV90 NO MORE LEFT FSOLV15 ADD GSWBIN8,CBIN1 DLETE EDITBUF,GSWBIN8,CBIN1 MOVE GSWBIN7,CBIN0 XCOPY GSWBIN7,CBIN1,CBIN1,EDITBUF,GSWBIN8 ADD GSWBIN8,CBIN1 INSRT EDITBUF,GSWBIN8,GSWBIN7,SPINPUT,CBIN0 MOVE GSWBIN7,=W'731' SUB GSWBIN7,GSWBIN8 B FSOLV10 FSOLV90 RET PEND EJECT NEWLIN PROC P MOVE GSWBIN5,P NEWL10 CBE GSWBIN5,CBIN0,NEWL90 PERF GENWRF,GTHCDEV,FNEWLIN SUB GSWBIN5,CBIN1 CBG GSWBIN5,CBIN0,NEWL10 NEWL90 RET PEND EJECT * * * PRTADJ PROC * THE PROCEDURE ASKS IF THE FORMULAR * HAS BEEN ADJESTED CORRECTLY, AND * SETS THE CONDITION REGISTER ACCORDINGLY. PRT010 SET SPPROMPT ATTFMT FRMADJ PERF SPCLRA IB SPBINW2,PRT010,PRT020,PRT030,PRT040 B PRT010 PRT020 MAK CMP CBIN1,CBIN0 B PRT090 PRT030 ENTER CMP CBIN0,CBIN0 B PRT090 PRT040 CREDIT CMP CBIN0,CBIN1 PRT090 RET PEND EJECT WCHECK PROC P * * THE PROCEDURE PRODUCES A STRAKS-CHECK OR * A TRANSACTIONRECORD * TBT GTBDTFLG,WCH010 BUNDTCHECK ? TBT GTSTRFLG,WCH050 STRAKSCHECK ? B WCH092 WCH010 BUNDTCHECK TBT GTCYFLG,WCH011 TBT TTCY2FLG,WCH092 TBF TTCY1FLG,WCH015 MOVE GTDUPF(CBIN1),TTARKSAV MOVE GTDUPF(CBIN4),TTCYKTOT B WCH015 WCH011 TBT TTCY1FLG,WCH092 WCH015 PERF WAITF,CLOCK WAIT FOR EXCL ACCESS MOVE GTLEVNR,GTDUPF(CBIN2) PERF IDXGET,GTLEVNR,GSWBIN4,GSWBIN5 TRY TO FIND LEV BNOK WCH020 ERROR OR NOT FOUND PERF TRGETF,GSWBIN7 GET A FREE RECORD BNOK WCH062 MOVE GTLEVNR,GTDUPF(CBIN2) PERF VARRD TRY TO FIND LEV BNOK WCH020 ERROR OR NOT FOUND CLEAR GTSWFLAG PERF TRINS,GSWBIN7 BNOK WCH062 B WCH090 WCH020 PERF SPLIN8,CBIN11,CBIN1 CLEAR CLOCK DELAY CBIN1 B WCH010 WCH050 STRAKSCHECK PERF WAITF,CLOCK MOVE GTLEVNR,GTDUPF(CBIN2) PERF VARRD BOK WCH051 SET TTLEVFLG WCH051 TBT GTCYFLG,WCH060 CYKEL/STABEL TBT TTCY2FLG,WCH057 TBF TTCY1FLG,WCH055 MOVE GTDUPF(CBIN4),TTCYKTOT WCH055 PERF WCHUPD PERF WSTRCH,CBIN0 WRITE STRAKSCHECK BNOK WCH095 WCH057 PERF LEVRD BOK WCH059 CLEAR CLOCK WCH058 MOVE GTRETUR,CBIN3 PERF LEVIN BNOK WCH058 PERF WAITF,CLOCK PERF WSTRCH,CBIN1 BNOK WCH095 B WCH090 WCH059 PERF WSTRCH,CBIN1 BNOK WCH095 B WCH080 WCH060 TBT TTCY2FLG,WCH070 B WCH090 WCH062 CLEAR CLOCK B WCH095 WCH070 STABEL PERF WCHUPD UPDATE VAR.INFO PERF WSTRCH,CBIN0 EDIT CHECKLINE * SKRIV CHECK HVIS FYLDT OP WCH080 PERF VARWRT BNOK WCH095 WCH090 CLEAR CLOCK WCH092 CMP CBIN0,CBIN0 B WCH099 WCH095 CLEAR CLOCK CMP CBIN0,CBIN1 WCH099 RET PEND EJECT FRMADJ FRMT FSL FTEXT 'INDSTILLING OK? ' FNL FKI 1,MAXL=1 FMEL 'X',GSWBCD1 FMEND FNEWLIN FRMT FNL FMEND END